tcmodules.pas 618 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149415041514152415341544155415641574158415941604161416241634164416541664167416841694170417141724173417441754176417741784179418041814182418341844185418641874188418941904191419241934194419541964197419841994200420142024203420442054206420742084209421042114212421342144215421642174218421942204221422242234224422542264227422842294230423142324233423442354236423742384239424042414242424342444245424642474248424942504251425242534254425542564257425842594260426142624263426442654266426742684269427042714272427342744275427642774278427942804281428242834284428542864287428842894290429142924293429442954296429742984299430043014302430343044305430643074308430943104311431243134314431543164317431843194320432143224323432443254326432743284329433043314332433343344335433643374338433943404341434243434344434543464347434843494350435143524353435443554356435743584359436043614362436343644365436643674368436943704371437243734374437543764377437843794380438143824383438443854386438743884389439043914392439343944395439643974398439944004401440244034404440544064407440844094410441144124413441444154416441744184419442044214422442344244425442644274428442944304431443244334434443544364437443844394440444144424443444444454446444744484449445044514452445344544455445644574458445944604461446244634464446544664467446844694470447144724473447444754476447744784479448044814482448344844485448644874488448944904491449244934494449544964497449844994500450145024503450445054506450745084509451045114512451345144515451645174518451945204521452245234524452545264527452845294530453145324533453445354536453745384539454045414542454345444545454645474548454945504551455245534554455545564557455845594560456145624563456445654566456745684569457045714572457345744575457645774578457945804581458245834584458545864587458845894590459145924593459445954596459745984599460046014602460346044605460646074608460946104611461246134614461546164617461846194620462146224623462446254626462746284629463046314632463346344635463646374638463946404641464246434644464546464647464846494650465146524653465446554656465746584659466046614662466346644665466646674668466946704671467246734674467546764677467846794680468146824683468446854686468746884689469046914692469346944695469646974698469947004701470247034704470547064707470847094710471147124713471447154716471747184719472047214722472347244725472647274728472947304731473247334734473547364737473847394740474147424743474447454746474747484749475047514752475347544755475647574758475947604761476247634764476547664767476847694770477147724773477447754776477747784779478047814782478347844785478647874788478947904791479247934794479547964797479847994800480148024803480448054806480748084809481048114812481348144815481648174818481948204821482248234824482548264827482848294830483148324833483448354836483748384839484048414842484348444845484648474848484948504851485248534854485548564857485848594860486148624863486448654866486748684869487048714872487348744875487648774878487948804881488248834884488548864887488848894890489148924893489448954896489748984899490049014902490349044905490649074908490949104911491249134914491549164917491849194920492149224923492449254926492749284929493049314932493349344935493649374938493949404941494249434944494549464947494849494950495149524953495449554956495749584959496049614962496349644965496649674968496949704971497249734974497549764977497849794980498149824983498449854986498749884989499049914992499349944995499649974998499950005001500250035004500550065007500850095010501150125013501450155016501750185019502050215022502350245025502650275028502950305031503250335034503550365037503850395040504150425043504450455046504750485049505050515052505350545055505650575058505950605061506250635064506550665067506850695070507150725073507450755076507750785079508050815082508350845085508650875088508950905091509250935094509550965097509850995100510151025103510451055106510751085109511051115112511351145115511651175118511951205121512251235124512551265127512851295130513151325133513451355136513751385139514051415142514351445145514651475148514951505151515251535154515551565157515851595160516151625163516451655166516751685169517051715172517351745175517651775178517951805181518251835184518551865187518851895190519151925193519451955196519751985199520052015202520352045205520652075208520952105211521252135214521552165217521852195220522152225223522452255226522752285229523052315232523352345235523652375238523952405241524252435244524552465247524852495250525152525253525452555256525752585259526052615262526352645265526652675268526952705271527252735274527552765277527852795280528152825283528452855286528752885289529052915292529352945295529652975298529953005301530253035304530553065307530853095310531153125313531453155316531753185319532053215322532353245325532653275328532953305331533253335334533553365337533853395340534153425343534453455346534753485349535053515352535353545355535653575358535953605361536253635364536553665367536853695370537153725373537453755376537753785379538053815382538353845385538653875388538953905391539253935394539553965397539853995400540154025403540454055406540754085409541054115412541354145415541654175418541954205421542254235424542554265427542854295430543154325433543454355436543754385439544054415442544354445445544654475448544954505451545254535454545554565457545854595460546154625463546454655466546754685469547054715472547354745475547654775478547954805481548254835484548554865487548854895490549154925493549454955496549754985499550055015502550355045505550655075508550955105511551255135514551555165517551855195520552155225523552455255526552755285529553055315532553355345535553655375538553955405541554255435544554555465547554855495550555155525553555455555556555755585559556055615562556355645565556655675568556955705571557255735574557555765577557855795580558155825583558455855586558755885589559055915592559355945595559655975598559956005601560256035604560556065607560856095610561156125613561456155616561756185619562056215622562356245625562656275628562956305631563256335634563556365637563856395640564156425643564456455646564756485649565056515652565356545655565656575658565956605661566256635664566556665667566856695670567156725673567456755676567756785679568056815682568356845685568656875688568956905691569256935694569556965697569856995700570157025703570457055706570757085709571057115712571357145715571657175718571957205721572257235724572557265727572857295730573157325733573457355736573757385739574057415742574357445745574657475748574957505751575257535754575557565757575857595760576157625763576457655766576757685769577057715772577357745775577657775778577957805781578257835784578557865787578857895790579157925793579457955796579757985799580058015802580358045805580658075808580958105811581258135814581558165817581858195820582158225823582458255826582758285829583058315832583358345835583658375838583958405841584258435844584558465847584858495850585158525853585458555856585758585859586058615862586358645865586658675868586958705871587258735874587558765877587858795880588158825883588458855886588758885889589058915892589358945895589658975898589959005901590259035904590559065907590859095910591159125913591459155916591759185919592059215922592359245925592659275928592959305931593259335934593559365937593859395940594159425943594459455946594759485949595059515952595359545955595659575958595959605961596259635964596559665967596859695970597159725973597459755976597759785979598059815982598359845985598659875988598959905991599259935994599559965997599859996000600160026003600460056006600760086009601060116012601360146015601660176018601960206021602260236024602560266027602860296030603160326033603460356036603760386039604060416042604360446045604660476048604960506051605260536054605560566057605860596060606160626063606460656066606760686069607060716072607360746075607660776078607960806081608260836084608560866087608860896090609160926093609460956096609760986099610061016102610361046105610661076108610961106111611261136114611561166117611861196120612161226123612461256126612761286129613061316132613361346135613661376138613961406141614261436144614561466147614861496150615161526153615461556156615761586159616061616162616361646165616661676168616961706171617261736174617561766177617861796180618161826183618461856186618761886189619061916192619361946195619661976198619962006201620262036204620562066207620862096210621162126213621462156216621762186219622062216222622362246225622662276228622962306231623262336234623562366237623862396240624162426243624462456246624762486249625062516252625362546255625662576258625962606261626262636264626562666267626862696270627162726273627462756276627762786279628062816282628362846285628662876288628962906291629262936294629562966297629862996300630163026303630463056306630763086309631063116312631363146315631663176318631963206321632263236324632563266327632863296330633163326333633463356336633763386339634063416342634363446345634663476348634963506351635263536354635563566357635863596360636163626363636463656366636763686369637063716372637363746375637663776378637963806381638263836384638563866387638863896390639163926393639463956396639763986399640064016402640364046405640664076408640964106411641264136414641564166417641864196420642164226423642464256426642764286429643064316432643364346435643664376438643964406441644264436444644564466447644864496450645164526453645464556456645764586459646064616462646364646465646664676468646964706471647264736474647564766477647864796480648164826483648464856486648764886489649064916492649364946495649664976498649965006501650265036504650565066507650865096510651165126513651465156516651765186519652065216522652365246525652665276528652965306531653265336534653565366537653865396540654165426543654465456546654765486549655065516552655365546555655665576558655965606561656265636564656565666567656865696570657165726573657465756576657765786579658065816582658365846585658665876588658965906591659265936594659565966597659865996600660166026603660466056606660766086609661066116612661366146615661666176618661966206621662266236624662566266627662866296630663166326633663466356636663766386639664066416642664366446645664666476648664966506651665266536654665566566657665866596660666166626663666466656666666766686669667066716672667366746675667666776678667966806681668266836684668566866687668866896690669166926693669466956696669766986699670067016702670367046705670667076708670967106711671267136714671567166717671867196720672167226723672467256726672767286729673067316732673367346735673667376738673967406741674267436744674567466747674867496750675167526753675467556756675767586759676067616762676367646765676667676768676967706771677267736774677567766777677867796780678167826783678467856786678767886789679067916792679367946795679667976798679968006801680268036804680568066807680868096810681168126813681468156816681768186819682068216822682368246825682668276828682968306831683268336834683568366837683868396840684168426843684468456846684768486849685068516852685368546855685668576858685968606861686268636864686568666867686868696870687168726873687468756876687768786879688068816882688368846885688668876888688968906891689268936894689568966897689868996900690169026903690469056906690769086909691069116912691369146915691669176918691969206921692269236924692569266927692869296930693169326933693469356936693769386939694069416942694369446945694669476948694969506951695269536954695569566957695869596960696169626963696469656966696769686969697069716972697369746975697669776978697969806981698269836984698569866987698869896990699169926993699469956996699769986999700070017002700370047005700670077008700970107011701270137014701570167017701870197020702170227023702470257026702770287029703070317032703370347035703670377038703970407041704270437044704570467047704870497050705170527053705470557056705770587059706070617062706370647065706670677068706970707071707270737074707570767077707870797080708170827083708470857086708770887089709070917092709370947095709670977098709971007101710271037104710571067107710871097110711171127113711471157116711771187119712071217122712371247125712671277128712971307131713271337134713571367137713871397140714171427143714471457146714771487149715071517152715371547155715671577158715971607161716271637164716571667167716871697170717171727173717471757176717771787179718071817182718371847185718671877188718971907191719271937194719571967197719871997200720172027203720472057206720772087209721072117212721372147215721672177218721972207221722272237224722572267227722872297230723172327233723472357236723772387239724072417242724372447245724672477248724972507251725272537254725572567257725872597260726172627263726472657266726772687269727072717272727372747275727672777278727972807281728272837284728572867287728872897290729172927293729472957296729772987299730073017302730373047305730673077308730973107311731273137314731573167317731873197320732173227323732473257326732773287329733073317332733373347335733673377338733973407341734273437344734573467347734873497350735173527353735473557356735773587359736073617362736373647365736673677368736973707371737273737374737573767377737873797380738173827383738473857386738773887389739073917392739373947395739673977398739974007401740274037404740574067407740874097410741174127413741474157416741774187419742074217422742374247425742674277428742974307431743274337434743574367437743874397440744174427443744474457446744774487449745074517452745374547455745674577458745974607461746274637464746574667467746874697470747174727473747474757476747774787479748074817482748374847485748674877488748974907491749274937494749574967497749874997500750175027503750475057506750775087509751075117512751375147515751675177518751975207521752275237524752575267527752875297530753175327533753475357536753775387539754075417542754375447545754675477548754975507551755275537554755575567557755875597560756175627563756475657566756775687569757075717572757375747575757675777578757975807581758275837584758575867587758875897590759175927593759475957596759775987599760076017602760376047605760676077608760976107611761276137614761576167617761876197620762176227623762476257626762776287629763076317632763376347635763676377638763976407641764276437644764576467647764876497650765176527653765476557656765776587659766076617662766376647665766676677668766976707671767276737674767576767677767876797680768176827683768476857686768776887689769076917692769376947695769676977698769977007701770277037704770577067707770877097710771177127713771477157716771777187719772077217722772377247725772677277728772977307731773277337734773577367737773877397740774177427743774477457746774777487749775077517752775377547755775677577758775977607761776277637764776577667767776877697770777177727773777477757776777777787779778077817782778377847785778677877788778977907791779277937794779577967797779877997800780178027803780478057806780778087809781078117812781378147815781678177818781978207821782278237824782578267827782878297830783178327833783478357836783778387839784078417842784378447845784678477848784978507851785278537854785578567857785878597860786178627863786478657866786778687869787078717872787378747875787678777878787978807881788278837884788578867887788878897890789178927893789478957896789778987899790079017902790379047905790679077908790979107911791279137914791579167917791879197920792179227923792479257926792779287929793079317932793379347935793679377938793979407941794279437944794579467947794879497950795179527953795479557956795779587959796079617962796379647965796679677968796979707971797279737974797579767977797879797980798179827983798479857986798779887989799079917992799379947995799679977998799980008001800280038004800580068007800880098010801180128013801480158016801780188019802080218022802380248025802680278028802980308031803280338034803580368037803880398040804180428043804480458046804780488049805080518052805380548055805680578058805980608061806280638064806580668067806880698070807180728073807480758076807780788079808080818082808380848085808680878088808980908091809280938094809580968097809880998100810181028103810481058106810781088109811081118112811381148115811681178118811981208121812281238124812581268127812881298130813181328133813481358136813781388139814081418142814381448145814681478148814981508151815281538154815581568157815881598160816181628163816481658166816781688169817081718172817381748175817681778178817981808181818281838184818581868187818881898190819181928193819481958196819781988199820082018202820382048205820682078208820982108211821282138214821582168217821882198220822182228223822482258226822782288229823082318232823382348235823682378238823982408241824282438244824582468247824882498250825182528253825482558256825782588259826082618262826382648265826682678268826982708271827282738274827582768277827882798280828182828283828482858286828782888289829082918292829382948295829682978298829983008301830283038304830583068307830883098310831183128313831483158316831783188319832083218322832383248325832683278328832983308331833283338334833583368337833883398340834183428343834483458346834783488349835083518352835383548355835683578358835983608361836283638364836583668367836883698370837183728373837483758376837783788379838083818382838383848385838683878388838983908391839283938394839583968397839883998400840184028403840484058406840784088409841084118412841384148415841684178418841984208421842284238424842584268427842884298430843184328433843484358436843784388439844084418442844384448445844684478448844984508451845284538454845584568457845884598460846184628463846484658466846784688469847084718472847384748475847684778478847984808481848284838484848584868487848884898490849184928493849484958496849784988499850085018502850385048505850685078508850985108511851285138514851585168517851885198520852185228523852485258526852785288529853085318532853385348535853685378538853985408541854285438544854585468547854885498550855185528553855485558556855785588559856085618562856385648565856685678568856985708571857285738574857585768577857885798580858185828583858485858586858785888589859085918592859385948595859685978598859986008601860286038604860586068607860886098610861186128613861486158616861786188619862086218622862386248625862686278628862986308631863286338634863586368637863886398640864186428643864486458646864786488649865086518652865386548655865686578658865986608661866286638664866586668667866886698670867186728673867486758676867786788679868086818682868386848685868686878688868986908691869286938694869586968697869886998700870187028703870487058706870787088709871087118712871387148715871687178718871987208721872287238724872587268727872887298730873187328733873487358736873787388739874087418742874387448745874687478748874987508751875287538754875587568757875887598760876187628763876487658766876787688769877087718772877387748775877687778778877987808781878287838784878587868787878887898790879187928793879487958796879787988799880088018802880388048805880688078808880988108811881288138814881588168817881888198820882188228823882488258826882788288829883088318832883388348835883688378838883988408841884288438844884588468847884888498850885188528853885488558856885788588859886088618862886388648865886688678868886988708871887288738874887588768877887888798880888188828883888488858886888788888889889088918892889388948895889688978898889989008901890289038904890589068907890889098910891189128913891489158916891789188919892089218922892389248925892689278928892989308931893289338934893589368937893889398940894189428943894489458946894789488949895089518952895389548955895689578958895989608961896289638964896589668967896889698970897189728973897489758976897789788979898089818982898389848985898689878988898989908991899289938994899589968997899889999000900190029003900490059006900790089009901090119012901390149015901690179018901990209021902290239024902590269027902890299030903190329033903490359036903790389039904090419042904390449045904690479048904990509051905290539054905590569057905890599060906190629063906490659066906790689069907090719072907390749075907690779078907990809081908290839084908590869087908890899090909190929093909490959096909790989099910091019102910391049105910691079108910991109111911291139114911591169117911891199120912191229123912491259126912791289129913091319132913391349135913691379138913991409141914291439144914591469147914891499150915191529153915491559156915791589159916091619162916391649165916691679168916991709171917291739174917591769177917891799180918191829183918491859186918791889189919091919192919391949195919691979198919992009201920292039204920592069207920892099210921192129213921492159216921792189219922092219222922392249225922692279228922992309231923292339234923592369237923892399240924192429243924492459246924792489249925092519252925392549255925692579258925992609261926292639264926592669267926892699270927192729273927492759276927792789279928092819282928392849285928692879288928992909291929292939294929592969297929892999300930193029303930493059306930793089309931093119312931393149315931693179318931993209321932293239324932593269327932893299330933193329333933493359336933793389339934093419342934393449345934693479348934993509351935293539354935593569357935893599360936193629363936493659366936793689369937093719372937393749375937693779378937993809381938293839384938593869387938893899390939193929393939493959396939793989399940094019402940394049405940694079408940994109411941294139414941594169417941894199420942194229423942494259426942794289429943094319432943394349435943694379438943994409441944294439444944594469447944894499450945194529453945494559456945794589459946094619462946394649465946694679468946994709471947294739474947594769477947894799480948194829483948494859486948794889489949094919492949394949495949694979498949995009501950295039504950595069507950895099510951195129513951495159516951795189519952095219522952395249525952695279528952995309531953295339534953595369537953895399540954195429543954495459546954795489549955095519552955395549555955695579558955995609561956295639564956595669567956895699570957195729573957495759576957795789579958095819582958395849585958695879588958995909591959295939594959595969597959895999600960196029603960496059606960796089609961096119612961396149615961696179618961996209621962296239624962596269627962896299630963196329633963496359636963796389639964096419642964396449645964696479648964996509651965296539654965596569657965896599660966196629663966496659666966796689669967096719672967396749675967696779678967996809681968296839684968596869687968896899690969196929693969496959696969796989699970097019702970397049705970697079708970997109711971297139714971597169717971897199720972197229723972497259726972797289729973097319732973397349735973697379738973997409741974297439744974597469747974897499750975197529753975497559756975797589759976097619762976397649765976697679768976997709771977297739774977597769777977897799780978197829783978497859786978797889789979097919792979397949795979697979798979998009801980298039804980598069807980898099810981198129813981498159816981798189819982098219822982398249825982698279828982998309831983298339834983598369837983898399840984198429843984498459846984798489849985098519852985398549855985698579858985998609861986298639864986598669867986898699870987198729873987498759876987798789879988098819882988398849885988698879888988998909891989298939894989598969897989898999900990199029903990499059906990799089909991099119912991399149915991699179918991999209921992299239924992599269927992899299930993199329933993499359936993799389939994099419942994399449945994699479948994999509951995299539954995599569957995899599960996199629963996499659966996799689969997099719972997399749975997699779978997999809981998299839984998599869987998899899990999199929993999499959996999799989999100001000110002100031000410005100061000710008100091001010011100121001310014100151001610017100181001910020100211002210023100241002510026100271002810029100301003110032100331003410035100361003710038100391004010041100421004310044100451004610047100481004910050100511005210053100541005510056100571005810059100601006110062100631006410065100661006710068100691007010071100721007310074100751007610077100781007910080100811008210083100841008510086100871008810089100901009110092100931009410095100961009710098100991010010101101021010310104101051010610107101081010910110101111011210113101141011510116101171011810119101201012110122101231012410125101261012710128101291013010131101321013310134101351013610137101381013910140101411014210143101441014510146101471014810149101501015110152101531015410155101561015710158101591016010161101621016310164101651016610167101681016910170101711017210173101741017510176101771017810179101801018110182101831018410185101861018710188101891019010191101921019310194101951019610197101981019910200102011020210203102041020510206102071020810209102101021110212102131021410215102161021710218102191022010221102221022310224102251022610227102281022910230102311023210233102341023510236102371023810239102401024110242102431024410245102461024710248102491025010251102521025310254102551025610257102581025910260102611026210263102641026510266102671026810269102701027110272102731027410275102761027710278102791028010281102821028310284102851028610287102881028910290102911029210293102941029510296102971029810299103001030110302103031030410305103061030710308103091031010311103121031310314103151031610317103181031910320103211032210323103241032510326103271032810329103301033110332103331033410335103361033710338103391034010341103421034310344103451034610347103481034910350103511035210353103541035510356103571035810359103601036110362103631036410365103661036710368103691037010371103721037310374103751037610377103781037910380103811038210383103841038510386103871038810389103901039110392103931039410395103961039710398103991040010401104021040310404104051040610407104081040910410104111041210413104141041510416104171041810419104201042110422104231042410425104261042710428104291043010431104321043310434104351043610437104381043910440104411044210443104441044510446104471044810449104501045110452104531045410455104561045710458104591046010461104621046310464104651046610467104681046910470104711047210473104741047510476104771047810479104801048110482104831048410485104861048710488104891049010491104921049310494104951049610497104981049910500105011050210503105041050510506105071050810509105101051110512105131051410515105161051710518105191052010521105221052310524105251052610527105281052910530105311053210533105341053510536105371053810539105401054110542105431054410545105461054710548105491055010551105521055310554105551055610557105581055910560105611056210563105641056510566105671056810569105701057110572105731057410575105761057710578105791058010581105821058310584105851058610587105881058910590105911059210593105941059510596105971059810599106001060110602106031060410605106061060710608106091061010611106121061310614106151061610617106181061910620106211062210623106241062510626106271062810629106301063110632106331063410635106361063710638106391064010641106421064310644106451064610647106481064910650106511065210653106541065510656106571065810659106601066110662106631066410665106661066710668106691067010671106721067310674106751067610677106781067910680106811068210683106841068510686106871068810689106901069110692106931069410695106961069710698106991070010701107021070310704107051070610707107081070910710107111071210713107141071510716107171071810719107201072110722107231072410725107261072710728107291073010731107321073310734107351073610737107381073910740107411074210743107441074510746107471074810749107501075110752107531075410755107561075710758107591076010761107621076310764107651076610767107681076910770107711077210773107741077510776107771077810779107801078110782107831078410785107861078710788107891079010791107921079310794107951079610797107981079910800108011080210803108041080510806108071080810809108101081110812108131081410815108161081710818108191082010821108221082310824108251082610827108281082910830108311083210833108341083510836108371083810839108401084110842108431084410845108461084710848108491085010851108521085310854108551085610857108581085910860108611086210863108641086510866108671086810869108701087110872108731087410875108761087710878108791088010881108821088310884108851088610887108881088910890108911089210893108941089510896108971089810899109001090110902109031090410905109061090710908109091091010911109121091310914109151091610917109181091910920109211092210923109241092510926109271092810929109301093110932109331093410935109361093710938109391094010941109421094310944109451094610947109481094910950109511095210953109541095510956109571095810959109601096110962109631096410965109661096710968109691097010971109721097310974109751097610977109781097910980109811098210983109841098510986109871098810989109901099110992109931099410995109961099710998109991100011001110021100311004110051100611007110081100911010110111101211013110141101511016110171101811019110201102111022110231102411025110261102711028110291103011031110321103311034110351103611037110381103911040110411104211043110441104511046110471104811049110501105111052110531105411055110561105711058110591106011061110621106311064110651106611067110681106911070110711107211073110741107511076110771107811079110801108111082110831108411085110861108711088110891109011091110921109311094110951109611097110981109911100111011110211103111041110511106111071110811109111101111111112111131111411115111161111711118111191112011121111221112311124111251112611127111281112911130111311113211133111341113511136111371113811139111401114111142111431114411145111461114711148111491115011151111521115311154111551115611157111581115911160111611116211163111641116511166111671116811169111701117111172111731117411175111761117711178111791118011181111821118311184111851118611187111881118911190111911119211193111941119511196111971119811199112001120111202112031120411205112061120711208112091121011211112121121311214112151121611217112181121911220112211122211223112241122511226112271122811229112301123111232112331123411235112361123711238112391124011241112421124311244112451124611247112481124911250112511125211253112541125511256112571125811259112601126111262112631126411265112661126711268112691127011271112721127311274112751127611277112781127911280112811128211283112841128511286112871128811289112901129111292112931129411295112961129711298112991130011301113021130311304113051130611307113081130911310113111131211313113141131511316113171131811319113201132111322113231132411325113261132711328113291133011331113321133311334113351133611337113381133911340113411134211343113441134511346113471134811349113501135111352113531135411355113561135711358113591136011361113621136311364113651136611367113681136911370113711137211373113741137511376113771137811379113801138111382113831138411385113861138711388113891139011391113921139311394113951139611397113981139911400114011140211403114041140511406114071140811409114101141111412114131141411415114161141711418114191142011421114221142311424114251142611427114281142911430114311143211433114341143511436114371143811439114401144111442114431144411445114461144711448114491145011451114521145311454114551145611457114581145911460114611146211463114641146511466114671146811469114701147111472114731147411475114761147711478114791148011481114821148311484114851148611487114881148911490114911149211493114941149511496114971149811499115001150111502115031150411505115061150711508115091151011511115121151311514115151151611517115181151911520115211152211523115241152511526115271152811529115301153111532115331153411535115361153711538115391154011541115421154311544115451154611547115481154911550115511155211553115541155511556115571155811559115601156111562115631156411565115661156711568115691157011571115721157311574115751157611577115781157911580115811158211583115841158511586115871158811589115901159111592115931159411595115961159711598115991160011601116021160311604116051160611607116081160911610116111161211613116141161511616116171161811619116201162111622116231162411625116261162711628116291163011631116321163311634116351163611637116381163911640116411164211643116441164511646116471164811649116501165111652116531165411655116561165711658116591166011661116621166311664116651166611667116681166911670116711167211673116741167511676116771167811679116801168111682116831168411685116861168711688116891169011691116921169311694116951169611697116981169911700117011170211703117041170511706117071170811709117101171111712117131171411715117161171711718117191172011721117221172311724117251172611727117281172911730117311173211733117341173511736117371173811739117401174111742117431174411745117461174711748117491175011751117521175311754117551175611757117581175911760117611176211763117641176511766117671176811769117701177111772117731177411775117761177711778117791178011781117821178311784117851178611787117881178911790117911179211793117941179511796117971179811799118001180111802118031180411805118061180711808118091181011811118121181311814118151181611817118181181911820118211182211823118241182511826118271182811829118301183111832118331183411835118361183711838118391184011841118421184311844118451184611847118481184911850118511185211853118541185511856118571185811859118601186111862118631186411865118661186711868118691187011871118721187311874118751187611877118781187911880118811188211883118841188511886118871188811889118901189111892118931189411895118961189711898118991190011901119021190311904119051190611907119081190911910119111191211913119141191511916119171191811919119201192111922119231192411925119261192711928119291193011931119321193311934119351193611937119381193911940119411194211943119441194511946119471194811949119501195111952119531195411955119561195711958119591196011961119621196311964119651196611967119681196911970119711197211973119741197511976119771197811979119801198111982119831198411985119861198711988119891199011991119921199311994119951199611997119981199912000120011200212003120041200512006120071200812009120101201112012120131201412015120161201712018120191202012021120221202312024120251202612027120281202912030120311203212033120341203512036120371203812039120401204112042120431204412045120461204712048120491205012051120521205312054120551205612057120581205912060120611206212063120641206512066120671206812069120701207112072120731207412075120761207712078120791208012081120821208312084120851208612087120881208912090120911209212093120941209512096120971209812099121001210112102121031210412105121061210712108121091211012111121121211312114121151211612117121181211912120121211212212123121241212512126121271212812129121301213112132121331213412135121361213712138121391214012141121421214312144121451214612147121481214912150121511215212153121541215512156121571215812159121601216112162121631216412165121661216712168121691217012171121721217312174121751217612177121781217912180121811218212183121841218512186121871218812189121901219112192121931219412195121961219712198121991220012201122021220312204122051220612207122081220912210122111221212213122141221512216122171221812219122201222112222122231222412225122261222712228122291223012231122321223312234122351223612237122381223912240122411224212243122441224512246122471224812249122501225112252122531225412255122561225712258122591226012261122621226312264122651226612267122681226912270122711227212273122741227512276122771227812279122801228112282122831228412285122861228712288122891229012291122921229312294122951229612297122981229912300123011230212303123041230512306123071230812309123101231112312123131231412315123161231712318123191232012321123221232312324123251232612327123281232912330123311233212333123341233512336123371233812339123401234112342123431234412345123461234712348123491235012351123521235312354123551235612357123581235912360123611236212363123641236512366123671236812369123701237112372123731237412375123761237712378123791238012381123821238312384123851238612387123881238912390123911239212393123941239512396123971239812399124001240112402124031240412405124061240712408124091241012411124121241312414124151241612417124181241912420124211242212423124241242512426124271242812429124301243112432124331243412435124361243712438124391244012441124421244312444124451244612447124481244912450124511245212453124541245512456124571245812459124601246112462124631246412465124661246712468124691247012471124721247312474124751247612477124781247912480124811248212483124841248512486124871248812489124901249112492124931249412495124961249712498124991250012501125021250312504125051250612507125081250912510125111251212513125141251512516125171251812519125201252112522125231252412525125261252712528125291253012531125321253312534125351253612537125381253912540125411254212543125441254512546125471254812549125501255112552125531255412555125561255712558125591256012561125621256312564125651256612567125681256912570125711257212573125741257512576125771257812579125801258112582125831258412585125861258712588125891259012591125921259312594125951259612597125981259912600126011260212603126041260512606126071260812609126101261112612126131261412615126161261712618126191262012621126221262312624126251262612627126281262912630126311263212633126341263512636126371263812639126401264112642126431264412645126461264712648126491265012651126521265312654126551265612657126581265912660126611266212663126641266512666126671266812669126701267112672126731267412675126761267712678126791268012681126821268312684126851268612687126881268912690126911269212693126941269512696126971269812699127001270112702127031270412705127061270712708127091271012711127121271312714127151271612717127181271912720127211272212723127241272512726127271272812729127301273112732127331273412735127361273712738127391274012741127421274312744127451274612747127481274912750127511275212753127541275512756127571275812759127601276112762127631276412765127661276712768127691277012771127721277312774127751277612777127781277912780127811278212783127841278512786127871278812789127901279112792127931279412795127961279712798127991280012801128021280312804128051280612807128081280912810128111281212813128141281512816128171281812819128201282112822128231282412825128261282712828128291283012831128321283312834128351283612837128381283912840128411284212843128441284512846128471284812849128501285112852128531285412855128561285712858128591286012861128621286312864128651286612867128681286912870128711287212873128741287512876128771287812879128801288112882128831288412885128861288712888128891289012891128921289312894128951289612897128981289912900129011290212903129041290512906129071290812909129101291112912129131291412915129161291712918129191292012921129221292312924129251292612927129281292912930129311293212933129341293512936129371293812939129401294112942129431294412945129461294712948129491295012951129521295312954129551295612957129581295912960129611296212963129641296512966129671296812969129701297112972129731297412975129761297712978129791298012981129821298312984129851298612987129881298912990129911299212993129941299512996129971299812999130001300113002130031300413005130061300713008130091301013011130121301313014130151301613017130181301913020130211302213023130241302513026130271302813029130301303113032130331303413035130361303713038130391304013041130421304313044130451304613047130481304913050130511305213053130541305513056130571305813059130601306113062130631306413065130661306713068130691307013071130721307313074130751307613077130781307913080130811308213083130841308513086130871308813089130901309113092130931309413095130961309713098130991310013101131021310313104131051310613107131081310913110131111311213113131141311513116131171311813119131201312113122131231312413125131261312713128131291313013131131321313313134131351313613137131381313913140131411314213143131441314513146131471314813149131501315113152131531315413155131561315713158131591316013161131621316313164131651316613167131681316913170131711317213173131741317513176131771317813179131801318113182131831318413185131861318713188131891319013191131921319313194131951319613197131981319913200132011320213203132041320513206132071320813209132101321113212132131321413215132161321713218132191322013221132221322313224132251322613227132281322913230132311323213233132341323513236132371323813239132401324113242132431324413245132461324713248132491325013251132521325313254132551325613257132581325913260132611326213263132641326513266132671326813269132701327113272132731327413275132761327713278132791328013281132821328313284132851328613287132881328913290132911329213293132941329513296132971329813299133001330113302133031330413305133061330713308133091331013311133121331313314133151331613317133181331913320133211332213323133241332513326133271332813329133301333113332133331333413335133361333713338133391334013341133421334313344133451334613347133481334913350133511335213353133541335513356133571335813359133601336113362133631336413365133661336713368133691337013371133721337313374133751337613377133781337913380133811338213383133841338513386133871338813389133901339113392133931339413395133961339713398133991340013401134021340313404134051340613407134081340913410134111341213413134141341513416134171341813419134201342113422134231342413425134261342713428134291343013431134321343313434134351343613437134381343913440134411344213443134441344513446134471344813449134501345113452134531345413455134561345713458134591346013461134621346313464134651346613467134681346913470134711347213473134741347513476134771347813479134801348113482134831348413485134861348713488134891349013491134921349313494134951349613497134981349913500135011350213503135041350513506135071350813509135101351113512135131351413515135161351713518135191352013521135221352313524135251352613527135281352913530135311353213533135341353513536135371353813539135401354113542135431354413545135461354713548135491355013551135521355313554135551355613557135581355913560135611356213563135641356513566135671356813569135701357113572135731357413575135761357713578135791358013581135821358313584135851358613587135881358913590135911359213593135941359513596135971359813599136001360113602136031360413605136061360713608136091361013611136121361313614136151361613617136181361913620136211362213623136241362513626136271362813629136301363113632136331363413635136361363713638136391364013641136421364313644136451364613647136481364913650136511365213653136541365513656136571365813659136601366113662136631366413665136661366713668136691367013671136721367313674136751367613677136781367913680136811368213683136841368513686136871368813689136901369113692136931369413695136961369713698136991370013701137021370313704137051370613707137081370913710137111371213713137141371513716137171371813719137201372113722137231372413725137261372713728137291373013731137321373313734137351373613737137381373913740137411374213743137441374513746137471374813749137501375113752137531375413755137561375713758137591376013761137621376313764137651376613767137681376913770137711377213773137741377513776137771377813779137801378113782137831378413785137861378713788137891379013791137921379313794137951379613797137981379913800138011380213803138041380513806138071380813809138101381113812138131381413815138161381713818138191382013821138221382313824138251382613827138281382913830138311383213833138341383513836138371383813839138401384113842138431384413845138461384713848138491385013851138521385313854138551385613857138581385913860138611386213863138641386513866138671386813869138701387113872138731387413875138761387713878138791388013881138821388313884138851388613887138881388913890138911389213893138941389513896138971389813899139001390113902139031390413905139061390713908139091391013911139121391313914139151391613917139181391913920139211392213923139241392513926139271392813929139301393113932139331393413935139361393713938139391394013941139421394313944139451394613947139481394913950139511395213953139541395513956139571395813959139601396113962139631396413965139661396713968139691397013971139721397313974139751397613977139781397913980139811398213983139841398513986139871398813989139901399113992139931399413995139961399713998139991400014001140021400314004140051400614007140081400914010140111401214013140141401514016140171401814019140201402114022140231402414025140261402714028140291403014031140321403314034140351403614037140381403914040140411404214043140441404514046140471404814049140501405114052140531405414055140561405714058140591406014061140621406314064140651406614067140681406914070140711407214073140741407514076140771407814079140801408114082140831408414085140861408714088140891409014091140921409314094140951409614097140981409914100141011410214103141041410514106141071410814109141101411114112141131411414115141161411714118141191412014121141221412314124141251412614127141281412914130141311413214133141341413514136141371413814139141401414114142141431414414145141461414714148141491415014151141521415314154141551415614157141581415914160141611416214163141641416514166141671416814169141701417114172141731417414175141761417714178141791418014181141821418314184141851418614187141881418914190141911419214193141941419514196141971419814199142001420114202142031420414205142061420714208142091421014211142121421314214142151421614217142181421914220142211422214223142241422514226142271422814229142301423114232142331423414235142361423714238142391424014241142421424314244142451424614247142481424914250142511425214253142541425514256142571425814259142601426114262142631426414265142661426714268142691427014271142721427314274142751427614277142781427914280142811428214283142841428514286142871428814289142901429114292142931429414295142961429714298142991430014301143021430314304143051430614307143081430914310143111431214313143141431514316143171431814319143201432114322143231432414325143261432714328143291433014331143321433314334143351433614337143381433914340143411434214343143441434514346143471434814349143501435114352143531435414355143561435714358143591436014361143621436314364143651436614367143681436914370143711437214373143741437514376143771437814379143801438114382143831438414385143861438714388143891439014391143921439314394143951439614397143981439914400144011440214403144041440514406144071440814409144101441114412144131441414415144161441714418144191442014421144221442314424144251442614427144281442914430144311443214433144341443514436144371443814439144401444114442144431444414445144461444714448144491445014451144521445314454144551445614457144581445914460144611446214463144641446514466144671446814469144701447114472144731447414475144761447714478144791448014481144821448314484144851448614487144881448914490144911449214493144941449514496144971449814499145001450114502145031450414505145061450714508145091451014511145121451314514145151451614517145181451914520145211452214523145241452514526145271452814529145301453114532145331453414535145361453714538145391454014541145421454314544145451454614547145481454914550145511455214553145541455514556145571455814559145601456114562145631456414565145661456714568145691457014571145721457314574145751457614577145781457914580145811458214583145841458514586145871458814589145901459114592145931459414595145961459714598145991460014601146021460314604146051460614607146081460914610146111461214613146141461514616146171461814619146201462114622146231462414625146261462714628146291463014631146321463314634146351463614637146381463914640146411464214643146441464514646146471464814649146501465114652146531465414655146561465714658146591466014661146621466314664146651466614667146681466914670146711467214673146741467514676146771467814679146801468114682146831468414685146861468714688146891469014691146921469314694146951469614697146981469914700147011470214703147041470514706147071470814709147101471114712147131471414715147161471714718147191472014721147221472314724147251472614727147281472914730147311473214733147341473514736147371473814739147401474114742147431474414745147461474714748147491475014751147521475314754147551475614757147581475914760147611476214763147641476514766147671476814769147701477114772147731477414775147761477714778147791478014781147821478314784147851478614787147881478914790147911479214793147941479514796147971479814799148001480114802148031480414805148061480714808148091481014811148121481314814148151481614817148181481914820148211482214823148241482514826148271482814829148301483114832148331483414835148361483714838148391484014841148421484314844148451484614847148481484914850148511485214853148541485514856148571485814859148601486114862148631486414865148661486714868148691487014871148721487314874148751487614877148781487914880148811488214883148841488514886148871488814889148901489114892148931489414895148961489714898148991490014901149021490314904149051490614907149081490914910149111491214913149141491514916149171491814919149201492114922149231492414925149261492714928149291493014931149321493314934149351493614937149381493914940149411494214943149441494514946149471494814949149501495114952149531495414955149561495714958149591496014961149621496314964149651496614967149681496914970149711497214973149741497514976149771497814979149801498114982149831498414985149861498714988149891499014991149921499314994149951499614997149981499915000150011500215003150041500515006150071500815009150101501115012150131501415015150161501715018150191502015021150221502315024150251502615027150281502915030150311503215033150341503515036150371503815039150401504115042150431504415045150461504715048150491505015051150521505315054150551505615057150581505915060150611506215063150641506515066150671506815069150701507115072150731507415075150761507715078150791508015081150821508315084150851508615087150881508915090150911509215093150941509515096150971509815099151001510115102151031510415105151061510715108151091511015111151121511315114151151511615117151181511915120151211512215123151241512515126151271512815129151301513115132151331513415135151361513715138151391514015141151421514315144151451514615147151481514915150151511515215153151541515515156151571515815159151601516115162151631516415165151661516715168151691517015171151721517315174151751517615177151781517915180151811518215183151841518515186151871518815189151901519115192151931519415195151961519715198151991520015201152021520315204152051520615207152081520915210152111521215213152141521515216152171521815219152201522115222152231522415225152261522715228152291523015231152321523315234152351523615237152381523915240152411524215243152441524515246152471524815249152501525115252152531525415255152561525715258152591526015261152621526315264152651526615267152681526915270152711527215273152741527515276152771527815279152801528115282152831528415285152861528715288152891529015291152921529315294152951529615297152981529915300153011530215303153041530515306153071530815309153101531115312153131531415315153161531715318153191532015321153221532315324153251532615327153281532915330153311533215333153341533515336153371533815339153401534115342153431534415345153461534715348153491535015351153521535315354153551535615357153581535915360153611536215363153641536515366153671536815369153701537115372153731537415375153761537715378153791538015381153821538315384153851538615387153881538915390153911539215393153941539515396153971539815399154001540115402154031540415405154061540715408154091541015411154121541315414154151541615417154181541915420154211542215423154241542515426154271542815429154301543115432154331543415435154361543715438154391544015441154421544315444154451544615447154481544915450154511545215453154541545515456154571545815459154601546115462154631546415465154661546715468154691547015471154721547315474154751547615477154781547915480154811548215483154841548515486154871548815489154901549115492154931549415495154961549715498154991550015501155021550315504155051550615507155081550915510155111551215513155141551515516155171551815519155201552115522155231552415525155261552715528155291553015531155321553315534155351553615537155381553915540155411554215543155441554515546155471554815549155501555115552155531555415555155561555715558155591556015561155621556315564155651556615567155681556915570155711557215573155741557515576155771557815579155801558115582155831558415585155861558715588155891559015591155921559315594155951559615597155981559915600156011560215603156041560515606156071560815609156101561115612156131561415615156161561715618156191562015621156221562315624156251562615627156281562915630156311563215633156341563515636156371563815639156401564115642156431564415645156461564715648156491565015651156521565315654156551565615657156581565915660156611566215663156641566515666156671566815669156701567115672156731567415675156761567715678156791568015681156821568315684156851568615687156881568915690156911569215693156941569515696156971569815699157001570115702157031570415705157061570715708157091571015711157121571315714157151571615717157181571915720157211572215723157241572515726157271572815729157301573115732157331573415735157361573715738157391574015741157421574315744157451574615747157481574915750157511575215753157541575515756157571575815759157601576115762157631576415765157661576715768157691577015771157721577315774157751577615777157781577915780157811578215783157841578515786157871578815789157901579115792157931579415795157961579715798157991580015801158021580315804158051580615807158081580915810158111581215813158141581515816158171581815819158201582115822158231582415825158261582715828158291583015831158321583315834158351583615837158381583915840158411584215843158441584515846158471584815849158501585115852158531585415855158561585715858158591586015861158621586315864158651586615867158681586915870158711587215873158741587515876158771587815879158801588115882158831588415885158861588715888158891589015891158921589315894158951589615897158981589915900159011590215903159041590515906159071590815909159101591115912159131591415915159161591715918159191592015921159221592315924159251592615927159281592915930159311593215933159341593515936159371593815939159401594115942159431594415945159461594715948159491595015951159521595315954159551595615957159581595915960159611596215963159641596515966159671596815969159701597115972159731597415975159761597715978159791598015981159821598315984159851598615987159881598915990159911599215993159941599515996159971599815999160001600116002160031600416005160061600716008160091601016011160121601316014160151601616017160181601916020160211602216023160241602516026160271602816029160301603116032160331603416035160361603716038160391604016041160421604316044160451604616047160481604916050160511605216053160541605516056160571605816059160601606116062160631606416065160661606716068160691607016071160721607316074160751607616077160781607916080160811608216083160841608516086160871608816089160901609116092160931609416095160961609716098160991610016101161021610316104161051610616107161081610916110161111611216113161141611516116161171611816119161201612116122161231612416125161261612716128161291613016131161321613316134161351613616137161381613916140161411614216143161441614516146161471614816149161501615116152161531615416155161561615716158161591616016161161621616316164161651616616167161681616916170161711617216173161741617516176161771617816179161801618116182161831618416185161861618716188161891619016191161921619316194161951619616197161981619916200162011620216203162041620516206162071620816209162101621116212162131621416215162161621716218162191622016221162221622316224162251622616227162281622916230162311623216233162341623516236162371623816239162401624116242162431624416245162461624716248162491625016251162521625316254162551625616257162581625916260162611626216263162641626516266162671626816269162701627116272162731627416275162761627716278162791628016281162821628316284162851628616287162881628916290162911629216293162941629516296162971629816299163001630116302163031630416305163061630716308163091631016311163121631316314163151631616317163181631916320163211632216323163241632516326163271632816329163301633116332163331633416335163361633716338163391634016341163421634316344163451634616347163481634916350163511635216353163541635516356163571635816359163601636116362163631636416365163661636716368163691637016371163721637316374163751637616377163781637916380163811638216383163841638516386163871638816389163901639116392163931639416395163961639716398163991640016401164021640316404164051640616407164081640916410164111641216413164141641516416164171641816419164201642116422164231642416425164261642716428164291643016431164321643316434164351643616437164381643916440164411644216443164441644516446164471644816449164501645116452164531645416455164561645716458164591646016461164621646316464164651646616467164681646916470164711647216473164741647516476164771647816479164801648116482164831648416485164861648716488164891649016491164921649316494164951649616497164981649916500165011650216503165041650516506165071650816509165101651116512165131651416515165161651716518165191652016521165221652316524165251652616527165281652916530165311653216533165341653516536165371653816539165401654116542165431654416545165461654716548165491655016551165521655316554165551655616557165581655916560165611656216563165641656516566165671656816569165701657116572165731657416575165761657716578165791658016581165821658316584165851658616587165881658916590165911659216593165941659516596165971659816599166001660116602166031660416605166061660716608166091661016611166121661316614166151661616617166181661916620166211662216623166241662516626166271662816629166301663116632166331663416635166361663716638166391664016641166421664316644166451664616647166481664916650166511665216653166541665516656166571665816659166601666116662166631666416665166661666716668166691667016671166721667316674166751667616677166781667916680166811668216683166841668516686166871668816689166901669116692166931669416695166961669716698166991670016701167021670316704167051670616707167081670916710167111671216713167141671516716167171671816719167201672116722167231672416725167261672716728167291673016731167321673316734167351673616737167381673916740167411674216743167441674516746167471674816749167501675116752167531675416755167561675716758167591676016761167621676316764167651676616767167681676916770167711677216773167741677516776167771677816779167801678116782167831678416785167861678716788167891679016791167921679316794167951679616797167981679916800168011680216803168041680516806168071680816809168101681116812168131681416815168161681716818168191682016821168221682316824168251682616827168281682916830168311683216833168341683516836168371683816839168401684116842168431684416845168461684716848168491685016851168521685316854168551685616857168581685916860168611686216863168641686516866168671686816869168701687116872168731687416875168761687716878168791688016881168821688316884168851688616887168881688916890168911689216893168941689516896168971689816899169001690116902169031690416905169061690716908169091691016911169121691316914169151691616917169181691916920169211692216923169241692516926169271692816929169301693116932169331693416935169361693716938169391694016941169421694316944169451694616947169481694916950169511695216953169541695516956169571695816959169601696116962169631696416965169661696716968169691697016971169721697316974169751697616977169781697916980169811698216983169841698516986169871698816989169901699116992169931699416995169961699716998169991700017001170021700317004170051700617007170081700917010170111701217013170141701517016170171701817019170201702117022170231702417025170261702717028170291703017031170321703317034170351703617037170381703917040170411704217043170441704517046170471704817049170501705117052170531705417055170561705717058170591706017061170621706317064170651706617067170681706917070170711707217073170741707517076170771707817079170801708117082170831708417085170861708717088170891709017091170921709317094170951709617097170981709917100171011710217103171041710517106171071710817109171101711117112171131711417115171161711717118171191712017121171221712317124171251712617127171281712917130171311713217133171341713517136171371713817139171401714117142171431714417145171461714717148171491715017151171521715317154171551715617157171581715917160171611716217163171641716517166171671716817169171701717117172171731717417175171761717717178171791718017181171821718317184171851718617187171881718917190171911719217193171941719517196171971719817199172001720117202172031720417205172061720717208172091721017211172121721317214172151721617217172181721917220172211722217223172241722517226172271722817229172301723117232172331723417235172361723717238172391724017241172421724317244172451724617247172481724917250172511725217253172541725517256172571725817259172601726117262172631726417265172661726717268172691727017271172721727317274172751727617277172781727917280172811728217283172841728517286172871728817289172901729117292172931729417295172961729717298172991730017301173021730317304173051730617307173081730917310173111731217313173141731517316173171731817319173201732117322173231732417325173261732717328173291733017331173321733317334173351733617337173381733917340173411734217343173441734517346173471734817349173501735117352173531735417355173561735717358173591736017361173621736317364173651736617367173681736917370173711737217373173741737517376173771737817379173801738117382173831738417385173861738717388173891739017391173921739317394173951739617397173981739917400174011740217403174041740517406174071740817409174101741117412174131741417415174161741717418174191742017421174221742317424174251742617427174281742917430174311743217433174341743517436174371743817439174401744117442174431744417445174461744717448174491745017451174521745317454174551745617457174581745917460174611746217463174641746517466174671746817469174701747117472174731747417475174761747717478174791748017481174821748317484174851748617487174881748917490174911749217493174941749517496174971749817499175001750117502175031750417505175061750717508175091751017511175121751317514175151751617517175181751917520175211752217523175241752517526175271752817529175301753117532175331753417535175361753717538175391754017541175421754317544175451754617547175481754917550175511755217553175541755517556175571755817559175601756117562175631756417565175661756717568175691757017571175721757317574175751757617577175781757917580175811758217583175841758517586175871758817589175901759117592175931759417595175961759717598175991760017601176021760317604176051760617607176081760917610176111761217613176141761517616176171761817619176201762117622176231762417625176261762717628176291763017631176321763317634176351763617637176381763917640176411764217643176441764517646176471764817649176501765117652176531765417655176561765717658176591766017661176621766317664176651766617667176681766917670176711767217673176741767517676176771767817679176801768117682176831768417685176861768717688176891769017691176921769317694176951769617697176981769917700177011770217703177041770517706177071770817709177101771117712177131771417715177161771717718177191772017721177221772317724177251772617727177281772917730177311773217733177341773517736177371773817739177401774117742177431774417745177461774717748177491775017751177521775317754177551775617757177581775917760177611776217763177641776517766177671776817769177701777117772177731777417775177761777717778177791778017781177821778317784177851778617787177881778917790177911779217793177941779517796177971779817799178001780117802178031780417805178061780717808178091781017811178121781317814178151781617817178181781917820178211782217823178241782517826178271782817829178301783117832178331783417835178361783717838178391784017841178421784317844178451784617847178481784917850178511785217853178541785517856178571785817859178601786117862178631786417865178661786717868178691787017871178721787317874178751787617877178781787917880178811788217883178841788517886178871788817889178901789117892178931789417895178961789717898178991790017901179021790317904179051790617907179081790917910179111791217913179141791517916179171791817919179201792117922179231792417925179261792717928179291793017931179321793317934179351793617937179381793917940179411794217943179441794517946179471794817949179501795117952179531795417955179561795717958179591796017961179621796317964179651796617967179681796917970179711797217973179741797517976179771797817979179801798117982179831798417985179861798717988179891799017991179921799317994179951799617997179981799918000180011800218003180041800518006180071800818009180101801118012180131801418015180161801718018180191802018021180221802318024180251802618027180281802918030180311803218033180341803518036180371803818039180401804118042180431804418045180461804718048180491805018051180521805318054180551805618057180581805918060180611806218063180641806518066180671806818069180701807118072180731807418075180761807718078180791808018081180821808318084180851808618087180881808918090180911809218093180941809518096180971809818099181001810118102181031810418105181061810718108181091811018111181121811318114181151811618117181181811918120181211812218123181241812518126181271812818129181301813118132181331813418135181361813718138181391814018141181421814318144181451814618147181481814918150181511815218153181541815518156181571815818159181601816118162181631816418165181661816718168181691817018171181721817318174181751817618177181781817918180181811818218183181841818518186181871818818189181901819118192181931819418195181961819718198181991820018201182021820318204182051820618207182081820918210182111821218213182141821518216182171821818219182201822118222182231822418225182261822718228182291823018231182321823318234182351823618237182381823918240182411824218243182441824518246182471824818249182501825118252182531825418255182561825718258182591826018261182621826318264182651826618267182681826918270182711827218273182741827518276182771827818279182801828118282182831828418285182861828718288182891829018291182921829318294182951829618297182981829918300183011830218303183041830518306183071830818309183101831118312183131831418315183161831718318183191832018321183221832318324183251832618327183281832918330183311833218333183341833518336183371833818339183401834118342183431834418345183461834718348183491835018351183521835318354183551835618357183581835918360183611836218363183641836518366183671836818369183701837118372183731837418375183761837718378183791838018381183821838318384183851838618387183881838918390183911839218393183941839518396183971839818399184001840118402184031840418405184061840718408184091841018411184121841318414184151841618417184181841918420184211842218423184241842518426184271842818429184301843118432184331843418435184361843718438184391844018441184421844318444184451844618447184481844918450184511845218453184541845518456184571845818459184601846118462184631846418465184661846718468184691847018471184721847318474184751847618477184781847918480184811848218483184841848518486184871848818489184901849118492184931849418495184961849718498184991850018501185021850318504185051850618507185081850918510185111851218513185141851518516185171851818519185201852118522185231852418525185261852718528185291853018531185321853318534185351853618537185381853918540185411854218543185441854518546185471854818549185501855118552185531855418555185561855718558185591856018561185621856318564185651856618567185681856918570185711857218573185741857518576185771857818579185801858118582185831858418585185861858718588185891859018591185921859318594185951859618597185981859918600186011860218603186041860518606186071860818609186101861118612186131861418615186161861718618186191862018621186221862318624186251862618627186281862918630186311863218633186341863518636186371863818639186401864118642186431864418645186461864718648186491865018651186521865318654186551865618657186581865918660186611866218663186641866518666186671866818669186701867118672186731867418675186761867718678186791868018681186821868318684186851868618687186881868918690186911869218693186941869518696186971869818699187001870118702187031870418705187061870718708187091871018711187121871318714187151871618717187181871918720187211872218723187241872518726187271872818729187301873118732187331873418735187361873718738187391874018741187421874318744187451874618747187481874918750187511875218753187541875518756187571875818759187601876118762187631876418765187661876718768187691877018771187721877318774187751877618777187781877918780187811878218783187841878518786187871878818789187901879118792187931879418795187961879718798187991880018801188021880318804188051880618807188081880918810188111881218813188141881518816188171881818819188201882118822188231882418825188261882718828188291883018831188321883318834188351883618837188381883918840188411884218843188441884518846188471884818849188501885118852188531885418855188561885718858188591886018861188621886318864188651886618867188681886918870188711887218873188741887518876188771887818879188801888118882188831888418885188861888718888188891889018891188921889318894188951889618897188981889918900189011890218903189041890518906189071890818909189101891118912189131891418915189161891718918189191892018921189221892318924189251892618927189281892918930189311893218933189341893518936189371893818939189401894118942189431894418945189461894718948189491895018951189521895318954189551895618957189581895918960189611896218963189641896518966189671896818969189701897118972189731897418975189761897718978189791898018981189821898318984189851898618987189881898918990189911899218993189941899518996189971899818999190001900119002190031900419005190061900719008190091901019011190121901319014190151901619017190181901919020190211902219023190241902519026190271902819029190301903119032190331903419035190361903719038190391904019041190421904319044190451904619047190481904919050190511905219053190541905519056190571905819059190601906119062190631906419065190661906719068190691907019071190721907319074190751907619077190781907919080190811908219083190841908519086190871908819089190901909119092190931909419095190961909719098190991910019101191021910319104191051910619107191081910919110191111911219113191141911519116191171911819119191201912119122191231912419125191261912719128191291913019131191321913319134191351913619137191381913919140191411914219143191441914519146191471914819149191501915119152191531915419155191561915719158191591916019161191621916319164191651916619167191681916919170191711917219173191741917519176191771917819179191801918119182191831918419185191861918719188191891919019191191921919319194191951919619197191981919919200192011920219203192041920519206192071920819209192101921119212192131921419215192161921719218192191922019221192221922319224192251922619227192281922919230192311923219233192341923519236192371923819239192401924119242192431924419245192461924719248192491925019251192521925319254192551925619257192581925919260192611926219263192641926519266192671926819269192701927119272192731927419275192761927719278192791928019281192821928319284192851928619287192881928919290192911929219293192941929519296192971929819299193001930119302193031930419305193061930719308193091931019311193121931319314193151931619317193181931919320193211932219323193241932519326193271932819329193301933119332193331933419335193361933719338193391934019341193421934319344193451934619347193481934919350193511935219353193541935519356193571935819359193601936119362193631936419365193661936719368193691937019371193721937319374193751937619377193781937919380193811938219383193841938519386193871938819389193901939119392193931939419395193961939719398193991940019401194021940319404194051940619407194081940919410194111941219413194141941519416194171941819419194201942119422194231942419425194261942719428194291943019431194321943319434194351943619437194381943919440194411944219443194441944519446194471944819449194501945119452194531945419455194561945719458194591946019461194621946319464194651946619467194681946919470194711947219473194741947519476194771947819479194801948119482194831948419485194861948719488194891949019491194921949319494194951949619497194981949919500195011950219503195041950519506195071950819509195101951119512195131951419515195161951719518195191952019521195221952319524195251952619527195281952919530195311953219533195341953519536195371953819539195401954119542195431954419545195461954719548195491955019551195521955319554195551955619557195581955919560195611956219563195641956519566195671956819569195701957119572195731957419575195761957719578195791958019581195821958319584195851958619587195881958919590195911959219593195941959519596195971959819599196001960119602196031960419605196061960719608196091961019611196121961319614196151961619617196181961919620196211962219623196241962519626196271962819629196301963119632196331963419635196361963719638196391964019641196421964319644196451964619647196481964919650196511965219653196541965519656196571965819659196601966119662196631966419665196661966719668196691967019671196721967319674196751967619677196781967919680196811968219683196841968519686196871968819689196901969119692196931969419695196961969719698196991970019701197021970319704197051970619707197081970919710197111971219713197141971519716197171971819719197201972119722197231972419725197261972719728197291973019731197321973319734197351973619737197381973919740197411974219743197441974519746197471974819749197501975119752197531975419755197561975719758197591976019761197621976319764197651976619767197681976919770197711977219773197741977519776197771977819779197801978119782197831978419785197861978719788197891979019791197921979319794197951979619797197981979919800198011980219803198041980519806198071980819809198101981119812198131981419815198161981719818198191982019821198221982319824198251982619827198281982919830198311983219833198341983519836198371983819839198401984119842198431984419845198461984719848198491985019851198521985319854198551985619857198581985919860198611986219863198641986519866198671986819869198701987119872198731987419875198761987719878198791988019881198821988319884198851988619887198881988919890198911989219893198941989519896198971989819899199001990119902199031990419905199061990719908199091991019911199121991319914199151991619917199181991919920199211992219923199241992519926199271992819929199301993119932199331993419935199361993719938199391994019941199421994319944199451994619947199481994919950199511995219953199541995519956199571995819959199601996119962199631996419965199661996719968199691997019971199721997319974199751997619977199781997919980199811998219983199841998519986199871998819989199901999119992199931999419995199961999719998199992000020001200022000320004200052000620007200082000920010200112001220013200142001520016200172001820019200202002120022200232002420025200262002720028200292003020031200322003320034200352003620037200382003920040200412004220043200442004520046200472004820049200502005120052200532005420055200562005720058200592006020061200622006320064200652006620067200682006920070200712007220073200742007520076200772007820079200802008120082200832008420085200862008720088200892009020091200922009320094200952009620097200982009920100201012010220103201042010520106201072010820109201102011120112201132011420115201162011720118201192012020121201222012320124201252012620127201282012920130201312013220133201342013520136201372013820139201402014120142201432014420145201462014720148201492015020151201522015320154201552015620157201582015920160201612016220163201642016520166201672016820169201702017120172201732017420175201762017720178201792018020181201822018320184201852018620187201882018920190201912019220193201942019520196201972019820199202002020120202202032020420205202062020720208202092021020211202122021320214202152021620217202182021920220202212022220223202242022520226202272022820229202302023120232202332023420235202362023720238202392024020241202422024320244202452024620247202482024920250202512025220253202542025520256202572025820259202602026120262202632026420265202662026720268202692027020271202722027320274202752027620277202782027920280202812028220283202842028520286202872028820289202902029120292202932029420295202962029720298202992030020301203022030320304203052030620307203082030920310203112031220313203142031520316203172031820319203202032120322203232032420325203262032720328203292033020331203322033320334203352033620337203382033920340203412034220343203442034520346203472034820349203502035120352203532035420355203562035720358203592036020361203622036320364203652036620367203682036920370203712037220373203742037520376203772037820379203802038120382203832038420385203862038720388203892039020391203922039320394203952039620397203982039920400204012040220403204042040520406204072040820409204102041120412204132041420415204162041720418204192042020421204222042320424204252042620427204282042920430204312043220433204342043520436204372043820439204402044120442204432044420445204462044720448204492045020451204522045320454204552045620457204582045920460204612046220463204642046520466204672046820469204702047120472204732047420475204762047720478204792048020481204822048320484204852048620487204882048920490204912049220493204942049520496204972049820499205002050120502205032050420505205062050720508205092051020511205122051320514205152051620517205182051920520205212052220523205242052520526205272052820529205302053120532205332053420535205362053720538205392054020541205422054320544205452054620547205482054920550205512055220553205542055520556205572055820559205602056120562205632056420565205662056720568205692057020571205722057320574205752057620577205782057920580205812058220583205842058520586205872058820589205902059120592205932059420595205962059720598205992060020601206022060320604206052060620607206082060920610206112061220613206142061520616206172061820619206202062120622206232062420625206262062720628206292063020631206322063320634206352063620637206382063920640206412064220643206442064520646206472064820649206502065120652206532065420655206562065720658206592066020661206622066320664206652066620667206682066920670206712067220673206742067520676206772067820679206802068120682206832068420685206862068720688206892069020691206922069320694206952069620697206982069920700207012070220703207042070520706207072070820709207102071120712207132071420715207162071720718207192072020721207222072320724207252072620727207282072920730207312073220733207342073520736207372073820739207402074120742207432074420745207462074720748207492075020751207522075320754207552075620757207582075920760207612076220763207642076520766207672076820769207702077120772207732077420775207762077720778207792078020781207822078320784207852078620787207882078920790207912079220793207942079520796207972079820799208002080120802208032080420805208062080720808208092081020811208122081320814208152081620817208182081920820208212082220823208242082520826208272082820829208302083120832208332083420835208362083720838208392084020841208422084320844208452084620847208482084920850208512085220853208542085520856208572085820859208602086120862208632086420865208662086720868208692087020871208722087320874208752087620877208782087920880208812088220883208842088520886208872088820889208902089120892208932089420895208962089720898208992090020901209022090320904209052090620907209082090920910209112091220913209142091520916209172091820919209202092120922209232092420925209262092720928209292093020931209322093320934209352093620937209382093920940209412094220943209442094520946209472094820949209502095120952209532095420955209562095720958209592096020961209622096320964209652096620967209682096920970209712097220973209742097520976209772097820979209802098120982209832098420985209862098720988209892099020991209922099320994209952099620997209982099921000210012100221003210042100521006210072100821009210102101121012210132101421015210162101721018210192102021021210222102321024210252102621027210282102921030210312103221033210342103521036210372103821039210402104121042210432104421045210462104721048210492105021051210522105321054210552105621057210582105921060210612106221063210642106521066210672106821069210702107121072210732107421075210762107721078210792108021081210822108321084210852108621087210882108921090210912109221093210942109521096210972109821099211002110121102211032110421105211062110721108211092111021111211122111321114211152111621117211182111921120211212112221123211242112521126211272112821129211302113121132211332113421135211362113721138211392114021141211422114321144211452114621147211482114921150211512115221153211542115521156211572115821159211602116121162211632116421165211662116721168211692117021171211722117321174211752117621177211782117921180211812118221183211842118521186211872118821189211902119121192211932119421195211962119721198211992120021201212022120321204212052120621207212082120921210212112121221213212142121521216212172121821219212202122121222212232122421225212262122721228212292123021231212322123321234212352123621237212382123921240212412124221243212442124521246212472124821249212502125121252212532125421255212562125721258212592126021261212622126321264212652126621267212682126921270212712127221273212742127521276212772127821279212802128121282212832128421285212862128721288212892129021291212922129321294212952129621297212982129921300213012130221303213042130521306213072130821309213102131121312213132131421315213162131721318213192132021321213222132321324213252132621327213282132921330213312133221333213342133521336213372133821339213402134121342213432134421345213462134721348213492135021351213522135321354213552135621357213582135921360213612136221363213642136521366213672136821369213702137121372213732137421375213762137721378213792138021381213822138321384213852138621387213882138921390213912139221393213942139521396213972139821399214002140121402214032140421405214062140721408214092141021411214122141321414214152141621417214182141921420214212142221423214242142521426214272142821429214302143121432214332143421435214362143721438214392144021441214422144321444214452144621447214482144921450214512145221453214542145521456214572145821459214602146121462214632146421465214662146721468214692147021471214722147321474214752147621477214782147921480214812148221483214842148521486214872148821489214902149121492214932149421495214962149721498214992150021501215022150321504215052150621507215082150921510215112151221513215142151521516215172151821519215202152121522215232152421525215262152721528215292153021531215322153321534215352153621537215382153921540215412154221543215442154521546215472154821549215502155121552215532155421555215562155721558215592156021561215622156321564215652156621567215682156921570215712157221573215742157521576215772157821579215802158121582215832158421585215862158721588215892159021591215922159321594215952159621597215982159921600216012160221603216042160521606216072160821609216102161121612216132161421615216162161721618216192162021621216222162321624216252162621627216282162921630216312163221633216342163521636216372163821639216402164121642216432164421645216462164721648216492165021651216522165321654216552165621657216582165921660216612166221663216642166521666216672166821669216702167121672216732167421675216762167721678216792168021681216822168321684216852168621687216882168921690216912169221693216942169521696216972169821699217002170121702217032170421705217062170721708217092171021711217122171321714217152171621717217182171921720217212172221723217242172521726217272172821729217302173121732217332173421735217362173721738217392174021741217422174321744217452174621747217482174921750217512175221753217542175521756217572175821759217602176121762217632176421765217662176721768217692177021771217722177321774217752177621777217782177921780217812178221783217842178521786217872178821789217902179121792217932179421795217962179721798217992180021801218022180321804218052180621807218082180921810218112181221813218142181521816218172181821819218202182121822218232182421825218262182721828218292183021831218322183321834218352183621837218382183921840218412184221843218442184521846218472184821849218502185121852218532185421855218562185721858218592186021861218622186321864218652186621867218682186921870218712187221873218742187521876218772187821879218802188121882218832188421885218862188721888218892189021891218922189321894218952189621897218982189921900219012190221903219042190521906219072190821909219102191121912219132191421915219162191721918219192192021921219222192321924219252192621927219282192921930219312193221933219342193521936219372193821939219402194121942219432194421945219462194721948219492195021951219522195321954219552195621957219582195921960219612196221963219642196521966219672196821969219702197121972219732197421975219762197721978219792198021981219822198321984219852198621987219882198921990219912199221993219942199521996219972199821999220002200122002220032200422005220062200722008220092201022011220122201322014220152201622017220182201922020220212202222023220242202522026220272202822029220302203122032220332203422035220362203722038220392204022041220422204322044220452204622047220482204922050220512205222053220542205522056220572205822059220602206122062220632206422065220662206722068220692207022071220722207322074220752207622077220782207922080220812208222083220842208522086220872208822089220902209122092220932209422095220962209722098220992210022101221022210322104221052210622107221082210922110221112211222113221142211522116221172211822119221202212122122221232212422125221262212722128221292213022131221322213322134221352213622137221382213922140221412214222143221442214522146221472214822149221502215122152221532215422155221562215722158221592216022161221622216322164221652216622167221682216922170221712217222173221742217522176221772217822179221802218122182221832218422185221862218722188221892219022191221922219322194221952219622197221982219922200222012220222203222042220522206222072220822209222102221122212222132221422215222162221722218222192222022221222222222322224222252222622227222282222922230222312223222233222342223522236222372223822239222402224122242222432224422245222462224722248222492225022251222522225322254222552225622257222582225922260222612226222263222642226522266222672226822269222702227122272222732227422275222762227722278222792228022281222822228322284222852228622287222882228922290222912229222293222942229522296222972229822299223002230122302223032230422305223062230722308223092231022311223122231322314223152231622317223182231922320223212232222323223242232522326223272232822329223302233122332223332233422335223362233722338223392234022341223422234322344223452234622347223482234922350223512235222353223542235522356223572235822359223602236122362223632236422365223662236722368223692237022371223722237322374223752237622377223782237922380223812238222383223842238522386223872238822389223902239122392223932239422395223962239722398223992240022401224022240322404224052240622407224082240922410224112241222413224142241522416224172241822419224202242122422224232242422425224262242722428224292243022431224322243322434224352243622437224382243922440224412244222443224442244522446224472244822449224502245122452224532245422455224562245722458224592246022461224622246322464224652246622467224682246922470224712247222473224742247522476224772247822479224802248122482224832248422485224862248722488224892249022491224922249322494224952249622497224982249922500225012250222503225042250522506225072250822509225102251122512225132251422515225162251722518225192252022521225222252322524225252252622527225282252922530225312253222533225342253522536225372253822539225402254122542225432254422545225462254722548225492255022551225522255322554225552255622557225582255922560225612256222563225642256522566225672256822569225702257122572225732257422575225762257722578225792258022581225822258322584225852258622587225882258922590225912259222593225942259522596225972259822599226002260122602226032260422605226062260722608226092261022611226122261322614226152261622617226182261922620226212262222623226242262522626226272262822629226302263122632226332263422635226362263722638226392264022641226422264322644226452264622647226482264922650226512265222653226542265522656226572265822659226602266122662226632266422665226662266722668226692267022671226722267322674226752267622677226782267922680226812268222683226842268522686226872268822689226902269122692226932269422695226962269722698226992270022701227022270322704227052270622707227082270922710227112271222713227142271522716227172271822719227202272122722227232272422725227262272722728227292273022731227322273322734227352273622737227382273922740227412274222743227442274522746227472274822749227502275122752227532275422755227562275722758227592276022761227622276322764227652276622767227682276922770227712277222773227742277522776227772277822779227802278122782227832278422785227862278722788227892279022791227922279322794227952279622797227982279922800228012280222803228042280522806228072280822809228102281122812228132281422815228162281722818228192282022821228222282322824228252282622827228282282922830228312283222833228342283522836228372283822839228402284122842228432284422845228462284722848228492285022851228522285322854228552285622857228582285922860228612286222863228642286522866228672286822869228702287122872228732287422875228762287722878228792288022881228822288322884228852288622887228882288922890228912289222893228942289522896228972289822899229002290122902229032290422905229062290722908229092291022911229122291322914229152291622917229182291922920229212292222923229242292522926229272292822929229302293122932229332293422935229362293722938229392294022941229422294322944229452294622947229482294922950229512295222953229542295522956229572295822959229602296122962229632296422965229662296722968229692297022971229722297322974229752297622977229782297922980229812298222983229842298522986229872298822989229902299122992229932299422995229962299722998229992300023001230022300323004230052300623007230082300923010230112301223013230142301523016230172301823019230202302123022230232302423025230262302723028230292303023031230322303323034230352303623037230382303923040230412304223043230442304523046230472304823049230502305123052230532305423055230562305723058230592306023061230622306323064230652306623067230682306923070230712307223073230742307523076230772307823079230802308123082230832308423085230862308723088230892309023091230922309323094230952309623097230982309923100231012310223103231042310523106231072310823109231102311123112231132311423115231162311723118231192312023121231222312323124231252312623127231282312923130231312313223133231342313523136231372313823139231402314123142231432314423145231462314723148231492315023151231522315323154231552315623157231582315923160231612316223163231642316523166231672316823169231702317123172231732317423175231762317723178231792318023181231822318323184231852318623187231882318923190231912319223193231942319523196231972319823199232002320123202232032320423205232062320723208232092321023211232122321323214232152321623217232182321923220232212322223223232242322523226232272322823229232302323123232232332323423235232362323723238232392324023241232422324323244232452324623247232482324923250232512325223253232542325523256232572325823259232602326123262232632326423265232662326723268232692327023271232722327323274232752327623277232782327923280232812328223283232842328523286232872328823289232902329123292232932329423295232962329723298232992330023301233022330323304233052330623307233082330923310233112331223313233142331523316233172331823319233202332123322233232332423325233262332723328233292333023331233322333323334233352333623337233382333923340233412334223343233442334523346233472334823349233502335123352233532335423355233562335723358233592336023361233622336323364233652336623367233682336923370233712337223373233742337523376233772337823379233802338123382233832338423385233862338723388233892339023391233922339323394233952339623397233982339923400234012340223403234042340523406234072340823409234102341123412234132341423415234162341723418234192342023421234222342323424234252342623427
  1. {
  2. This file is part of the Free Component Library (FCL)
  3. Copyright (c) 2018 by Michael Van Canneyt
  4. Unit tests for Pascal-to-Javascript converter class.
  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. Examples:
  12. ./testpas2js --suite=TTestModule.TestEmptyProgram
  13. ./testpas2js --suite=TTestModule.TestEmptyUnit
  14. }
  15. unit TCModules;
  16. {$mode objfpc}{$H+}
  17. interface
  18. uses
  19. Classes, SysUtils, fpcunit, testregistry, contnrs,
  20. jstree, jswriter, jsbase,
  21. PasTree, PScanner, PasResolver, PParser, PasResolveEval,
  22. FPPas2Js;
  23. const
  24. // default parser+scanner options
  25. po_tcmodules = po_Pas2js+[po_KeepScannerError];
  26. co_tcmodules = [coNoTypeInfo];
  27. type
  28. TSrcMarkerKind = (
  29. mkLabel,
  30. mkResolverReference,
  31. mkDirectReference
  32. );
  33. PSrcMarker = ^TSrcMarker;
  34. TSrcMarker = record
  35. Kind: TSrcMarkerKind;
  36. Filename: string;
  37. Row: integer;
  38. StartCol, EndCol: integer; // token start, end column
  39. Identifier: string;
  40. Next: PSrcMarker;
  41. end;
  42. { TTestHintMessage }
  43. TTestHintMessage = class
  44. public
  45. Id: int64;
  46. MsgType: TMessageType;
  47. MsgNumber: integer;
  48. Msg: string;
  49. SourcePos: TPasSourcePos;
  50. end;
  51. { TTestPasParser }
  52. TTestPasParser = Class(TPasParser)
  53. end;
  54. TOnFindUnit = function(const aUnitName: String): TPasModule of object;
  55. { TTestEnginePasResolver }
  56. TTestEnginePasResolver = class(TPas2JsResolver)
  57. private
  58. FFilename: string;
  59. FModule: TPasModule;
  60. FOnFindUnit: TOnFindUnit;
  61. FParser: TTestPasParser;
  62. FStreamResolver: TStreamResolver;
  63. FScanner: TPas2jsPasScanner;
  64. FSource: string;
  65. public
  66. destructor Destroy; override;
  67. function FindUnit(const AName, InFilename: String; NameExpr,
  68. InFileExpr: TPasExpr): TPasModule; override;
  69. procedure UsedInterfacesFinished(Section: TPasSection); override;
  70. property OnFindUnit: TOnFindUnit read FOnFindUnit write FOnFindUnit;
  71. property Filename: string read FFilename write FFilename;
  72. property StreamResolver: TStreamResolver read FStreamResolver write FStreamResolver;
  73. property Scanner: TPas2jsPasScanner read FScanner write FScanner;
  74. property Parser: TTestPasParser read FParser write FParser;
  75. property Source: string read FSource write FSource;
  76. property Module: TPasModule read FModule;
  77. end;
  78. { TCustomTestModule }
  79. TCustomTestModule = Class(TTestCase)
  80. private
  81. FConverter: TPasToJSConverter;
  82. FEngine: TTestEnginePasResolver;
  83. FExpectedErrorClass: ExceptClass;
  84. FExpectedErrorMsg: string;
  85. FExpectedErrorNumber: integer;
  86. FFilename: string;
  87. FFileResolver: TStreamResolver;
  88. FJSImplementationSrc: TJSSourceElements;
  89. FJSImplementationUses: TJSArrayLiteral;
  90. FJSInitBody: TJSFunctionBody;
  91. FJSImplentationUses: TJSArrayLiteral;
  92. FJSInterfaceUses: TJSArrayLiteral;
  93. FJSModule: TJSSourceElements;
  94. FJSModuleSrc: TJSSourceElements;
  95. FJSSource: TStringList;
  96. FModule: TPasModule;
  97. FJSModuleCallArgs: TJSArguments;
  98. FModules: TObjectList;// list of TTestEnginePasResolver
  99. FParser: TTestPasParser;
  100. FPasProgram: TPasProgram;
  101. FHintMsgs: TObjectList; // list of TTestHintMessage
  102. FHintMsgsGood: TFPList; // list of TTestHintMessage marked as expected
  103. FJSRegModuleCall: TJSCallExpression;
  104. FScanner: TPas2jsPasScanner;
  105. FSkipTests: boolean;
  106. FSource: TStringList;
  107. FFirstPasStatement: TPasImplBlock;
  108. {$IFDEF EnablePasTreeGlobalRefCount}
  109. FElementRefCountAtSetup: int64;
  110. {$ENDIF}
  111. function GetMsgCount: integer;
  112. function GetMsgs(Index: integer): TTestHintMessage;
  113. function GetResolverCount: integer;
  114. function GetResolvers(Index: integer): TTestEnginePasResolver;
  115. function OnPasResolverFindUnit(const aUnitName: String): TPasModule;
  116. procedure OnParserLog(Sender: TObject; const Msg: String);
  117. procedure OnPasResolverLog(Sender: TObject; const Msg: String);
  118. procedure OnScannerLog(Sender: TObject; const Msg: String);
  119. protected
  120. procedure SetUp; override;
  121. function CreateConverter: TPasToJSConverter; virtual;
  122. function LoadUnit(const aUnitName: String): TPasModule;
  123. procedure InitScanner(aScanner: TPas2jsPasScanner); virtual;
  124. procedure TearDown; override;
  125. Procedure Add(Line: string); virtual;
  126. Procedure Add(const Lines: array of string);
  127. Procedure StartParsing; virtual;
  128. procedure ParseModuleQueue; virtual;
  129. procedure ParseModule; virtual;
  130. procedure ParseProgram; virtual;
  131. procedure ParseUnit; virtual;
  132. protected
  133. function FindModuleWithFilename(aFilename: string): TTestEnginePasResolver; virtual;
  134. function AddModule(aFilename: string): TTestEnginePasResolver; virtual;
  135. function AddModuleWithSrc(aFilename, Src: string): TTestEnginePasResolver; virtual;
  136. function AddModuleWithIntfImplSrc(aFilename, InterfaceSrc,
  137. ImplementationSrc: string): TTestEnginePasResolver; virtual;
  138. procedure AddSystemUnit; virtual;
  139. procedure StartProgram(NeedSystemUnit: boolean); virtual;
  140. procedure StartUnit(NeedSystemUnit: boolean); virtual;
  141. procedure ConvertModule; virtual;
  142. procedure ConvertProgram; virtual;
  143. procedure ConvertUnit; virtual;
  144. function ConvertJSModuleToString(El: TJSElement): string; virtual;
  145. procedure CheckDottedIdentifier(Msg: string; El: TJSElement; DottedName: string);
  146. function GetDottedIdentifier(El: TJSElement): string;
  147. procedure CheckSource(Msg,Statements: String; InitStatements: string = '';
  148. ImplStatements: string = ''); virtual;
  149. procedure CheckDiff(Msg, Expected, Actual: string); virtual;
  150. procedure CheckUnit(Filename, ExpectedSrc: string); virtual;
  151. procedure CheckHint(MsgType: TMessageType; MsgNumber: integer;
  152. Msg: string; Marker: PSrcMarker = nil); virtual;
  153. procedure CheckResolverUnexpectedHints(WithSourcePos: boolean = false); virtual;
  154. procedure SetExpectedScannerError(Msg: string; MsgNumber: integer);
  155. procedure SetExpectedParserError(Msg: string; MsgNumber: integer);
  156. procedure SetExpectedPasResolverError(Msg: string; MsgNumber: integer);
  157. procedure SetExpectedConverterError(Msg: string; MsgNumber: integer);
  158. function IsErrorExpected(E: Exception): boolean;
  159. procedure HandleScannerError(E: EScannerError);
  160. procedure HandleParserError(E: EParserError);
  161. procedure HandlePasResolveError(E: EPasResolve);
  162. procedure HandlePas2JSError(E: EPas2JS);
  163. procedure HandleException(E: Exception);
  164. procedure FailException(E: Exception);
  165. procedure WriteSources(const aFilename: string; aRow, aCol: integer);
  166. function IndexOfResolver(const Filename: string): integer;
  167. function GetResolver(const Filename: string): TTestEnginePasResolver;
  168. function GetDefaultNamespace: string;
  169. property PasProgram: TPasProgram Read FPasProgram;
  170. property Resolvers[Index: integer]: TTestEnginePasResolver read GetResolvers;
  171. property ResolverCount: integer read GetResolverCount;
  172. property Engine: TTestEnginePasResolver read FEngine;
  173. property Filename: string read FFilename;
  174. Property Module: TPasModule Read FModule;
  175. property FirstPasStatement: TPasImplBlock read FFirstPasStatement;
  176. property Converter: TPasToJSConverter read FConverter;
  177. property JSSource: TStringList read FJSSource;
  178. property JSModule: TJSSourceElements read FJSModule;
  179. property JSRegModuleCall: TJSCallExpression read FJSRegModuleCall;
  180. property JSModuleCallArgs: TJSArguments read FJSModuleCallArgs;
  181. property JSImplementationUses: TJSArrayLiteral read FJSImplementationUses;
  182. property JSInterfaceUses: TJSArrayLiteral read FJSInterfaceUses;
  183. property JSModuleSrc: TJSSourceElements read FJSModuleSrc;
  184. property JSInitBody: TJSFunctionBody read FJSInitBody;
  185. property JSImplementationSrc: TJSSourceElements read FJSImplementationSrc;
  186. property ExpectedErrorClass: ExceptClass read FExpectedErrorClass write FExpectedErrorClass;
  187. property ExpectedErrorMsg: string read FExpectedErrorMsg write FExpectedErrorMsg;
  188. property ExpectedErrorNumber: integer read FExpectedErrorNumber write FExpectedErrorNumber;
  189. property SkipTests: boolean read FSkipTests write FSkipTests;
  190. public
  191. constructor Create; override;
  192. destructor Destroy; override;
  193. property Source: TStringList read FSource;
  194. property FileResolver: TStreamResolver read FFileResolver;
  195. property Scanner: TPas2jsPasScanner read FScanner;
  196. property Parser: TTestPasParser read FParser;
  197. property MsgCount: integer read GetMsgCount;
  198. property Msgs[Index: integer]: TTestHintMessage read GetMsgs;
  199. end;
  200. { TTestModule }
  201. TTestModule = class(TCustomTestModule)
  202. Published
  203. // program/units
  204. Procedure TestEmptyProgram;
  205. Procedure TestEmptyProgramUseStrict;
  206. Procedure TestEmptyUnit;
  207. Procedure TestEmptyUnitUseStrict;
  208. Procedure TestDottedUnitNames;
  209. Procedure TestDottedUnitNameImpl;
  210. Procedure TestDottedUnitExpr;
  211. Procedure Test_ModeFPCFail;
  212. Procedure Test_ModeSwitchCBlocksFail;
  213. Procedure TestUnit_UseSystem;
  214. Procedure TestUnit_Intf1Impl2Intf1;
  215. Procedure TestIncludeVersion;
  216. // vars/const
  217. Procedure TestVarInt;
  218. Procedure TestVarBaseTypes;
  219. Procedure TestBaseTypeSingleFail;
  220. Procedure TestBaseTypeExtendedFail;
  221. Procedure TestConstBaseTypes;
  222. Procedure TestUnitImplVars;
  223. Procedure TestUnitImplConsts;
  224. Procedure TestUnitImplRecord;
  225. Procedure TestRenameJSNameConflict;
  226. Procedure TestLocalConst;
  227. Procedure TestVarExternal;
  228. Procedure TestVarExternalOtherUnit;
  229. Procedure TestVarAbsoluteFail;
  230. Procedure TestConstExternal;
  231. // numbers
  232. Procedure TestDouble;
  233. Procedure TestInteger;
  234. Procedure TestIntegerRange;
  235. Procedure TestIntegerTypecasts;
  236. Procedure TestCurrency;
  237. Procedure TestForBoolDo;
  238. Procedure TestForIntDo;
  239. Procedure TestForIntInDo;
  240. // strings
  241. Procedure TestCharConst;
  242. Procedure TestChar_Compare;
  243. Procedure TestChar_BuiltInProcs;
  244. Procedure TestStringConst;
  245. Procedure TestStringConstSurrogate;
  246. Procedure TestString_Length;
  247. Procedure TestString_Compare;
  248. Procedure TestString_SetLength;
  249. Procedure TestString_CharAt;
  250. Procedure TestStringHMinusFail;
  251. Procedure TestStr;
  252. Procedure TestBaseType_AnsiStringFail;
  253. Procedure TestBaseType_WideStringFail;
  254. Procedure TestBaseType_ShortStringFail;
  255. Procedure TestBaseType_RawByteStringFail;
  256. Procedure TestTypeShortstring_Fail;
  257. Procedure TestCharSet_Custom;
  258. Procedure TestForCharDo;
  259. Procedure TestForCharInDo;
  260. // alias types
  261. Procedure TestAliasTypeRef;
  262. Procedure TestTypeCast_BaseTypes;
  263. Procedure TestTypeCast_AliasBaseTypes;
  264. // functions
  265. Procedure TestEmptyProc;
  266. Procedure TestProcOneParam;
  267. Procedure TestFunctionWithoutParams;
  268. Procedure TestProcedureWithoutParams;
  269. Procedure TestPrgProcVar;
  270. Procedure TestProcTwoArgs;
  271. Procedure TestProc_DefaultValue;
  272. Procedure TestUnitProcVar;
  273. Procedure TestImplProc;
  274. Procedure TestFunctionResult;
  275. Procedure TestNestedProc;
  276. Procedure TestNestedProc_ResultString;
  277. Procedure TestForwardProc;
  278. Procedure TestNestedForwardProc;
  279. Procedure TestAssignFunctionResult;
  280. Procedure TestFunctionResultInCondition;
  281. Procedure TestFunctionResultInForLoop;
  282. Procedure TestFunctionResultInTypeCast;
  283. Procedure TestExit;
  284. Procedure TestBreak;
  285. Procedure TestBreakAsVar;
  286. Procedure TestContinue;
  287. Procedure TestProc_External;
  288. Procedure TestProc_ExternalOtherUnit;
  289. Procedure TestProc_Asm;
  290. Procedure TestProc_Assembler;
  291. Procedure TestProc_VarParam;
  292. Procedure TestProc_VarParamString;
  293. Procedure TestProc_VarParamV;
  294. Procedure TestProc_Overload;
  295. Procedure TestProc_OverloadForward;
  296. Procedure TestProc_OverloadIntfImpl;
  297. Procedure TestProc_OverloadNested;
  298. Procedure TestProc_OverloadUnitCycle;
  299. Procedure TestProc_Varargs;
  300. Procedure TestProc_ConstOrder;
  301. Procedure TestProc_DuplicateConst;
  302. Procedure TestProc_LocalVarAbsolute;
  303. Procedure TestProc_ReservedWords;
  304. // anonymous functions
  305. Procedure TestAnonymousProc_Assign_ObjFPC;
  306. Procedure TestAnonymousProc_Assign_Delphi;
  307. Procedure TestAnonymousProc_Arg;
  308. Procedure TestAnonymousProc_Typecast;
  309. Procedure TestAnonymousProc_With;
  310. Procedure TestAnonymousProc_ExceptOn;
  311. Procedure TestAnonymousProc_Nested;
  312. Procedure TestAnonymousProc_NestedAssignResult;
  313. // enums, sets
  314. Procedure TestEnum_Name;
  315. Procedure TestEnum_Number;
  316. Procedure TestEnum_ConstFail;
  317. Procedure TestEnum_Functions;
  318. Procedure TestEnum_AsParams;
  319. Procedure TestEnumRange_Array;
  320. Procedure TestEnum_ForIn;
  321. Procedure TestEnum_ScopedNumber;
  322. Procedure TestEnum_InFunction;
  323. Procedure TestSet_Enum;
  324. Procedure TestSet_Operators;
  325. Procedure TestSet_Operator_In;
  326. Procedure TestSet_Functions;
  327. Procedure TestSet_PassAsArgClone;
  328. Procedure TestSet_AsParams;
  329. Procedure TestSet_Property;
  330. Procedure TestSet_EnumConst;
  331. Procedure TestSet_IntConst;
  332. Procedure TestSet_AnonymousEnumType;
  333. Procedure TestSet_AnonymousEnumTypeChar; // ToDo
  334. Procedure TestSet_ConstEnum;
  335. Procedure TestSet_ConstChar;
  336. Procedure TestSet_ConstInt;
  337. Procedure TestSet_InFunction;
  338. Procedure TestSet_ForIn;
  339. // statements
  340. Procedure TestNestBegin;
  341. Procedure TestIncDec;
  342. Procedure TestAssignments;
  343. Procedure TestArithmeticOperators1;
  344. Procedure TestLogicalOperators;
  345. Procedure TestBitwiseOperators;
  346. Procedure TestFunctionInt;
  347. Procedure TestFunctionString;
  348. Procedure TestIfThen;
  349. Procedure TestForLoop;
  350. Procedure TestForLoopInsideFunction;
  351. Procedure TestForLoop_ReadVarAfter;
  352. Procedure TestForLoop_Nested;
  353. Procedure TestRepeatUntil;
  354. Procedure TestAsmBlock;
  355. Procedure TestAsmPas_Impl; // ToDo
  356. Procedure TestTryFinally;
  357. Procedure TestTryExcept;
  358. Procedure TestTryExcept_ReservedWords;
  359. Procedure TestIfThenRaiseElse;
  360. Procedure TestCaseOf;
  361. Procedure TestCaseOf_UseSwitch;
  362. Procedure TestCaseOfNoElse;
  363. Procedure TestCaseOfNoElse_UseSwitch;
  364. Procedure TestCaseOfRange;
  365. Procedure TestCaseOfString;
  366. Procedure TestCaseOfExternalClassConst;
  367. Procedure TestDebugger;
  368. // arrays
  369. Procedure TestArray_Dynamic;
  370. Procedure TestArray_Dynamic_Nil;
  371. Procedure TestArray_DynMultiDimensional;
  372. Procedure TestArray_StaticInt;
  373. Procedure TestArray_StaticBool;
  374. Procedure TestArray_StaticChar;
  375. Procedure TestArray_StaticMultiDim;
  376. Procedure TestArray_StaticInFunction;
  377. Procedure TestArrayOfRecord;
  378. Procedure TestArray_StaticRecord;
  379. Procedure TestArrayOfSet;
  380. // call(set) literal and clone var
  381. // call([set]) literal and clone var
  382. Procedure TestArray_DynAsParam;
  383. Procedure TestArray_StaticAsParam;
  384. Procedure TestArrayElement_AsParams;
  385. Procedure TestArrayElementFromFuncResult_AsParams;
  386. Procedure TestArrayEnumTypeRange;
  387. Procedure TestArray_SetLengthOutArg;
  388. Procedure TestArray_SetLengthProperty;
  389. Procedure TestArray_SetLengthMultiDim;
  390. Procedure TestArray_OpenArrayOfString;
  391. Procedure TestArray_Concat;
  392. Procedure TestArray_Copy;
  393. Procedure TestArray_InsertDelete;
  394. Procedure TestArray_DynArrayConstObjFPC;
  395. Procedure TestArray_DynArrayConstDelphi;
  396. Procedure TestArray_ArrayLitAsParam;
  397. Procedure TestArray_ArrayLitMultiDimAsParam;
  398. Procedure TestArray_ArrayLitStaticAsParam;
  399. Procedure TestArray_ForInArrOfString;
  400. Procedure TestExternalClass_TypeCastArrayToExternalClass;
  401. Procedure TestExternalClass_TypeCastArrayFromExternalClass;
  402. // record
  403. Procedure TestRecord_Empty;
  404. Procedure TestRecord_Var;
  405. Procedure TestRecord_VarExternal;
  406. Procedure TestRecord_WithDo;
  407. Procedure TestRecord_Assign;
  408. Procedure TestRecord_PassAsArgClone;
  409. Procedure TestRecord_AsParams;
  410. Procedure TestRecordElement_AsParams;
  411. Procedure TestRecordElementFromFuncResult_AsParams;
  412. Procedure TestRecordElementFromWith_AsParams;
  413. Procedure TestRecord_Equal;
  414. Procedure TestRecord_TypeCastJSValueToRecord;
  415. Procedure TestRecord_VariantFail;
  416. Procedure TestRecord_FieldArray;
  417. Procedure TestRecord_Const;
  418. Procedure TestRecord_TypecastFail;
  419. Procedure TestRecord_InFunction;
  420. // ToDo: RTTI of local record
  421. // ToDo: pcu local record, name clash and rtti
  422. // advanced record
  423. // ToDo: TestAdvRecord_Function;
  424. // ToDo: TestAdvRecord_Property;
  425. // ToDo: TestAdvRecord_PropertyDefault;
  426. // ToDo: TestAdvRecord_InFunction;
  427. // ToDo: pcu: record default property
  428. // ToDo: class constructor
  429. // classes
  430. Procedure TestClass_TObjectDefaultConstructor;
  431. Procedure TestClass_TObjectConstructorWithParams;
  432. Procedure TestClass_TObjectConstructorWithDefaultParam;
  433. Procedure TestClass_Var;
  434. Procedure TestClass_Method;
  435. Procedure TestClass_Implementation;
  436. Procedure TestClass_Inheritance;
  437. Procedure TestClass_TypeAlias;
  438. Procedure TestClass_AbstractMethod;
  439. Procedure TestClass_CallInherited_ProcNoParams;
  440. Procedure TestClass_CallInherited_WithParams;
  441. Procedure TestClasS_CallInheritedConstructor;
  442. Procedure TestClass_ClassVar_Assign;
  443. //ToDo Procedure TestClass_ClassVar_Arg;
  444. Procedure TestClass_CallClassMethod;
  445. Procedure TestClass_Property;
  446. Procedure TestClass_Property_ClassMethod;
  447. Procedure TestClass_Property_Indexed;
  448. Procedure TestClass_Property_IndexSpec;
  449. Procedure TestClass_PropertyOfTypeArray;
  450. Procedure TestClass_PropertyDefault;
  451. Procedure TestClass_PropertyDefault2;
  452. Procedure TestClass_PropertyOverride;
  453. Procedure TestClass_PropertyIncVisibility;
  454. Procedure TestClass_Assigned;
  455. Procedure TestClass_WithClassDoCreate;
  456. Procedure TestClass_WithClassInstDoProperty;
  457. Procedure TestClass_WithClassInstDoPropertyWithParams;
  458. Procedure TestClass_WithClassInstDoFunc;
  459. Procedure TestClass_TypeCast;
  460. Procedure TestClass_TypeCastUntypedParam;
  461. Procedure TestClass_Overloads;
  462. Procedure TestClass_OverloadsAncestor;
  463. Procedure TestClass_OverloadConstructor;
  464. Procedure TestClass_OverloadDelphiOverride;
  465. Procedure TestClass_ReintroducedVar;
  466. Procedure TestClass_RaiseDescendant;
  467. Procedure TestClass_ExternalMethod;
  468. Procedure TestClass_ExternalVirtualNameMismatchFail;
  469. Procedure TestClass_ExternalOverrideFail;
  470. Procedure TestClass_ExternalVar;
  471. Procedure TestClass_Const;
  472. Procedure TestClass_LocalVarSelfFail;
  473. Procedure TestClass_ArgSelfFail;
  474. Procedure TestClass_NestedProcSelf;
  475. Procedure TestClass_NestedProcSelf2;
  476. Procedure TestClass_NestedProcClassSelf;
  477. Procedure TestClass_NestedProcCallInherited;
  478. Procedure TestClass_TObjectFree;
  479. Procedure TestClass_TObjectFreeNewInstance;
  480. Procedure TestClass_TObjectFreeLowerCase;
  481. Procedure TestClass_TObjectFreeFunctionFail;
  482. Procedure TestClass_TObjectFreePropertyFail;
  483. Procedure TestClass_ForIn;
  484. // class of
  485. Procedure TestClassOf_Create;
  486. Procedure TestClassOf_Call;
  487. Procedure TestClassOf_Assign;
  488. Procedure TestClassOf_Is;
  489. Procedure TestClassOf_Compare;
  490. Procedure TestClassOf_ClassVar;
  491. Procedure TestClassOf_ClassMethod;
  492. Procedure TestClassOf_ClassProperty;
  493. Procedure TestClassOf_ClassMethodSelf;
  494. Procedure TestClassOf_TypeCast;
  495. Procedure TestClassOf_ImplicitFunctionCall;
  496. Procedure TestClassOf_Const;
  497. // nested class
  498. Procedure TestNestedClass_Alias;
  499. Procedure TestNestedClass_Record;
  500. Procedure TestNestedClass_Class;
  501. // external class
  502. Procedure TestExternalClass_Var;
  503. Procedure TestExternalClass_Const;
  504. Procedure TestExternalClass_Dollar;
  505. Procedure TestExternalClass_DuplicateVarFail;
  506. Procedure TestExternalClass_Method;
  507. Procedure TestExternalClass_ClassMethod;
  508. Procedure TestExternalClass_FunctionResultInTypeCast;
  509. Procedure TestExternalClass_NonExternalOverride;
  510. Procedure TestExternalClass_OverloadHint;
  511. Procedure TestExternalClass_SameNamePublishedProperty;
  512. Procedure TestExternalClass_Property;
  513. Procedure TestExternalClass_PropertyDate;
  514. Procedure TestExternalClass_ClassProperty;
  515. Procedure TestExternalClass_ClassOf;
  516. Procedure TestExternalClass_ClassOtherUnit;
  517. Procedure TestExternalClass_Is;
  518. Procedure TestExternalClass_As;
  519. Procedure TestExternalClass_DestructorFail;
  520. Procedure TestExternalClass_New;
  521. Procedure TestExternalClass_ClassOf_New;
  522. Procedure TestExternalClass_FuncClassOf_New;
  523. Procedure TestExternalClass_New_PasClassFail;
  524. Procedure TestExternalClass_New_PasClassBracketsFail;
  525. Procedure TestExternalClass_LocalConstSameName;
  526. Procedure TestExternalClass_ReintroduceOverload;
  527. Procedure TestExternalClass_Inherited;
  528. Procedure TestExternalClass_PascalAncestorFail;
  529. Procedure TestExternalClass_NewInstance;
  530. Procedure TestExternalClass_NewInstance_NonVirtualFail;
  531. Procedure TestExternalClass_NewInstance_FirstParamNotString_Fail;
  532. Procedure TestExternalClass_NewInstance_SecondParamTyped_Fail;
  533. Procedure TestExternalClass_PascalProperty;
  534. Procedure TestExternalClass_TypeCastToRootClass;
  535. Procedure TestExternalClass_TypeCastToJSObject;
  536. Procedure TestExternalClass_TypeCastStringToExternalString;
  537. Procedure TestExternalClass_TypeCastToJSFunction;
  538. Procedure TestExternalClass_CallClassFunctionOfInstanceFail;
  539. Procedure TestExternalClass_BracketAccessor;
  540. Procedure TestExternalClass_BracketAccessor_Call;
  541. Procedure TestExternalClass_BracketAccessor_2ParamsFail;
  542. Procedure TestExternalClass_BracketAccessor_ReadOnly;
  543. Procedure TestExternalClass_BracketAccessor_WriteOnly;
  544. Procedure TestExternalClass_BracketAccessor_MultiType;
  545. Procedure TestExternalClass_BracketAccessor_Index;
  546. Procedure TestExternalClass_ForInJSObject;
  547. Procedure TestExternalClass_ForInJSArray;
  548. Procedure TestExternalClass_IncompatibleArgDuplicateIdentifier;
  549. // class interfaces
  550. Procedure TestClassInterface_Corba;
  551. Procedure TestClassInterface_ProcExternalFail;
  552. Procedure TestClassInterface_Overloads;
  553. Procedure TestClassInterface_DuplicateGUIInIntfListFail;
  554. Procedure TestClassInterface_DuplicateGUIInAncestorFail;
  555. Procedure TestClassInterface_AncestorImpl;
  556. Procedure TestClassInterface_ImplReintroduce;
  557. Procedure TestClassInterface_MethodResolution;
  558. Procedure TestClassInterface_AncestorMoreInterfaces;
  559. Procedure TestClassInterface_MethodOverride;
  560. Procedure TestClassInterface_Corba_Delegation;
  561. Procedure TestClassInterface_Corba_DelegationStatic;
  562. Procedure TestClassInterface_Corba_Operators;
  563. Procedure TestClassInterface_Corba_Args;
  564. Procedure TestClassInterface_Corba_ForIn;
  565. Procedure TestClassInterface_COM_AssignVar;
  566. Procedure TestClassInterface_COM_AssignArg;
  567. Procedure TestClassInterface_COM_FunctionResult;
  568. Procedure TestClassInterface_COM_InheritedFuncResult;
  569. Procedure TestClassInterface_COM_IsAsTypeCasts;
  570. Procedure TestClassInterface_COM_PassAsArg;
  571. Procedure TestClassInterface_COM_PassToUntypedParam;
  572. Procedure TestClassInterface_COM_FunctionInExpr;
  573. Procedure TestClassInterface_COM_Property;
  574. Procedure TestClassInterface_COM_IntfProperty;
  575. Procedure TestClassInterface_COM_Delegation;
  576. Procedure TestClassInterface_COM_With;
  577. Procedure TestClassInterface_COM_ForIn;
  578. Procedure TestClassInterface_COM_ArrayOfIntfFail;
  579. Procedure TestClassInterface_COM_RecordIntfFail;
  580. Procedure TestClassInterface_COM_UnitInitialization;
  581. Procedure TestClassInterface_GUID;
  582. Procedure TestClassInterface_GUIDProperty;
  583. // proc types
  584. Procedure TestProcType;
  585. Procedure TestProcType_Arg;
  586. Procedure TestProcType_FunctionFPC;
  587. Procedure TestProcType_FunctionDelphi;
  588. Procedure TestProcType_ProcedureDelphi;
  589. Procedure TestProcType_AsParam;
  590. Procedure TestProcType_MethodFPC;
  591. Procedure TestProcType_MethodDelphi;
  592. Procedure TestProcType_PropertyFPC;
  593. Procedure TestProcType_PropertyDelphi;
  594. Procedure TestProcType_WithClassInstDoPropertyFPC;
  595. Procedure TestProcType_Nested;
  596. Procedure TestProcType_NestedOfObject;
  597. Procedure TestProcType_ReferenceToProc;
  598. Procedure TestProcType_ReferenceToMethod;
  599. Procedure TestProcType_Typecast;
  600. Procedure TestProcType_PassProcToUntyped;
  601. Procedure TestProcType_PassProcToArray;
  602. // pointer
  603. Procedure TestPointer;
  604. Procedure TestPointer_Proc;
  605. Procedure TestPointer_AssignRecordFail;
  606. Procedure TestPointer_AssignStaticArrayFail;
  607. Procedure TestPointer_TypeCastJSValueToPointer;
  608. Procedure TestPointer_NonRecordFail;
  609. Procedure TestPointer_AnonymousArgTypeFail;
  610. Procedure TestPointer_AnonymousVarTypeFail;
  611. Procedure TestPointer_AnonymousResultTypeFail;
  612. Procedure TestPointer_AddrOperatorFail;
  613. Procedure TestPointer_ArrayParamsFail;
  614. Procedure TestPointer_PointerAddFail;
  615. Procedure TestPointer_IncPointerFail;
  616. Procedure TestPointer_Record;
  617. Procedure TestPointer_RecordArg;
  618. // jsvalue
  619. Procedure TestJSValue_AssignToJSValue;
  620. Procedure TestJSValue_TypeCastToBaseType;
  621. Procedure TestJSValue_Equal;
  622. Procedure TestJSValue_If;
  623. Procedure TestJSValue_Not;
  624. Procedure TestJSValue_Enum;
  625. Procedure TestJSValue_ClassInstance;
  626. Procedure TestJSValue_ClassOf;
  627. Procedure TestJSValue_ArrayOfJSValue;
  628. Procedure TestJSValue_ArrayLit;
  629. Procedure TestJSValue_Params;
  630. Procedure TestJSValue_UntypedParam;
  631. Procedure TestJSValue_FuncResultType;
  632. Procedure TestJSValue_ProcType_Assign;
  633. Procedure TestJSValue_ProcType_Equal;
  634. Procedure TestJSValue_ProcType_Param;
  635. Procedure TestJSValue_AssignToPointerFail;
  636. Procedure TestJSValue_OverloadDouble;
  637. Procedure TestJSValue_OverloadNativeInt;
  638. Procedure TestJSValue_OverloadWord;
  639. Procedure TestJSValue_OverloadString;
  640. Procedure TestJSValue_OverloadChar;
  641. Procedure TestJSValue_OverloadPointer;
  642. Procedure TestJSValue_ForIn;
  643. // RTTI
  644. Procedure TestRTTI_IntRange;
  645. Procedure TestRTTI_Double;
  646. Procedure TestRTTI_ProcType;
  647. Procedure TestRTTI_ProcType_ArgFromOtherUnit;
  648. Procedure TestRTTI_EnumAndSetType;
  649. Procedure TestRTTI_EnumRange;
  650. Procedure TestRTTI_AnonymousEnumType;
  651. Procedure TestRTTI_StaticArray;
  652. Procedure TestRTTI_DynArray;
  653. Procedure TestRTTI_ArrayNestedAnonymous;
  654. Procedure TestRTTI_PublishedMethodOverloadFail;
  655. Procedure TestRTTI_PublishedMethodExternalFail;
  656. Procedure TestRTTI_PublishedClassPropertyFail;
  657. Procedure TestRTTI_PublishedClassFieldFail;
  658. Procedure TestRTTI_PublishedFieldExternalFail;
  659. Procedure TestRTTI_Class_Field;
  660. Procedure TestRTTI_Class_Method;
  661. Procedure TestRTTI_Class_MethodArgFlags;
  662. Procedure TestRTTI_Class_Property;
  663. Procedure TestRTTI_Class_PropertyParams;
  664. Procedure TestRTTI_Class_OtherUnit_TypeAlias;
  665. Procedure TestRTTI_Class_OmitRTTI;
  666. Procedure TestRTTI_IndexModifier;
  667. Procedure TestRTTI_StoredModifier;
  668. Procedure TestRTTI_DefaultValue;
  669. Procedure TestRTTI_DefaultValueSet;
  670. Procedure TestRTTI_DefaultValueRangeType;
  671. Procedure TestRTTI_DefaultValueInherit;
  672. Procedure TestRTTI_OverrideMethod;
  673. Procedure TestRTTI_OverloadProperty;
  674. // ToDo: array argument
  675. Procedure TestRTTI_ClassForward;
  676. Procedure TestRTTI_ClassOf;
  677. Procedure TestRTTI_Record;
  678. Procedure TestRTTI_RecordAnonymousArray;
  679. Procedure TestRTTI_LocalTypes;
  680. Procedure TestRTTI_TypeInfo_BaseTypes;
  681. Procedure TestRTTI_TypeInfo_Type_BaseTypes;
  682. Procedure TestRTTI_TypeInfo_LocalFail;
  683. Procedure TestRTTI_TypeInfo_ExtTypeInfoClasses1;
  684. Procedure TestRTTI_TypeInfo_ExtTypeInfoClasses2;
  685. Procedure TestRTTI_TypeInfo_ExtTypeInfoClasses3;
  686. Procedure TestRTTI_TypeInfo_FunctionClassType;
  687. Procedure TestRTTI_TypeInfo_MixedUnits_PointerAndClass;
  688. Procedure TestRTTI_Interface_Corba;
  689. Procedure TestRTTI_Interface_COM;
  690. // Resourcestring
  691. Procedure TestResourcestringProgram;
  692. Procedure TestResourcestringUnit;
  693. Procedure TestResourcestringImplementation;
  694. // Attributes
  695. Procedure TestAtributes_Ignore;
  696. // Assertions, checks
  697. procedure TestAssert;
  698. procedure TestAssert_SysUtils;
  699. procedure TestObjectChecks;
  700. procedure TestRangeChecks_AssignInt;
  701. procedure TestRangeChecks_AssignIntRange;
  702. procedure TestRangeChecks_AssignEnum;
  703. procedure TestRangeChecks_AssignEnumRange;
  704. procedure TestRangeChecks_AssignChar;
  705. procedure TestRangeChecks_AssignCharRange;
  706. procedure TestRangeChecks_ArrayIndex;
  707. procedure TestRangeChecks_StringIndex;
  708. procedure TestRangeChecks_TypecastInt;
  709. end;
  710. function LinesToStr(Args: array of const): string;
  711. function ExtractFileUnitName(aFilename: string): string;
  712. function JSToStr(El: TJSElement): string;
  713. function CheckSrcDiff(Expected, Actual: string; out Msg: string): boolean;
  714. implementation
  715. function LinesToStr(Args: array of const): string;
  716. var
  717. s: String;
  718. i: Integer;
  719. begin
  720. s:='';
  721. for i:=Low(Args) to High(Args) do
  722. case Args[i].VType of
  723. vtChar: s += Args[i].VChar+LineEnding;
  724. vtString: s += Args[i].VString^+LineEnding;
  725. vtPChar: s += Args[i].VPChar+LineEnding;
  726. vtWideChar: s += AnsiString(Args[i].VWideChar)+LineEnding;
  727. vtPWideChar: s += AnsiString(Args[i].VPWideChar)+LineEnding;
  728. vtAnsiString: s += AnsiString(Args[i].VAnsiString)+LineEnding;
  729. vtWidestring: s += AnsiString(WideString(Args[i].VWideString))+LineEnding;
  730. vtUnicodeString:s += AnsiString(UnicodeString(Args[i].VUnicodeString))+LineEnding;
  731. end;
  732. Result:=s;
  733. end;
  734. function ExtractFileUnitName(aFilename: string): string;
  735. var
  736. p: Integer;
  737. begin
  738. Result:=ExtractFileName(aFilename);
  739. if Result='' then exit;
  740. for p:=length(Result) downto 1 do
  741. case Result[p] of
  742. '/','\': exit;
  743. '.':
  744. begin
  745. Delete(Result,p,length(Result));
  746. exit;
  747. end;
  748. end;
  749. end;
  750. function JSToStr(El: TJSElement): string;
  751. var
  752. aWriter: TBufferWriter;
  753. aJSWriter: TJSWriter;
  754. begin
  755. aJSWriter:=nil;
  756. aWriter:=TBufferWriter.Create(1000);
  757. try
  758. aJSWriter:=TJSWriter.Create(aWriter);
  759. aJSWriter.IndentSize:=2;
  760. aJSWriter.WriteJS(El);
  761. Result:=aWriter.AsString;
  762. finally
  763. aJSWriter.Free;
  764. aWriter.Free;
  765. end;
  766. end;
  767. function CheckSrcDiff(Expected, Actual: string; out Msg: string): boolean;
  768. // search diff, ignore changes in spaces
  769. const
  770. SpaceChars = [#9,#10,#13,' '];
  771. var
  772. ExpectedP, ActualP: PChar;
  773. function FindLineEnd(p: PChar): PChar;
  774. begin
  775. Result:=p;
  776. while not (Result^ in [#0,#10,#13]) do inc(Result);
  777. end;
  778. function FindLineStart(p, MinP: PChar): PChar;
  779. begin
  780. while (p>MinP) and not (p[-1] in [#10,#13]) do dec(p);
  781. Result:=p;
  782. end;
  783. procedure SkipLineEnd(var p: PChar);
  784. begin
  785. if p^ in [#10,#13] then
  786. begin
  787. if (p[1] in [#10,#13]) and (p^<>p[1]) then
  788. inc(p,2)
  789. else
  790. inc(p);
  791. end;
  792. end;
  793. procedure DiffFound;
  794. var
  795. ActLineStartP, ActLineEndP, p, StartPos: PChar;
  796. ExpLine, ActLine: String;
  797. i, LineNo, DiffLineNo: Integer;
  798. begin
  799. writeln('Diff found "',Msg,'". Lines:');
  800. // write correct lines
  801. p:=PChar(Expected);
  802. LineNo:=0;
  803. DiffLineNo:=0;
  804. repeat
  805. StartPos:=p;
  806. while not (p^ in [#0,#10,#13]) do inc(p);
  807. ExpLine:=copy(Expected,StartPos-PChar(Expected)+1,p-StartPos);
  808. SkipLineEnd(p);
  809. inc(LineNo);
  810. if (p<=ExpectedP) and (p^<>#0) then
  811. begin
  812. writeln('= ',ExpLine);
  813. end else begin
  814. // diff line
  815. if DiffLineNo=0 then DiffLineNo:=LineNo;
  816. // write actual line
  817. ActLineStartP:=FindLineStart(ActualP,PChar(Actual));
  818. ActLineEndP:=FindLineEnd(ActualP);
  819. ActLine:=copy(Actual,ActLineStartP-PChar(Actual)+1,ActLineEndP-ActLineStartP);
  820. writeln('- ',ActLine);
  821. // write expected line
  822. writeln('+ ',ExpLine);
  823. // write empty line with pointer ^
  824. for i:=1 to 2+ExpectedP-StartPos do write(' ');
  825. writeln('^');
  826. Msg:='expected "'+ExpLine+'", but got "'+ActLine+'".';
  827. CheckSrcDiff:=false;
  828. // write up to three following actual lines to get some context
  829. for i:=1 to 3 do begin
  830. ActLineStartP:=ActLineEndP;
  831. SkipLineEnd(ActLineStartP);
  832. if ActLineStartP^=#0 then break;
  833. ActLineEndP:=FindLineEnd(ActLineStartP);
  834. ActLine:=copy(Actual,ActLineStartP-PChar(Actual)+1,ActLineEndP-ActLineStartP);
  835. writeln('~ ',ActLine);
  836. end;
  837. exit;
  838. end;
  839. until p^=#0;
  840. writeln('DiffFound Actual:-----------------------');
  841. writeln(Actual);
  842. writeln('DiffFound Expected:---------------------');
  843. writeln(Expected);
  844. writeln('DiffFound ------------------------------');
  845. Msg:='diff found, but lines are the same, internal error';
  846. CheckSrcDiff:=false;
  847. end;
  848. var
  849. IsSpaceNeeded: Boolean;
  850. LastChar, Quote: Char;
  851. begin
  852. Result:=true;
  853. Msg:='';
  854. if Expected='' then Expected:=' ';
  855. if Actual='' then Actual:=' ';
  856. ExpectedP:=PChar(Expected);
  857. ActualP:=PChar(Actual);
  858. repeat
  859. //writeln('TTestModule.CheckDiff Exp="',ExpectedP^,'" Act="',ActualP^,'"');
  860. case ExpectedP^ of
  861. #0:
  862. begin
  863. // check that rest of Actual has only spaces
  864. while ActualP^ in SpaceChars do inc(ActualP);
  865. if ActualP^<>#0 then
  866. begin
  867. DiffFound;
  868. exit;
  869. end;
  870. exit(true);
  871. end;
  872. ' ',#9,#10,#13:
  873. begin
  874. // skip space in Expected
  875. IsSpaceNeeded:=false;
  876. if ExpectedP>PChar(Expected) then
  877. LastChar:=ExpectedP[-1]
  878. else
  879. LastChar:=#0;
  880. while ExpectedP^ in SpaceChars do inc(ExpectedP);
  881. if (LastChar in ['a'..'z','A'..'Z','0'..'9','_','$'])
  882. and (ExpectedP^ in ['a'..'z','A'..'Z','0'..'9','_','$']) then
  883. IsSpaceNeeded:=true;
  884. if IsSpaceNeeded and (not (ActualP^ in SpaceChars)) then
  885. begin
  886. DiffFound;
  887. exit;
  888. end;
  889. while ActualP^ in SpaceChars do inc(ActualP);
  890. end;
  891. '''','"':
  892. begin
  893. while ActualP^ in SpaceChars do inc(ActualP);
  894. if ExpectedP^<>ActualP^ then
  895. begin
  896. DiffFound;
  897. exit;
  898. end;
  899. Quote:=ExpectedP^;
  900. repeat
  901. inc(ExpectedP);
  902. inc(ActualP);
  903. if ExpectedP^<>ActualP^ then
  904. begin
  905. DiffFound;
  906. exit;
  907. end;
  908. if (ExpectedP^ in [#0,#10,#13]) then
  909. break
  910. else if (ExpectedP^=Quote) then
  911. begin
  912. inc(ExpectedP);
  913. inc(ActualP);
  914. break;
  915. end;
  916. until false;
  917. end;
  918. else
  919. while ActualP^ in SpaceChars do inc(ActualP);
  920. if ExpectedP^<>ActualP^ then
  921. begin
  922. DiffFound;
  923. exit;
  924. end;
  925. inc(ExpectedP);
  926. inc(ActualP);
  927. end;
  928. until false;
  929. end;
  930. { TTestEnginePasResolver }
  931. destructor TTestEnginePasResolver.Destroy;
  932. begin
  933. FreeAndNil(FStreamResolver);
  934. FreeAndNil(FParser);
  935. FreeAndNil(FScanner);
  936. FreeAndNil(FStreamResolver);
  937. if Module<>nil then
  938. begin
  939. Module.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
  940. FModule:=nil;
  941. end;
  942. inherited Destroy;
  943. end;
  944. function TTestEnginePasResolver.FindUnit(const AName, InFilename: String;
  945. NameExpr, InFileExpr: TPasExpr): TPasModule;
  946. begin
  947. Result:=nil;
  948. if InFilename<>'' then
  949. RaiseNotYetImplemented(20180224101926,InFileExpr,'Use testcase tcunitsearch instead');
  950. if Assigned(OnFindUnit) then
  951. Result:=OnFindUnit(AName);
  952. if NameExpr=nil then ;
  953. end;
  954. procedure TTestEnginePasResolver.UsedInterfacesFinished(Section: TPasSection);
  955. begin
  956. // do not parse recursively
  957. // parse via the queue
  958. if Section=nil then ;
  959. end;
  960. { TCustomTestModule }
  961. function TCustomTestModule.GetMsgCount: integer;
  962. begin
  963. Result:=FHintMsgs.Count;
  964. end;
  965. function TCustomTestModule.GetMsgs(Index: integer): TTestHintMessage;
  966. begin
  967. Result:=TTestHintMessage(FHintMsgs[Index]);
  968. end;
  969. function TCustomTestModule.GetResolverCount: integer;
  970. begin
  971. Result:=FModules.Count;
  972. end;
  973. function TCustomTestModule.GetResolvers(Index: integer
  974. ): TTestEnginePasResolver;
  975. begin
  976. Result:=TTestEnginePasResolver(FModules[Index]);
  977. end;
  978. function TCustomTestModule.OnPasResolverFindUnit(const aUnitName: String
  979. ): TPasModule;
  980. var
  981. DefNamespace: String;
  982. begin
  983. //writeln('TTestModule.OnPasResolverFindUnit START Unit="',aUnitName,'"');
  984. if (Pos('.',aUnitName)<1) then
  985. begin
  986. DefNamespace:=GetDefaultNamespace;
  987. if DefNamespace<>'' then
  988. begin
  989. Result:=LoadUnit(DefNamespace+'.'+aUnitName);
  990. if Result<>nil then exit;
  991. end;
  992. end;
  993. Result:=LoadUnit(aUnitName);
  994. if Result<>nil then exit;
  995. {$IFDEF VerbosePas2JS}
  996. writeln('TTestModule.OnPasResolverFindUnit missing unit "',aUnitName,'"');
  997. {$ENDIF}
  998. Fail('can''t find unit "'+aUnitName+'"');
  999. end;
  1000. procedure TCustomTestModule.OnParserLog(Sender: TObject; const Msg: String);
  1001. var
  1002. aParser: TPasParser;
  1003. Item: TTestHintMessage;
  1004. begin
  1005. aParser:=Sender as TPasParser;
  1006. Item:=TTestHintMessage.Create;
  1007. Item.Id:=aParser.LastMsgNumber;
  1008. Item.MsgType:=aParser.LastMsgType;
  1009. Item.MsgNumber:=aParser.LastMsgNumber;
  1010. Item.Msg:=Msg;
  1011. Item.SourcePos:=aParser.Scanner.CurSourcePos;
  1012. {$IFDEF VerbosePas2JS}
  1013. writeln('TCustomTestModule.OnParserLog ',GetObjName(Sender),' ',Item.MsgType,' (',Item.MsgNumber,') {',Msg,'}');
  1014. {$ENDIF}
  1015. FHintMsgs.Add(Item);
  1016. end;
  1017. procedure TCustomTestModule.OnPasResolverLog(Sender: TObject; const Msg: String
  1018. );
  1019. var
  1020. aResolver: TTestEnginePasResolver;
  1021. Item: TTestHintMessage;
  1022. begin
  1023. aResolver:=Sender as TTestEnginePasResolver;
  1024. Item:=TTestHintMessage.Create;
  1025. Item.Id:=aResolver.LastMsgId;
  1026. Item.MsgType:=aResolver.LastMsgType;
  1027. Item.MsgNumber:=aResolver.LastMsgNumber;
  1028. Item.Msg:=Msg;
  1029. Item.SourcePos:=aResolver.LastSourcePos;
  1030. {$IFDEF VerbosePas2JS}
  1031. writeln('TCustomTestModule.OnPasResolverLog ',GetObjName(Sender),' ',Item.MsgType,' (',Item.MsgNumber,') {',Msg,'}');
  1032. {$ENDIF}
  1033. FHintMsgs.Add(Item);
  1034. end;
  1035. procedure TCustomTestModule.OnScannerLog(Sender: TObject; const Msg: String);
  1036. var
  1037. Item: TTestHintMessage;
  1038. aScanner: TPas2jsPasScanner;
  1039. begin
  1040. aScanner:=Sender as TPas2jsPasScanner;
  1041. Item:=TTestHintMessage.Create;
  1042. Item.Id:=aScanner.LastMsgNumber;
  1043. Item.MsgType:=aScanner.LastMsgType;
  1044. Item.MsgNumber:=aScanner.LastMsgNumber;
  1045. Item.Msg:=Msg;
  1046. Item.SourcePos:=aScanner.CurSourcePos;
  1047. {$IFDEF VerbosePas2JS}
  1048. writeln('TCustomTestModule.OnScannerLog ',GetObjName(Sender),' ',Item.MsgType,' (',Item.MsgNumber,') {',Msg,'}');
  1049. {$ENDIF}
  1050. FHintMsgs.Add(Item);
  1051. end;
  1052. function TCustomTestModule.LoadUnit(const aUnitName: String): TPasModule;
  1053. var
  1054. i: Integer;
  1055. CurEngine: TTestEnginePasResolver;
  1056. CurUnitName: String;
  1057. begin
  1058. //writeln('TTestModule.FindUnit START Unit="',aUnitName,'"');
  1059. Result:=nil;
  1060. if (Module.ClassType=TPasModule)
  1061. and (CompareText(Module.Name,aUnitName)=0) then
  1062. exit(Module);
  1063. for i:=0 to ResolverCount-1 do
  1064. begin
  1065. CurEngine:=Resolvers[i];
  1066. CurUnitName:=ExtractFileUnitName(CurEngine.Filename);
  1067. //writeln('TTestModule.FindUnit Checking ',i,'/',ResolverCount,' ',CurEngine.Filename,' ',CurUnitName);
  1068. if CompareText(aUnitName,CurUnitName)=0 then
  1069. begin
  1070. Result:=CurEngine.Module;
  1071. if Result<>nil then exit;
  1072. //writeln('TTestModule.FindUnit PARSING unit "',CurEngine.Filename,'"');
  1073. FileResolver.FindSourceFile(aUnitName);
  1074. CurEngine.StreamResolver:=TStreamResolver.Create;
  1075. CurEngine.StreamResolver.OwnsStreams:=True;
  1076. //writeln('TTestModule.FindUnit SOURCE=',CurEngine.Source);
  1077. CurEngine.StreamResolver.AddStream(CurEngine.FileName,TStringStream.Create(CurEngine.Source));
  1078. CurEngine.Scanner:=TPas2jsPasScanner.Create(CurEngine.StreamResolver);
  1079. InitScanner(CurEngine.Scanner);
  1080. CurEngine.Parser:=TTestPasParser.Create(CurEngine.Scanner,CurEngine.StreamResolver,CurEngine);
  1081. CurEngine.Parser.Options:=po_tcmodules;
  1082. if CompareText(CurUnitName,'System')=0 then
  1083. CurEngine.Parser.ImplicitUses.Clear;
  1084. CurEngine.Scanner.OpenFile(CurEngine.Filename);
  1085. try
  1086. CurEngine.Parser.NextToken;
  1087. CurEngine.Parser.ParseUnit(CurEngine.FModule);
  1088. except
  1089. on E: Exception do
  1090. HandleException(E);
  1091. end;
  1092. //writeln('TTestModule.FindUnit END ',CurUnitName);
  1093. Result:=CurEngine.Module;
  1094. exit;
  1095. end;
  1096. end;
  1097. end;
  1098. procedure TCustomTestModule.SetUp;
  1099. begin
  1100. {$IFDEF EnablePasTreeGlobalRefCount}
  1101. FElementRefCountAtSetup:=TPasElement.GlobalRefCount;
  1102. {$ENDIF}
  1103. if FModules<>nil then
  1104. begin
  1105. writeln('TCustomTestModule.SetUp FModules<>nil');
  1106. Halt;
  1107. end;
  1108. inherited SetUp;
  1109. FSkipTests:=false;
  1110. FSource:=TStringList.Create;
  1111. FModules:=TObjectList.Create(true);
  1112. FFilename:='test1.pp';
  1113. FFileResolver:=TStreamResolver.Create;
  1114. FFileResolver.OwnsStreams:=True;
  1115. FScanner:=TPas2jsPasScanner.Create(FFileResolver);
  1116. InitScanner(FScanner);
  1117. FEngine:=AddModule(Filename);
  1118. FEngine.Scanner:=FScanner;
  1119. FScanner.Resolver:=FEngine;
  1120. FParser:=TTestPasParser.Create(FScanner,FFileResolver,FEngine);
  1121. FParser.OnLog:=@OnParserLog;
  1122. FEngine.Parser:=FParser;
  1123. Parser.Options:=po_tcmodules;
  1124. FModule:=Nil;
  1125. FConverter:=CreateConverter;
  1126. FExpectedErrorClass:=nil;
  1127. end;
  1128. function TCustomTestModule.CreateConverter: TPasToJSConverter;
  1129. begin
  1130. Result:=TPasToJSConverter.Create;
  1131. Result.Options:=co_tcmodules;
  1132. Result.Globals:=TPasToJSConverterGlobals.Create(Result);
  1133. end;
  1134. procedure TCustomTestModule.InitScanner(aScanner: TPas2jsPasScanner);
  1135. begin
  1136. aScanner.AllowedModeSwitches:=msAllPas2jsModeSwitches;
  1137. aScanner.ReadOnlyModeSwitches:=msAllPas2jsModeSwitchesReadOnly;
  1138. aScanner.CurrentModeSwitches:=OBJFPCModeSwitches*msAllPas2jsModeSwitches+msAllPas2jsModeSwitchesReadOnly;
  1139. aScanner.AllowedBoolSwitches:=msAllPas2jsBoolSwitches;
  1140. aScanner.ReadOnlyBoolSwitches:=msAllPas2jsBoolSwitchesReadOnly;
  1141. aScanner.CurrentBoolSwitches:=msAllPas2jsBoolSwitchesReadOnly+[bsHints,bsNotes,bsWarnings,bsWriteableConst];
  1142. aScanner.OnLog:=@OnScannerLog;
  1143. aScanner.CompilerVersion:='Comp.Ver.tcmodules';
  1144. end;
  1145. procedure TCustomTestModule.TearDown;
  1146. {$IFDEF CheckPasTreeRefCount}
  1147. var
  1148. El: TPasElement;
  1149. {$ENDIF}
  1150. var
  1151. i: Integer;
  1152. CurModule: TPasModule;
  1153. begin
  1154. FHintMsgs.Clear;
  1155. FHintMsgsGood.Clear;
  1156. FSkipTests:=false;
  1157. FJSRegModuleCall:=nil;
  1158. FJSModuleCallArgs:=nil;
  1159. FJSImplentationUses:=nil;
  1160. FJSInterfaceUses:=nil;
  1161. FJSModuleSrc:=nil;
  1162. FJSInitBody:=nil;
  1163. FreeAndNil(FJSSource);
  1164. FreeAndNil(FJSModule);
  1165. FreeAndNil(FConverter);
  1166. Engine.Clear;
  1167. FreeAndNil(FSource);
  1168. FreeAndNil(FFileResolver);
  1169. if FModules<>nil then
  1170. begin
  1171. for i:=0 to FModules.Count-1 do
  1172. begin
  1173. CurModule:=TTestEnginePasResolver(FModules[i]).Module;
  1174. if CurModule=nil then continue;
  1175. //writeln('TCustomTestModule.TearDown ReleaseUsedUnits ',CurModule.Name,' ',CurModule.RefCount,' ',CurModule.RefIds.Text);
  1176. CurModule.ReleaseUsedUnits;
  1177. end;
  1178. if FModule<>nil then
  1179. FModule.ReleaseUsedUnits;
  1180. for i:=0 to FModules.Count-1 do
  1181. begin
  1182. CurModule:=TTestEnginePasResolver(FModules[i]).Module;
  1183. if CurModule=nil then continue;
  1184. //writeln('TCustomTestModule.TearDown UsesReleased ',CurModule.Name,' ',CurModule.RefCount,' ',CurModule.RefIds.Text);
  1185. end;
  1186. FreeAndNil(FModules);
  1187. ReleaseAndNil(TPasElement(FModule){$IFDEF CheckPasTreeRefCount},'CreateElement'{$ENDIF});
  1188. FEngine:=nil;
  1189. end;
  1190. inherited TearDown;
  1191. {$IFDEF EnablePasTreeGlobalRefCount}
  1192. if FElementRefCountAtSetup<>TPasElement.GlobalRefCount then
  1193. begin
  1194. writeln('TCustomTestModule.TearDown GlobalRefCount Was='+IntToStr(FElementRefCountAtSetup)+' Now='+IntToStr(TPasElement.GlobalRefCount));
  1195. {$IFDEF CheckPasTreeRefCount}
  1196. El:=TPasElement.FirstRefEl;
  1197. while El<>nil do
  1198. begin
  1199. writeln(' ',GetObjName(El),' RefIds.Count=',El.RefIds.Count,':');
  1200. for i:=0 to El.RefIds.Count-1 do
  1201. writeln(' ',El.RefIds[i]);
  1202. El:=El.NextRefEl;
  1203. end;
  1204. {$ENDIF}
  1205. Halt;
  1206. Fail('TCustomTestModule.TearDown Was='+IntToStr(FElementRefCountAtSetup)+' Now='+IntToStr(TPasElement.GlobalRefCount));
  1207. end;
  1208. {$ENDIF}
  1209. end;
  1210. procedure TCustomTestModule.Add(Line: string);
  1211. begin
  1212. Source.Add(Line);
  1213. end;
  1214. procedure TCustomTestModule.Add(const Lines: array of string);
  1215. var
  1216. i: Integer;
  1217. begin
  1218. for i:=low(Lines) to high(Lines) do
  1219. Add(Lines[i]);
  1220. end;
  1221. procedure TCustomTestModule.StartParsing;
  1222. var
  1223. Src: String;
  1224. begin
  1225. Src:=Source.Text;
  1226. FEngine.Source:=Src;
  1227. FileResolver.AddStream(FileName,TStringStream.Create(Src));
  1228. Scanner.OpenFile(FileName);
  1229. Writeln('// Test : ',Self.TestName);
  1230. Writeln(Src);
  1231. end;
  1232. procedure TCustomTestModule.ParseModuleQueue;
  1233. var
  1234. i: Integer;
  1235. CurResolver: TTestEnginePasResolver;
  1236. Found: Boolean;
  1237. Section: TPasSection;
  1238. begin
  1239. // parse til exception or all modules finished
  1240. while not SkipTests do
  1241. begin
  1242. Found:=false;
  1243. for i:=0 to ResolverCount-1 do
  1244. begin
  1245. CurResolver:=Resolvers[i];
  1246. if CurResolver.CurrentParser=nil then continue;
  1247. if not CurResolver.CurrentParser.CanParseContinue(Section) then
  1248. continue;
  1249. CurResolver.Parser.ParseContinue;
  1250. Found:=true;
  1251. break;
  1252. end;
  1253. if not Found then break;
  1254. end;
  1255. for i:=0 to ResolverCount-1 do
  1256. begin
  1257. CurResolver:=Resolvers[i];
  1258. if CurResolver.Parser=nil then
  1259. begin
  1260. if CurResolver.CurrentParser<>nil then
  1261. Fail('TCustomTestModule.ParseModuleQueue '+CurResolver.Filename+' '+GetObjName(CurResolver.Parser)+'=Parser<>CurrentParser='+GetObjName(CurResolver.CurrentParser));
  1262. continue;
  1263. end;
  1264. if CurResolver.Parser.CurModule<>nil then
  1265. Fail('TCustomTestModule.ParseModuleQueue '+CurResolver.Filename+' NOT FINISHED CurModule='+GetObjName(CurResolver.Parser.CurModule));
  1266. end;
  1267. end;
  1268. procedure TCustomTestModule.ParseModule;
  1269. begin
  1270. if SkipTests then exit;
  1271. FFirstPasStatement:=nil;
  1272. try
  1273. StartParsing;
  1274. Parser.ParseMain(FModule);
  1275. ParseModuleQueue;
  1276. except
  1277. on E: Exception do
  1278. HandleException(E);
  1279. end;
  1280. if SkipTests then exit;
  1281. AssertNotNull('Module resulted in Module',Module);
  1282. AssertEquals('modulename',lowercase(ChangeFileExt(FFileName,'')),lowercase(Module.Name));
  1283. TAssert.AssertSame('Has resolver',Engine,Parser.Engine);
  1284. end;
  1285. procedure TCustomTestModule.ParseProgram;
  1286. begin
  1287. if SkipTests then exit;
  1288. ParseModule;
  1289. if SkipTests then exit;
  1290. AssertEquals('Has program',TPasProgram,Module.ClassType);
  1291. FPasProgram:=TPasProgram(Module);
  1292. AssertNotNull('Has program section',PasProgram.ProgramSection);
  1293. AssertNotNull('Has initialization section',PasProgram.InitializationSection);
  1294. if (PasProgram.InitializationSection.Elements.Count>0) then
  1295. if TObject(PasProgram.InitializationSection.Elements[0]) is TPasImplBlock then
  1296. FFirstPasStatement:=TPasImplBlock(PasProgram.InitializationSection.Elements[0]);
  1297. end;
  1298. procedure TCustomTestModule.ParseUnit;
  1299. begin
  1300. if SkipTests then exit;
  1301. ParseModule;
  1302. if SkipTests then exit;
  1303. AssertEquals('Has unit (TPasModule)',TPasModule,Module.ClassType);
  1304. AssertNotNull('Has interface section',Module.InterfaceSection);
  1305. AssertNotNull('Has implementation section',Module.ImplementationSection);
  1306. if (Module.InitializationSection<>nil)
  1307. and (Module.InitializationSection.Elements.Count>0)
  1308. and (TObject(Module.InitializationSection.Elements[0]) is TPasImplBlock) then
  1309. FFirstPasStatement:=TPasImplBlock(Module.InitializationSection.Elements[0]);
  1310. end;
  1311. function TCustomTestModule.FindModuleWithFilename(aFilename: string
  1312. ): TTestEnginePasResolver;
  1313. var
  1314. i: Integer;
  1315. begin
  1316. for i:=0 to ResolverCount-1 do
  1317. if CompareText(Resolvers[i].Filename,aFilename)=0 then
  1318. exit(Resolvers[i]);
  1319. Result:=nil;
  1320. end;
  1321. function TCustomTestModule.AddModule(aFilename: string
  1322. ): TTestEnginePasResolver;
  1323. begin
  1324. //writeln('TTestModuleConverter.AddModule ',aFilename);
  1325. if FindModuleWithFilename(aFilename)<>nil then
  1326. Fail('TTestModuleConverter.AddModule: file "'+aFilename+'" already exists');
  1327. Result:=TTestEnginePasResolver.Create;
  1328. Result.Filename:=aFilename;
  1329. Result.AddObjFPCBuiltInIdentifiers(btAllJSBaseTypes,bfAllJSBaseProcs);
  1330. Result.OnFindUnit:=@OnPasResolverFindUnit;
  1331. Result.OnLog:=@OnPasResolverLog;
  1332. FModules.Add(Result);
  1333. end;
  1334. function TCustomTestModule.AddModuleWithSrc(aFilename, Src: string
  1335. ): TTestEnginePasResolver;
  1336. begin
  1337. Result:=AddModule(aFilename);
  1338. Result.Source:=Src;
  1339. end;
  1340. function TCustomTestModule.AddModuleWithIntfImplSrc(aFilename, InterfaceSrc,
  1341. ImplementationSrc: string): TTestEnginePasResolver;
  1342. var
  1343. Src: String;
  1344. begin
  1345. Src:='unit '+ExtractFileUnitName(aFilename)+';'+LineEnding;
  1346. Src+=LineEnding;
  1347. Src+='interface'+LineEnding;
  1348. Src+=LineEnding;
  1349. Src+=InterfaceSrc;
  1350. Src+='implementation'+LineEnding;
  1351. Src+=LineEnding;
  1352. Src+=ImplementationSrc;
  1353. Src+='end.'+LineEnding;
  1354. Result:=AddModuleWithSrc(aFilename,Src);
  1355. end;
  1356. procedure TCustomTestModule.AddSystemUnit;
  1357. begin
  1358. AddModuleWithIntfImplSrc('system.pp',
  1359. // interface
  1360. LinesToStr([
  1361. 'type',
  1362. ' integer=longint;',
  1363. 'var',
  1364. ' ExitCode: Longint;',
  1365. ''
  1366. // implementation
  1367. ]),LinesToStr([
  1368. ''
  1369. ]));
  1370. end;
  1371. procedure TCustomTestModule.StartProgram(NeedSystemUnit: boolean);
  1372. begin
  1373. if NeedSystemUnit then
  1374. AddSystemUnit
  1375. else
  1376. Parser.ImplicitUses.Clear;
  1377. Add('program '+ExtractFileUnitName(Filename)+';');
  1378. Add('');
  1379. end;
  1380. procedure TCustomTestModule.StartUnit(NeedSystemUnit: boolean);
  1381. begin
  1382. if NeedSystemUnit then
  1383. AddSystemUnit
  1384. else
  1385. Parser.ImplicitUses.Clear;
  1386. Add('unit Test1;');
  1387. Add('');
  1388. end;
  1389. procedure TCustomTestModule.ConvertModule;
  1390. procedure CheckUsesList(UsesName: String; Arg: TJSArrayLiteralElement;
  1391. out UsesLit: TJSArrayLiteral);
  1392. var
  1393. i: Integer;
  1394. Item: TJSElement;
  1395. Lit: TJSLiteral;
  1396. begin
  1397. UsesLit:=nil;
  1398. AssertNotNull(UsesName+' uses section',Arg.Expr);
  1399. if (Arg.Expr.ClassType=TJSLiteral) and TJSLiteral(Arg.Expr).Value.IsNull then
  1400. exit; // null is ok
  1401. AssertEquals(UsesName+' uses section param is array',TJSArrayLiteral,Arg.Expr.ClassType);
  1402. FJSInterfaceUses:=TJSArrayLiteral(Arg.Expr);
  1403. for i:=0 to FJSInterfaceUses.Elements.Count-1 do
  1404. begin
  1405. Item:=FJSInterfaceUses.Elements.Elements[i].Expr;
  1406. AssertNotNull(UsesName+' uses section item['+IntToStr(i)+'].Expr',Item);
  1407. AssertEquals(UsesName+' uses section item['+IntToStr(i)+'] is lit',TJSLiteral,Item.ClassType);
  1408. Lit:=TJSLiteral(Item);
  1409. AssertEquals(UsesName+' uses section item['+IntToStr(i)+'] is string lit',
  1410. ord(jsbase.jstString),ord(Lit.Value.ValueType));
  1411. end;
  1412. end;
  1413. procedure CheckFunctionParam(ParamName: string; Arg: TJSArrayLiteralElement;
  1414. out Src: TJSSourceElements);
  1415. var
  1416. FunDecl: TJSFunctionDeclarationStatement;
  1417. FunDef: TJSFuncDef;
  1418. FunBody: TJSFunctionBody;
  1419. begin
  1420. Src:=nil;
  1421. AssertNotNull(ParamName,Arg.Expr);
  1422. AssertEquals(ParamName+' Arg.Expr type',TJSFunctionDeclarationStatement,Arg.Expr.ClassType);
  1423. FunDecl:=Arg.Expr as TJSFunctionDeclarationStatement;
  1424. AssertNotNull(ParamName+' FunDecl.AFunction',FunDecl.AFunction);
  1425. AssertEquals(ParamName+' FunDecl.AFunction type',TJSFuncDef,FunDecl.AFunction.ClassType);
  1426. FunDef:=FunDecl.AFunction as TJSFuncDef;
  1427. AssertEquals(ParamName+' name empty','',String(FunDef.Name));
  1428. AssertNotNull(ParamName+' body',FunDef.Body);
  1429. AssertEquals(ParamName+' body type',TJSFunctionBody,FunDef.Body.ClassType);
  1430. FunBody:=FunDef.Body as TJSFunctionBody;
  1431. AssertNotNull(ParamName+' body.A',FunBody.A);
  1432. AssertEquals(ParamName+' body.A type',TJSSourceElements,FunBody.A.ClassType);
  1433. Src:=FunBody.A as TJSSourceElements;
  1434. end;
  1435. var
  1436. ModuleNameExpr: TJSLiteral;
  1437. InitFunction: TJSFunctionDeclarationStatement;
  1438. InitAssign: TJSSimpleAssignStatement;
  1439. InitName: String;
  1440. LastNode: TJSElement;
  1441. Arg: TJSArrayLiteralElement;
  1442. begin
  1443. if SkipTests then exit;
  1444. try
  1445. FJSModule:=FConverter.ConvertPasElement(Module,Engine) as TJSSourceElements;
  1446. except
  1447. on E: Exception do
  1448. HandleException(E);
  1449. end;
  1450. if SkipTests then exit;
  1451. if ExpectedErrorClass<>nil then
  1452. Fail('Missing '+ExpectedErrorClass.ClassName+' error {'+ExpectedErrorMsg+'} ('+IntToStr(ExpectedErrorNumber)+')');
  1453. FJSSource:=TStringList.Create;
  1454. FJSSource.Text:=ConvertJSModuleToString(JSModule);
  1455. {$IFDEF VerbosePas2JS}
  1456. writeln('TTestModule.ConvertModule JS:');
  1457. write(FJSSource.Text);
  1458. {$ENDIF}
  1459. // rtl.module(...
  1460. AssertEquals('jsmodule has one statement - the call',1,JSModule.Statements.Count);
  1461. AssertNotNull('register module call',JSModule.Statements.Nodes[0].Node);
  1462. AssertEquals('register module call',TJSCallExpression,JSModule.Statements.Nodes[0].Node.ClassType);
  1463. FJSRegModuleCall:=JSModule.Statements.Nodes[0].Node as TJSCallExpression;
  1464. AssertNotNull('register module rtl.module expr',JSRegModuleCall.Expr);
  1465. AssertNotNull('register module rtl.module args',JSRegModuleCall.Args);
  1466. AssertEquals('rtl.module args',TJSArguments,JSRegModuleCall.Args.ClassType);
  1467. FJSModuleCallArgs:=JSRegModuleCall.Args as TJSArguments;
  1468. // parameter 'unitname'
  1469. if JSModuleCallArgs.Elements.Count<1 then
  1470. Fail('rtl.module first param unit missing');
  1471. Arg:=JSModuleCallArgs.Elements.Elements[0];
  1472. AssertNotNull('module name param',Arg.Expr);
  1473. ModuleNameExpr:=Arg.Expr as TJSLiteral;
  1474. AssertEquals('module name param is string',ord(jstString),ord(ModuleNameExpr.Value.ValueType));
  1475. if Module is TPasProgram then
  1476. AssertEquals('module name','program',String(ModuleNameExpr.Value.AsString))
  1477. else
  1478. AssertEquals('module name',Module.Name,String(ModuleNameExpr.Value.AsString));
  1479. // main uses section
  1480. if JSModuleCallArgs.Elements.Count<2 then
  1481. Fail('rtl.module second param main uses missing');
  1482. Arg:=JSModuleCallArgs.Elements.Elements[1];
  1483. CheckUsesList('interface',Arg,FJSInterfaceUses);
  1484. // program/library/interface function()
  1485. if JSModuleCallArgs.Elements.Count<3 then
  1486. Fail('rtl.module third param intf-function missing');
  1487. Arg:=JSModuleCallArgs.Elements.Elements[2];
  1488. CheckFunctionParam('module intf-function',Arg,FJSModuleSrc);
  1489. // search for $mod.$init or $mod.$main - the last statement
  1490. if Module is TPasProgram then
  1491. begin
  1492. InitName:='$main';
  1493. AssertEquals('$mod.'+InitName+' function 1',true,JSModuleSrc.Statements.Count>0);
  1494. end
  1495. else
  1496. InitName:='$init';
  1497. FJSInitBody:=nil;
  1498. if JSModuleSrc.Statements.Count>0 then
  1499. begin
  1500. LastNode:=JSModuleSrc.Statements.Nodes[JSModuleSrc.Statements.Count-1].Node;
  1501. if LastNode is TJSSimpleAssignStatement then
  1502. begin
  1503. InitAssign:=LastNode as TJSSimpleAssignStatement;
  1504. if GetDottedIdentifier(InitAssign.LHS)='$mod.'+InitName then
  1505. begin
  1506. InitFunction:=InitAssign.Expr as TJSFunctionDeclarationStatement;
  1507. FJSInitBody:=InitFunction.AFunction.Body as TJSFunctionBody;
  1508. end
  1509. else if Module is TPasProgram then
  1510. CheckDottedIdentifier('init function',InitAssign.LHS,'$mod.'+InitName);
  1511. end;
  1512. end;
  1513. // optional: implementation uses section
  1514. if JSModuleCallArgs.Elements.Count<4 then
  1515. exit;
  1516. Arg:=JSModuleCallArgs.Elements.Elements[3];
  1517. CheckUsesList('implementation',Arg,FJSImplentationUses);
  1518. // optional: implementation function()
  1519. if JSModuleCallArgs.Elements.Count<5 then
  1520. exit;
  1521. Arg:=JSModuleCallArgs.Elements.Elements[4];
  1522. CheckFunctionParam('module impl-function',Arg,FJSImplementationSrc);
  1523. end;
  1524. procedure TCustomTestModule.ConvertProgram;
  1525. begin
  1526. Add('end.');
  1527. ParseProgram;
  1528. ConvertModule;
  1529. end;
  1530. procedure TCustomTestModule.ConvertUnit;
  1531. begin
  1532. Add('end.');
  1533. ParseUnit;
  1534. ConvertModule;
  1535. end;
  1536. function TCustomTestModule.ConvertJSModuleToString(El: TJSElement): string;
  1537. begin
  1538. Result:=tcmodules.JSToStr(El);
  1539. end;
  1540. procedure TCustomTestModule.CheckDottedIdentifier(Msg: string; El: TJSElement;
  1541. DottedName: string);
  1542. begin
  1543. if DottedName='' then
  1544. begin
  1545. AssertNull(Msg,El);
  1546. end
  1547. else
  1548. begin
  1549. AssertNotNull(Msg,El);
  1550. AssertEquals(Msg,DottedName,GetDottedIdentifier(El));
  1551. end;
  1552. end;
  1553. function TCustomTestModule.GetDottedIdentifier(El: TJSElement): string;
  1554. begin
  1555. if El=nil then
  1556. Result:=''
  1557. else if El is TJSPrimaryExpressionIdent then
  1558. Result:=String(TJSPrimaryExpressionIdent(El).Name)
  1559. else if El is TJSDotMemberExpression then
  1560. Result:=GetDottedIdentifier(TJSDotMemberExpression(El).MExpr)+'.'+String(TJSDotMemberExpression(El).Name)
  1561. else
  1562. AssertEquals('GetDottedIdentifier',TJSPrimaryExpressionIdent,El.ClassType);
  1563. end;
  1564. procedure TCustomTestModule.CheckSource(Msg, Statements: String;
  1565. InitStatements: string; ImplStatements: string);
  1566. var
  1567. ActualSrc, ExpectedSrc, InitName: String;
  1568. begin
  1569. ActualSrc:=JSToStr(JSModuleSrc);
  1570. ExpectedSrc:=
  1571. 'var $mod = this;'+LineEnding
  1572. +Statements;
  1573. if coUseStrict in Converter.Options then
  1574. ExpectedSrc:='"use strict";'+LineEnding+ExpectedSrc;
  1575. if Module is TPasProgram then
  1576. InitName:='$main'
  1577. else
  1578. InitName:='$init';
  1579. if (Module is TPasProgram) or (Trim(InitStatements)<>'') then
  1580. ExpectedSrc:=ExpectedSrc+LineEnding
  1581. +'$mod.'+InitName+' = function () {'+LineEnding
  1582. +InitStatements
  1583. +'};'+LineEnding;
  1584. //writeln('TCustomTestModule.CheckSource ExpectedIntf="',ExpectedSrc,'"');
  1585. //writeln('TTestModule.CheckSource InitStatements="',Trim(InitStatements),'"');
  1586. CheckDiff(Msg,ExpectedSrc,ActualSrc);
  1587. if (JSImplementationSrc<>nil) then
  1588. begin
  1589. ActualSrc:=JSToStr(JSImplementationSrc);
  1590. ExpectedSrc:=
  1591. 'var $mod = this;'+LineEnding
  1592. +'var $impl = $mod.$impl;'+LineEnding
  1593. +ImplStatements;
  1594. end
  1595. else
  1596. begin
  1597. ActualSrc:='';
  1598. ExpectedSrc:=ImplStatements;
  1599. end;
  1600. //writeln('TTestModule.CheckSource InitStatements="',InitStatements,'"');
  1601. //writeln('TCustomTestModule.CheckSource Expected: ',ExpectedSrc);
  1602. CheckDiff(Msg,ExpectedSrc,ActualSrc);
  1603. end;
  1604. procedure TCustomTestModule.CheckDiff(Msg, Expected, Actual: string);
  1605. // search diff, ignore changes in spaces
  1606. var
  1607. s: string;
  1608. begin
  1609. if CheckSrcDiff(Expected,Actual,s) then exit;
  1610. Fail(Msg+': '+s);
  1611. end;
  1612. procedure TCustomTestModule.CheckUnit(Filename, ExpectedSrc: string);
  1613. var
  1614. aResolver: TTestEnginePasResolver;
  1615. aConverter: TPasToJSConverter;
  1616. aJSModule: TJSSourceElements;
  1617. ActualSrc: String;
  1618. begin
  1619. aResolver:=GetResolver(Filename);
  1620. AssertNotNull('missing resolver of unit '+Filename,aResolver);
  1621. {$IFDEF VerbosePas2JS}
  1622. writeln('CheckUnit '+Filename+' converting ...');
  1623. {$ENDIF}
  1624. aConverter:=CreateConverter;
  1625. aJSModule:=nil;
  1626. try
  1627. try
  1628. aJSModule:=aConverter.ConvertPasElement(aResolver.Module,aResolver) as TJSSourceElements;
  1629. except
  1630. on E: Exception do
  1631. HandleException(E);
  1632. end;
  1633. ActualSrc:=ConvertJSModuleToString(aJSModule);
  1634. {$IFDEF VerbosePas2JS}
  1635. writeln('TTestModule.CheckUnit ',Filename,' Pas:');
  1636. write(aResolver.Source);
  1637. writeln('TTestModule.CheckUnit ',Filename,' JS:');
  1638. write(ActualSrc);
  1639. {$ENDIF}
  1640. CheckDiff('Converted unit: "'+ChangeFileExt(Filename,'.js')+'"',ExpectedSrc,ActualSrc);
  1641. finally
  1642. aJSModule.Free;
  1643. aConverter.Free;
  1644. end;
  1645. end;
  1646. procedure TCustomTestModule.CheckHint(MsgType: TMessageType;
  1647. MsgNumber: integer; Msg: string; Marker: PSrcMarker);
  1648. var
  1649. i: Integer;
  1650. Item: TTestHintMessage;
  1651. Expected,Actual: string;
  1652. begin
  1653. //writeln('TCustomTestModule.CheckHint MsgCount=',MsgCount);
  1654. for i:=0 to MsgCount-1 do
  1655. begin
  1656. Item:=Msgs[i];
  1657. if (Item.MsgNumber<>MsgNumber) or (Item.Msg<>Msg) then continue;
  1658. if (Marker<>nil) then
  1659. begin
  1660. if Item.SourcePos.Row<>cardinal(Marker^.Row) then continue;
  1661. if (Item.SourcePos.Column<cardinal(Marker^.StartCol))
  1662. or (Item.SourcePos.Column>cardinal(Marker^.EndCol)) then continue;
  1663. end;
  1664. // found
  1665. FHintMsgsGood.Add(Item);
  1666. str(Item.MsgType,Actual);
  1667. str(MsgType,Expected);
  1668. AssertEquals('MsgType',Expected,Actual);
  1669. exit;
  1670. end;
  1671. // needed message missing -> show emitted messages
  1672. WriteSources('',0,0);
  1673. for i:=0 to MsgCount-1 do
  1674. begin
  1675. Item:=Msgs[i];
  1676. write('TCustomTestModule.CheckHint ',i,'/',MsgCount,' ',Item.MsgType,
  1677. ' ('+IntToStr(Item.MsgNumber),')');
  1678. if Marker<>nil then
  1679. write(' '+ExtractFileName(Item.SourcePos.FileName),'(',Item.SourcePos.Row,',',Item.SourcePos.Column,')');
  1680. writeln(' {',Item.Msg,'}');
  1681. end;
  1682. str(MsgType,Expected);
  1683. Actual:='Missing '+Expected+' ('+IntToStr(MsgNumber)+')';
  1684. if Marker<>nil then
  1685. Actual:=Actual+' '+ExtractFileName(Marker^.Filename)+'('+IntToStr(Marker^.Row)+','+IntToStr(Marker^.StartCol)+'..'+IntToStr(Marker^.EndCol)+')';
  1686. Actual:=Actual+' '+Msg;
  1687. Fail(Actual);
  1688. end;
  1689. procedure TCustomTestModule.CheckResolverUnexpectedHints(WithSourcePos: boolean
  1690. );
  1691. var
  1692. i: Integer;
  1693. s, Txt: String;
  1694. Msg: TTestHintMessage;
  1695. begin
  1696. for i:=0 to MsgCount-1 do
  1697. begin
  1698. Msg:=Msgs[i];
  1699. if FHintMsgsGood.IndexOf(Msg)>=0 then continue;
  1700. s:='';
  1701. str(Msg.MsgType,s);
  1702. Txt:='Unexpected resolver message found ['+IntToStr(Msg.Id)+'] '
  1703. +s+': ('+IntToStr(Msg.MsgNumber)+')';
  1704. if WithSourcePos then
  1705. Txt:=Txt+' '+ExtractFileName(Msg.SourcePos.FileName)+'('+IntToStr(Msg.SourcePos.Row)+','+IntToStr(Msg.SourcePos.Column)+')';
  1706. Txt:=Txt+' {'+Msg.Msg+'}';
  1707. Fail(Txt);
  1708. end;
  1709. end;
  1710. procedure TCustomTestModule.SetExpectedScannerError(Msg: string;
  1711. MsgNumber: integer);
  1712. begin
  1713. ExpectedErrorClass:=EScannerError;
  1714. ExpectedErrorMsg:=Msg;
  1715. ExpectedErrorNumber:=MsgNumber;
  1716. end;
  1717. procedure TCustomTestModule.SetExpectedParserError(Msg: string;
  1718. MsgNumber: integer);
  1719. begin
  1720. ExpectedErrorClass:=EParserError;
  1721. ExpectedErrorMsg:=Msg;
  1722. ExpectedErrorNumber:=MsgNumber;
  1723. end;
  1724. procedure TCustomTestModule.SetExpectedPasResolverError(Msg: string;
  1725. MsgNumber: integer);
  1726. begin
  1727. ExpectedErrorClass:=EPasResolve;
  1728. ExpectedErrorMsg:=Msg;
  1729. ExpectedErrorNumber:=MsgNumber;
  1730. end;
  1731. procedure TCustomTestModule.SetExpectedConverterError(Msg: string;
  1732. MsgNumber: integer);
  1733. begin
  1734. ExpectedErrorClass:=EPas2JS;
  1735. ExpectedErrorMsg:=Msg;
  1736. ExpectedErrorNumber:=MsgNumber;
  1737. end;
  1738. function TCustomTestModule.IsErrorExpected(E: Exception): boolean;
  1739. var
  1740. MsgNumber: Integer;
  1741. Msg: String;
  1742. begin
  1743. Result:=false;
  1744. if (ExpectedErrorClass=nil) or (ExpectedErrorClass<>E.ClassType) then exit;
  1745. Msg:=E.Message;
  1746. if E is EPas2JS then
  1747. MsgNumber:=EPas2JS(E).MsgNumber
  1748. else if E is EPasResolve then
  1749. MsgNumber:=EPasResolve(E).MsgNumber
  1750. else if E is EParserError then
  1751. MsgNumber:=Parser.LastMsgNumber
  1752. else if E is EScannerError then
  1753. begin
  1754. MsgNumber:=Scanner.LastMsgNumber;
  1755. Msg:=Scanner.LastMsg;
  1756. end
  1757. else
  1758. MsgNumber:=0;
  1759. Result:=(MsgNumber=ExpectedErrorNumber) and (Msg=ExpectedErrorMsg);
  1760. if Result then
  1761. SkipTests:=true;
  1762. end;
  1763. procedure TCustomTestModule.HandleScannerError(E: EScannerError);
  1764. begin
  1765. if IsErrorExpected(E) then exit;
  1766. WriteSources(Scanner.CurFilename,Scanner.CurRow,Scanner.CurColumn);
  1767. writeln('ERROR: TCustomTestModule.HandleScannerError '+E.ClassName+':'+E.Message
  1768. +' '+Scanner.CurFilename
  1769. +'('+IntToStr(Scanner.CurRow)+','+IntToStr(Scanner.CurColumn)+')');
  1770. FailException(E);
  1771. end;
  1772. procedure TCustomTestModule.HandleParserError(E: EParserError);
  1773. begin
  1774. if IsErrorExpected(E) then exit;
  1775. WriteSources(E.Filename,E.Row,E.Column);
  1776. writeln('ERROR: TCustomTestModule.HandleParserError '+E.ClassName+':'+E.Message
  1777. +' '+E.Filename+'('+IntToStr(E.Row)+','+IntToStr(E.Column)+')'
  1778. +' MainModuleScannerLine="'+Scanner.CurLine+'"'
  1779. );
  1780. FailException(E);
  1781. end;
  1782. procedure TCustomTestModule.HandlePasResolveError(E: EPasResolve);
  1783. var
  1784. P: TPasSourcePos;
  1785. begin
  1786. if IsErrorExpected(E) then exit;
  1787. P:=E.SourcePos;
  1788. WriteSources(P.FileName,P.Row,P.Column);
  1789. writeln('ERROR: TCustomTestModule.HandlePasResolveError '+E.ClassName+':'+E.Message
  1790. +' '+P.FileName+'('+IntToStr(P.Row)+','+IntToStr(P.Column)+')');
  1791. FailException(E);
  1792. end;
  1793. procedure TCustomTestModule.HandlePas2JSError(E: EPas2JS);
  1794. var
  1795. Row, Col: integer;
  1796. begin
  1797. if IsErrorExpected(E) then exit;
  1798. Engine.UnmangleSourceLineNumber(E.PasElement.SourceLinenumber,Row,Col);
  1799. WriteSources(E.PasElement.SourceFilename,Row,Col);
  1800. writeln('ERROR: TCustomTestModule.HandlePas2JSError '+E.ClassName+':'+E.Message
  1801. +' '+E.PasElement.SourceFilename
  1802. +'('+IntToStr(Row)+','+IntToStr(Col)+')');
  1803. FailException(E);
  1804. end;
  1805. procedure TCustomTestModule.HandleException(E: Exception);
  1806. begin
  1807. if E is EScannerError then
  1808. HandleScannerError(EScannerError(E))
  1809. else if E is EParserError then
  1810. HandleParserError(EParserError(E))
  1811. else if E is EPasResolve then
  1812. HandlePasResolveError(EPasResolve(E))
  1813. else if E is EPas2JS then
  1814. HandlePas2JSError(EPas2JS(E))
  1815. else
  1816. begin
  1817. if IsErrorExpected(E) then exit;
  1818. if not (E is EAssertionFailedError) then
  1819. begin
  1820. WriteSources('',0,0);
  1821. writeln('ERROR: TCustomTestModule.HandleException '+E.ClassName+':'+E.Message);
  1822. end;
  1823. FailException(E);
  1824. end;
  1825. end;
  1826. procedure TCustomTestModule.FailException(E: Exception);
  1827. var
  1828. MsgNumber: Integer;
  1829. begin
  1830. if ExpectedErrorClass<>nil then
  1831. begin
  1832. if FExpectedErrorClass=E.ClassType then
  1833. begin
  1834. if E is EPas2JS then
  1835. MsgNumber:=EPas2JS(E).MsgNumber
  1836. else if E is EPasResolve then
  1837. MsgNumber:=EPasResolve(E).MsgNumber
  1838. else if E is EParserError then
  1839. MsgNumber:=Parser.LastMsgNumber
  1840. else if E is EScannerError then
  1841. MsgNumber:=Scanner.LastMsgNumber
  1842. else
  1843. MsgNumber:=0;
  1844. AssertEquals('Expected error message ('+IntToStr(ExpectedErrorNumber)+')','{'+ExpectedErrorMsg+'}','{'+E.Message+'}');
  1845. AssertEquals('Expected {'+ExpectedErrorMsg+'}, but got msg {'+E.Message+'} number',
  1846. ExpectedErrorNumber,MsgNumber);
  1847. end else begin
  1848. AssertEquals('Wrong exception class',ExpectedErrorClass.ClassName,E.ClassName);
  1849. end;
  1850. end;
  1851. Fail(E.Message);
  1852. end;
  1853. procedure TCustomTestModule.WriteSources(const aFilename: string; aRow,
  1854. aCol: integer);
  1855. var
  1856. IsSrc: Boolean;
  1857. i, j: Integer;
  1858. SrcLines: TStringList;
  1859. Line: string;
  1860. aModule: TTestEnginePasResolver;
  1861. begin
  1862. writeln('TCustomTestModule.WriteSources File="',aFilename,'" Row=',aRow,' Col=',aCol);
  1863. for i:=0 to ResolverCount-1 do
  1864. begin
  1865. aModule:=Resolvers[i];
  1866. SrcLines:=TStringList.Create;
  1867. try
  1868. SrcLines.Text:=aModule.Source;
  1869. IsSrc:=ExtractFilename(aModule.Filename)=ExtractFileName(aFilename);
  1870. writeln('Testcode:-File="',aModule.Filename,'"----------------------------------:');
  1871. for j:=1 to SrcLines.Count do
  1872. begin
  1873. Line:=SrcLines[j-1];
  1874. if IsSrc and (j=aRow) then
  1875. begin
  1876. write('*');
  1877. Line:=LeftStr(Line,aCol-1)+'|'+copy(Line,aCol,length(Line));
  1878. end;
  1879. writeln(Format('%:4d: ',[j]),Line);
  1880. end;
  1881. finally
  1882. SrcLines.Free;
  1883. end;
  1884. end;
  1885. end;
  1886. function TCustomTestModule.IndexOfResolver(const Filename: string): integer;
  1887. var
  1888. i: Integer;
  1889. begin
  1890. for i:=0 to ResolverCount-1 do
  1891. if Filename=Resolvers[i].Filename then exit(i);
  1892. Result:=-1;
  1893. end;
  1894. function TCustomTestModule.GetResolver(const Filename: string
  1895. ): TTestEnginePasResolver;
  1896. var
  1897. i: Integer;
  1898. begin
  1899. i:=IndexOfResolver(Filename);
  1900. if i<0 then exit(nil);
  1901. Result:=Resolvers[i];
  1902. end;
  1903. function TCustomTestModule.GetDefaultNamespace: string;
  1904. var
  1905. C: TClass;
  1906. begin
  1907. Result:='';
  1908. if FModule=nil then exit;
  1909. C:=FModule.ClassType;
  1910. if (C=TPasProgram) or (C=TPasLibrary) or (C=TPasPackage) then
  1911. Result:=Engine.DefaultNameSpace;
  1912. end;
  1913. constructor TCustomTestModule.Create;
  1914. begin
  1915. inherited Create;
  1916. FHintMsgs:=TObjectList.Create(true);
  1917. FHintMsgsGood:=TFPList.Create;
  1918. end;
  1919. destructor TCustomTestModule.Destroy;
  1920. begin
  1921. FreeAndNil(FHintMsgs);
  1922. FreeAndNil(FHintMsgsGood);
  1923. inherited Destroy;
  1924. end;
  1925. { TTestModule }
  1926. procedure TTestModule.TestEmptyProgram;
  1927. begin
  1928. StartProgram(false);
  1929. Add('begin');
  1930. ConvertProgram;
  1931. CheckSource('TestEmptyProgram','','');
  1932. end;
  1933. procedure TTestModule.TestEmptyProgramUseStrict;
  1934. begin
  1935. Converter.Options:=Converter.Options+[coUseStrict];
  1936. StartProgram(false);
  1937. Add('begin');
  1938. ConvertProgram;
  1939. CheckSource('TestEmptyProgramUseStrict','','');
  1940. end;
  1941. procedure TTestModule.TestEmptyUnit;
  1942. begin
  1943. StartUnit(false);
  1944. Add('interface');
  1945. Add('implementation');
  1946. ConvertUnit;
  1947. CheckSource('TestEmptyUnit',
  1948. LinesToStr([
  1949. ]),
  1950. '');
  1951. end;
  1952. procedure TTestModule.TestEmptyUnitUseStrict;
  1953. begin
  1954. Converter.Options:=Converter.Options+[coUseStrict];
  1955. StartUnit(false);
  1956. Add('interface');
  1957. Add('implementation');
  1958. ConvertUnit;
  1959. CheckSource('TestEmptyUnitUseStrict',
  1960. LinesToStr([
  1961. ''
  1962. ]),
  1963. '');
  1964. end;
  1965. procedure TTestModule.TestDottedUnitNames;
  1966. begin
  1967. AddModuleWithIntfImplSrc('NS1.Unit2.pas',
  1968. LinesToStr([
  1969. 'var iV: longint;'
  1970. ]),
  1971. '');
  1972. FFilename:='ns1.test1.pp';
  1973. StartProgram(true);
  1974. Add('uses unIt2;');
  1975. Add('implementation');
  1976. Add('var');
  1977. Add(' i: longint;');
  1978. Add('begin');
  1979. Add(' i:=iv;');
  1980. Add(' i:=uNit2.iv;');
  1981. Add(' i:=Ns1.TEst1.i;');
  1982. ConvertProgram;
  1983. CheckSource('TestDottedUnitNames',
  1984. LinesToStr([
  1985. 'this.i = 0;',
  1986. '']),
  1987. LinesToStr([ // this.$init
  1988. '$mod.i = pas["NS1.Unit2"].iV;',
  1989. '$mod.i = pas["NS1.Unit2"].iV;',
  1990. '$mod.i = $mod.i;',
  1991. '']) );
  1992. end;
  1993. procedure TTestModule.TestDottedUnitNameImpl;
  1994. begin
  1995. AddModuleWithIntfImplSrc('TEST.UnitA.pas',
  1996. LinesToStr([
  1997. 'type',
  1998. ' TObject = class end;',
  1999. ' TTestA = class',
  2000. ' end;'
  2001. ]),
  2002. LinesToStr(['uses TEST.UnitB;'])
  2003. );
  2004. AddModuleWithIntfImplSrc('TEST.UnitB.pas',
  2005. LinesToStr([
  2006. 'uses TEST.UnitA;',
  2007. 'type TTestB = class(TTestA);'
  2008. ]),
  2009. ''
  2010. );
  2011. StartProgram(true);
  2012. Add('uses TEST.UnitA;');
  2013. Add('begin');
  2014. ConvertProgram;
  2015. CheckSource('TestDottedUnitNameImpl',
  2016. LinesToStr([
  2017. '']),
  2018. LinesToStr([ // this.$init
  2019. '']) );
  2020. CheckUnit('TEST.UnitA.pas',
  2021. LinesToStr([
  2022. 'rtl.module("TEST.UnitA", ["system"], function () {',
  2023. ' var $mod = this;',
  2024. ' rtl.createClass($mod, "TObject", null, function () {',
  2025. ' this.$init = function () {',
  2026. ' };',
  2027. ' this.$final = function () {',
  2028. ' };',
  2029. ' });',
  2030. ' rtl.createClass($mod, "TTestA", $mod.TObject, function () {',
  2031. ' });',
  2032. '}, ["TEST.UnitB"]);'
  2033. ]));
  2034. CheckUnit('TEST.UnitB.pas',
  2035. LinesToStr([
  2036. 'rtl.module("TEST.UnitB", ["system","TEST.UnitA"], function () {',
  2037. ' var $mod = this;',
  2038. ' rtl.createClass($mod, "TTestB", pas["TEST.UnitA"].TTestA, function () {',
  2039. ' });',
  2040. '});'
  2041. ]));
  2042. end;
  2043. procedure TTestModule.TestDottedUnitExpr;
  2044. begin
  2045. AddModuleWithIntfImplSrc('NS2.SubNs2.Unit2.pas',
  2046. LinesToStr([
  2047. 'procedure DoIt;'
  2048. ]),
  2049. 'procedure DoIt; begin end;');
  2050. FFilename:='Ns1.SubNs1.Test1.pp';
  2051. StartProgram(true);
  2052. Add('uses Ns2.sUbnS2.unIt2;');
  2053. Add('implementation');
  2054. Add('var');
  2055. Add(' i: longint;');
  2056. Add('begin');
  2057. Add(' ns2.subns2.unit2.doit;');
  2058. Add(' i:=Ns1.SubNS1.TEst1.i;');
  2059. ConvertProgram;
  2060. CheckSource('TestDottedUnitExpr',
  2061. LinesToStr([
  2062. 'this.i = 0;',
  2063. '']),
  2064. LinesToStr([ // this.$init
  2065. 'pas["NS2.SubNs2.Unit2"].DoIt();',
  2066. '$mod.i = $mod.i;',
  2067. '']) );
  2068. end;
  2069. procedure TTestModule.Test_ModeFPCFail;
  2070. begin
  2071. StartProgram(false);
  2072. Add('{$mode FPC}');
  2073. Add('begin');
  2074. SetExpectedScannerError('Invalid mode: "FPC"',nErrInvalidMode);
  2075. ConvertProgram;
  2076. end;
  2077. procedure TTestModule.Test_ModeSwitchCBlocksFail;
  2078. begin
  2079. StartProgram(false);
  2080. Add('{$modeswitch cblocks-}');
  2081. Add('begin');
  2082. SetExpectedScannerError('Invalid mode switch: "cblocks-"',nErrInvalidModeSwitch);
  2083. ConvertProgram;
  2084. end;
  2085. procedure TTestModule.TestUnit_UseSystem;
  2086. begin
  2087. StartUnit(true);
  2088. Add([
  2089. 'interface',
  2090. 'var i: integer;',
  2091. 'implementation']);
  2092. ConvertUnit;
  2093. CheckSource('TestUnit_UseSystem',
  2094. LinesToStr([
  2095. 'this.i = 0;',
  2096. '']),
  2097. LinesToStr([
  2098. '']) );
  2099. end;
  2100. procedure TTestModule.TestUnit_Intf1Impl2Intf1;
  2101. begin
  2102. AddModuleWithIntfImplSrc('unit1.pp',
  2103. LinesToStr([
  2104. 'type number = longint;']),
  2105. LinesToStr([
  2106. 'uses test1;',
  2107. 'procedure DoIt;',
  2108. 'begin',
  2109. ' i:=3;',
  2110. 'end;']));
  2111. StartUnit(true);
  2112. Add([
  2113. 'interface',
  2114. 'uses unit1;',
  2115. 'var i: number;',
  2116. 'implementation']);
  2117. ConvertUnit;
  2118. CheckSource('TestUnit_Intf1Impl2Intf1',
  2119. LinesToStr([
  2120. 'this.i = 0;',
  2121. '']),
  2122. LinesToStr([
  2123. '']) );
  2124. end;
  2125. procedure TTestModule.TestIncludeVersion;
  2126. begin
  2127. StartProgram(false);
  2128. Add([
  2129. 'var',
  2130. ' s: string;',
  2131. ' i: word;',
  2132. 'begin',
  2133. ' s:={$I %line%};',
  2134. ' i:={$I %linenum%};',
  2135. ' s:={$I %currentroutine%};',
  2136. ' s:={$I %pas2jsversion%};',
  2137. ' s:={$I %pas2jstarget%};',
  2138. ' s:={$I %pas2jstargetos%};',
  2139. ' s:={$I %pas2jstargetcpu%};',
  2140. ' s:={$I %file%};',
  2141. '']);
  2142. ConvertProgram;
  2143. CheckSource('TestIncludeVersion',
  2144. LinesToStr([
  2145. 'this.s="";',
  2146. 'this.i = 0;']),
  2147. LinesToStr([
  2148. '$mod.s = "7";',
  2149. '$mod.i = 8;',
  2150. '$mod.s = "<anonymous>";',
  2151. '$mod.s = "Comp.Ver.tcmodules";',
  2152. '$mod.s = "Browser";',
  2153. '$mod.s = "Browser";',
  2154. '$mod.s = "ECMAScript5";',
  2155. '$mod.s = "test1.pp";',
  2156. '']));
  2157. end;
  2158. procedure TTestModule.TestVarInt;
  2159. begin
  2160. StartProgram(false);
  2161. Add('var MyI: longint;');
  2162. Add('begin');
  2163. ConvertProgram;
  2164. CheckSource('TestVarInt','this.MyI=0;','');
  2165. end;
  2166. procedure TTestModule.TestVarBaseTypes;
  2167. begin
  2168. StartProgram(false);
  2169. Add('var');
  2170. Add(' i: longint;');
  2171. Add(' s: string;');
  2172. Add(' c: char;');
  2173. Add(' b: boolean;');
  2174. Add(' d: double;');
  2175. Add(' i2: longint = 3;');
  2176. Add(' s2: string = ''foo'';');
  2177. Add(' c2: char = ''4'';');
  2178. Add(' b2: boolean = true;');
  2179. Add(' d2: double = 5.6;');
  2180. Add(' i3: longint = $707;');
  2181. Add(' i4: nativeint = 4503599627370495;');
  2182. Add(' i5: nativeint = -4503599627370496;');
  2183. Add(' i6: nativeint = $fffffffffffff;');
  2184. Add(' i7: nativeint = -$10000000000000;');
  2185. Add(' i8: byte = 00;');
  2186. Add(' u8: nativeuint = $fffffffffffff;');
  2187. Add(' u9: nativeuint = $0000000000000;');
  2188. Add(' u10: nativeuint = $00ff00;');
  2189. Add('begin');
  2190. ConvertProgram;
  2191. CheckSource('TestVarBaseTypes',
  2192. LinesToStr([
  2193. 'this.i = 0;',
  2194. 'this.s = "";',
  2195. 'this.c = "";',
  2196. 'this.b = false;',
  2197. 'this.d = 0.0;',
  2198. 'this.i2 = 3;',
  2199. 'this.s2 = "foo";',
  2200. 'this.c2 = "4";',
  2201. 'this.b2 = true;',
  2202. 'this.d2 = 5.6;',
  2203. 'this.i3 = 0x707;',
  2204. 'this.i4 = 4503599627370495;',
  2205. 'this.i5 = -4503599627370496;',
  2206. 'this.i6 = 0xfffffffffffff;',
  2207. 'this.i7 =-0x10000000000000;',
  2208. 'this.i8 = 0;',
  2209. 'this.u8 = 0xfffffffffffff;',
  2210. 'this.u9 = 0x0;',
  2211. 'this.u10 = 0xff00;'
  2212. ]),
  2213. '');
  2214. end;
  2215. procedure TTestModule.TestBaseTypeSingleFail;
  2216. begin
  2217. StartProgram(false);
  2218. Add('var s: single;');
  2219. SetExpectedPasResolverError('identifier not found "single"',PasResolveEval.nIdentifierNotFound);
  2220. ConvertProgram;
  2221. end;
  2222. procedure TTestModule.TestBaseTypeExtendedFail;
  2223. begin
  2224. StartProgram(false);
  2225. Add('var e: extended;');
  2226. SetExpectedPasResolverError('identifier not found "extended"',PasResolveEval.nIdentifierNotFound);
  2227. ConvertProgram;
  2228. end;
  2229. procedure TTestModule.TestConstBaseTypes;
  2230. begin
  2231. StartProgram(false);
  2232. Add('const');
  2233. Add(' i: longint = 3;');
  2234. Add(' s: string = ''foo'';');
  2235. Add(' c: char = ''4'';');
  2236. Add(' b: boolean = true;');
  2237. Add(' d: double = 5.6;');
  2238. Add(' e = low(word);');
  2239. Add(' f = high(word);');
  2240. Add('begin');
  2241. ConvertProgram;
  2242. CheckSource('TestVarBaseTypes',
  2243. LinesToStr([
  2244. 'this.i=3;',
  2245. 'this.s="foo";',
  2246. 'this.c="4";',
  2247. 'this.b=true;',
  2248. 'this.d=5.6;',
  2249. 'this.e = 0;',
  2250. 'this.f = 65535;'
  2251. ]),
  2252. '');
  2253. end;
  2254. procedure TTestModule.TestAliasTypeRef;
  2255. begin
  2256. StartProgram(false);
  2257. Add('type');
  2258. Add(' a=longint;');
  2259. Add(' b=a;');
  2260. Add('var');
  2261. Add(' c: A;');
  2262. Add(' d: B;');
  2263. Add('begin');
  2264. ConvertProgram;
  2265. CheckSource('TestAliasTypeRef',
  2266. LinesToStr([ // statements
  2267. 'this.c = 0;',
  2268. 'this.d = 0;'
  2269. ]),
  2270. LinesToStr([ // this.$main
  2271. ''
  2272. ]));
  2273. end;
  2274. procedure TTestModule.TestTypeCast_BaseTypes;
  2275. begin
  2276. StartProgram(false);
  2277. Add([
  2278. 'var',
  2279. ' i: longint;',
  2280. ' b: boolean;',
  2281. ' d: double;',
  2282. ' s: string;',
  2283. ' c: char;',
  2284. 'begin',
  2285. ' i:=longint(i);',
  2286. ' i:=longint(b);',
  2287. ' b:=boolean(b);',
  2288. ' b:=boolean(i);',
  2289. ' d:=double(d);',
  2290. ' d:=double(i);',
  2291. ' s:=string(s);',
  2292. ' s:=string(c);',
  2293. ' c:=char(c);',
  2294. ' c:=char(i);',
  2295. ' c:=char(65);',
  2296. ' c:=char(#10);',
  2297. ' c:=char(#$E000);',
  2298. '']);
  2299. ConvertProgram;
  2300. CheckSource('TestAliasTypeRef',
  2301. LinesToStr([ // statements
  2302. 'this.i = 0;',
  2303. 'this.b = false;',
  2304. 'this.d = 0.0;',
  2305. 'this.s = "";',
  2306. 'this.c = "";',
  2307. '']),
  2308. LinesToStr([ // this.$main
  2309. '$mod.i = $mod.i;',
  2310. '$mod.i = ($mod.b ? 1 : 0);',
  2311. '$mod.b = $mod.b;',
  2312. '$mod.b = $mod.i != 0;',
  2313. '$mod.d = $mod.d;',
  2314. '$mod.d = $mod.i;',
  2315. '$mod.s = $mod.s;',
  2316. '$mod.s = $mod.c;',
  2317. '$mod.c = $mod.c;',
  2318. '$mod.c = String.fromCharCode($mod.i);',
  2319. '$mod.c = "A";',
  2320. '$mod.c = "\n";',
  2321. '$mod.c = "";',
  2322. '']));
  2323. end;
  2324. procedure TTestModule.TestTypeCast_AliasBaseTypes;
  2325. begin
  2326. StartProgram(false);
  2327. Add('type');
  2328. Add(' integer = longint;');
  2329. Add(' TYesNo = boolean;');
  2330. Add(' TFloat = double;');
  2331. Add(' TCaption = string;');
  2332. Add(' TChar = char;');
  2333. Add('var');
  2334. Add(' i: integer;');
  2335. Add(' b: TYesNo;');
  2336. Add(' d: TFloat;');
  2337. Add(' s: TCaption;');
  2338. Add(' c: TChar;');
  2339. Add('begin');
  2340. Add(' i:=integer(i);');
  2341. Add(' i:=integer(b);');
  2342. Add(' b:=TYesNo(b);');
  2343. Add(' b:=TYesNo(i);');
  2344. Add(' d:=TFloat(d);');
  2345. Add(' d:=TFloat(i);');
  2346. Add(' s:=TCaption(s);');
  2347. Add(' s:=TCaption(c);');
  2348. Add(' c:=TChar(c);');
  2349. ConvertProgram;
  2350. CheckSource('TestAliasTypeRef',
  2351. LinesToStr([ // statements
  2352. 'this.i = 0;',
  2353. 'this.b = false;',
  2354. 'this.d = 0.0;',
  2355. 'this.s = "";',
  2356. 'this.c = "";',
  2357. '']),
  2358. LinesToStr([ // this.$main
  2359. '$mod.i = $mod.i;',
  2360. '$mod.i = ($mod.b ? 1 : 0);',
  2361. '$mod.b = $mod.b;',
  2362. '$mod.b = $mod.i != 0;',
  2363. '$mod.d = $mod.d;',
  2364. '$mod.d = $mod.i;',
  2365. '$mod.s = $mod.s;',
  2366. '$mod.s = $mod.c;',
  2367. '$mod.c = $mod.c;',
  2368. '']));
  2369. end;
  2370. procedure TTestModule.TestEmptyProc;
  2371. begin
  2372. StartProgram(false);
  2373. Add('procedure Test;');
  2374. Add('begin');
  2375. Add('end;');
  2376. Add('begin');
  2377. ConvertProgram;
  2378. CheckSource('TestEmptyProc',
  2379. LinesToStr([ // statements
  2380. 'this.Test = function () {',
  2381. '};'
  2382. ]),
  2383. LinesToStr([ // this.$main
  2384. ''
  2385. ]));
  2386. end;
  2387. procedure TTestModule.TestProcOneParam;
  2388. begin
  2389. StartProgram(false);
  2390. Add('procedure ProcA(i: longint);');
  2391. Add('begin');
  2392. Add('end;');
  2393. Add('begin');
  2394. Add(' PROCA(3);');
  2395. ConvertProgram;
  2396. CheckSource('TestProcOneParam',
  2397. LinesToStr([ // statements
  2398. 'this.ProcA = function (i) {',
  2399. '};'
  2400. ]),
  2401. LinesToStr([ // this.$main
  2402. '$mod.ProcA(3);'
  2403. ]));
  2404. end;
  2405. procedure TTestModule.TestFunctionWithoutParams;
  2406. begin
  2407. StartProgram(false);
  2408. Add('function FuncA: longint;');
  2409. Add('begin');
  2410. Add('end;');
  2411. Add('var i: longint;');
  2412. Add('begin');
  2413. Add(' I:=FUNCA();');
  2414. Add(' I:=FUNCA;');
  2415. Add(' FUNCA();');
  2416. Add(' FUNCA;');
  2417. ConvertProgram;
  2418. CheckSource('TestProcWithoutParams',
  2419. LinesToStr([ // statements
  2420. 'this.FuncA = function () {',
  2421. ' var Result = 0;',
  2422. ' return Result;',
  2423. '};',
  2424. 'this.i=0;'
  2425. ]),
  2426. LinesToStr([ // this.$main
  2427. '$mod.i=$mod.FuncA();',
  2428. '$mod.i=$mod.FuncA();',
  2429. '$mod.FuncA();',
  2430. '$mod.FuncA();'
  2431. ]));
  2432. end;
  2433. procedure TTestModule.TestProcedureWithoutParams;
  2434. begin
  2435. StartProgram(false);
  2436. Add('procedure ProcA;');
  2437. Add('begin');
  2438. Add('end;');
  2439. Add('begin');
  2440. Add(' PROCA();');
  2441. Add(' PROCA;');
  2442. ConvertProgram;
  2443. CheckSource('TestProcWithoutParams',
  2444. LinesToStr([ // statements
  2445. 'this.ProcA = function () {',
  2446. '};'
  2447. ]),
  2448. LinesToStr([ // this.$main
  2449. '$mod.ProcA();',
  2450. '$mod.ProcA();'
  2451. ]));
  2452. end;
  2453. procedure TTestModule.TestIncDec;
  2454. begin
  2455. StartProgram(false);
  2456. Add([
  2457. 'procedure DoIt(var i: longint);',
  2458. 'begin',
  2459. ' inc(i);',
  2460. ' inc(i,2);',
  2461. 'end;',
  2462. 'var',
  2463. ' Bar: longint;',
  2464. 'begin',
  2465. ' inc(bar);',
  2466. ' inc(bar,2);',
  2467. ' dec(bar);',
  2468. ' dec(bar,3);',
  2469. '']);
  2470. ConvertProgram;
  2471. CheckSource('TestIncDec',
  2472. LinesToStr([ // statements
  2473. 'this.DoIt = function (i) {',
  2474. ' i.set(i.get()+1);',
  2475. ' i.set(i.get()+2);',
  2476. '};',
  2477. 'this.Bar = 0;'
  2478. ]),
  2479. LinesToStr([ // this.$main
  2480. '$mod.Bar+=1;',
  2481. '$mod.Bar+=2;',
  2482. '$mod.Bar-=1;',
  2483. '$mod.Bar-=3;'
  2484. ]));
  2485. end;
  2486. procedure TTestModule.TestAssignments;
  2487. begin
  2488. StartProgram(false);
  2489. Parser.Options:=Parser.Options+[po_cassignments];
  2490. Add('var');
  2491. Add(' Bar:longint;');
  2492. Add('begin');
  2493. Add(' bar:=3;');
  2494. Add(' bar+=4;');
  2495. Add(' bar-=5;');
  2496. Add(' bar*=6;');
  2497. ConvertProgram;
  2498. CheckSource('TestAssignments',
  2499. LinesToStr([ // statements
  2500. 'this.Bar = 0;'
  2501. ]),
  2502. LinesToStr([ // this.$main
  2503. '$mod.Bar=3;',
  2504. '$mod.Bar+=4;',
  2505. '$mod.Bar-=5;',
  2506. '$mod.Bar*=6;'
  2507. ]));
  2508. end;
  2509. procedure TTestModule.TestArithmeticOperators1;
  2510. begin
  2511. StartProgram(false);
  2512. Add('var');
  2513. Add(' vA,vB,vC:longint;');
  2514. Add('begin');
  2515. Add(' va:=1;');
  2516. Add(' vb:=va+va;');
  2517. Add(' vb:=va div vb;');
  2518. Add(' vb:=va mod vb;');
  2519. Add(' vb:=va+va*vb+va div vb;');
  2520. Add(' vc:=-va;');
  2521. Add(' va:=va-vb;');
  2522. Add(' vb:=va;');
  2523. Add(' if va<vb then vc:=va else vc:=vb;');
  2524. ConvertProgram;
  2525. CheckSource('TestArithmeticOperators1',
  2526. LinesToStr([ // statements
  2527. 'this.vA = 0;',
  2528. 'this.vB = 0;',
  2529. 'this.vC = 0;'
  2530. ]),
  2531. LinesToStr([ // this.$main
  2532. '$mod.vA = 1;',
  2533. '$mod.vB = $mod.vA + $mod.vA;',
  2534. '$mod.vB = Math.floor($mod.vA / $mod.vB);',
  2535. '$mod.vB = $mod.vA % $mod.vB;',
  2536. '$mod.vB = $mod.vA + ($mod.vA * $mod.vB) + Math.floor($mod.vA / $mod.vB);',
  2537. '$mod.vC = -$mod.vA;',
  2538. '$mod.vA = $mod.vA - $mod.vB;',
  2539. '$mod.vB = $mod.vA;',
  2540. 'if ($mod.vA < $mod.vB){ $mod.vC = $mod.vA } else $mod.vC = $mod.vB;'
  2541. ]));
  2542. end;
  2543. procedure TTestModule.TestLogicalOperators;
  2544. begin
  2545. StartProgram(false);
  2546. Add('var');
  2547. Add(' vA,vB,vC:boolean;');
  2548. Add('begin');
  2549. Add(' va:=vb and vc;');
  2550. Add(' va:=vb or vc;');
  2551. Add(' va:=vb xor vc;');
  2552. Add(' va:=true and vc;');
  2553. Add(' va:=(vb and vc) or (va and vb);');
  2554. Add(' va:=not vb;');
  2555. ConvertProgram;
  2556. CheckSource('TestLogicalOperators',
  2557. LinesToStr([ // statements
  2558. 'this.vA = false;',
  2559. 'this.vB = false;',
  2560. 'this.vC = false;'
  2561. ]),
  2562. LinesToStr([ // this.$main
  2563. '$mod.vA = $mod.vB && $mod.vC;',
  2564. '$mod.vA = $mod.vB || $mod.vC;',
  2565. '$mod.vA = $mod.vB ^ $mod.vC;',
  2566. '$mod.vA = true && $mod.vC;',
  2567. '$mod.vA = ($mod.vB && $mod.vC) || ($mod.vA && $mod.vB);',
  2568. '$mod.vA = !$mod.vB;'
  2569. ]));
  2570. end;
  2571. procedure TTestModule.TestBitwiseOperators;
  2572. begin
  2573. StartProgram(false);
  2574. Add('var');
  2575. Add(' vA,vB,vC:longint;');
  2576. Add('begin');
  2577. Add(' va:=vb and vc;');
  2578. Add(' va:=vb or vc;');
  2579. Add(' va:=vb xor vc;');
  2580. Add(' va:=vb shl vc;');
  2581. Add(' va:=vb shr vc;');
  2582. Add(' va:=3 and vc;');
  2583. Add(' va:=(vb and vc) or (va and vb);');
  2584. Add(' va:=not vb;');
  2585. ConvertProgram;
  2586. CheckSource('TestBitwiseOperators',
  2587. LinesToStr([ // statements
  2588. 'this.vA = 0;',
  2589. 'this.vB = 0;',
  2590. 'this.vC = 0;'
  2591. ]),
  2592. LinesToStr([ // this.$main
  2593. '$mod.vA = $mod.vB & $mod.vC;',
  2594. '$mod.vA = $mod.vB | $mod.vC;',
  2595. '$mod.vA = $mod.vB ^ $mod.vC;',
  2596. '$mod.vA = $mod.vB << $mod.vC;',
  2597. '$mod.vA = $mod.vB >>> $mod.vC;',
  2598. '$mod.vA = 3 & $mod.vC;',
  2599. '$mod.vA = ($mod.vB & $mod.vC) | ($mod.vA & $mod.vB);',
  2600. '$mod.vA = ~$mod.vB;'
  2601. ]));
  2602. end;
  2603. procedure TTestModule.TestPrgProcVar;
  2604. begin
  2605. StartProgram(false);
  2606. Add('procedure Proc1;');
  2607. Add('type');
  2608. Add(' t1=longint;');
  2609. Add('var');
  2610. Add(' vA:t1;');
  2611. Add('begin');
  2612. Add('end;');
  2613. Add('begin');
  2614. ConvertProgram;
  2615. CheckSource('TestPrgProcVar',
  2616. LinesToStr([ // statements
  2617. 'this.Proc1 = function () {',
  2618. ' var vA=0;',
  2619. '};'
  2620. ]),
  2621. LinesToStr([ // this.$main
  2622. ''
  2623. ]));
  2624. end;
  2625. procedure TTestModule.TestUnitProcVar;
  2626. begin
  2627. StartUnit(false);
  2628. Add('interface');
  2629. Add('');
  2630. Add('type tA=string; // unit scope');
  2631. Add('procedure Proc1;');
  2632. Add('');
  2633. Add('implementation');
  2634. Add('');
  2635. Add('procedure Proc1;');
  2636. Add('type tA=longint; // local proc scope');
  2637. Add('var v1:tA; // using local tA');
  2638. Add('begin');
  2639. Add('end;');
  2640. Add('var v2:tA; // using interface tA');
  2641. ConvertUnit;
  2642. CheckSource('TestUnitProcVar',
  2643. LinesToStr([ // statements
  2644. 'var $impl = $mod.$impl;',
  2645. 'this.Proc1 = function () {',
  2646. ' var v1 = 0;',
  2647. '};',
  2648. '']),
  2649. // this.$init
  2650. '',
  2651. // implementation
  2652. LinesToStr([
  2653. '$impl.v2 = "";',
  2654. '']));
  2655. end;
  2656. procedure TTestModule.TestImplProc;
  2657. begin
  2658. StartUnit(false);
  2659. Add('interface');
  2660. Add('');
  2661. Add('procedure Proc1;');
  2662. Add('');
  2663. Add('implementation');
  2664. Add('');
  2665. Add('procedure Proc1; begin end;');
  2666. Add('procedure Proc2; begin end;');
  2667. Add('initialization');
  2668. Add(' Proc1;');
  2669. Add(' Proc2;');
  2670. ConvertUnit;
  2671. CheckSource('TestImplProc',
  2672. LinesToStr([ // statements
  2673. 'var $impl = $mod.$impl;',
  2674. 'this.Proc1 = function () {',
  2675. '};',
  2676. '']),
  2677. LinesToStr([ // this.$init
  2678. '$mod.Proc1();',
  2679. '$impl.Proc2();',
  2680. '']),
  2681. LinesToStr([ // implementation
  2682. '$impl.Proc2 = function () {',
  2683. '};',
  2684. ''])
  2685. );
  2686. end;
  2687. procedure TTestModule.TestFunctionResult;
  2688. begin
  2689. StartProgram(false);
  2690. Add('function Func1: longint;');
  2691. Add('begin');
  2692. Add(' Result:=3;');
  2693. Add(' Func1:=4;');
  2694. Add('end;');
  2695. Add('begin');
  2696. ConvertProgram;
  2697. CheckSource('TestFunctionResult',
  2698. LinesToStr([ // statements
  2699. 'this.Func1 = function () {',
  2700. ' var Result = 0;',
  2701. ' Result = 3;',
  2702. ' Result = 4;',
  2703. ' return Result;',
  2704. '};'
  2705. ]),
  2706. '');
  2707. end;
  2708. procedure TTestModule.TestNestedProc;
  2709. begin
  2710. StartProgram(false);
  2711. Add([
  2712. 'var vInUnit: longint;',
  2713. 'function DoIt(pA,pD: longint): longint;',
  2714. 'var',
  2715. ' vB: longint;',
  2716. ' vC: longint;',
  2717. ' function Nesty(pA: longint): longint; ',
  2718. ' var vB: longint;',
  2719. ' begin',
  2720. ' Result:=pa+vb+vc+pd+vInUnit;',
  2721. ' nesty:=3;',
  2722. ' doit:=4;',
  2723. ' exit;',
  2724. ' end;',
  2725. 'begin',
  2726. ' Result:=pa+vb+vc;',
  2727. ' doit:=6;',
  2728. ' exit;',
  2729. 'end;',
  2730. 'begin']);
  2731. ConvertProgram;
  2732. CheckSource('TestNestedProc',
  2733. LinesToStr([ // statements
  2734. 'this.vInUnit = 0;',
  2735. 'this.DoIt = function (pA, pD) {',
  2736. ' var Result = 0;',
  2737. ' var vB = 0;',
  2738. ' var vC = 0;',
  2739. ' function Nesty(pA) {',
  2740. ' var Result$1 = 0;',
  2741. ' var vB = 0;',
  2742. ' Result$1 = pA + vB + vC + pD + $mod.vInUnit;',
  2743. ' Result$1 = 3;',
  2744. ' Result = 4;',
  2745. ' return Result$1;',
  2746. ' return Result$1;',
  2747. ' };',
  2748. ' Result = pA + vB + vC;',
  2749. ' Result = 6;',
  2750. ' return Result;',
  2751. ' return Result;',
  2752. '};'
  2753. ]),
  2754. '');
  2755. end;
  2756. procedure TTestModule.TestNestedProc_ResultString;
  2757. begin
  2758. StartProgram(false);
  2759. Add([
  2760. 'function DoIt: string;',
  2761. ' function Nesty: string; ',
  2762. ' begin',
  2763. ' nesty:=#65#66;',
  2764. ' nesty[1]:=#67;',
  2765. ' doit:=#68;',
  2766. ' doit[2]:=#69;',
  2767. ' end;',
  2768. 'begin',
  2769. ' doit:=#70;',
  2770. ' doit[3]:=#71;',
  2771. 'end;',
  2772. 'begin']);
  2773. ConvertProgram;
  2774. CheckSource('TestNestedProc_ResultString',
  2775. LinesToStr([ // statements
  2776. 'this.DoIt = function () {',
  2777. ' var Result = "";',
  2778. ' function Nesty() {',
  2779. ' var Result$1 = "";',
  2780. ' Result$1 = "AB";',
  2781. ' Result$1 = rtl.setCharAt(Result$1, 0, "C");',
  2782. ' Result = "D";',
  2783. ' Result = rtl.setCharAt(Result, 1, "E");',
  2784. ' return Result$1;',
  2785. ' };',
  2786. ' Result = "F";',
  2787. ' Result = rtl.setCharAt(Result, 2, "G");',
  2788. ' return Result;',
  2789. '};'
  2790. ]),
  2791. '');
  2792. end;
  2793. procedure TTestModule.TestForwardProc;
  2794. begin
  2795. StartProgram(false);
  2796. Add('procedure FuncA(Bar: longint); forward;');
  2797. Add('procedure FuncB(Bar: longint);');
  2798. Add('begin');
  2799. Add(' funca(bar);');
  2800. Add('end;');
  2801. Add('procedure funca(bar: longint);');
  2802. Add('begin');
  2803. Add(' if bar=3 then ;');
  2804. Add('end;');
  2805. Add('begin');
  2806. Add(' funca(4);');
  2807. Add(' funcb(5);');
  2808. ConvertProgram;
  2809. CheckSource('TestForwardProc',
  2810. LinesToStr([ // statements'
  2811. 'this.FuncB = function (Bar) {',
  2812. ' $mod.FuncA(Bar);',
  2813. '};',
  2814. 'this.FuncA = function (Bar) {',
  2815. ' if (Bar === 3);',
  2816. '};'
  2817. ]),
  2818. LinesToStr([
  2819. '$mod.FuncA(4);',
  2820. '$mod.FuncB(5);'
  2821. ])
  2822. );
  2823. end;
  2824. procedure TTestModule.TestNestedForwardProc;
  2825. begin
  2826. StartProgram(false);
  2827. Add('procedure FuncA;');
  2828. Add(' procedure FuncB(i: longint); forward;');
  2829. Add(' procedure FuncC(i: longint);');
  2830. Add(' begin');
  2831. Add(' funcb(i);');
  2832. Add(' end;');
  2833. Add(' procedure FuncB(i: longint);');
  2834. Add(' begin');
  2835. Add(' if i=3 then ;');
  2836. Add(' end;');
  2837. Add('begin');
  2838. Add(' funcc(4)');
  2839. Add('end;');
  2840. Add('begin');
  2841. Add(' funca;');
  2842. ConvertProgram;
  2843. CheckSource('TestNestedForwardProc',
  2844. LinesToStr([ // statements'
  2845. 'this.FuncA = function () {',
  2846. ' function FuncC(i) {',
  2847. ' FuncB(i);',
  2848. ' };',
  2849. ' function FuncB(i) {',
  2850. ' if (i === 3);',
  2851. ' };',
  2852. ' FuncC(4);',
  2853. '};'
  2854. ]),
  2855. LinesToStr([
  2856. '$mod.FuncA();'
  2857. ])
  2858. );
  2859. end;
  2860. procedure TTestModule.TestAssignFunctionResult;
  2861. begin
  2862. StartProgram(false);
  2863. Add('function Func1: longint;');
  2864. Add('begin');
  2865. Add('end;');
  2866. Add('var i: longint;');
  2867. Add('begin');
  2868. Add(' i:=func1();');
  2869. Add(' i:=func1()+func1();');
  2870. ConvertProgram;
  2871. CheckSource('TestAssignFunctionResult',
  2872. LinesToStr([ // statements
  2873. 'this.Func1 = function () {',
  2874. ' var Result = 0;',
  2875. ' return Result;',
  2876. '};',
  2877. 'this.i = 0;'
  2878. ]),
  2879. LinesToStr([
  2880. '$mod.i = $mod.Func1();',
  2881. '$mod.i = $mod.Func1() + $mod.Func1();'
  2882. ]));
  2883. end;
  2884. procedure TTestModule.TestFunctionResultInCondition;
  2885. begin
  2886. StartProgram(false);
  2887. Add('function Func1: longint;');
  2888. Add('begin');
  2889. Add('end;');
  2890. Add('function Func2: boolean;');
  2891. Add('begin');
  2892. Add('end;');
  2893. Add('var i: longint;');
  2894. Add('begin');
  2895. Add(' if func2 then ;');
  2896. Add(' if i=func1() then ;');
  2897. Add(' if i=func1 then ;');
  2898. ConvertProgram;
  2899. CheckSource('TestFunctionResultInCondition',
  2900. LinesToStr([ // statements
  2901. 'this.Func1 = function () {',
  2902. ' var Result = 0;',
  2903. ' return Result;',
  2904. '};',
  2905. 'this.Func2 = function () {',
  2906. ' var Result = false;',
  2907. ' return Result;',
  2908. '};',
  2909. 'this.i = 0;'
  2910. ]),
  2911. LinesToStr([
  2912. 'if ($mod.Func2());',
  2913. 'if ($mod.i === $mod.Func1());',
  2914. 'if ($mod.i === $mod.Func1());'
  2915. ]));
  2916. end;
  2917. procedure TTestModule.TestFunctionResultInForLoop;
  2918. begin
  2919. StartProgram(false);
  2920. Add([
  2921. 'function Func1(a: array of longint): longint;',
  2922. 'begin',
  2923. ' for Result:=High(a) downto Low(a) do if a[Result]=0 then exit;',
  2924. ' for Result in a do if a[Result]=0 then exit;',
  2925. 'end;',
  2926. 'begin',
  2927. ' Func1([1,2,3])']);
  2928. ConvertProgram;
  2929. CheckSource('TestFunctionResultInForLoop',
  2930. LinesToStr([ // statements
  2931. 'this.Func1 = function (a) {',
  2932. ' var Result = 0;',
  2933. ' for (var $l1 = rtl.length(a) - 1; $l1 >= 0; $l1--) {',
  2934. ' Result = $l1;',
  2935. ' if (a[Result] === 0) return Result;',
  2936. ' };',
  2937. ' for (var $in2 = a, $l3 = 0, $end4 = rtl.length($in2) - 1; $l3 <= $end4; $l3++) {',
  2938. ' Result = $in2[$l3];',
  2939. ' if (a[Result] === 0) return Result;',
  2940. ' };',
  2941. ' return Result;',
  2942. '};',
  2943. '']),
  2944. LinesToStr([
  2945. '$mod.Func1([1, 2, 3]);'
  2946. ]));
  2947. end;
  2948. procedure TTestModule.TestFunctionResultInTypeCast;
  2949. begin
  2950. StartProgram(false);
  2951. Add([
  2952. 'function GetInt: longint;',
  2953. 'begin',
  2954. 'end;',
  2955. 'begin',
  2956. ' if Byte(GetInt)=0 then ;',
  2957. '']);
  2958. ConvertProgram;
  2959. CheckSource('TestFunctionResultInTypeCast',
  2960. LinesToStr([ // statements
  2961. 'this.GetInt = function () {',
  2962. ' var Result = 0;',
  2963. ' return Result;',
  2964. '};',
  2965. '']),
  2966. LinesToStr([
  2967. 'if (($mod.GetInt() & 255) === 0) ;'
  2968. ]));
  2969. end;
  2970. procedure TTestModule.TestExit;
  2971. begin
  2972. StartProgram(false);
  2973. Add('procedure ProcA;');
  2974. Add('begin');
  2975. Add(' exit;');
  2976. Add('end;');
  2977. Add('function FuncB: longint;');
  2978. Add('begin');
  2979. Add(' exit;');
  2980. Add(' exit(3);');
  2981. Add('end;');
  2982. Add('function FuncC: string;');
  2983. Add('begin');
  2984. Add(' exit;');
  2985. Add(' exit(''a'');');
  2986. Add(' exit(''abc'');');
  2987. Add('end;');
  2988. Add('begin');
  2989. Add(' exit;');
  2990. Add(' exit(1);');
  2991. ConvertProgram;
  2992. CheckSource('TestExit',
  2993. LinesToStr([ // statements
  2994. 'this.ProcA = function () {',
  2995. ' return;',
  2996. '};',
  2997. 'this.FuncB = function () {',
  2998. ' var Result = 0;',
  2999. ' return Result;',
  3000. ' return 3;',
  3001. ' return Result;',
  3002. '};',
  3003. 'this.FuncC = function () {',
  3004. ' var Result = "";',
  3005. ' return Result;',
  3006. ' return "a";',
  3007. ' return "abc";',
  3008. ' return Result;',
  3009. '};'
  3010. ]),
  3011. LinesToStr([
  3012. 'return;',
  3013. 'return 1;',
  3014. '']));
  3015. end;
  3016. procedure TTestModule.TestBreak;
  3017. begin
  3018. StartProgram(false);
  3019. Add([
  3020. 'var',
  3021. ' i: longint;',
  3022. 'begin',
  3023. ' repeat',
  3024. ' break;',
  3025. ' until true;',
  3026. ' while true do',
  3027. ' break;',
  3028. ' for i:=1 to 2 do',
  3029. ' break;']);
  3030. ConvertProgram;
  3031. CheckSource('TestBreak',
  3032. LinesToStr([ // statements
  3033. 'this.i = 0;'
  3034. ]),
  3035. LinesToStr([
  3036. 'do {',
  3037. ' break;',
  3038. '} while (!true);',
  3039. 'while (true) break;',
  3040. 'for ($mod.i = 1; $mod.i <= 2; $mod.i++) break;',
  3041. '']));
  3042. end;
  3043. procedure TTestModule.TestBreakAsVar;
  3044. begin
  3045. StartProgram(false);
  3046. Add([
  3047. 'procedure DoIt(break: boolean);',
  3048. 'begin',
  3049. ' if break then ;',
  3050. 'end;',
  3051. 'var',
  3052. ' break: boolean;',
  3053. 'begin',
  3054. ' if break then ;']);
  3055. ConvertProgram;
  3056. CheckSource('TestBreakAsVar',
  3057. LinesToStr([ // statements
  3058. 'this.DoIt = function (Break) {',
  3059. ' if (Break) ;',
  3060. '};',
  3061. 'this.Break = false;',
  3062. '']),
  3063. LinesToStr([
  3064. 'if($mod.Break) ;',
  3065. '']));
  3066. end;
  3067. procedure TTestModule.TestContinue;
  3068. begin
  3069. StartProgram(false);
  3070. Add('var i: longint;');
  3071. Add('begin');
  3072. Add(' repeat');
  3073. Add(' continue;');
  3074. Add(' until true;');
  3075. Add(' while true do');
  3076. Add(' continue;');
  3077. Add(' for i:=1 to 2 do');
  3078. Add(' continue;');
  3079. ConvertProgram;
  3080. CheckSource('TestContinue',
  3081. LinesToStr([ // statements
  3082. 'this.i = 0;'
  3083. ]),
  3084. LinesToStr([
  3085. 'do {',
  3086. ' continue;',
  3087. '} while (!true);',
  3088. 'while (true) continue;',
  3089. 'for ($mod.i = 1; $mod.i <= 2; $mod.i++) continue;',
  3090. '']));
  3091. end;
  3092. procedure TTestModule.TestProc_External;
  3093. begin
  3094. StartProgram(false);
  3095. Add('procedure Foo; external name ''console.log'';');
  3096. Add('function Bar: longint; external name ''get.item'';');
  3097. Add('function Bla(s: string): longint; external name ''apply.something'';');
  3098. Add('var');
  3099. Add(' i: longint;');
  3100. Add('begin');
  3101. Add(' Foo;');
  3102. Add(' i:=Bar;');
  3103. Add(' i:=Bla(''abc'');');
  3104. ConvertProgram;
  3105. CheckSource('TestProc_External',
  3106. LinesToStr([ // statements
  3107. 'this.i = 0;'
  3108. ]),
  3109. LinesToStr([
  3110. 'console.log();',
  3111. '$mod.i = get.item();',
  3112. '$mod.i = apply.something("abc");'
  3113. ]));
  3114. end;
  3115. procedure TTestModule.TestProc_ExternalOtherUnit;
  3116. begin
  3117. AddModuleWithIntfImplSrc('unit2.pas',
  3118. LinesToStr([
  3119. 'procedure Now; external name ''Date.now'';',
  3120. 'procedure DoIt;'
  3121. ]),
  3122. 'procedure doit; begin end;');
  3123. StartUnit(true);
  3124. Add('interface');
  3125. Add('uses unit2;');
  3126. Add('implementation');
  3127. Add('begin');
  3128. Add(' now;');
  3129. Add(' now();');
  3130. Add(' uNit2.now;');
  3131. Add(' uNit2.now();');
  3132. Add(' doit;');
  3133. Add(' uNit2.doit;');
  3134. ConvertUnit;
  3135. CheckSource('TestProc_ExternalOtherUnit',
  3136. LinesToStr([
  3137. '']),
  3138. LinesToStr([
  3139. 'Date.now();',
  3140. 'Date.now();',
  3141. 'Date.now();',
  3142. 'Date.now();',
  3143. 'pas.unit2.DoIt();',
  3144. 'pas.unit2.DoIt();',
  3145. '']));
  3146. end;
  3147. procedure TTestModule.TestProc_Asm;
  3148. begin
  3149. StartProgram(false);
  3150. Add([
  3151. 'function DoIt: longint;',
  3152. 'begin;',
  3153. ' asm',
  3154. ' { a:{ b:{}, c:[]}, d:''1'' };',
  3155. ' end;',
  3156. ' asm console.log(); end;',
  3157. ' asm',
  3158. ' s = "'' ";',
  3159. ' s = ''" '';',
  3160. ' s = s + "world" + "''";',
  3161. ' // end',
  3162. ' s = ''end'';',
  3163. ' s = "end";',
  3164. ' end;',
  3165. 'end;',
  3166. 'begin']);
  3167. ConvertProgram;
  3168. CheckSource('TestProc_Asm',
  3169. LinesToStr([ // statements
  3170. 'this.DoIt = function () {',
  3171. ' var Result = 0;',
  3172. ' { a:{ b:{}, c:[]}, d:''1'' };',
  3173. ' console.log();',
  3174. ' s = "'' ";',
  3175. ' s = ''" '';',
  3176. ' s = s + "world" + "''";',
  3177. ' // end',
  3178. ' s = ''end'';',
  3179. ' s = "end";',
  3180. ' return Result;',
  3181. '};'
  3182. ]),
  3183. LinesToStr([
  3184. ''
  3185. ]));
  3186. end;
  3187. procedure TTestModule.TestProc_Assembler;
  3188. begin
  3189. StartProgram(false);
  3190. Add('function DoIt: longint; assembler;');
  3191. Add('asm');
  3192. Add('{ a:{ b:{}, c:[]}, d:''1'' };');
  3193. Add('end;');
  3194. Add('begin');
  3195. ConvertProgram;
  3196. CheckSource('TestProc_Assembler',
  3197. LinesToStr([ // statements
  3198. 'this.DoIt = function () {',
  3199. ' { a:{ b:{}, c:[]}, d:''1'' };',
  3200. '};'
  3201. ]),
  3202. LinesToStr([
  3203. ''
  3204. ]));
  3205. end;
  3206. procedure TTestModule.TestProc_VarParam;
  3207. begin
  3208. StartProgram(false);
  3209. Add('type integer = longint;');
  3210. Add('procedure DoIt(vG: integer; const vH: integer; var vI: integer);');
  3211. Add('var vJ: integer;');
  3212. Add('begin');
  3213. Add(' vg:=vg+1;');
  3214. Add(' vj:=vh+2;');
  3215. Add(' vi:=vi+3;');
  3216. Add(' doit(vg,vg,vg);');
  3217. Add(' doit(vh,vh,vj);');
  3218. Add(' doit(vi,vi,vi);');
  3219. Add(' doit(vj,vj,vj);');
  3220. Add('end;');
  3221. Add('var i: integer;');
  3222. Add('begin');
  3223. Add(' doit(i,i,i);');
  3224. ConvertProgram;
  3225. CheckSource('TestProc_VarParam',
  3226. LinesToStr([ // statements
  3227. 'this.DoIt = function (vG,vH,vI) {',
  3228. ' var vJ = 0;',
  3229. ' vG = vG + 1;',
  3230. ' vJ = vH + 2;',
  3231. ' vI.set(vI.get()+3);',
  3232. ' $mod.DoIt(vG, vG, {',
  3233. ' get: function () {',
  3234. ' return vG;',
  3235. ' },',
  3236. ' set: function (v) {',
  3237. ' vG = v;',
  3238. ' }',
  3239. ' });',
  3240. ' $mod.DoIt(vH, vH, {',
  3241. ' get: function () {',
  3242. ' return vJ;',
  3243. ' },',
  3244. ' set: function (v) {',
  3245. ' vJ = v;',
  3246. ' }',
  3247. ' });',
  3248. ' $mod.DoIt(vI.get(), vI.get(), vI);',
  3249. ' $mod.DoIt(vJ, vJ, {',
  3250. ' get: function () {',
  3251. ' return vJ;',
  3252. ' },',
  3253. ' set: function (v) {',
  3254. ' vJ = v;',
  3255. ' }',
  3256. ' });',
  3257. '};',
  3258. 'this.i = 0;'
  3259. ]),
  3260. LinesToStr([
  3261. '$mod.DoIt($mod.i,$mod.i,{',
  3262. ' p: $mod,',
  3263. ' get: function () {',
  3264. ' return this.p.i;',
  3265. ' },',
  3266. ' set: function (v) {',
  3267. ' this.p.i = v;',
  3268. ' }',
  3269. '});'
  3270. ]));
  3271. end;
  3272. procedure TTestModule.TestProc_VarParamString;
  3273. begin
  3274. StartProgram(false);
  3275. Add(['type TCaption = string;',
  3276. 'procedure DoIt(vA: TCaption; var vB: TCaption; out vC: TCaption);',
  3277. 'var c: char;',
  3278. 'begin',
  3279. ' va[1]:=c;',
  3280. ' vb[2]:=c;',
  3281. ' vc[3]:=c;',
  3282. 'end;',
  3283. 'begin']);
  3284. ConvertProgram;
  3285. CheckSource('TestProc_VarParamString',
  3286. LinesToStr([ // statements
  3287. 'this.DoIt = function (vA,vB,vC) {',
  3288. ' var c = "";',
  3289. ' vA = rtl.setCharAt(vA, 0, c);',
  3290. ' vB.set(rtl.setCharAt(vB.get(), 1, c));',
  3291. ' vC.set(rtl.setCharAt(vC.get(), 2, c));',
  3292. '};',
  3293. '']),
  3294. LinesToStr([
  3295. ]));
  3296. end;
  3297. procedure TTestModule.TestProc_VarParamV;
  3298. begin
  3299. StartProgram(false);
  3300. Add([
  3301. 'procedure Inc2(var i: longint);',
  3302. 'begin',
  3303. ' i:=i+2;',
  3304. 'end;',
  3305. 'procedure DoIt(v: longint);',
  3306. 'var p: array of longint;',
  3307. 'begin',
  3308. ' Inc2(v);',
  3309. ' Inc2(p[v]);',
  3310. 'end;',
  3311. 'begin']);
  3312. ConvertProgram;
  3313. CheckSource('TestProc_VarParamV',
  3314. LinesToStr([ // statements
  3315. 'this.Inc2 = function (i) {',
  3316. ' i.set(i.get()+2);',
  3317. '};',
  3318. 'this.DoIt = function (v) {',
  3319. ' var p = [];',
  3320. ' $mod.Inc2({get: function () {',
  3321. ' return v;',
  3322. ' }, set: function (w) {',
  3323. ' v = w;',
  3324. ' }});',
  3325. ' $mod.Inc2({',
  3326. ' a: v,',
  3327. ' p: p,',
  3328. ' get: function () {',
  3329. ' return this.p[this.a];',
  3330. ' },',
  3331. ' set: function (v) {',
  3332. ' this.p[this.a] = v;',
  3333. ' }',
  3334. ' });',
  3335. '};',
  3336. '']),
  3337. LinesToStr([
  3338. '']));
  3339. end;
  3340. procedure TTestModule.TestProc_Overload;
  3341. begin
  3342. StartProgram(false);
  3343. Add('procedure DoIt(vI: longint); begin end;');
  3344. Add('procedure DoIt(vI, vJ: longint); begin end;');
  3345. Add('procedure DoIt(vD: double); begin end;');
  3346. Add('begin');
  3347. Add(' DoIt(1);');
  3348. Add(' DoIt(2,3);');
  3349. Add(' DoIt(4.5);');
  3350. ConvertProgram;
  3351. CheckSource('TestProcedureOverload',
  3352. LinesToStr([ // statements
  3353. 'this.DoIt = function (vI) {',
  3354. '};',
  3355. 'this.DoIt$1 = function (vI, vJ) {',
  3356. '};',
  3357. 'this.DoIt$2 = function (vD) {',
  3358. '};',
  3359. '']),
  3360. LinesToStr([
  3361. '$mod.DoIt(1);',
  3362. '$mod.DoIt$1(2, 3);',
  3363. '$mod.DoIt$2(4.5);',
  3364. '']));
  3365. end;
  3366. procedure TTestModule.TestProc_OverloadForward;
  3367. begin
  3368. StartProgram(false);
  3369. Add('procedure DoIt(vI: longint); forward;');
  3370. Add('procedure DoIt(vI, vJ: longint); begin end;');
  3371. Add('procedure doit(vi: longint); begin end;');
  3372. Add('begin');
  3373. Add(' doit(1);');
  3374. Add(' doit(2,3);');
  3375. ConvertProgram;
  3376. CheckSource('TestProcedureOverloadForward',
  3377. LinesToStr([ // statements
  3378. 'this.DoIt$1 = function (vI, vJ) {',
  3379. '};',
  3380. 'this.DoIt = function (vI) {',
  3381. '};',
  3382. '']),
  3383. LinesToStr([
  3384. '$mod.DoIt(1);',
  3385. '$mod.DoIt$1(2, 3);',
  3386. '']));
  3387. end;
  3388. procedure TTestModule.TestProc_OverloadIntfImpl;
  3389. begin
  3390. StartUnit(false);
  3391. Add('interface');
  3392. Add('procedure DoIt(vI: longint);');
  3393. Add('procedure DoIt(vI, vJ: longint);');
  3394. Add('implementation');
  3395. Add('procedure DoIt(vI, vJ, vK, vL, vM: longint); forward;');
  3396. Add('procedure DoIt(vI, vJ, vK: longint); begin end;');
  3397. Add('procedure DoIt(vi: longint); begin end;');
  3398. Add('procedure DoIt(vI, vJ, vK, vL: longint); begin end;');
  3399. Add('procedure DoIt(vi, vj: longint); begin end;');
  3400. Add('procedure DoIt(vi, vj, vk, vl, vm: longint); begin end;');
  3401. Add('begin');
  3402. Add(' doit(1);');
  3403. Add(' doit(2,3);');
  3404. Add(' doit(4,5,6);');
  3405. Add(' doit(7,8,9,10);');
  3406. Add(' doit(11,12,13,14,15);');
  3407. ConvertUnit;
  3408. CheckSource('TestProcedureOverloadUnit',
  3409. LinesToStr([ // statements
  3410. 'var $impl = $mod.$impl;',
  3411. 'this.DoIt = function (vI) {',
  3412. '};',
  3413. 'this.DoIt$1 = function (vI, vJ) {',
  3414. '};',
  3415. '']),
  3416. LinesToStr([ // this.$init
  3417. '$mod.DoIt(1);',
  3418. '$mod.DoIt$1(2, 3);',
  3419. '$impl.DoIt$3(4,5,6);',
  3420. '$impl.DoIt$4(7,8,9,10);',
  3421. '$impl.DoIt$2(11,12,13,14,15);',
  3422. '']),
  3423. LinesToStr([ // implementation
  3424. '$impl.DoIt$3 = function (vI, vJ, vK) {',
  3425. '};',
  3426. '$impl.DoIt$4 = function (vI, vJ, vK, vL) {',
  3427. '};',
  3428. '$impl.DoIt$2 = function (vI, vJ, vK, vL, vM) {',
  3429. '};',
  3430. '']));
  3431. end;
  3432. procedure TTestModule.TestProc_OverloadNested;
  3433. begin
  3434. StartProgram(false);
  3435. Add([
  3436. 'procedure DoIt(vA: longint); overload; forward;',
  3437. 'procedure DoIt(vB, vC: longint); overload;',
  3438. 'begin // 2 param overload',
  3439. ' doit(1);',
  3440. ' doit(1,2);',
  3441. 'end;',
  3442. 'procedure doit(vA: longint);',
  3443. ' procedure DoIt(vA, vB, vC: longint); overload; forward;',
  3444. ' procedure DoIt(vA, vB, vC, vD: longint); overload;',
  3445. ' begin // 4 param overload',
  3446. ' doit(1);',
  3447. ' doit(1,2);',
  3448. ' doit(1,2,3);',
  3449. ' doit(1,2,3,4);',
  3450. ' end;',
  3451. ' procedure doit(vA, vB, vC: longint);',
  3452. ' procedure DoIt(vA, vB, vC, vD, vE: longint); overload; forward;',
  3453. ' procedure DoIt(vA, vB, vC, vD, vE, vF: longint); overload;',
  3454. ' begin // 6 param overload',
  3455. ' doit(1);',
  3456. ' doit(1,2);',
  3457. ' doit(1,2,3);',
  3458. ' doit(1,2,3,4);',
  3459. ' doit(1,2,3,4,5);',
  3460. ' doit(1,2,3,4,5,6);',
  3461. ' end;',
  3462. ' procedure doit(vA, vB, vC, vD, vE: longint);',
  3463. ' begin // 5 param overload',
  3464. ' doit(1);',
  3465. ' doit(1,2);',
  3466. ' doit(1,2,3);',
  3467. ' doit(1,2,3,4);',
  3468. ' doit(1,2,3,4,5);',
  3469. ' doit(1,2,3,4,5,6);',
  3470. ' end;',
  3471. ' begin // 3 param overload',
  3472. ' doit(1);',
  3473. ' doit(1,2);',
  3474. ' doit(1,2,3);',
  3475. ' doit(1,2,3,4);',
  3476. ' doit(1,2,3,4,5);',
  3477. ' doit(1,2,3,4,5,6);',
  3478. ' end;',
  3479. 'begin // 1 param overload',
  3480. ' doit(1);',
  3481. ' doit(1,2);',
  3482. ' doit(1,2,3);',
  3483. ' doit(1,2,3,4);',
  3484. 'end;',
  3485. 'begin // main',
  3486. ' doit(1);',
  3487. ' doit(1,2);']);
  3488. ConvertProgram;
  3489. CheckSource('TestProcedureOverloadNested',
  3490. LinesToStr([ // statements
  3491. 'this.DoIt$1 = function (vB, vC) {',
  3492. ' $mod.DoIt(1);',
  3493. ' $mod.DoIt$1(1, 2);',
  3494. '};',
  3495. 'this.DoIt = function (vA) {',
  3496. ' function DoIt$3(vA, vB, vC, vD) {',
  3497. ' $mod.DoIt(1);',
  3498. ' $mod.DoIt$1(1, 2);',
  3499. ' DoIt$2(1, 2, 3);',
  3500. ' DoIt$3(1, 2, 3, 4);',
  3501. ' };',
  3502. ' function DoIt$2(vA, vB, vC) {',
  3503. ' function DoIt$5(vA, vB, vC, vD, vE, vF) {',
  3504. ' $mod.DoIt(1);',
  3505. ' $mod.DoIt$1(1, 2);',
  3506. ' DoIt$2(1, 2, 3);',
  3507. ' DoIt$3(1, 2, 3, 4);',
  3508. ' DoIt$4(1, 2, 3, 4, 5);',
  3509. ' DoIt$5(1, 2, 3, 4, 5, 6);',
  3510. ' };',
  3511. ' function DoIt$4(vA, vB, vC, vD, vE) {',
  3512. ' $mod.DoIt(1);',
  3513. ' $mod.DoIt$1(1, 2);',
  3514. ' DoIt$2(1, 2, 3);',
  3515. ' DoIt$3(1, 2, 3, 4);',
  3516. ' DoIt$4(1, 2, 3, 4, 5);',
  3517. ' DoIt$5(1, 2, 3, 4, 5, 6);',
  3518. ' };',
  3519. ' $mod.DoIt(1);',
  3520. ' $mod.DoIt$1(1, 2);',
  3521. ' DoIt$2(1, 2, 3);',
  3522. ' DoIt$3(1, 2, 3, 4);',
  3523. ' DoIt$4(1, 2, 3, 4, 5);',
  3524. ' DoIt$5(1, 2, 3, 4, 5, 6);',
  3525. ' };',
  3526. ' $mod.DoIt(1);',
  3527. ' $mod.DoIt$1(1, 2);',
  3528. ' DoIt$2(1, 2, 3);',
  3529. ' DoIt$3(1, 2, 3, 4);',
  3530. '};',
  3531. '']),
  3532. LinesToStr([
  3533. '$mod.DoIt(1);',
  3534. '$mod.DoIt$1(1, 2);',
  3535. '']));
  3536. end;
  3537. procedure TTestModule.TestProc_OverloadUnitCycle;
  3538. begin
  3539. AddModuleWithIntfImplSrc('Unit2.pas',
  3540. LinesToStr([
  3541. 'type',
  3542. ' TObject = class',
  3543. ' procedure DoIt(b: boolean); virtual; abstract;',
  3544. ' procedure DoIt(i: longint); virtual; abstract;',
  3545. ' end;',
  3546. '']),
  3547. 'uses test1;');
  3548. StartUnit(true);
  3549. Add([
  3550. 'interface',
  3551. 'uses unit2;',
  3552. 'type',
  3553. ' TEagle = class(TObject)',
  3554. ' procedure DoIt(b: boolean); override;',
  3555. ' procedure DoIt(i: longint); override;',
  3556. ' end;',
  3557. 'implementation',
  3558. 'procedure TEagle.DoIt(b: boolean); begin end;',
  3559. 'procedure TEagle.DoIt(i: longint); begin end;',
  3560. '']);
  3561. ConvertUnit;
  3562. CheckSource('TestProc_OverloadUnitCycle',
  3563. LinesToStr([ // statements
  3564. 'rtl.createClass($mod, "TEagle", pas.Unit2.TObject, function () {',
  3565. ' this.DoIt = function (b) {',
  3566. ' };',
  3567. ' this.DoIt$1 = function (i) {',
  3568. ' };',
  3569. '});',
  3570. '']),
  3571. '',
  3572. LinesToStr([
  3573. '']));
  3574. end;
  3575. procedure TTestModule.TestProc_Varargs;
  3576. begin
  3577. StartProgram(false);
  3578. Add([
  3579. 'procedure ProcA(i:longint); varargs; external name ''ProcA'';',
  3580. 'procedure ProcB; varargs; external name ''ProcB'';',
  3581. 'procedure ProcC(i: longint = 17); varargs; external name ''ProcC'';',
  3582. 'function GetIt: longint; begin end;',
  3583. 'begin',
  3584. ' ProcA(1);',
  3585. ' ProcA(1,2);',
  3586. ' ProcA(1,2.0);',
  3587. ' ProcA(1,2,3);',
  3588. ' ProcA(1,''2'');',
  3589. ' ProcA(2,'''');',
  3590. ' ProcA(3,false);',
  3591. ' ProcB;',
  3592. ' ProcB();',
  3593. ' ProcB(4);',
  3594. ' ProcB(''foo'');',
  3595. ' ProcC;',
  3596. ' ProcC();',
  3597. ' ProcC(4);',
  3598. ' ProcC(5,''foo'');',
  3599. ' ProcB(GetIt);',
  3600. ' ProcB(GetIt());',
  3601. ' ProcB(GetIt,GetIt());']);
  3602. ConvertProgram;
  3603. CheckSource('TestProc_Varargs',
  3604. LinesToStr([ // statements
  3605. 'this.GetIt = function () {',
  3606. ' var Result = 0;',
  3607. ' return Result;',
  3608. '};',
  3609. '']),
  3610. LinesToStr([
  3611. 'ProcA(1);',
  3612. 'ProcA(1, 2);',
  3613. 'ProcA(1, 2.0);',
  3614. 'ProcA(1, 2, 3);',
  3615. 'ProcA(1, "2");',
  3616. 'ProcA(2, "");',
  3617. 'ProcA(3, false);',
  3618. 'ProcB();',
  3619. 'ProcB();',
  3620. 'ProcB(4);',
  3621. 'ProcB("foo");',
  3622. 'ProcC(17);',
  3623. 'ProcC(17);',
  3624. 'ProcC(4);',
  3625. 'ProcC(5, "foo");',
  3626. 'ProcB($mod.GetIt());',
  3627. 'ProcB($mod.GetIt());',
  3628. 'ProcB($mod.GetIt(), $mod.GetIt());',
  3629. '']));
  3630. end;
  3631. procedure TTestModule.TestProc_ConstOrder;
  3632. begin
  3633. StartProgram(false);
  3634. Add([
  3635. 'const A = 3;',
  3636. 'const B = A+1;',
  3637. 'procedure DoIt;',
  3638. 'const C = A+1;',
  3639. 'const D = B+1;',
  3640. 'const E = D+C+B+A;',
  3641. 'begin',
  3642. 'end;',
  3643. 'begin'
  3644. ]);
  3645. ConvertProgram;
  3646. CheckSource('TestProc_ConstOrder',
  3647. LinesToStr([ // statements
  3648. 'this.A = 3;',
  3649. 'this.B = 3 + 1;',
  3650. 'var C = 3 + 1;',
  3651. 'var D = 4 + 1;',
  3652. 'var E = 5 + 4 + 4 + 3;',
  3653. 'this.DoIt = function () {',
  3654. '};',
  3655. '']),
  3656. LinesToStr([
  3657. ''
  3658. ]));
  3659. end;
  3660. procedure TTestModule.TestProc_DuplicateConst;
  3661. begin
  3662. StartProgram(false);
  3663. Add([
  3664. 'const A = 1;',
  3665. 'procedure DoIt;',
  3666. 'const A = 2;',
  3667. ' procedure SubIt;',
  3668. ' const A = 21;',
  3669. ' begin',
  3670. ' end;',
  3671. 'begin',
  3672. 'end;',
  3673. 'procedure DoSome;',
  3674. 'const A = 3;',
  3675. 'begin',
  3676. 'end;',
  3677. 'begin'
  3678. ]);
  3679. ConvertProgram;
  3680. CheckSource('TestProc_DuplicateConst',
  3681. LinesToStr([ // statements
  3682. 'this.A = 1;',
  3683. 'var A$1 = 2;',
  3684. 'var A$2 = 21;',
  3685. 'this.DoIt = function () {',
  3686. ' function SubIt() {',
  3687. ' };',
  3688. '};',
  3689. 'var A$3 = 3;',
  3690. 'this.DoSome = function () {',
  3691. '};',
  3692. '']),
  3693. LinesToStr([
  3694. ''
  3695. ]));
  3696. end;
  3697. procedure TTestModule.TestProc_LocalVarAbsolute;
  3698. begin
  3699. StartProgram(false);
  3700. Add([
  3701. 'type',
  3702. ' TObject = class',
  3703. ' Index: longint;',
  3704. ' procedure DoAbs(Item: pointer);',
  3705. ' end;',
  3706. 'procedure TObject.DoAbs(Item: pointer);',
  3707. 'var',
  3708. ' o: TObject absolute Item;',
  3709. 'begin',
  3710. ' if o.Index<o.Index then o.Index:=o.Index;',
  3711. 'end;',
  3712. 'procedure DoIt(i: longint; p: pointer);',
  3713. 'var',
  3714. ' d: double absolute i;',
  3715. ' s: string absolute d;',
  3716. ' oi: TObject absolute i;',
  3717. ' op: TObject absolute p;',
  3718. 'begin',
  3719. ' if d=d then d:=d;',
  3720. ' if s=s then s:=s;',
  3721. ' if oi.Index<oi.Index then oi.Index:=oi.Index;',
  3722. ' if op.Index=op.Index then op.Index:=op.Index;',
  3723. 'end;',
  3724. 'begin']);
  3725. ConvertProgram;
  3726. CheckSource('TestProc_LocalVarAbsolute',
  3727. LinesToStr([ // statements
  3728. 'rtl.createClass($mod, "TObject", null, function () {',
  3729. ' this.$init = function () {',
  3730. ' this.Index = 0;',
  3731. ' };',
  3732. ' this.$final = function () {',
  3733. ' };',
  3734. ' this.DoAbs = function (Item) {',
  3735. ' if (Item.Index < Item.Index) Item.Index = Item.Index;',
  3736. ' };',
  3737. '});',
  3738. 'this.DoIt = function (i, p) {',
  3739. ' if (i === i) i = i;',
  3740. ' if (i === i) i = i;',
  3741. ' if (i.Index < i.Index) i.Index = i.Index;',
  3742. ' if (p.Index === p.Index) p.Index = p.Index;',
  3743. '};'
  3744. ]),
  3745. LinesToStr([
  3746. ]));
  3747. end;
  3748. procedure TTestModule.TestProc_ReservedWords;
  3749. begin
  3750. StartProgram(false);
  3751. Add([
  3752. 'procedure Date(ArrayBuffer: longint);',
  3753. 'const',
  3754. ' NaN: longint = 3;',
  3755. 'var',
  3756. ' &Boolean: longint;',
  3757. ' procedure Error(ArrayBuffer: longint);',
  3758. ' begin',
  3759. ' end;',
  3760. 'begin',
  3761. ' Nan:=&bOolean;',
  3762. 'end;',
  3763. 'begin',
  3764. ' Date(1);']);
  3765. ConvertProgram;
  3766. CheckSource('TestProc_ReservedWords',
  3767. LinesToStr([ // statements
  3768. 'var naN = 3;',
  3769. 'this.Date = function (arrayBuffer) {',
  3770. ' var boolean = 0;',
  3771. ' function error(arrayBuffer) {',
  3772. ' };',
  3773. ' naN = boolean;',
  3774. '};',
  3775. '']),
  3776. LinesToStr([
  3777. ' $mod.Date(1);'
  3778. ]));
  3779. end;
  3780. procedure TTestModule.TestAnonymousProc_Assign_ObjFPC;
  3781. begin
  3782. StartProgram(false);
  3783. Add([
  3784. '{$mode objfpc}',
  3785. 'type',
  3786. ' TFunc = reference to function(x: word): word;',
  3787. 'var Func: TFunc;',
  3788. 'procedure DoIt(a: word);',
  3789. 'begin',
  3790. ' Func:=function(b:word): word',
  3791. ' begin',
  3792. ' Result:=a+b;',
  3793. ' exit(b);',
  3794. ' exit(Result);',
  3795. ' end;',// test semicolon
  3796. ' a:=3;',
  3797. 'end;',
  3798. 'begin',
  3799. ' Func:=function(c:word):word begin',
  3800. ' Result:=3+c;',
  3801. ' exit(c);',
  3802. ' exit(Result);',
  3803. ' end;']);
  3804. ConvertProgram;
  3805. CheckSource('TestAnonymousProc_Assign_ObjFPC',
  3806. LinesToStr([ // statements
  3807. 'this.Func = null;',
  3808. 'this.DoIt = function (a) {',
  3809. ' $mod.Func = function (b) {',
  3810. ' var Result = 0;',
  3811. ' Result = a + b;',
  3812. ' return b;',
  3813. ' return Result;',
  3814. ' return Result;',
  3815. ' };',
  3816. ' a = 3;',
  3817. '};',
  3818. '']),
  3819. LinesToStr([
  3820. '$mod.Func = function (c) {',
  3821. ' var Result = 0;',
  3822. ' Result = 3 + c;',
  3823. ' return c;',
  3824. ' return Result;',
  3825. ' return Result;',
  3826. '};',
  3827. '']));
  3828. end;
  3829. procedure TTestModule.TestAnonymousProc_Assign_Delphi;
  3830. begin
  3831. StartProgram(false);
  3832. Add([
  3833. '{$mode delphi}',
  3834. 'type',
  3835. ' TProc = reference to procedure(x: word);',
  3836. 'procedure DoIt(a: word);',
  3837. 'var Proc: TProc;',
  3838. 'begin',
  3839. ' Proc:=procedure(b:word) begin end;',
  3840. 'end;',
  3841. 'var Proc: TProc;',
  3842. 'begin',
  3843. ' Proc:=procedure(c:word) begin end;',
  3844. '']);
  3845. ConvertProgram;
  3846. CheckSource('TestAnonymousProc_Assign_Delphi',
  3847. LinesToStr([ // statements
  3848. 'this.DoIt = function (a) {',
  3849. ' var Proc = null;',
  3850. ' Proc = function (b) {',
  3851. ' };',
  3852. '};',
  3853. 'this.Proc = null;',
  3854. '']),
  3855. LinesToStr([
  3856. '$mod.Proc = function (c) {',
  3857. '};',
  3858. '']));
  3859. end;
  3860. procedure TTestModule.TestAnonymousProc_Arg;
  3861. begin
  3862. StartProgram(false);
  3863. Add([
  3864. 'type',
  3865. ' TProc = reference to procedure;',
  3866. ' TFunc = reference to function(x: word): word;',
  3867. 'procedure DoMore(f,g: TProc);',
  3868. 'begin',
  3869. 'end;',
  3870. 'procedure DoOdd(v: jsvalue);',
  3871. 'begin',
  3872. 'end;',
  3873. 'procedure DoIt(f: TFunc);',
  3874. 'begin',
  3875. ' DoIt(function(b:word): word',
  3876. ' begin',
  3877. ' Result:=1+b;',
  3878. ' end);',
  3879. ' DoMore(procedure begin end, procedure begin end);',
  3880. ' DoOdd(procedure begin end);',
  3881. 'end;',
  3882. 'begin',
  3883. ' DoMore(procedure begin end,',
  3884. ' procedure assembler asm',
  3885. ' console.log("c");',
  3886. ' end);',
  3887. '']);
  3888. ConvertProgram;
  3889. CheckSource('TestAnonymousProc_Arg',
  3890. LinesToStr([ // statements
  3891. 'this.DoMore = function (f, g) {',
  3892. '};',
  3893. 'this.DoOdd = function (v) {',
  3894. '};',
  3895. 'this.DoIt = function (f) {',
  3896. ' $mod.DoIt(function (b) {',
  3897. ' var Result = 0;',
  3898. ' Result = 1 + b;',
  3899. ' return Result;',
  3900. ' });',
  3901. ' $mod.DoMore(function () {',
  3902. ' }, function () {',
  3903. ' });',
  3904. ' $mod.DoOdd(function () {',
  3905. ' });',
  3906. '};',
  3907. '']),
  3908. LinesToStr([
  3909. '$mod.DoMore(function () {',
  3910. '}, function () {',
  3911. ' console.log("c");',
  3912. '});',
  3913. '']));
  3914. end;
  3915. procedure TTestModule.TestAnonymousProc_Typecast;
  3916. begin
  3917. StartProgram(false);
  3918. Add([
  3919. 'type',
  3920. ' TProc = reference to procedure(w: word);',
  3921. ' TArr = array of word;',
  3922. ' TFuncArr = reference to function: TArr;',
  3923. 'procedure DoIt(p: TProc);',
  3924. 'var',
  3925. ' w: word;',
  3926. ' a: TArr;',
  3927. 'begin',
  3928. ' p:=TProc(procedure(b: smallint) begin end);',
  3929. ' a:=TFuncArr(function: TArr begin end)();',
  3930. ' w:=TFuncArr(function: TArr begin end)()[3];',
  3931. 'end;',
  3932. 'begin']);
  3933. ConvertProgram;
  3934. CheckSource('TestAnonymousProc_Typecast',
  3935. LinesToStr([ // statements
  3936. 'this.DoIt = function (p) {',
  3937. ' var w = 0;',
  3938. ' var a = [];',
  3939. ' p = function (b) {',
  3940. ' };',
  3941. ' a = function () {',
  3942. ' var Result = [];',
  3943. ' return Result;',
  3944. ' }();',
  3945. ' w = function () {',
  3946. ' var Result = [];',
  3947. ' return Result;',
  3948. ' }()[3];',
  3949. '};',
  3950. '']),
  3951. LinesToStr([
  3952. '']));
  3953. end;
  3954. procedure TTestModule.TestAnonymousProc_With;
  3955. begin
  3956. StartProgram(false);
  3957. Add([
  3958. 'type',
  3959. ' TProc = reference to procedure(w: word);',
  3960. ' TObject = class',
  3961. ' b: boolean;',
  3962. ' end;',
  3963. 'var',
  3964. ' p: TProc;',
  3965. ' bird: TObject;',
  3966. 'begin',
  3967. ' with bird do',
  3968. ' p:=procedure(w: word)',
  3969. ' begin',
  3970. ' b:=w>2;',
  3971. ' end;',
  3972. '']);
  3973. ConvertProgram;
  3974. CheckSource('TestAnonymousProc_With',
  3975. LinesToStr([ // statements
  3976. 'rtl.createClass($mod, "TObject", null, function () {',
  3977. ' this.$init = function () {',
  3978. ' this.b = false;',
  3979. ' };',
  3980. ' this.$final = function () {',
  3981. ' };',
  3982. '});',
  3983. 'this.p = null;',
  3984. 'this.bird = null;',
  3985. '']),
  3986. LinesToStr([
  3987. 'var $with1 = $mod.bird;',
  3988. '$mod.p = function (w) {',
  3989. ' $with1.b = w > 2;',
  3990. '};',
  3991. '']));
  3992. end;
  3993. procedure TTestModule.TestAnonymousProc_ExceptOn;
  3994. begin
  3995. StartProgram(false);
  3996. Add([
  3997. 'type',
  3998. ' TProc = reference to procedure;',
  3999. ' TObject = class',
  4000. ' b: boolean;',
  4001. ' end;',
  4002. 'procedure DoIt;',
  4003. 'var',
  4004. ' p: TProc;',
  4005. 'begin',
  4006. ' try',
  4007. ' except',
  4008. ' on E: TObject do',
  4009. ' p:=procedure',
  4010. ' begin',
  4011. ' E.b:=true;',
  4012. ' end;',
  4013. ' end;',
  4014. 'end;',
  4015. 'begin']);
  4016. ConvertProgram;
  4017. CheckSource('TestAnonymousProc_ExceptOn',
  4018. LinesToStr([ // statements
  4019. 'rtl.createClass($mod, "TObject", null, function () {',
  4020. ' this.$init = function () {',
  4021. ' this.b = false;',
  4022. ' };',
  4023. ' this.$final = function () {',
  4024. ' };',
  4025. '});',
  4026. 'this.DoIt = function () {',
  4027. ' var p = null;',
  4028. ' try {} catch ($e) {',
  4029. ' if ($mod.TObject.isPrototypeOf($e)) {',
  4030. ' var E = $e;',
  4031. ' p = function () {',
  4032. ' E.b = true;',
  4033. ' };',
  4034. ' } else throw $e',
  4035. ' };',
  4036. '};',
  4037. '']),
  4038. LinesToStr([
  4039. '']));
  4040. end;
  4041. procedure TTestModule.TestAnonymousProc_Nested;
  4042. begin
  4043. StartProgram(false);
  4044. Add([
  4045. 'type',
  4046. ' TProc = reference to procedure;',
  4047. ' TObject = class',
  4048. ' i: byte;',
  4049. ' procedure DoIt;',
  4050. ' end;',
  4051. 'procedure TObject.DoIt;',
  4052. 'var',
  4053. ' p: TProc;',
  4054. ' procedure Sub;',
  4055. ' begin',
  4056. ' p:=procedure',
  4057. ' begin',
  4058. ' i:=3;',
  4059. ' Self.i:=4;',
  4060. ' p:=procedure',
  4061. ' procedure SubSub;',
  4062. ' begin',
  4063. ' i:=13;',
  4064. ' Self.i:=14;',
  4065. ' end;',
  4066. ' begin',
  4067. ' i:=13;',
  4068. ' Self.i:=14;',
  4069. ' end;',
  4070. ' end;',
  4071. ' end;',
  4072. 'begin',
  4073. 'end;',
  4074. 'begin']);
  4075. ConvertProgram;
  4076. CheckSource('TestAnonymousProc_Nested',
  4077. LinesToStr([ // statements
  4078. 'rtl.createClass($mod, "TObject", null, function () {',
  4079. ' this.$init = function () {',
  4080. ' this.i = 0;',
  4081. ' };',
  4082. ' this.$final = function () {',
  4083. ' };',
  4084. ' this.DoIt = function () {',
  4085. ' var Self = this;',
  4086. ' var p = null;',
  4087. ' function Sub() {',
  4088. ' p = function () {',
  4089. ' Self.i = 3;',
  4090. ' Self.i = 4;',
  4091. ' p = function () {',
  4092. ' function SubSub() {',
  4093. ' Self.i = 13;',
  4094. ' Self.i = 14;',
  4095. ' };',
  4096. ' Self.i = 13;',
  4097. ' Self.i = 14;',
  4098. ' };',
  4099. ' };',
  4100. ' };',
  4101. ' };',
  4102. '});',
  4103. '']),
  4104. LinesToStr([
  4105. '']));
  4106. end;
  4107. procedure TTestModule.TestAnonymousProc_NestedAssignResult;
  4108. begin
  4109. StartProgram(false);
  4110. Add([
  4111. 'type',
  4112. ' TProc = reference to procedure;',
  4113. 'function DoIt: TProc;',
  4114. ' function Sub: TProc;',
  4115. ' begin',
  4116. ' Result:=procedure',
  4117. ' begin',
  4118. ' Sub:=procedure',
  4119. ' procedure SubSub;',
  4120. ' begin',
  4121. ' Result:=nil;',
  4122. ' Sub:=nil;',
  4123. ' DoIt:=nil;',
  4124. ' end;',
  4125. ' begin',
  4126. ' Result:=nil;',
  4127. ' Sub:=nil;',
  4128. ' DoIt:=nil;',
  4129. ' end;',
  4130. ' end;',
  4131. ' end;',
  4132. 'begin',
  4133. 'end;',
  4134. 'begin']);
  4135. ConvertProgram;
  4136. CheckSource('TestAnonymousProc_NestedAssignResult',
  4137. LinesToStr([ // statements
  4138. 'this.DoIt = function () {',
  4139. ' var Result = null;',
  4140. ' function Sub() {',
  4141. ' var Result$1 = null;',
  4142. ' Result$1 = function () {',
  4143. ' Result$1 = function () {',
  4144. ' function SubSub() {',
  4145. ' Result$1 = null;',
  4146. ' Result$1 = null;',
  4147. ' Result = null;',
  4148. ' };',
  4149. ' Result$1 = null;',
  4150. ' Result$1 = null;',
  4151. ' Result = null;',
  4152. ' };',
  4153. ' };',
  4154. ' return Result$1;',
  4155. ' };',
  4156. ' return Result;',
  4157. '};',
  4158. '']),
  4159. LinesToStr([
  4160. '']));
  4161. end;
  4162. procedure TTestModule.TestEnum_Name;
  4163. begin
  4164. StartProgram(false);
  4165. Add('type TMyEnum = (Red, Green, Blue);');
  4166. Add('var e: TMyEnum;');
  4167. Add('var f: TMyEnum = Blue;');
  4168. Add('begin');
  4169. Add(' e:=green;');
  4170. Add(' e:=default(TMyEnum);');
  4171. ConvertProgram;
  4172. CheckSource('TestEnumName',
  4173. LinesToStr([ // statements
  4174. 'this.TMyEnum = {',
  4175. ' "0":"Red",',
  4176. ' Red:0,',
  4177. ' "1":"Green",',
  4178. ' Green:1,',
  4179. ' "2":"Blue",',
  4180. ' Blue:2',
  4181. ' };',
  4182. 'this.e = 0;',
  4183. 'this.f = $mod.TMyEnum.Blue;'
  4184. ]),
  4185. LinesToStr([
  4186. '$mod.e=$mod.TMyEnum.Green;',
  4187. '$mod.e=$mod.TMyEnum.Red;'
  4188. ]));
  4189. end;
  4190. procedure TTestModule.TestEnum_Number;
  4191. begin
  4192. Converter.Options:=Converter.Options+[coEnumNumbers];
  4193. StartProgram(false);
  4194. Add('type TMyEnum = (Red, Green);');
  4195. Add('var');
  4196. Add(' e: TMyEnum;');
  4197. Add(' f: TMyEnum = Green;');
  4198. Add(' i: longint;');
  4199. Add('begin');
  4200. Add(' e:=green;');
  4201. Add(' i:=longint(e);');
  4202. ConvertProgram;
  4203. CheckSource('TestEnumNumber',
  4204. LinesToStr([ // statements
  4205. 'this.TMyEnum = {',
  4206. ' "0":"Red",',
  4207. ' Red:0,',
  4208. ' "1":"Green",',
  4209. ' Green:1',
  4210. ' };',
  4211. 'this.e = 0;',
  4212. 'this.f = 1;',
  4213. 'this.i = 0;'
  4214. ]),
  4215. LinesToStr([
  4216. '$mod.e=1;',
  4217. '$mod.i=$mod.e;'
  4218. ]));
  4219. end;
  4220. procedure TTestModule.TestEnum_ConstFail;
  4221. begin
  4222. StartProgram(false);
  4223. Add([
  4224. 'type TMyEnum = (Red = 100, Green = 101);',
  4225. 'var',
  4226. ' e: TMyEnum;',
  4227. ' f: TMyEnum = Green;',
  4228. 'begin',
  4229. ' e:=green;']);
  4230. SetExpectedPasResolverError('not yet implemented: Red:TPasEnumValue [20180126202434] enum const',3002);
  4231. ConvertProgram;
  4232. end;
  4233. procedure TTestModule.TestEnum_Functions;
  4234. begin
  4235. StartProgram(false);
  4236. Add([
  4237. 'type TMyEnum = (Red, Green);',
  4238. 'procedure DoIt(var e: TMyEnum; var i: word);',
  4239. 'var',
  4240. ' v: longint;',
  4241. ' s: string;',
  4242. 'begin',
  4243. ' val(s,e,v);',
  4244. ' val(s,e,i);',
  4245. 'end;',
  4246. 'var',
  4247. ' e: TMyEnum;',
  4248. ' i: longint;',
  4249. ' s: string;',
  4250. ' b: boolean;',
  4251. 'begin',
  4252. ' i:=ord(red);',
  4253. ' i:=ord(green);',
  4254. ' i:=ord(e);',
  4255. ' i:=ord(b);',
  4256. ' e:=low(tmyenum);',
  4257. ' e:=low(e);',
  4258. ' b:=low(boolean);',
  4259. ' e:=high(tmyenum);',
  4260. ' e:=high(e);',
  4261. ' b:=high(boolean);',
  4262. ' e:=pred(green);',
  4263. ' e:=pred(e);',
  4264. ' b:=pred(b);',
  4265. ' e:=succ(red);',
  4266. ' e:=succ(e);',
  4267. ' b:=succ(b);',
  4268. ' e:=tmyenum(1);',
  4269. ' e:=tmyenum(i);',
  4270. ' s:=str(e);',
  4271. ' str(e,s);',
  4272. ' str(red,s);',
  4273. ' s:=str(e:3);',
  4274. ' writestr(s,e:3,red);',
  4275. ' val(s,e,i);',
  4276. ' e:=TMyEnum(i);',
  4277. ' i:=longint(e);']);
  4278. ConvertProgram;
  4279. CheckSource('TestEnum_Functions',
  4280. LinesToStr([ // statements
  4281. 'this.TMyEnum = {',
  4282. ' "0":"Red",',
  4283. ' Red:0,',
  4284. ' "1":"Green",',
  4285. ' Green:1',
  4286. ' };',
  4287. 'this.DoIt = function (e, i) {',
  4288. ' var v = 0;',
  4289. ' var s = "";',
  4290. ' e.set(rtl.valEnum(s, $mod.TMyEnum, function (w) {',
  4291. ' v = w;',
  4292. ' }));',
  4293. ' e.set(rtl.valEnum(s, $mod.TMyEnum, i.set));',
  4294. '};',
  4295. 'this.e = 0;',
  4296. 'this.i = 0;',
  4297. 'this.s = "";',
  4298. 'this.b = false;',
  4299. '']),
  4300. LinesToStr([
  4301. '$mod.i=$mod.TMyEnum.Red;',
  4302. '$mod.i=$mod.TMyEnum.Green;',
  4303. '$mod.i=$mod.e;',
  4304. '$mod.i=$mod.b+0;',
  4305. '$mod.e=$mod.TMyEnum.Red;',
  4306. '$mod.e=$mod.TMyEnum.Red;',
  4307. '$mod.b=false;',
  4308. '$mod.e=$mod.TMyEnum.Green;',
  4309. '$mod.e=$mod.TMyEnum.Green;',
  4310. '$mod.b=true;',
  4311. '$mod.e=$mod.TMyEnum.Green-1;',
  4312. '$mod.e=$mod.e-1;',
  4313. '$mod.b=false;',
  4314. '$mod.e=$mod.TMyEnum.Red+1;',
  4315. '$mod.e=$mod.e+1;',
  4316. '$mod.b=true;',
  4317. '$mod.e=1;',
  4318. '$mod.e=$mod.i;',
  4319. '$mod.s = $mod.TMyEnum[$mod.e];',
  4320. '$mod.s = $mod.TMyEnum[$mod.e];',
  4321. '$mod.s = $mod.TMyEnum[$mod.TMyEnum.Red];',
  4322. '$mod.s = rtl.spaceLeft($mod.TMyEnum[$mod.e], 3);',
  4323. '$mod.s = rtl.spaceLeft($mod.TMyEnum[$mod.e], 3)+$mod.TMyEnum[$mod.TMyEnum.Red];',
  4324. '$mod.e = rtl.valEnum($mod.s, $mod.TMyEnum, function (v) {',
  4325. ' $mod.i = v;',
  4326. '});',
  4327. '$mod.e=$mod.i;',
  4328. '$mod.i=$mod.e;',
  4329. '']));
  4330. end;
  4331. procedure TTestModule.TestEnum_AsParams;
  4332. begin
  4333. StartProgram(false);
  4334. Add('type TEnum = (Red,Blue);');
  4335. Add('procedure DoIt(vG: TEnum; const vH: TEnum; var vI: TEnum);');
  4336. Add('var vJ: TEnum;');
  4337. Add('begin');
  4338. Add(' vg:=vg;');
  4339. Add(' vj:=vh;');
  4340. Add(' vi:=vi;');
  4341. Add(' doit(vg,vg,vg);');
  4342. Add(' doit(vh,vh,vj);');
  4343. Add(' doit(vi,vi,vi);');
  4344. Add(' doit(vj,vj,vj);');
  4345. Add('end;');
  4346. Add('var i: TEnum;');
  4347. Add('begin');
  4348. Add(' doit(i,i,i);');
  4349. ConvertProgram;
  4350. CheckSource('TestEnum_AsParams',
  4351. LinesToStr([ // statements
  4352. 'this.TEnum = {',
  4353. ' "0": "Red",',
  4354. ' Red: 0,',
  4355. ' "1": "Blue",',
  4356. ' Blue: 1',
  4357. '};',
  4358. 'this.DoIt = function (vG,vH,vI) {',
  4359. ' var vJ = 0;',
  4360. ' vG = vG;',
  4361. ' vJ = vH;',
  4362. ' vI.set(vI.get());',
  4363. ' $mod.DoIt(vG, vG, {',
  4364. ' get: function () {',
  4365. ' return vG;',
  4366. ' },',
  4367. ' set: function (v) {',
  4368. ' vG = v;',
  4369. ' }',
  4370. ' });',
  4371. ' $mod.DoIt(vH, vH, {',
  4372. ' get: function () {',
  4373. ' return vJ;',
  4374. ' },',
  4375. ' set: function (v) {',
  4376. ' vJ = v;',
  4377. ' }',
  4378. ' });',
  4379. ' $mod.DoIt(vI.get(), vI.get(), vI);',
  4380. ' $mod.DoIt(vJ, vJ, {',
  4381. ' get: function () {',
  4382. ' return vJ;',
  4383. ' },',
  4384. ' set: function (v) {',
  4385. ' vJ = v;',
  4386. ' }',
  4387. ' });',
  4388. '};',
  4389. 'this.i = 0;'
  4390. ]),
  4391. LinesToStr([
  4392. '$mod.DoIt($mod.i,$mod.i,{',
  4393. ' p: $mod,',
  4394. ' get: function () {',
  4395. ' return this.p.i;',
  4396. ' },',
  4397. ' set: function (v) {',
  4398. ' this.p.i = v;',
  4399. ' }',
  4400. '});'
  4401. ]));
  4402. end;
  4403. procedure TTestModule.TestEnumRange_Array;
  4404. begin
  4405. StartProgram(false);
  4406. Add([
  4407. 'type',
  4408. ' TEnum = (Red, Green, Blue);',
  4409. ' TEnumRg = green..blue;',
  4410. ' TArr = array[TEnumRg] of byte;',
  4411. ' TArr2 = array[green..blue] of byte;',
  4412. 'var',
  4413. ' a: TArr;',
  4414. ' b: TArr = (3,4);',
  4415. ' c: TArr2 = (5,6);',
  4416. 'begin',
  4417. ' a[green] := b[blue];',
  4418. ' c[green] := c[blue];',
  4419. '']);
  4420. ConvertProgram;
  4421. CheckSource('TestEnumRange_Array',
  4422. LinesToStr([ // statements
  4423. 'this.TEnum = {',
  4424. ' "0": "Red",',
  4425. ' Red: 0,',
  4426. ' "1": "Green",',
  4427. ' Green: 1,',
  4428. ' "2": "Blue",',
  4429. ' Blue: 2',
  4430. '};',
  4431. 'this.a = rtl.arraySetLength(null, 0, 2);',
  4432. 'this.b = [3, 4];',
  4433. 'this.c = [5, 6];',
  4434. '']),
  4435. LinesToStr([
  4436. ' $mod.a[$mod.TEnum.Green - 1] = $mod.b[$mod.TEnum.Blue - 1];',
  4437. ' $mod.c[$mod.TEnum.Green - 1] = $mod.c[$mod.TEnum.Blue - 1];',
  4438. '']));
  4439. end;
  4440. procedure TTestModule.TestEnum_ForIn;
  4441. begin
  4442. StartProgram(false);
  4443. Add([
  4444. 'type',
  4445. ' TEnum = (Red, Green, Blue);',
  4446. ' TEnumRg = green..blue;',
  4447. ' TArr = array[TEnum] of byte;',
  4448. ' TArrRg = array[TEnumRg] of byte;',
  4449. 'var',
  4450. ' e: TEnum;',
  4451. ' a1: TArr = (3,4,5);',
  4452. ' a2: TArrRg = (11,12);',
  4453. ' b: byte;',
  4454. 'begin',
  4455. ' for e in TEnum do ;',
  4456. ' for e in TEnumRg do ;',
  4457. ' for e in TArr do ;',
  4458. ' for e in TArrRg do ;',
  4459. ' for b in a1 do ;',
  4460. ' for b in a2 do ;',
  4461. '']);
  4462. ConvertProgram;
  4463. CheckSource('TestEnum_ForIn',
  4464. LinesToStr([ // statements
  4465. 'this.TEnum = {',
  4466. ' "0": "Red",',
  4467. ' Red: 0,',
  4468. ' "1": "Green",',
  4469. ' Green: 1,',
  4470. ' "2": "Blue",',
  4471. ' Blue: 2',
  4472. '};',
  4473. 'this.e = 0;',
  4474. 'this.a1 = [3, 4, 5];',
  4475. 'this.a2 = [11, 12];',
  4476. 'this.b = 0;',
  4477. '']),
  4478. LinesToStr([
  4479. ' for ($mod.e = 0; $mod.e <= 2; $mod.e++) ;',
  4480. ' for ($mod.e = 1; $mod.e <= 2; $mod.e++) ;',
  4481. ' for ($mod.e = 0; $mod.e <= 2; $mod.e++) ;',
  4482. ' for ($mod.e = 1; $mod.e <= 2; $mod.e++) ;',
  4483. ' for (var $in1 = $mod.a1, $l2 = 0, $end3 = rtl.length($in1) - 1; $l2 <= $end3; $l2++) $mod.b = $in1[$l2];',
  4484. ' for (var $in4 = $mod.a2, $l5 = 0, $end6 = rtl.length($in4) - 1; $l5 <= $end6; $l5++) $mod.b = $in4[$l5];',
  4485. '']));
  4486. end;
  4487. procedure TTestModule.TestEnum_ScopedNumber;
  4488. begin
  4489. Converter.Options:=Converter.Options+[coEnumNumbers];
  4490. StartProgram(false);
  4491. Add([
  4492. 'type',
  4493. ' TEnum = (Red, Green);',
  4494. 'var',
  4495. ' e: TEnum;',
  4496. 'begin',
  4497. ' e:=TEnum.Green;',
  4498. '']);
  4499. ConvertProgram;
  4500. CheckSource('TestEnum_ScopedNumber',
  4501. LinesToStr([ // statements
  4502. 'this.TEnum = {',
  4503. ' "0": "Red",',
  4504. ' Red: 0,',
  4505. ' "1": "Green",',
  4506. ' Green: 1',
  4507. '};',
  4508. 'this.e = 0;',
  4509. '']),
  4510. LinesToStr([
  4511. '$mod.e = 1;']));
  4512. end;
  4513. procedure TTestModule.TestEnum_InFunction;
  4514. begin
  4515. StartProgram(false);
  4516. Add([
  4517. 'const TEnum = 3;',
  4518. 'procedure DoIt;',
  4519. 'type',
  4520. ' TEnum = (Red, Green, Blue);',
  4521. ' procedure Sub;',
  4522. ' type',
  4523. ' TEnumSub = (Left, Right);',
  4524. ' var',
  4525. ' es: TEnumSub;',
  4526. ' begin',
  4527. ' es:=Left;',
  4528. ' end;',
  4529. 'var',
  4530. ' e, e2: TEnum;',
  4531. 'begin',
  4532. ' if e in [red,blue] then e2:=e;',
  4533. 'end;',
  4534. 'begin']);
  4535. ConvertProgram;
  4536. CheckSource('TestEnum_InFunction',
  4537. LinesToStr([ // statements
  4538. 'this.TEnum = 3;',
  4539. 'var TEnum$1 = {',
  4540. ' "0":"Red",',
  4541. ' Red:0,',
  4542. ' "1":"Green",',
  4543. ' Green:1,',
  4544. ' "2":"Blue",',
  4545. ' Blue:2',
  4546. ' };',
  4547. 'var TEnumSub = {',
  4548. ' "0": "Left",',
  4549. ' Left: 0,',
  4550. ' "1": "Right",',
  4551. ' Right: 1',
  4552. '};',
  4553. 'this.DoIt = function () {',
  4554. ' function Sub() {',
  4555. ' var es = 0;',
  4556. ' es = TEnumSub.Left;',
  4557. ' };',
  4558. ' var e = 0;',
  4559. ' var e2 = 0;',
  4560. ' if (e in rtl.createSet(TEnum$1.Red, TEnum$1.Blue)) e2 = e;',
  4561. '};',
  4562. '']),
  4563. LinesToStr([
  4564. '']));
  4565. end;
  4566. procedure TTestModule.TestSet_Enum;
  4567. begin
  4568. StartProgram(false);
  4569. Add([
  4570. 'type',
  4571. ' TColor = (Red, Green, Blue);',
  4572. ' TColors = set of TColor;',
  4573. 'var',
  4574. ' c: TColor;',
  4575. ' s: TColors;',
  4576. ' t: TColors = [];',
  4577. ' u: TColors = [Red];',
  4578. 'begin',
  4579. ' s:=[];',
  4580. ' s:=[Green];',
  4581. ' s:=[Green,Blue];',
  4582. ' s:=[Red..Blue];',
  4583. ' s:=[Red,Green..Blue];',
  4584. ' s:=[Red,c];',
  4585. ' s:=t;',
  4586. ' s:=default(TColors);',
  4587. '']);
  4588. ConvertProgram;
  4589. CheckSource('TestSet',
  4590. LinesToStr([ // statements
  4591. 'this.TColor = {',
  4592. ' "0":"Red",',
  4593. ' Red:0,',
  4594. ' "1":"Green",',
  4595. ' Green:1,',
  4596. ' "2":"Blue",',
  4597. ' Blue:2',
  4598. ' };',
  4599. 'this.c = 0;',
  4600. 'this.s = {};',
  4601. 'this.t = {};',
  4602. 'this.u = rtl.createSet($mod.TColor.Red);'
  4603. ]),
  4604. LinesToStr([
  4605. '$mod.s={};',
  4606. '$mod.s=rtl.createSet($mod.TColor.Green);',
  4607. '$mod.s=rtl.createSet($mod.TColor.Green,$mod.TColor.Blue);',
  4608. '$mod.s=rtl.createSet(null,$mod.TColor.Red,$mod.TColor.Blue);',
  4609. '$mod.s=rtl.createSet($mod.TColor.Red,null,$mod.TColor.Green,$mod.TColor.Blue);',
  4610. '$mod.s=rtl.createSet($mod.TColor.Red,$mod.c);',
  4611. '$mod.s=rtl.refSet($mod.t);',
  4612. '$mod.s={};',
  4613. '']));
  4614. end;
  4615. procedure TTestModule.TestSet_Operators;
  4616. begin
  4617. StartProgram(false);
  4618. Add('type');
  4619. Add(' TColor = (Red, Green, Blue);');
  4620. Add(' TColors = set of tcolor;');
  4621. Add('var');
  4622. Add(' vC: TColor;');
  4623. Add(' vS: TColors;');
  4624. Add(' vT: TColors;');
  4625. Add(' vU: TColors;');
  4626. Add(' B: boolean;');
  4627. Add('begin');
  4628. Add(' include(vs,green);');
  4629. Add(' exclude(vs,vc);');
  4630. Add(' vs:=vt+vu;');
  4631. Add(' vs:=vt+[red];');
  4632. Add(' vs:=[red]+vt;');
  4633. Add(' vs:=[red]+[green];');
  4634. Add(' vs:=vt-vu;');
  4635. Add(' vs:=vt-[red];');
  4636. Add(' vs:=[red]-vt;');
  4637. Add(' vs:=[red]-[green];');
  4638. Add(' vs:=vt*vu;');
  4639. Add(' vs:=vt*[red];');
  4640. Add(' vs:=[red]*vt;');
  4641. Add(' vs:=[red]*[green];');
  4642. Add(' vs:=vt><vu;');
  4643. Add(' vs:=vt><[red];');
  4644. Add(' vs:=[red]><vt;');
  4645. Add(' vs:=[red]><[green];');
  4646. Add(' b:=vt=vu;');
  4647. Add(' b:=vt=[red];');
  4648. Add(' b:=[red]=vt;');
  4649. Add(' b:=[red]=[green];');
  4650. Add(' b:=vt<>vu;');
  4651. Add(' b:=vt<>[red];');
  4652. Add(' b:=[red]<>vt;');
  4653. Add(' b:=[red]<>[green];');
  4654. Add(' b:=vt<=vu;');
  4655. Add(' b:=vt<=[red];');
  4656. Add(' b:=[red]<=vt;');
  4657. Add(' b:=[red]<=[green];');
  4658. Add(' b:=vt>=vu;');
  4659. Add(' b:=vt>=[red];');
  4660. Add(' b:=[red]>=vt;');
  4661. Add(' b:=[red]>=[green];');
  4662. ConvertProgram;
  4663. CheckSource('TestSet_Operators',
  4664. LinesToStr([ // statements
  4665. 'this.TColor = {',
  4666. ' "0":"Red",',
  4667. ' Red:0,',
  4668. ' "1":"Green",',
  4669. ' Green:1,',
  4670. ' "2":"Blue",',
  4671. ' Blue:2',
  4672. ' };',
  4673. 'this.vC = 0;',
  4674. 'this.vS = {};',
  4675. 'this.vT = {};',
  4676. 'this.vU = {};',
  4677. 'this.B = false;'
  4678. ]),
  4679. LinesToStr([
  4680. '$mod.vS = rtl.includeSet($mod.vS,$mod.TColor.Green);',
  4681. '$mod.vS = rtl.excludeSet($mod.vS,$mod.vC);',
  4682. '$mod.vS = rtl.unionSet($mod.vT, $mod.vU);',
  4683. '$mod.vS = rtl.unionSet($mod.vT, rtl.createSet($mod.TColor.Red));',
  4684. '$mod.vS = rtl.unionSet(rtl.createSet($mod.TColor.Red), $mod.vT);',
  4685. '$mod.vS = rtl.unionSet(rtl.createSet($mod.TColor.Red), rtl.createSet($mod.TColor.Green));',
  4686. '$mod.vS = rtl.diffSet($mod.vT, $mod.vU);',
  4687. '$mod.vS = rtl.diffSet($mod.vT, rtl.createSet($mod.TColor.Red));',
  4688. '$mod.vS = rtl.diffSet(rtl.createSet($mod.TColor.Red), $mod.vT);',
  4689. '$mod.vS = rtl.diffSet(rtl.createSet($mod.TColor.Red), rtl.createSet($mod.TColor.Green));',
  4690. '$mod.vS = rtl.intersectSet($mod.vT, $mod.vU);',
  4691. '$mod.vS = rtl.intersectSet($mod.vT, rtl.createSet($mod.TColor.Red));',
  4692. '$mod.vS = rtl.intersectSet(rtl.createSet($mod.TColor.Red), $mod.vT);',
  4693. '$mod.vS = rtl.intersectSet(rtl.createSet($mod.TColor.Red), rtl.createSet($mod.TColor.Green));',
  4694. '$mod.vS = rtl.symDiffSet($mod.vT, $mod.vU);',
  4695. '$mod.vS = rtl.symDiffSet($mod.vT, rtl.createSet($mod.TColor.Red));',
  4696. '$mod.vS = rtl.symDiffSet(rtl.createSet($mod.TColor.Red), $mod.vT);',
  4697. '$mod.vS = rtl.symDiffSet(rtl.createSet($mod.TColor.Red), rtl.createSet($mod.TColor.Green));',
  4698. '$mod.B = rtl.eqSet($mod.vT, $mod.vU);',
  4699. '$mod.B = rtl.eqSet($mod.vT, rtl.createSet($mod.TColor.Red));',
  4700. '$mod.B = rtl.eqSet(rtl.createSet($mod.TColor.Red), $mod.vT);',
  4701. '$mod.B = rtl.eqSet(rtl.createSet($mod.TColor.Red), rtl.createSet($mod.TColor.Green));',
  4702. '$mod.B = rtl.neSet($mod.vT, $mod.vU);',
  4703. '$mod.B = rtl.neSet($mod.vT, rtl.createSet($mod.TColor.Red));',
  4704. '$mod.B = rtl.neSet(rtl.createSet($mod.TColor.Red), $mod.vT);',
  4705. '$mod.B = rtl.neSet(rtl.createSet($mod.TColor.Red), rtl.createSet($mod.TColor.Green));',
  4706. '$mod.B = rtl.leSet($mod.vT, $mod.vU);',
  4707. '$mod.B = rtl.leSet($mod.vT, rtl.createSet($mod.TColor.Red));',
  4708. '$mod.B = rtl.leSet(rtl.createSet($mod.TColor.Red), $mod.vT);',
  4709. '$mod.B = rtl.leSet(rtl.createSet($mod.TColor.Red), rtl.createSet($mod.TColor.Green));',
  4710. '$mod.B = rtl.geSet($mod.vT, $mod.vU);',
  4711. '$mod.B = rtl.geSet($mod.vT, rtl.createSet($mod.TColor.Red));',
  4712. '$mod.B = rtl.geSet(rtl.createSet($mod.TColor.Red), $mod.vT);',
  4713. '$mod.B = rtl.geSet(rtl.createSet($mod.TColor.Red), rtl.createSet($mod.TColor.Green));',
  4714. '']));
  4715. end;
  4716. procedure TTestModule.TestSet_Operator_In;
  4717. begin
  4718. StartProgram(false);
  4719. Add('type');
  4720. Add(' TColor = (Red, Green, Blue);');
  4721. Add(' TColors = set of tcolor;');
  4722. Add('var');
  4723. Add(' vC: tcolor;');
  4724. Add(' vT: tcolors;');
  4725. Add(' B: boolean;');
  4726. Add('begin');
  4727. Add(' b:=red in vt;');
  4728. Add(' b:=vc in vt;');
  4729. Add(' b:=green in [red..blue];');
  4730. Add(' b:=vc in [red..blue];');
  4731. Add(' ');
  4732. Add(' if red in vt then ;');
  4733. Add(' while vC in vt do ;');
  4734. Add(' repeat');
  4735. Add(' until vC in vt;');
  4736. ConvertProgram;
  4737. CheckSource('TestSet_Operator_In',
  4738. LinesToStr([ // statements
  4739. 'this.TColor = {',
  4740. ' "0":"Red",',
  4741. ' Red:0,',
  4742. ' "1":"Green",',
  4743. ' Green:1,',
  4744. ' "2":"Blue",',
  4745. ' Blue:2',
  4746. ' };',
  4747. 'this.vC = 0;',
  4748. 'this.vT = {};',
  4749. 'this.B = false;'
  4750. ]),
  4751. LinesToStr([
  4752. '$mod.B = $mod.TColor.Red in $mod.vT;',
  4753. '$mod.B = $mod.vC in $mod.vT;',
  4754. '$mod.B = $mod.TColor.Green in rtl.createSet(null, $mod.TColor.Red, $mod.TColor.Blue);',
  4755. '$mod.B = $mod.vC in rtl.createSet(null, $mod.TColor.Red, $mod.TColor.Blue);',
  4756. 'if ($mod.TColor.Red in $mod.vT) ;',
  4757. 'while ($mod.vC in $mod.vT) {',
  4758. '};',
  4759. 'do {',
  4760. '} while (!($mod.vC in $mod.vT));',
  4761. '']));
  4762. end;
  4763. procedure TTestModule.TestSet_Functions;
  4764. begin
  4765. StartProgram(false);
  4766. Add('type');
  4767. Add(' TMyEnum = (Red, Green);');
  4768. Add(' TMyEnums = set of TMyEnum;');
  4769. Add('var');
  4770. Add(' e: TMyEnum;');
  4771. Add(' s: TMyEnums;');
  4772. Add('begin');
  4773. Add(' e:=Low(TMyEnums);');
  4774. Add(' e:=Low(s);');
  4775. Add(' e:=High(TMyEnums);');
  4776. Add(' e:=High(s);');
  4777. ConvertProgram;
  4778. CheckSource('TestSetFunctions',
  4779. LinesToStr([ // statements
  4780. 'this.TMyEnum = {',
  4781. ' "0":"Red",',
  4782. ' Red:0,',
  4783. ' "1":"Green",',
  4784. ' Green:1',
  4785. ' };',
  4786. 'this.e = 0;',
  4787. 'this.s = {};'
  4788. ]),
  4789. LinesToStr([
  4790. '$mod.e=$mod.TMyEnum.Red;',
  4791. '$mod.e=$mod.TMyEnum.Red;',
  4792. '$mod.e=$mod.TMyEnum.Green;',
  4793. '$mod.e=$mod.TMyEnum.Green;',
  4794. '']));
  4795. end;
  4796. procedure TTestModule.TestSet_PassAsArgClone;
  4797. begin
  4798. StartProgram(false);
  4799. Add('type');
  4800. Add(' TMyEnum = (Red, Green);');
  4801. Add(' TMyEnums = set of TMyEnum;');
  4802. Add('procedure DoDefault(s: tmyenums); begin end;');
  4803. Add('procedure DoConst(const s: tmyenums); begin end;');
  4804. Add('var');
  4805. Add(' aSet: tmyenums;');
  4806. Add('begin');
  4807. Add(' dodefault(aset);');
  4808. Add(' doconst(aset);');
  4809. ConvertProgram;
  4810. CheckSource('TestSetFunctions',
  4811. LinesToStr([ // statements
  4812. 'this.TMyEnum = {',
  4813. ' "0":"Red",',
  4814. ' Red:0,',
  4815. ' "1":"Green",',
  4816. ' Green:1',
  4817. ' };',
  4818. 'this.DoDefault = function (s) {',
  4819. '};',
  4820. 'this.DoConst = function (s) {',
  4821. '};',
  4822. 'this.aSet = {};'
  4823. ]),
  4824. LinesToStr([
  4825. '$mod.DoDefault(rtl.refSet($mod.aSet));',
  4826. '$mod.DoConst($mod.aSet);',
  4827. '']));
  4828. end;
  4829. procedure TTestModule.TestSet_AsParams;
  4830. begin
  4831. StartProgram(false);
  4832. Add([
  4833. 'type TEnum = (Red,Blue);',
  4834. 'type TEnums = set of TEnum;',
  4835. 'function DoIt(vG: TEnums; const vH: TEnums; var vI: TEnums): TEnums;',
  4836. 'var vJ: TEnums;',
  4837. 'begin',
  4838. ' Include(vg,red);',
  4839. ' Include(result,blue);',
  4840. ' vg:=vg;',
  4841. ' vj:=vh;',
  4842. ' vi:=vi;',
  4843. ' doit(vg,vg,vg);',
  4844. ' doit(vh,vh,vj);',
  4845. ' doit(vi,vi,vi);',
  4846. ' doit(vj,vj,vj);',
  4847. 'end;',
  4848. 'var i: TEnums;',
  4849. 'begin',
  4850. ' doit(i,i,i);']);
  4851. ConvertProgram;
  4852. CheckSource('TestSet_AsParams',
  4853. LinesToStr([ // statements
  4854. 'this.TEnum = {',
  4855. ' "0": "Red",',
  4856. ' Red: 0,',
  4857. ' "1": "Blue",',
  4858. ' Blue: 1',
  4859. '};',
  4860. 'this.DoIt = function (vG,vH,vI) {',
  4861. ' var Result = {};',
  4862. ' var vJ = {};',
  4863. ' vG = rtl.includeSet(vG, $mod.TEnum.Red);',
  4864. ' Result = rtl.includeSet(Result, $mod.TEnum.Blue);',
  4865. ' vG = rtl.refSet(vG);',
  4866. ' vJ = rtl.refSet(vH);',
  4867. ' vI.set(rtl.refSet(vI.get()));',
  4868. ' $mod.DoIt(rtl.refSet(vG), vG, {',
  4869. ' get: function () {',
  4870. ' return vG;',
  4871. ' },',
  4872. ' set: function (v) {',
  4873. ' vG = v;',
  4874. ' }',
  4875. ' });',
  4876. ' $mod.DoIt(rtl.refSet(vH), vH, {',
  4877. ' get: function () {',
  4878. ' return vJ;',
  4879. ' },',
  4880. ' set: function (v) {',
  4881. ' vJ = v;',
  4882. ' }',
  4883. ' });',
  4884. ' $mod.DoIt(rtl.refSet(vI.get()), vI.get(), vI);',
  4885. ' $mod.DoIt(rtl.refSet(vJ), vJ, {',
  4886. ' get: function () {',
  4887. ' return vJ;',
  4888. ' },',
  4889. ' set: function (v) {',
  4890. ' vJ = v;',
  4891. ' }',
  4892. ' });',
  4893. ' return Result;',
  4894. '};',
  4895. 'this.i = {};'
  4896. ]),
  4897. LinesToStr([
  4898. '$mod.DoIt(rtl.refSet($mod.i),$mod.i,{',
  4899. ' p: $mod,',
  4900. ' get: function () {',
  4901. ' return this.p.i;',
  4902. ' },',
  4903. ' set: function (v) {',
  4904. ' this.p.i = v;',
  4905. ' }',
  4906. '});'
  4907. ]));
  4908. end;
  4909. procedure TTestModule.TestSet_Property;
  4910. begin
  4911. StartProgram(false);
  4912. Add('type');
  4913. Add(' TEnum = (Red,Blue);');
  4914. Add(' TEnums = set of TEnum;');
  4915. Add(' TObject = class');
  4916. Add(' function GetColors: TEnums; external name ''GetColors'';');
  4917. Add(' procedure SetColors(const Value: TEnums); external name ''SetColors'';');
  4918. Add(' property Colors: TEnums read GetColors write SetColors;');
  4919. Add(' end;');
  4920. Add('procedure DoIt(i: TEnums; const j: TEnums; var k: TEnums; out l: TEnums);');
  4921. Add('begin end;');
  4922. Add('var Obj: TObject;');
  4923. Add('begin');
  4924. Add(' Include(Obj.Colors,Red);');
  4925. Add(' Exclude(Obj.Colors,Red);');
  4926. //Add(' DoIt(Obj.Colors,Obj.Colors,Obj.Colors,Obj.Colors);');
  4927. ConvertProgram;
  4928. CheckSource('TestSet_Property',
  4929. LinesToStr([ // statements
  4930. 'this.TEnum = {',
  4931. ' "0": "Red",',
  4932. ' Red: 0,',
  4933. ' "1": "Blue",',
  4934. ' Blue: 1',
  4935. '};',
  4936. 'rtl.createClass($mod, "TObject", null, function () {',
  4937. ' this.$init = function () {',
  4938. ' };',
  4939. ' this.$final = function () {',
  4940. ' };',
  4941. '});',
  4942. 'this.DoIt = function (i, j, k, l) {',
  4943. '};',
  4944. 'this.Obj = null;',
  4945. '']),
  4946. LinesToStr([
  4947. '$mod.Obj.SetColors(rtl.includeSet($mod.Obj.GetColors(), $mod.TEnum.Red));',
  4948. '$mod.Obj.SetColors(rtl.excludeSet($mod.Obj.GetColors(), $mod.TEnum.Red));',
  4949. '']));
  4950. end;
  4951. procedure TTestModule.TestSet_EnumConst;
  4952. begin
  4953. StartProgram(false);
  4954. Add([
  4955. 'type',
  4956. ' TEnum = (Red,Blue);',
  4957. ' TEnums = set of TEnum;',
  4958. 'const',
  4959. ' Orange = red;',
  4960. 'var',
  4961. ' Enum: tenum;',
  4962. ' Enums: tenums;',
  4963. 'begin',
  4964. ' Include(enums,orange);',
  4965. ' Exclude(enums,orange);',
  4966. ' if orange in enums then;',
  4967. ' if orange in [orange,red] then;']);
  4968. ConvertProgram;
  4969. CheckSource('TestSet_EnumConst',
  4970. LinesToStr([ // statements
  4971. 'this.TEnum = {',
  4972. ' "0": "Red",',
  4973. ' Red: 0,',
  4974. ' "1": "Blue",',
  4975. ' Blue: 1',
  4976. '};',
  4977. 'this.Orange = $mod.TEnum.Red;',
  4978. 'this.Enum = 0;',
  4979. 'this.Enums = {};',
  4980. '']),
  4981. LinesToStr([
  4982. '$mod.Enums = rtl.includeSet($mod.Enums, $mod.TEnum.Red);',
  4983. '$mod.Enums = rtl.excludeSet($mod.Enums, $mod.TEnum.Red);',
  4984. 'if ($mod.TEnum.Red in $mod.Enums) ;',
  4985. 'if ($mod.TEnum.Red in rtl.createSet($mod.TEnum.Red, $mod.TEnum.Red)) ;',
  4986. '']));
  4987. end;
  4988. procedure TTestModule.TestSet_IntConst;
  4989. begin
  4990. StartProgram(false);
  4991. Add([
  4992. 'type',
  4993. ' TEnums = set of Byte;',
  4994. 'const',
  4995. ' Orange = 0;',
  4996. 'var',
  4997. ' Enum: byte;',
  4998. ' Enums: tenums;',
  4999. 'begin',
  5000. ' Enums:=[];',
  5001. ' Enums:=[0];',
  5002. ' Enums:=[1..2];',
  5003. //' Include(enums,orange);',
  5004. //' Exclude(enums,orange);',
  5005. ' if orange in enums then;',
  5006. ' if orange in [orange,1] then;']);
  5007. ConvertProgram;
  5008. CheckSource('TestSet_IntConst',
  5009. LinesToStr([ // statements
  5010. 'this.Orange = 0;',
  5011. 'this.Enum = 0;',
  5012. 'this.Enums = {};',
  5013. '']),
  5014. LinesToStr([
  5015. '$mod.Enums = {};',
  5016. '$mod.Enums = rtl.createSet(0);',
  5017. '$mod.Enums = rtl.createSet(null, 1, 2);',
  5018. 'if (0 in $mod.Enums) ;',
  5019. 'if (0 in rtl.createSet(0, 1)) ;',
  5020. '']));
  5021. end;
  5022. procedure TTestModule.TestSet_AnonymousEnumType;
  5023. begin
  5024. StartProgram(false);
  5025. Add('type');
  5026. Add(' TFlags = set of (red, green);');
  5027. Add('const');
  5028. Add(' favorite = red;');
  5029. Add('var');
  5030. Add(' f: TFlags;');
  5031. Add(' i: longint;');
  5032. Add('begin');
  5033. Add(' Include(f,red);');
  5034. Add(' Include(f,favorite);');
  5035. Add(' i:=ord(red);');
  5036. Add(' i:=ord(favorite);');
  5037. Add(' i:=ord(low(TFlags));');
  5038. Add(' i:=ord(low(f));');
  5039. Add(' i:=ord(low(favorite));');
  5040. Add(' i:=ord(high(TFlags));');
  5041. Add(' i:=ord(high(f));');
  5042. Add(' i:=ord(high(favorite));');
  5043. Add(' f:=[green,favorite];');
  5044. ConvertProgram;
  5045. CheckSource('TestSet_AnonymousEnumType',
  5046. LinesToStr([ // statements
  5047. 'this.TFlags$a = {',
  5048. ' "0": "red",',
  5049. ' red: 0,',
  5050. ' "1": "green",',
  5051. ' green: 1',
  5052. '};',
  5053. 'this.favorite = $mod.TFlags$a.red;',
  5054. 'this.f = {};',
  5055. 'this.i = 0;',
  5056. '']),
  5057. LinesToStr([
  5058. '$mod.f = rtl.includeSet($mod.f, $mod.TFlags$a.red);',
  5059. '$mod.f = rtl.includeSet($mod.f, $mod.TFlags$a.red);',
  5060. '$mod.i = $mod.TFlags$a.red;',
  5061. '$mod.i = $mod.TFlags$a.red;',
  5062. '$mod.i = $mod.TFlags$a.red;',
  5063. '$mod.i = $mod.TFlags$a.red;',
  5064. '$mod.i = $mod.TFlags$a.red;',
  5065. '$mod.i = $mod.TFlags$a.green;',
  5066. '$mod.i = $mod.TFlags$a.green;',
  5067. '$mod.i = $mod.TFlags$a.green;',
  5068. '$mod.f = rtl.createSet($mod.TFlags$a.green, $mod.TFlags$a.red);',
  5069. '']));
  5070. end;
  5071. procedure TTestModule.TestSet_AnonymousEnumTypeChar;
  5072. begin
  5073. exit;
  5074. StartProgram(false);
  5075. Add([
  5076. 'type',
  5077. ' TAtoZ = ''A''..''Z'';',
  5078. ' TSetOfAZ = set of TAtoZ;',
  5079. 'var',
  5080. ' c: char;',
  5081. ' a: TAtoZ;',
  5082. ' s: TSetOfAZ = [''P'',''A''];',
  5083. ' i: longint;',
  5084. 'begin',
  5085. ' Include(s,''S'');',
  5086. ' Include(s,c);',
  5087. ' Include(s,a);',
  5088. ' c:=low(TAtoZ);',
  5089. ' i:=ord(low(TAtoZ));',
  5090. ' a:=high(TAtoZ);',
  5091. ' a:=high(TSetOfAtoZ);',
  5092. ' s:=[a,c,''M''];',
  5093. '']);
  5094. ConvertProgram;
  5095. CheckSource('TestSet_AnonymousEnumTypeChar',
  5096. LinesToStr([ // statements
  5097. '']),
  5098. LinesToStr([
  5099. '']));
  5100. end;
  5101. procedure TTestModule.TestSet_ConstEnum;
  5102. begin
  5103. StartProgram(false);
  5104. Add([
  5105. 'type',
  5106. ' TEnum = (red,blue,green);',
  5107. ' TEnums = set of TEnum;',
  5108. 'const',
  5109. ' teAny = [low(TEnum)..high(TEnum)];',
  5110. ' teRedBlue = [low(TEnum)..pred(high(TEnum))];',
  5111. 'var',
  5112. ' e: TEnum;',
  5113. ' s: TEnums;',
  5114. 'begin',
  5115. ' if blue in teAny then;',
  5116. ' if blue in teAny+[e] then;',
  5117. ' if blue in teAny+teRedBlue then;',
  5118. ' if e in [red,blue] then;',
  5119. ' s:=teAny;',
  5120. ' s:=teAny+[e];',
  5121. ' s:=[e]+teAny;',
  5122. ' s:=teAny+teRedBlue;',
  5123. ' s:=teAny+teRedBlue+[e];',
  5124. '']);
  5125. ConvertProgram;
  5126. CheckSource('TestSet_ConstEnum',
  5127. LinesToStr([ // statements
  5128. 'this.TEnum = {',
  5129. ' "0": "red",',
  5130. ' red: 0,',
  5131. ' "1": "blue",',
  5132. ' blue: 1,',
  5133. ' "2": "green",',
  5134. ' green: 2',
  5135. '};',
  5136. 'this.teAny = rtl.createSet(null, $mod.TEnum.red, $mod.TEnum.green);',
  5137. 'this.teRedBlue = rtl.createSet(null, $mod.TEnum.red, $mod.TEnum.green - 1);',
  5138. 'this.e = 0;',
  5139. 'this.s = {};',
  5140. '']),
  5141. LinesToStr([
  5142. 'if ($mod.TEnum.blue in $mod.teAny) ;',
  5143. 'if ($mod.TEnum.blue in rtl.unionSet($mod.teAny, rtl.createSet($mod.e))) ;',
  5144. 'if ($mod.TEnum.blue in rtl.unionSet($mod.teAny, $mod.teRedBlue)) ;',
  5145. 'if ($mod.e in rtl.createSet($mod.TEnum.red, $mod.TEnum.blue)) ;',
  5146. '$mod.s = rtl.refSet($mod.teAny);',
  5147. '$mod.s = rtl.unionSet($mod.teAny, rtl.createSet($mod.e));',
  5148. '$mod.s = rtl.unionSet(rtl.createSet($mod.e), $mod.teAny);',
  5149. '$mod.s = rtl.unionSet($mod.teAny, $mod.teRedBlue);',
  5150. '$mod.s = rtl.unionSet(rtl.unionSet($mod.teAny, $mod.teRedBlue), rtl.createSet($mod.e));',
  5151. '']));
  5152. end;
  5153. procedure TTestModule.TestSet_ConstChar;
  5154. begin
  5155. StartProgram(false);
  5156. Add([
  5157. 'const',
  5158. ' LowChars = [''a''..''z''];',
  5159. ' Chars = LowChars+[''A''..''Z''];',
  5160. 'var',
  5161. ' c: char;',
  5162. ' s: string;',
  5163. 'begin',
  5164. ' if c in lowchars then ;',
  5165. ' if ''a'' in lowchars then ;',
  5166. ' if s[1] in lowchars then ;',
  5167. ' if c in chars then ;',
  5168. ' if c in [''a''..''z'',''_''] then ;',
  5169. ' if ''b'' in [''a''..''z'',''_''] then ;',
  5170. '']);
  5171. ConvertProgram;
  5172. CheckSource('TestSet_ConstChar',
  5173. LinesToStr([ // statements
  5174. 'this.LowChars = rtl.createSet(null, 97, 122);',
  5175. 'this.Chars = rtl.unionSet($mod.LowChars, rtl.createSet(null, 65, 90));',
  5176. 'this.c = "";',
  5177. 'this.s = "";',
  5178. '']),
  5179. LinesToStr([
  5180. 'if ($mod.c.charCodeAt() in $mod.LowChars) ;',
  5181. 'if (97 in $mod.LowChars) ;',
  5182. 'if ($mod.s.charCodeAt(0) in $mod.LowChars) ;',
  5183. 'if ($mod.c.charCodeAt() in $mod.Chars) ;',
  5184. 'if ($mod.c.charCodeAt() in rtl.createSet(null, 97, 122, 95)) ;',
  5185. 'if (98 in rtl.createSet(null, 97, 122, 95)) ;',
  5186. '']));
  5187. end;
  5188. procedure TTestModule.TestSet_ConstInt;
  5189. begin
  5190. StartProgram(false);
  5191. Add([
  5192. 'const',
  5193. ' Months = [1..12];',
  5194. ' Mirror = [-12..-1]+Months;',
  5195. 'var',
  5196. ' i: smallint;',
  5197. 'begin',
  5198. ' if 3 in Months then;',
  5199. ' if i in Months+[i] then;',
  5200. ' if i in Months+Mirror then;',
  5201. ' if i in [4..6,8] then;',
  5202. '']);
  5203. ConvertProgram;
  5204. CheckSource('TestSet_ConstInt',
  5205. LinesToStr([ // statements
  5206. 'this.Months = rtl.createSet(null, 1, 12);',
  5207. 'this.Mirror = rtl.unionSet(rtl.createSet(null, -12, -1), $mod.Months);',
  5208. 'this.i = 0;',
  5209. '']),
  5210. LinesToStr([
  5211. 'if (3 in $mod.Months) ;',
  5212. 'if ($mod.i in rtl.unionSet($mod.Months, rtl.createSet($mod.i))) ;',
  5213. 'if ($mod.i in rtl.unionSet($mod.Months, $mod.Mirror)) ;',
  5214. 'if ($mod.i in rtl.createSet(null, 4, 6, 8)) ;',
  5215. '']));
  5216. end;
  5217. procedure TTestModule.TestSet_InFunction;
  5218. begin
  5219. StartProgram(false);
  5220. Add([
  5221. 'const',
  5222. ' TEnum = 3;',
  5223. ' TSetOfEnum = 4;',
  5224. ' TSetOfAno = 5;',
  5225. 'procedure DoIt;',
  5226. 'type',
  5227. ' TEnum = (red, blue);',
  5228. ' TSetOfEnum = set of TEnum;',
  5229. ' TSetOfAno = set of (up,down);',
  5230. 'var',
  5231. ' e: TEnum;',
  5232. ' se: TSetOfEnum;',
  5233. ' sa: TSetOfAno;',
  5234. 'begin',
  5235. ' se:=[e];',
  5236. ' sa:=[up];',
  5237. 'end;',
  5238. 'begin',
  5239. '']);
  5240. ConvertProgram;
  5241. CheckSource('TestSet_InFunction',
  5242. LinesToStr([ // statements
  5243. 'this.TEnum = 3;',
  5244. 'this.TSetOfEnum = 4;',
  5245. 'this.TSetOfAno = 5;',
  5246. 'var TEnum$1 = {',
  5247. ' "0": "red",',
  5248. ' red: 0,',
  5249. ' "1": "blue",',
  5250. ' blue: 1',
  5251. '};',
  5252. 'var TSetOfAno$a = {',
  5253. ' "0": "up",',
  5254. ' up: 0,',
  5255. ' "1": "down",',
  5256. ' down: 1',
  5257. '};',
  5258. 'this.DoIt = function () {',
  5259. ' var e = 0;',
  5260. ' var se = {};',
  5261. ' var sa = {};',
  5262. ' se = rtl.createSet(e);',
  5263. ' sa = rtl.createSet(TSetOfAno$a.up);',
  5264. '};',
  5265. '']),
  5266. LinesToStr([
  5267. '']));
  5268. end;
  5269. procedure TTestModule.TestSet_ForIn;
  5270. begin
  5271. StartProgram(false);
  5272. Add([
  5273. 'type',
  5274. ' TEnum = (Red, Green, Blue);',
  5275. ' TEnumRg = green..blue;',
  5276. ' TSetOfEnum = set of TEnum;',
  5277. ' TSetOfEnumRg = set of TEnumRg;',
  5278. 'var',
  5279. ' e, e2: TEnum;',
  5280. ' er: TEnum;',
  5281. ' s: TSetOfEnum;',
  5282. 'begin',
  5283. ' for e in TSetOfEnum do ;',
  5284. ' for e in TSetOfEnumRg do ;',
  5285. ' for e in [] do e2:=e;',
  5286. ' for e in [red..green] do e2:=e;',
  5287. ' for e in [green,blue] do e2:=e;',
  5288. ' for e in [red,blue] do e2:=e;',
  5289. ' for e in s do e2:=e;',
  5290. ' for er in TSetOfEnumRg do ;',
  5291. '']);
  5292. ConvertProgram;
  5293. CheckSource('TestSet_ForIn',
  5294. LinesToStr([ // statements
  5295. 'this.TEnum = {',
  5296. ' "0":"Red",',
  5297. ' Red:0,',
  5298. ' "1":"Green",',
  5299. ' Green:1,',
  5300. ' "2":"Blue",',
  5301. ' Blue:2',
  5302. ' };',
  5303. 'this.e = 0;',
  5304. 'this.e2 = 0;',
  5305. 'this.er = 0;',
  5306. 'this.s = {};',
  5307. '']),
  5308. LinesToStr([
  5309. 'for ($mod.e = 0; $mod.e <= 2; $mod.e++) ;',
  5310. 'for ($mod.e = 1; $mod.e <= 2; $mod.e++) ;',
  5311. 'for ($mod.e = 0; $mod.e <= 1; $mod.e++) $mod.e2 = $mod.e;',
  5312. 'for ($mod.e = 1; $mod.e <= 2; $mod.e++) $mod.e2 = $mod.e;',
  5313. 'for ($mod.e in rtl.createSet($mod.TEnum.Red, $mod.TEnum.Blue)) $mod.e2 = $mod.e;',
  5314. 'for (var $l1 in $mod.s){',
  5315. ' $mod.e = +$l1;',
  5316. ' $mod.e2 = $mod.e;',
  5317. '};',
  5318. 'for ($mod.er = 1; $mod.er <= 2; $mod.er++) ;',
  5319. '']));
  5320. end;
  5321. procedure TTestModule.TestNestBegin;
  5322. begin
  5323. StartProgram(false);
  5324. Add('begin');
  5325. Add(' begin');
  5326. Add(' begin');
  5327. Add(' end;');
  5328. Add(' begin');
  5329. Add(' if true then ;');
  5330. Add(' end;');
  5331. Add(' end;');
  5332. ConvertProgram;
  5333. CheckSource('TestNestBegin',
  5334. '',
  5335. 'if (true) ;');
  5336. end;
  5337. procedure TTestModule.TestUnitImplVars;
  5338. begin
  5339. StartUnit(false);
  5340. Add('interface');
  5341. Add('implementation');
  5342. Add('var');
  5343. Add(' V1:longint;');
  5344. Add(' V2:longint = 3;');
  5345. Add(' V3:string = ''abc'';');
  5346. ConvertUnit;
  5347. CheckSource('TestUnitImplVars',
  5348. LinesToStr([ // statements
  5349. 'var $impl = $mod.$impl;',
  5350. '']),
  5351. '', // this.$init
  5352. LinesToStr([ // implementation
  5353. '$impl.V1 = 0;',
  5354. '$impl.V2 = 3;',
  5355. '$impl.V3 = "abc";',
  5356. '']) );
  5357. end;
  5358. procedure TTestModule.TestUnitImplConsts;
  5359. begin
  5360. StartUnit(false);
  5361. Add('interface');
  5362. Add('implementation');
  5363. Add('const');
  5364. Add(' v1 = 3;');
  5365. Add(' v2:longint = 4;');
  5366. Add(' v3:string = ''abc'';');
  5367. ConvertUnit;
  5368. CheckSource('TestUnitImplConsts',
  5369. LinesToStr([ // statements
  5370. 'var $impl = $mod.$impl;',
  5371. '']),
  5372. '', // this.$init
  5373. LinesToStr([ // implementation
  5374. '$impl.v1 = 3;',
  5375. '$impl.v2 = 4;',
  5376. '$impl.v3 = "abc";',
  5377. '']) );
  5378. end;
  5379. procedure TTestModule.TestUnitImplRecord;
  5380. begin
  5381. StartUnit(false);
  5382. Add('interface');
  5383. Add('implementation');
  5384. Add('type');
  5385. Add(' TMyRecord = record');
  5386. Add(' i: longint;');
  5387. Add(' end;');
  5388. Add('var aRec: TMyRecord;');
  5389. Add('initialization');
  5390. Add(' arec.i:=3;');
  5391. ConvertUnit;
  5392. CheckSource('TestUnitImplRecord',
  5393. LinesToStr([ // statements
  5394. 'var $impl = $mod.$impl;',
  5395. '']),
  5396. // this.$init
  5397. '$impl.aRec.i = 3;',
  5398. LinesToStr([ // implementation
  5399. '$impl.TMyRecord = function (s) {',
  5400. ' if (s) {',
  5401. ' this.i = s.i;',
  5402. ' } else {',
  5403. ' this.i = 0;',
  5404. ' };',
  5405. ' this.$equal = function (b) {',
  5406. ' return this.i === b.i;',
  5407. ' };',
  5408. '};',
  5409. '$impl.aRec = new $impl.TMyRecord();',
  5410. '']) );
  5411. end;
  5412. procedure TTestModule.TestRenameJSNameConflict;
  5413. begin
  5414. StartProgram(false);
  5415. Add('var apply: longint;');
  5416. Add('var bind: longint;');
  5417. Add('var call: longint;');
  5418. Add('begin');
  5419. ConvertProgram;
  5420. CheckSource('TestRenameJSNameConflict',
  5421. LinesToStr([ // statements
  5422. 'this.Apply = 0;',
  5423. 'this.Bind = 0;',
  5424. 'this.Call = 0;'
  5425. ]),
  5426. LinesToStr([ // this.$main
  5427. ''
  5428. ]));
  5429. end;
  5430. procedure TTestModule.TestLocalConst;
  5431. begin
  5432. StartProgram(false);
  5433. Add('procedure DoIt;');
  5434. Add('const');
  5435. Add(' cA: longint = 1;');
  5436. Add(' cB = 2;');
  5437. Add(' procedure Sub;');
  5438. Add(' const');
  5439. Add(' csA = 3;');
  5440. Add(' cB: double = 4;');
  5441. Add(' begin');
  5442. Add(' cb:=cb+csa;');
  5443. Add(' ca:=ca+csa+5;');
  5444. Add(' end;');
  5445. Add('begin');
  5446. Add(' ca:=ca+cb+6;');
  5447. Add('end;');
  5448. Add('begin');
  5449. ConvertProgram;
  5450. CheckSource('TestLocalConst',
  5451. LinesToStr([
  5452. 'var cA = 1;',
  5453. 'var cB = 2;',
  5454. 'var csA = 3;',
  5455. 'var cB$1 = 4;',
  5456. 'this.DoIt = function () {',
  5457. ' function Sub() {',
  5458. ' cB$1 = cB$1 + 3;',
  5459. ' cA = cA + 3 + 5;',
  5460. ' };',
  5461. ' cA = cA + 2 + 6;',
  5462. '};'
  5463. ]),
  5464. LinesToStr([
  5465. ]));
  5466. end;
  5467. procedure TTestModule.TestVarExternal;
  5468. begin
  5469. StartProgram(false);
  5470. Add('var');
  5471. Add(' NaN: double; external name ''Global.NaN'';');
  5472. Add(' d: double;');
  5473. Add('begin');
  5474. Add(' d:=NaN;');
  5475. ConvertProgram;
  5476. CheckSource('TestVarExternal',
  5477. LinesToStr([
  5478. 'this.d = 0.0;'
  5479. ]),
  5480. LinesToStr([
  5481. '$mod.d = Global.NaN;'
  5482. ]));
  5483. end;
  5484. procedure TTestModule.TestVarExternalOtherUnit;
  5485. begin
  5486. AddModuleWithIntfImplSrc('unit2.pas',
  5487. LinesToStr([
  5488. 'var NaN: double; external name ''Global.NaN'';',
  5489. 'var iV: longint;'
  5490. ]),
  5491. '');
  5492. StartUnit(true);
  5493. Add('interface');
  5494. Add('uses unit2;');
  5495. Add('implementation');
  5496. Add('var');
  5497. Add(' d: double;');
  5498. Add(' i: longint; external name ''$i'';');
  5499. Add('begin');
  5500. Add(' d:=nan;');
  5501. Add(' d:=uNit2.nan;');
  5502. Add(' d:=test1.d;');
  5503. Add(' i:=iv;');
  5504. Add(' i:=uNit2.iv;');
  5505. Add(' i:=test1.i;');
  5506. ConvertUnit;
  5507. CheckSource('TestVarExternalOtherUnit',
  5508. LinesToStr([
  5509. 'var $impl = $mod.$impl;',
  5510. '']),
  5511. LinesToStr([ // this.$init
  5512. '$impl.d = Global.NaN;',
  5513. '$impl.d = Global.NaN;',
  5514. '$impl.d = $impl.d;',
  5515. '$i = pas.unit2.iV;',
  5516. '$i = pas.unit2.iV;',
  5517. '$i = $i;',
  5518. '']),
  5519. LinesToStr([ // implementation
  5520. '$impl.d = 0.0;',
  5521. '']) );
  5522. end;
  5523. procedure TTestModule.TestVarAbsoluteFail;
  5524. begin
  5525. StartProgram(false);
  5526. Add([
  5527. 'var',
  5528. ' a: longint;',
  5529. ' b: longword absolute a;',
  5530. 'begin']);
  5531. SetExpectedPasResolverError('Invalid variable modifier "absolute"',nInvalidVariableModifier);
  5532. ConvertProgram;
  5533. end;
  5534. procedure TTestModule.TestConstExternal;
  5535. begin
  5536. StartProgram(false);
  5537. Add([
  5538. 'const',
  5539. ' PI: double; external name ''Global.PI'';',
  5540. ' Tau = 2*pi;',
  5541. 'var d: double;',
  5542. 'begin',
  5543. ' d:=pi;',
  5544. ' d:=tau+pi;']);
  5545. ConvertProgram;
  5546. CheckSource('TestConstExternal',
  5547. LinesToStr([
  5548. 'this.Tau = 2*Global.PI;',
  5549. 'this.d = 0.0;'
  5550. ]),
  5551. LinesToStr([
  5552. '$mod.d = Global.PI;',
  5553. '$mod.d = $mod.Tau + Global.PI;'
  5554. ]));
  5555. end;
  5556. procedure TTestModule.TestDouble;
  5557. begin
  5558. StartProgram(false);
  5559. Add([
  5560. 'type',
  5561. ' TDateTime = double;',
  5562. 'const',
  5563. ' a = TDateTime(2.7);',
  5564. ' b = a + TDateTime(1.7);',
  5565. ' c = 0.9 + 0.1;',
  5566. ' f0_1 = 0.1;',
  5567. ' f0_3 = 0.3;',
  5568. ' fn0_1 = -0.1;',
  5569. ' fn0_3 = -0.3;',
  5570. ' fn0_003 = -0.003;',
  5571. ' fn0_123456789 = -0.123456789;',
  5572. ' fn300_0 = -300.0;',
  5573. ' fn123456_0 = -123456.0;',
  5574. ' fn1234567_8 = -1234567.8;',
  5575. ' fn12345678_9 = -12345678.9;',
  5576. ' f1_0En12 = 1E-12;',
  5577. ' fn1_0En12 = -1E-12;',
  5578. ' maxdouble = 1.7e+308;',
  5579. ' mindouble = -1.7e+308;',
  5580. ' MinSafeIntDouble = -$10000000000000;',
  5581. ' MaxSafeIntDouble = $fffffffffffff;',
  5582. 'var',
  5583. ' d: double = b;',
  5584. 'begin',
  5585. ' d:=1.0;',
  5586. ' d:=1.0/3.0;',
  5587. ' d:=1/3;',
  5588. ' d:=5.0E-324;',
  5589. ' d:=1.7E308;',
  5590. ' d:=001.00E00;',
  5591. ' d:=002.00E001;',
  5592. ' d:=-003.00E-00;',
  5593. ' d:=-004.00E-001;',
  5594. ' d:=10**3;',
  5595. ' d:=10 mod 3;',
  5596. ' d:=10 div 3;',
  5597. ' d:=c;',
  5598. ' d:=f0_1;',
  5599. ' d:=f0_3;',
  5600. ' d:=fn0_1;',
  5601. ' d:=fn0_3;',
  5602. ' d:=fn0_003;',
  5603. ' d:=fn0_123456789;',
  5604. ' d:=fn300_0;',
  5605. ' d:=fn123456_0;',
  5606. ' d:=fn1234567_8;',
  5607. ' d:=fn12345678_9;',
  5608. ' d:=f1_0En12;',
  5609. ' d:=fn1_0En12;',
  5610. ' d:=maxdouble;',
  5611. ' d:=mindouble;',
  5612. ' d:=MinSafeIntDouble;',
  5613. ' d:=MaxSafeIntDouble;',
  5614. ' d:=default(double);',
  5615. '']);
  5616. ConvertProgram;
  5617. CheckSource('TestDouble',
  5618. LinesToStr([
  5619. 'this.a = 2.7;',
  5620. 'this.b = 2.7 + 1.7;',
  5621. 'this.c = 0.9 + 0.1;',
  5622. 'this.f0_1 = 0.1;',
  5623. 'this.f0_3 = 0.3;',
  5624. 'this.fn0_1 = -0.1;',
  5625. 'this.fn0_3 = -0.3;',
  5626. 'this.fn0_003 = -0.003;',
  5627. 'this.fn0_123456789 = -0.123456789;',
  5628. 'this.fn300_0 = -300.0;',
  5629. 'this.fn123456_0 = -123456.0;',
  5630. 'this.fn1234567_8 = -1234567.8;',
  5631. 'this.fn12345678_9 = -12345678.9;',
  5632. 'this.f1_0En12 = 1E-12;',
  5633. 'this.fn1_0En12 = -1E-12;',
  5634. 'this.maxdouble = 1.7e+308;',
  5635. 'this.mindouble = -1.7e+308;',
  5636. 'this.MinSafeIntDouble = -0x10000000000000;',
  5637. 'this.MaxSafeIntDouble = 0xfffffffffffff;',
  5638. 'this.d = 4.4;'
  5639. ]),
  5640. LinesToStr([
  5641. '$mod.d = 1.0;',
  5642. '$mod.d = 1.0 / 3.0;',
  5643. '$mod.d = 1 / 3;',
  5644. '$mod.d = 5.0E-324;',
  5645. '$mod.d = 1.7E308;',
  5646. '$mod.d = 1.00E0;',
  5647. '$mod.d = 2.00E1;',
  5648. '$mod.d = -3.00E-0;',
  5649. '$mod.d = -4.00E-1;',
  5650. '$mod.d = Math.pow(10, 3);',
  5651. '$mod.d = 10 % 3;',
  5652. '$mod.d = Math.floor(10 / 3);',
  5653. '$mod.d = 1;',
  5654. '$mod.d = 0.1;',
  5655. '$mod.d = 0.3;',
  5656. '$mod.d = -0.1;',
  5657. '$mod.d = -0.3;',
  5658. '$mod.d = -0.003;',
  5659. '$mod.d = -0.123456789;',
  5660. '$mod.d = -300;',
  5661. '$mod.d = -123456;',
  5662. '$mod.d = -1234567.8;',
  5663. '$mod.d = -1.23456789E7;',
  5664. '$mod.d = 1E-12;',
  5665. '$mod.d = -1E-12;',
  5666. '$mod.d = 1.7E308;',
  5667. '$mod.d = -1.7E308;',
  5668. '$mod.d = -4503599627370496;',
  5669. '$mod.d = 4503599627370495;',
  5670. '$mod.d = 0.0;',
  5671. '']));
  5672. end;
  5673. procedure TTestModule.TestInteger;
  5674. begin
  5675. StartProgram(false);
  5676. Add([
  5677. 'const',
  5678. ' MinInt = low(NativeInt);',
  5679. ' MaxInt = high(NativeInt);',
  5680. 'type',
  5681. ' {#TMyInt}TMyInt = MinInt..MaxInt;',
  5682. 'const',
  5683. ' a = low(TMyInt)+High(TMyInt);',
  5684. 'var',
  5685. ' i: TMyInt;',
  5686. 'begin',
  5687. ' i:=-MinInt;',
  5688. ' i:=default(TMyInt);',
  5689. ' i:=low(i)+high(i);',
  5690. '']);
  5691. ConvertProgram;
  5692. CheckSource('TestIntegerRange',
  5693. LinesToStr([
  5694. 'this.MinInt = -4503599627370496;',
  5695. 'this.MaxInt = 4503599627370495;',
  5696. 'this.a = -4503599627370496 + 4503599627370495;',
  5697. 'this.i = 0;',
  5698. '']),
  5699. LinesToStr([
  5700. '$mod.i = - -4503599627370496;',
  5701. '$mod.i = -4503599627370496;',
  5702. '$mod.i = -4503599627370496 + 4503599627370495;',
  5703. '']));
  5704. end;
  5705. procedure TTestModule.TestIntegerRange;
  5706. begin
  5707. StartProgram(false);
  5708. Add([
  5709. 'const',
  5710. ' MinInt = -1;',
  5711. ' MaxInt = +1;',
  5712. 'type',
  5713. ' {#TMyInt}TMyInt = MinInt..MaxInt;',
  5714. ' TInt2 = 1..3;',
  5715. 'const',
  5716. ' a = low(TMyInt)+High(TMyInt);',
  5717. ' b = low(TInt2)+High(TInt2);',
  5718. ' s1 = [1];',
  5719. ' s2 = [1,2];',
  5720. ' s3 = [1..3];',
  5721. ' s4 = [low(shortint)..high(shortint)];',
  5722. ' s5 = [succ(low(shortint))..pred(high(shortint))];',
  5723. ' s6 = 1 in s2;',
  5724. 'var',
  5725. ' i: TMyInt;',
  5726. ' i2: TInt2;',
  5727. 'begin',
  5728. ' i:=i2;',
  5729. ' i:=default(TMyInt);',
  5730. ' if i=i2 then ;']);
  5731. ConvertProgram;
  5732. CheckSource('TestIntegerRange',
  5733. LinesToStr([
  5734. 'this.MinInt = -1;',
  5735. 'this.MaxInt = +1;',
  5736. 'this.a = -1 + 1;',
  5737. 'this.b = 1 + 3;',
  5738. 'this.s1 = rtl.createSet(1);',
  5739. 'this.s2 = rtl.createSet(1, 2);',
  5740. 'this.s3 = rtl.createSet(null, 1, 3);',
  5741. 'this.s4 = rtl.createSet(null, -128, 127);',
  5742. 'this.s5 = rtl.createSet(null, -128 + 1, 127 - 1);',
  5743. 'this.s6 = 1 in $mod.s2;',
  5744. 'this.i = 0;',
  5745. 'this.i2 = 0;',
  5746. '']),
  5747. LinesToStr([
  5748. '$mod.i = $mod.i2;',
  5749. '$mod.i = -1;',
  5750. 'if ($mod.i === $mod.i2) ;',
  5751. '']));
  5752. end;
  5753. procedure TTestModule.TestIntegerTypecasts;
  5754. begin
  5755. StartProgram(false);
  5756. Add([
  5757. 'var',
  5758. ' i: nativeint;',
  5759. ' b: byte;',
  5760. ' sh: shortint;',
  5761. ' w: word;',
  5762. ' sm: smallint;',
  5763. ' lw: longword;',
  5764. ' li: longint;',
  5765. 'begin',
  5766. ' b:=byte(i);',
  5767. ' sh:=shortint(i);',
  5768. ' w:=word(i);',
  5769. ' sm:=smallint(i);',
  5770. ' lw:=longword(i);',
  5771. ' li:=longint(i);',
  5772. '']);
  5773. ConvertProgram;
  5774. CheckSource('TestIntegerTypecasts',
  5775. LinesToStr([
  5776. 'this.i = 0;',
  5777. 'this.b = 0;',
  5778. 'this.sh = 0;',
  5779. 'this.w = 0;',
  5780. 'this.sm = 0;',
  5781. 'this.lw = 0;',
  5782. 'this.li = 0;',
  5783. '']),
  5784. LinesToStr([
  5785. '$mod.b = $mod.i & 255;',
  5786. '$mod.sh = (($mod.i & 255) << 24) >> 24;',
  5787. '$mod.w = $mod.i & 65535;',
  5788. '$mod.sm = (($mod.i & 65535) << 16) >> 16;',
  5789. '$mod.lw = $mod.i >>> 0;',
  5790. '$mod.li = $mod.i & 0xFFFFFFFF;',
  5791. '']));
  5792. end;
  5793. procedure TTestModule.TestCurrency;
  5794. begin
  5795. StartProgram(false);
  5796. Add([
  5797. 'type',
  5798. ' TCoin = currency;',
  5799. 'const',
  5800. ' a = TCoin(2.7);',
  5801. ' b = a + TCoin(1.7);',
  5802. ' MinSafeIntCurrency: TCoin = -92233720368.5477;',
  5803. ' MaxSafeIntCurrency: TCoin = 92233720368.5477;',
  5804. 'var',
  5805. ' c: TCoin = b;',
  5806. ' i: nativeint;',
  5807. ' d: double;',
  5808. ' j: jsvalue;',
  5809. 'function DoIt(c: currency): currency; begin end;',
  5810. 'function GetIt(d: double): double; begin end;',
  5811. 'procedure Write(v: jsvalue); begin end;',
  5812. 'begin',
  5813. ' c:=1.0;',
  5814. ' c:=0.1;',
  5815. ' c:=1.0/3.0;',
  5816. ' c:=1/3;',
  5817. ' c:=a;',
  5818. ' d:=c;',
  5819. ' c:=d;',
  5820. ' c:=currency(c);',
  5821. ' c:=currency(d);',
  5822. ' d:=double(c);',
  5823. ' c:=i;',
  5824. ' c:=currency(i);',
  5825. //' i:=c;', not allowed
  5826. ' i:=nativeint(c);',
  5827. ' c:=c+a;',
  5828. ' c:=-c-a;',
  5829. ' c:=d+c;',
  5830. ' c:=c+d;',
  5831. ' c:=d-c;',
  5832. ' c:=c-d;',
  5833. ' c:=c*a;',
  5834. ' c:=a*c;',
  5835. ' c:=d*c;',
  5836. ' c:=c*d;',
  5837. ' c:=c/a;',
  5838. ' c:=a/c;',
  5839. ' c:=d/c;',
  5840. ' c:=c/d;',
  5841. ' c:=c**a;',
  5842. ' c:=a**c;',
  5843. ' c:=d**c;',
  5844. ' c:=c**d;',
  5845. ' if c=c then ;',
  5846. ' if c=a then ;',
  5847. ' if a=c then ;',
  5848. ' if d=c then ;',
  5849. ' if c=d then ;',
  5850. ' c:=DoIt(c);',
  5851. ' c:=DoIt(i);',
  5852. ' c:=DoIt(d);',
  5853. ' c:=GetIt(c);',
  5854. ' j:=c;',
  5855. ' Write(c);',
  5856. ' c:=default(currency);',
  5857. ' j:=str(c);',
  5858. ' j:=str(c:0:3);',
  5859. '']);
  5860. ConvertProgram;
  5861. CheckSource('TestCurrency',
  5862. LinesToStr([
  5863. 'this.a = 27000;',
  5864. 'this.b = $mod.a + 17000;',
  5865. 'this.MinSafeIntCurrency = -92233720368.5477;',
  5866. 'this.MaxSafeIntCurrency = 92233720368.5477;',
  5867. 'this.c = $mod.b;',
  5868. 'this.i = 0;',
  5869. 'this.d = 0.0;',
  5870. 'this.j = undefined;',
  5871. 'this.DoIt = function (c) {',
  5872. ' var Result = 0;',
  5873. ' return Result;',
  5874. '};',
  5875. 'this.GetIt = function (d) {',
  5876. ' var Result = 0.0;',
  5877. ' return Result;',
  5878. '};',
  5879. 'this.Write = function (v) {',
  5880. '};',
  5881. '']),
  5882. LinesToStr([
  5883. '$mod.c = 10000;',
  5884. '$mod.c = 1000;',
  5885. '$mod.c = Math.floor((1.0 / 3.0) * 10000);',
  5886. '$mod.c = Math.floor((1 / 3) * 10000);',
  5887. '$mod.c = $mod.a;',
  5888. '$mod.d = $mod.c / 10000;',
  5889. '$mod.c = Math.floor($mod.d * 10000);',
  5890. '$mod.c = $mod.c;',
  5891. '$mod.c = $mod.d * 10000;',
  5892. '$mod.d = $mod.c / 10000;',
  5893. '$mod.c = $mod.i * 10000;',
  5894. '$mod.c = $mod.i * 10000;',
  5895. '$mod.i = Math.floor($mod.c / 10000);',
  5896. '$mod.c = $mod.c + $mod.a;',
  5897. '$mod.c = -$mod.c - $mod.a;',
  5898. '$mod.c = ($mod.d * 10000) + $mod.c;',
  5899. '$mod.c = $mod.c + ($mod.d * 10000);',
  5900. '$mod.c = ($mod.d * 10000) - $mod.c;',
  5901. '$mod.c = $mod.c - ($mod.d * 10000);',
  5902. '$mod.c = ($mod.c * $mod.a) / 10000;',
  5903. '$mod.c = ($mod.a * $mod.c) / 10000;',
  5904. '$mod.c = $mod.d * $mod.c;',
  5905. '$mod.c = $mod.c * $mod.d;',
  5906. '$mod.c = Math.floor(($mod.c / $mod.a) * 10000);',
  5907. '$mod.c = Math.floor(($mod.a / $mod.c) * 10000);',
  5908. '$mod.c = Math.floor($mod.d / $mod.c);',
  5909. '$mod.c = Math.floor($mod.c / $mod.d);',
  5910. '$mod.c = Math.floor(Math.pow($mod.c / 10000, $mod.a / 10000) * 10000);',
  5911. '$mod.c = Math.floor(Math.pow($mod.a / 10000, $mod.c / 10000) * 10000);',
  5912. '$mod.c = Math.floor(Math.pow($mod.d, $mod.c / 10000) * 10000);',
  5913. '$mod.c = Math.floor(Math.pow($mod.c / 10000, $mod.d) * 10000);',
  5914. 'if ($mod.c === $mod.c) ;',
  5915. 'if ($mod.c === $mod.a) ;',
  5916. 'if ($mod.a === $mod.c) ;',
  5917. 'if (($mod.d * 10000) === $mod.c) ;',
  5918. 'if ($mod.c === ($mod.d * 10000)) ;',
  5919. '$mod.c = $mod.DoIt($mod.c);',
  5920. '$mod.c = $mod.DoIt($mod.i * 10000);',
  5921. '$mod.c = $mod.DoIt($mod.d * 10000);',
  5922. '$mod.c = Math.floor($mod.GetIt($mod.c / 10000) * 10000);',
  5923. '$mod.j = $mod.c / 10000;',
  5924. '$mod.Write($mod.c / 10000);',
  5925. '$mod.c = 0;',
  5926. '$mod.j = rtl.floatToStr($mod.c / 10000);',
  5927. '$mod.j = rtl.floatToStr($mod.c / 10000, 0, 3);',
  5928. '']));
  5929. end;
  5930. procedure TTestModule.TestForBoolDo;
  5931. begin
  5932. StartProgram(false);
  5933. Add([
  5934. 'var b: boolean;',
  5935. 'begin',
  5936. ' for b:=false to true do ;',
  5937. ' for b:=b downto false do ;',
  5938. ' for b in boolean do ;',
  5939. '']);
  5940. ConvertProgram;
  5941. CheckSource('TestForBoolDo',
  5942. LinesToStr([ // statements
  5943. 'this.b = false;']),
  5944. LinesToStr([ // this.$main
  5945. 'for (var $l1 = 0; $l1 <= 1; $l1++) $mod.b = $l1 !== 0;',
  5946. 'for (var $l2 = +$mod.b; $l2 >= 0; $l2--) $mod.b = $l2 !== 0;',
  5947. 'for (var $l3 = 0; $l3 <= 1; $l3++) $mod.b = $l3 !== 0;',
  5948. '']));
  5949. end;
  5950. procedure TTestModule.TestForIntDo;
  5951. begin
  5952. StartProgram(false);
  5953. Add([
  5954. 'var i: longint;',
  5955. 'begin',
  5956. ' for i:=3 to 5 do ;',
  5957. ' for i:=i downto 2 do ;',
  5958. ' for i in byte do ;',
  5959. '']);
  5960. ConvertProgram;
  5961. CheckSource('TestForIntDo',
  5962. LinesToStr([ // statements
  5963. 'this.i = 0;']),
  5964. LinesToStr([ // this.$main
  5965. 'for ($mod.i = 3; $mod.i <= 5; $mod.i++) ;',
  5966. 'for (var $l1 = $mod.i; $l1 >= 2; $l1--) $mod.i = $l1;',
  5967. 'for (var $l2 = 0; $l2 <= 255; $l2++) $mod.i = $l2;',
  5968. '']));
  5969. end;
  5970. procedure TTestModule.TestForIntInDo;
  5971. begin
  5972. StartProgram(false);
  5973. Add([
  5974. 'type',
  5975. ' TSetOfInt = set of byte;',
  5976. ' TIntRg = 3..7;',
  5977. ' TSetOfIntRg = set of TIntRg;',
  5978. 'var',
  5979. ' i,i2: longint;',
  5980. ' a1: array of byte;',
  5981. ' a2: array[1..3] of byte;',
  5982. ' soi: TSetOfInt;',
  5983. ' soir: TSetOfIntRg;',
  5984. ' ir: TIntRg;',
  5985. 'begin',
  5986. ' for i in byte do ;',
  5987. ' for i in a1 do ;',
  5988. ' for i in a2 do ;',
  5989. ' for i in [11..13] do ;',
  5990. ' for i in TSetOfInt do ;',
  5991. ' for i in TIntRg do ;',
  5992. ' for i in soi do i2:=i;',
  5993. ' for i in TSetOfIntRg do ;',
  5994. ' for i in soir do ;',
  5995. ' for ir in TIntRg do ;',
  5996. ' for ir in TSetOfIntRg do ;',
  5997. ' for ir in soir do ;',
  5998. '']);
  5999. ConvertProgram;
  6000. CheckSource('TestForIntInDo',
  6001. LinesToStr([ // statements
  6002. 'this.i = 0;',
  6003. 'this.i2 = 0;',
  6004. 'this.a1 = [];',
  6005. 'this.a2 = rtl.arraySetLength(null, 0, 3);',
  6006. 'this.soi = {};',
  6007. 'this.soir = {};',
  6008. 'this.ir = 0;',
  6009. '']),
  6010. LinesToStr([ // this.$main
  6011. 'for (var $l1 = 0; $l1 <= 255; $l1++) $mod.i = $l1;',
  6012. 'for (var $in2 = $mod.a1, $l3 = 0, $end4 = rtl.length($in2) - 1; $l3 <= $end4; $l3++) $mod.i = $in2[$l3];',
  6013. 'for (var $in5 = $mod.a2, $l6 = 0, $end7 = rtl.length($in5) - 1; $l6 <= $end7; $l6++) $mod.i = $in5[$l6];',
  6014. 'for (var $l8 = 11; $l8 <= 13; $l8++) $mod.i = $l8;',
  6015. 'for (var $l9 = 0; $l9 <= 255; $l9++) $mod.i = $l9;',
  6016. 'for (var $l10 = 3; $l10 <= 7; $l10++) $mod.i = $l10;',
  6017. 'for (var $l11 in $mod.soi) {',
  6018. ' $mod.i = +$l11;',
  6019. ' $mod.i2 = $mod.i;',
  6020. '};',
  6021. 'for (var $l12 = 3; $l12 <= 7; $l12++) $mod.i = $l12;',
  6022. 'for (var $l13 in $mod.soir) $mod.i = +$l13;',
  6023. 'for (var $l14 = 3; $l14 <= 7; $l14++) $mod.ir = $l14;',
  6024. 'for (var $l15 = 3; $l15 <= 7; $l15++) $mod.ir = $l15;',
  6025. 'for (var $l16 in $mod.soir) $mod.ir = +$l16;',
  6026. '']));
  6027. end;
  6028. procedure TTestModule.TestCharConst;
  6029. begin
  6030. StartProgram(false);
  6031. Add([
  6032. 'const',
  6033. ' c: char = ''1'';',
  6034. 'begin',
  6035. ' c:=#0;',
  6036. ' c:=#1;',
  6037. ' c:=#9;',
  6038. ' c:=#10;',
  6039. ' c:=#13;',
  6040. ' c:=#31;',
  6041. ' c:=#32;',
  6042. ' c:=#$A;',
  6043. ' c:=#$0A;',
  6044. ' c:=#$b;',
  6045. ' c:=#$0b;',
  6046. ' c:=^A;',
  6047. ' c:=''"'';',
  6048. ' c:=default(char);',
  6049. ' c:=#$00E4;', // ä
  6050. ' c:=''ä'';',
  6051. ' c:=#$E4;', // ä
  6052. ' c:=#$D800;', // invalid UTF-16
  6053. ' c:=#$DFFF;', // invalid UTF-16
  6054. ' c:=#$FFFF;', // last UCS-2
  6055. ' c:=high(c);', // last UCS-2
  6056. '']);
  6057. ConvertProgram;
  6058. CheckSource('TestCharConst',
  6059. LinesToStr([
  6060. 'this.c="1";'
  6061. ]),
  6062. LinesToStr([
  6063. '$mod.c="\x00";',
  6064. '$mod.c="\x01";',
  6065. '$mod.c="\t";',
  6066. '$mod.c="\n";',
  6067. '$mod.c="\r";',
  6068. '$mod.c="\x1F";',
  6069. '$mod.c=" ";',
  6070. '$mod.c="\n";',
  6071. '$mod.c="\n";',
  6072. '$mod.c="\x0B";',
  6073. '$mod.c="\x0B";',
  6074. '$mod.c="\x01";',
  6075. '$mod.c=''"'';',
  6076. '$mod.c="\x00";',
  6077. '$mod.c = "ä";',
  6078. '$mod.c = "ä";',
  6079. '$mod.c = "ä";',
  6080. '$mod.c="\uD800";',
  6081. '$mod.c="\uDFFF";',
  6082. '$mod.c="\uFFFF";',
  6083. '$mod.c="\uFFFF";',
  6084. '']));
  6085. end;
  6086. procedure TTestModule.TestChar_Compare;
  6087. begin
  6088. StartProgram(false);
  6089. Add('var');
  6090. Add(' c: char;');
  6091. Add(' b: boolean;');
  6092. Add('begin');
  6093. Add(' b:=c=''1'';');
  6094. Add(' b:=''2''=c;');
  6095. Add(' b:=''3''=''4'';');
  6096. Add(' b:=c<>''5'';');
  6097. Add(' b:=''6''<>c;');
  6098. Add(' b:=c>''7'';');
  6099. Add(' b:=''8''>c;');
  6100. Add(' b:=c>=''9'';');
  6101. Add(' b:=''A''>=c;');
  6102. Add(' b:=c<''B'';');
  6103. Add(' b:=''C''<c;');
  6104. Add(' b:=c<=''D'';');
  6105. Add(' b:=''E''<=c;');
  6106. ConvertProgram;
  6107. CheckSource('TestChar_Compare',
  6108. LinesToStr([
  6109. 'this.c="";',
  6110. 'this.b = false;'
  6111. ]),
  6112. LinesToStr([
  6113. '$mod.b = $mod.c === "1";',
  6114. '$mod.b = "2" === $mod.c;',
  6115. '$mod.b = "3" === "4";',
  6116. '$mod.b = $mod.c !== "5";',
  6117. '$mod.b = "6" !== $mod.c;',
  6118. '$mod.b = $mod.c > "7";',
  6119. '$mod.b = "8" > $mod.c;',
  6120. '$mod.b = $mod.c >= "9";',
  6121. '$mod.b = "A" >= $mod.c;',
  6122. '$mod.b = $mod.c < "B";',
  6123. '$mod.b = "C" < $mod.c;',
  6124. '$mod.b = $mod.c <= "D";',
  6125. '$mod.b = "E" <= $mod.c;',
  6126. '']));
  6127. end;
  6128. procedure TTestModule.TestChar_BuiltInProcs;
  6129. begin
  6130. StartProgram(false);
  6131. Add([
  6132. 'var',
  6133. ' c: char;',
  6134. ' i: longint;',
  6135. ' s: string;',
  6136. 'begin',
  6137. ' i:=ord(c);',
  6138. ' i:=ord(s[i]);',
  6139. ' c:=chr(i);',
  6140. ' c:=pred(c);',
  6141. ' c:=succ(c);',
  6142. ' c:=low(c);',
  6143. ' c:=high(c);',
  6144. '']);
  6145. ConvertProgram;
  6146. CheckSource('TestChar_BuiltInProcs',
  6147. LinesToStr([
  6148. 'this.c = "";',
  6149. 'this.i = 0;',
  6150. 'this.s = "";'
  6151. ]),
  6152. LinesToStr([
  6153. '$mod.i = $mod.c.charCodeAt();',
  6154. '$mod.i = $mod.s.charCodeAt($mod.i-1);',
  6155. '$mod.c = String.fromCharCode($mod.i);',
  6156. '$mod.c = String.fromCharCode($mod.c.charCodeAt() - 1);',
  6157. '$mod.c = String.fromCharCode($mod.c.charCodeAt() + 1);',
  6158. '$mod.c = "\x00";',
  6159. '$mod.c = "\uFFFF";',
  6160. '']));
  6161. end;
  6162. procedure TTestModule.TestStringConst;
  6163. begin
  6164. StartProgram(false);
  6165. Add([
  6166. '{$H+}',
  6167. 'var',
  6168. ' s: string = ''abc'';',
  6169. 'begin',
  6170. ' s:='''';',
  6171. ' s:=#13#10;',
  6172. ' s:=#9''foo'';',
  6173. ' s:=#$A9;',
  6174. ' s:=''foo''#13''bar'';',
  6175. ' s:=''"'';',
  6176. ' s:=''"''''"'';',
  6177. ' s:=#$20AC;', // euro
  6178. ' s:=#$10437;', // outside BMP
  6179. ' s:=default(string);',
  6180. ' s:=concat(s);',
  6181. ' s:=concat(s,''a'',s)',
  6182. '']);
  6183. ConvertProgram;
  6184. CheckSource('TestStringConst',
  6185. LinesToStr([
  6186. 'this.s="abc";'
  6187. ]),
  6188. LinesToStr([
  6189. '$mod.s="";',
  6190. '$mod.s="\r\n";',
  6191. '$mod.s="\tfoo";',
  6192. '$mod.s="©";',
  6193. '$mod.s="foo\rbar";',
  6194. '$mod.s=''"'';',
  6195. '$mod.s=''"\''"'';',
  6196. '$mod.s="€";',
  6197. '$mod.s="'#$F0#$90#$90#$B7'";',
  6198. '$mod.s="";',
  6199. '$mod.s = $mod.s;',
  6200. '$mod.s = $mod.s.concat("a", $mod.s);',
  6201. '']));
  6202. end;
  6203. procedure TTestModule.TestStringConstSurrogate;
  6204. begin
  6205. StartProgram(false);
  6206. Add([
  6207. 'var',
  6208. ' s: string;',
  6209. 'begin',
  6210. ' s:=''😊'';', // 1F60A
  6211. '']);
  6212. ConvertProgram;
  6213. CheckSource('TestStringConstSurrogate',
  6214. LinesToStr([
  6215. 'this.s="";'
  6216. ]),
  6217. LinesToStr([
  6218. '$mod.s="😊";'
  6219. ]));
  6220. end;
  6221. procedure TTestModule.TestString_Length;
  6222. begin
  6223. StartProgram(false);
  6224. Add('const c = ''foo'';');
  6225. Add('var');
  6226. Add(' s: string;');
  6227. Add(' i: longint;');
  6228. Add('begin');
  6229. Add(' i:=length(s);');
  6230. Add(' i:=length(s+s);');
  6231. Add(' i:=length(''abc'');');
  6232. Add(' i:=length(c);');
  6233. ConvertProgram;
  6234. CheckSource('TestString_Length',
  6235. LinesToStr([
  6236. 'this.c = "foo";',
  6237. 'this.s = "";',
  6238. 'this.i = 0;',
  6239. '']),
  6240. LinesToStr([
  6241. '$mod.i = $mod.s.length;',
  6242. '$mod.i = ($mod.s+$mod.s).length;',
  6243. '$mod.i = "abc".length;',
  6244. '$mod.i = $mod.c.length;',
  6245. '']));
  6246. end;
  6247. procedure TTestModule.TestString_Compare;
  6248. begin
  6249. StartProgram(false);
  6250. Add('var');
  6251. Add(' s, t: string;');
  6252. Add(' b: boolean;');
  6253. Add('begin');
  6254. Add(' b:=s=t;');
  6255. Add(' b:=s<>t;');
  6256. Add(' b:=s>t;');
  6257. Add(' b:=s>=t;');
  6258. Add(' b:=s<t;');
  6259. Add(' b:=s<=t;');
  6260. ConvertProgram;
  6261. CheckSource('TestString_Compare',
  6262. LinesToStr([ // statements
  6263. 'this.s = "";',
  6264. 'this.t = "";',
  6265. 'this.b =false;'
  6266. ]),
  6267. LinesToStr([ // this.$main
  6268. '$mod.b = $mod.s === $mod.t;',
  6269. '$mod.b = $mod.s !== $mod.t;',
  6270. '$mod.b = $mod.s > $mod.t;',
  6271. '$mod.b = $mod.s >= $mod.t;',
  6272. '$mod.b = $mod.s < $mod.t;',
  6273. '$mod.b = $mod.s <= $mod.t;',
  6274. '']));
  6275. end;
  6276. procedure TTestModule.TestString_SetLength;
  6277. begin
  6278. StartProgram(false);
  6279. Add([
  6280. 'procedure DoIt(var s: string);',
  6281. 'begin',
  6282. ' SetLength(s,2);',
  6283. 'end;',
  6284. 'var s: string;',
  6285. 'begin',
  6286. ' SetLength(s,3);',
  6287. '']);
  6288. ConvertProgram;
  6289. CheckSource('TestString_SetLength',
  6290. LinesToStr([ // statements
  6291. 'this.DoIt = function (s) {',
  6292. ' s.set(rtl.strSetLength(s.get(), 2));',
  6293. '};',
  6294. 'this.s = "";',
  6295. '']),
  6296. LinesToStr([ // this.$main
  6297. '$mod.s = rtl.strSetLength($mod.s, 3);'
  6298. ]));
  6299. end;
  6300. procedure TTestModule.TestString_CharAt;
  6301. begin
  6302. StartProgram(false);
  6303. Add([
  6304. 'var',
  6305. ' s: string;',
  6306. ' c: char;',
  6307. ' b: boolean;',
  6308. 'begin',
  6309. ' b:= s[1] = c;',
  6310. ' b:= c = s[1];',
  6311. ' b:= c <> s[1];',
  6312. ' b:= c > s[1];',
  6313. ' b:= c >= s[1];',
  6314. ' b:= c < s[2];',
  6315. ' b:= c <= s[1];',
  6316. ' s[1] := c;',
  6317. ' s[2+3] := c;']);
  6318. ConvertProgram;
  6319. CheckSource('TestString_CharAt',
  6320. LinesToStr([ // statements
  6321. 'this.s = "";',
  6322. 'this.c = "";',
  6323. 'this.b = false;'
  6324. ]),
  6325. LinesToStr([ // this.$main
  6326. '$mod.b = $mod.s.charAt(0) === $mod.c;',
  6327. '$mod.b = $mod.c === $mod.s.charAt(0);',
  6328. '$mod.b = $mod.c !== $mod.s.charAt(0);',
  6329. '$mod.b = $mod.c > $mod.s.charAt(0);',
  6330. '$mod.b = $mod.c >= $mod.s.charAt(0);',
  6331. '$mod.b = $mod.c < $mod.s.charAt(1);',
  6332. '$mod.b = $mod.c <= $mod.s.charAt(0);',
  6333. '$mod.s = rtl.setCharAt($mod.s, 0, $mod.c);',
  6334. '$mod.s = rtl.setCharAt($mod.s, (2 + 3) - 1, $mod.c);',
  6335. '']));
  6336. end;
  6337. procedure TTestModule.TestStringHMinusFail;
  6338. begin
  6339. StartProgram(false);
  6340. Add([
  6341. '{$H-}',
  6342. 'var s: string;',
  6343. 'begin']);
  6344. ConvertProgram;
  6345. CheckHint(mtWarning,nWarnIllegalCompilerDirectiveX,'Warning: test1.pp(3,6) : Illegal compiler directive "H-"');
  6346. end;
  6347. procedure TTestModule.TestStr;
  6348. begin
  6349. StartProgram(false);
  6350. Add('var');
  6351. Add(' b: boolean;');
  6352. Add(' i: longint;');
  6353. Add(' d: double;');
  6354. Add(' s: string;');
  6355. Add('begin');
  6356. Add(' str(b,s);');
  6357. Add(' str(i,s);');
  6358. Add(' str(d,s);');
  6359. Add(' str(i:3,s);');
  6360. Add(' str(d:3:2,s);');
  6361. Add(' Str(12.456:12:1,s);');
  6362. Add(' Str(12.456:12,s);');
  6363. Add(' s:=str(b);');
  6364. Add(' s:=str(i);');
  6365. Add(' s:=str(d);');
  6366. Add(' s:=str(i,i);');
  6367. Add(' s:=str(i:3);');
  6368. Add(' s:=str(d:3:2);');
  6369. Add(' s:=str(i:4,i);');
  6370. Add(' s:=str(i,i:5);');
  6371. Add(' s:=str(i:4,i:5);');
  6372. Add(' s:=str(s,s);');
  6373. Add(' s:=str(s,''foo'');');
  6374. ConvertProgram;
  6375. CheckSource('TestStr',
  6376. LinesToStr([ // statements
  6377. 'this.b = false;',
  6378. 'this.i = 0;',
  6379. 'this.d = 0.0;',
  6380. 'this.s = "";',
  6381. '']),
  6382. LinesToStr([ // this.$main
  6383. '$mod.s = ""+$mod.b;',
  6384. '$mod.s = ""+$mod.i;',
  6385. '$mod.s = rtl.floatToStr($mod.d);',
  6386. '$mod.s = rtl.spaceLeft(""+$mod.i,3);',
  6387. '$mod.s = rtl.floatToStr($mod.d,3,2);',
  6388. '$mod.s = rtl.floatToStr(12.456,12,1);',
  6389. '$mod.s = rtl.floatToStr(12.456,12);',
  6390. '$mod.s = ""+$mod.b;',
  6391. '$mod.s = ""+$mod.i;',
  6392. '$mod.s = rtl.floatToStr($mod.d);',
  6393. '$mod.s = ""+$mod.i+$mod.i;',
  6394. '$mod.s = rtl.spaceLeft(""+$mod.i,3);',
  6395. '$mod.s = rtl.floatToStr($mod.d,3,2);',
  6396. '$mod.s = rtl.spaceLeft("" + $mod.i, 4) + $mod.i;',
  6397. '$mod.s = "" + $mod.i + rtl.spaceLeft("" + $mod.i, 5);',
  6398. '$mod.s = rtl.spaceLeft("" + $mod.i, 4) + rtl.spaceLeft("" + $mod.i, 5);',
  6399. '$mod.s = $mod.s + $mod.s;',
  6400. '$mod.s = $mod.s + "foo";',
  6401. '']));
  6402. end;
  6403. procedure TTestModule.TestBaseType_AnsiStringFail;
  6404. begin
  6405. StartProgram(false);
  6406. Add('var s: AnsiString');
  6407. SetExpectedPasResolverError('identifier not found "AnsiString"',PasResolveEval.nIdentifierNotFound);
  6408. ConvertProgram;
  6409. end;
  6410. procedure TTestModule.TestBaseType_WideStringFail;
  6411. begin
  6412. StartProgram(false);
  6413. Add('var s: WideString');
  6414. SetExpectedPasResolverError('identifier not found "WideString"',PasResolveEval.nIdentifierNotFound);
  6415. ConvertProgram;
  6416. end;
  6417. procedure TTestModule.TestBaseType_ShortStringFail;
  6418. begin
  6419. StartProgram(false);
  6420. Add('var s: ShortString');
  6421. SetExpectedPasResolverError('identifier not found "ShortString"',PasResolveEval.nIdentifierNotFound);
  6422. ConvertProgram;
  6423. end;
  6424. procedure TTestModule.TestBaseType_RawByteStringFail;
  6425. begin
  6426. StartProgram(false);
  6427. Add('var s: RawByteString');
  6428. SetExpectedPasResolverError('identifier not found "RawByteString"',PasResolveEval.nIdentifierNotFound);
  6429. ConvertProgram;
  6430. end;
  6431. procedure TTestModule.TestTypeShortstring_Fail;
  6432. begin
  6433. StartProgram(false);
  6434. Add('type t = string[12];');
  6435. Add('var s: t;');
  6436. Add('begin');
  6437. SetExpectedPasResolverError('illegal qualifier "["',nIllegalQualifier);
  6438. ConvertProgram;
  6439. end;
  6440. procedure TTestModule.TestCharSet_Custom;
  6441. begin
  6442. StartProgram(false);
  6443. Add([
  6444. 'type',
  6445. ' TCharRg = ''a''..''z'';',
  6446. ' TSetOfCharRg = set of TCharRg;',
  6447. ' TCharRg2 = ''m''..''p'';',
  6448. 'const',
  6449. ' crg: TCharRg = ''b'';',
  6450. 'var',
  6451. ' c: char;',
  6452. ' crg2: TCharRg2;',
  6453. ' s: TSetOfCharRg;',
  6454. 'begin',
  6455. ' c:=crg;',
  6456. ' crg:=c;',
  6457. ' crg2:=crg;',
  6458. ' if c=crg then ;',
  6459. ' if crg=c then ;',
  6460. ' if crg=crg2 then ;',
  6461. ' if c in s then ;',
  6462. ' if crg2 in s then ;',
  6463. ' c:=default(TCharRg);',
  6464. '']);
  6465. ConvertProgram;
  6466. CheckSource('TestCharSet_Custom',
  6467. LinesToStr([ // statements
  6468. 'this.crg = "b";',
  6469. 'this.c = "";',
  6470. 'this.crg2 = "m";',
  6471. 'this.s = {};',
  6472. '']),
  6473. LinesToStr([ // this.$main
  6474. '$mod.c = $mod.crg;',
  6475. '$mod.crg = $mod.c;',
  6476. '$mod.crg2 = $mod.crg;',
  6477. 'if ($mod.c === $mod.crg) ;',
  6478. 'if ($mod.crg === $mod.c) ;',
  6479. 'if ($mod.crg === $mod.crg2) ;',
  6480. 'if ($mod.c.charCodeAt() in $mod.s) ;',
  6481. 'if ($mod.crg2.charCodeAt() in $mod.s) ;',
  6482. '$mod.c = "a";',
  6483. '']));
  6484. end;
  6485. procedure TTestModule.TestForCharDo;
  6486. begin
  6487. StartProgram(false);
  6488. Add([
  6489. 'var c: char;',
  6490. 'begin',
  6491. ' for c:=''a'' to ''c'' do ;',
  6492. ' for c:=c downto ''a'' do ;',
  6493. '']);
  6494. ConvertProgram;
  6495. CheckSource('TestForCharDo',
  6496. LinesToStr([ // statements
  6497. 'this.c = "";']),
  6498. LinesToStr([ // this.$main
  6499. 'for (var $l1 = 97; $l1 <= 99; $l1++) $mod.c = String.fromCharCode($l1);',
  6500. 'for (var $l2 = $mod.c.charCodeAt(); $l2 >= 97; $l2--) $mod.c = String.fromCharCode($l2);',
  6501. '']));
  6502. end;
  6503. procedure TTestModule.TestForCharInDo;
  6504. begin
  6505. StartProgram(false);
  6506. Add([
  6507. 'type',
  6508. ' TSetOfChar = set of char;',
  6509. ' TCharRg = ''a''..''z'';',
  6510. ' TSetOfCharRg = set of TCharRg;',
  6511. 'const Foo = ''foo'';',
  6512. 'var',
  6513. ' c,c2: char;',
  6514. ' s: string;',
  6515. ' a1: array of char;',
  6516. ' a2: array[1..3] of char;',
  6517. ' soc: TSetOfChar;',
  6518. ' socr: TSetOfCharRg;',
  6519. ' cr: TCharRg;',
  6520. 'begin',
  6521. ' for c in foo do ;',
  6522. ' for c in s do ;',
  6523. ' for c in char do ;',
  6524. ' for c in a1 do ;',
  6525. ' for c in a2 do ;',
  6526. ' for c in [''1''..''3''] do ;',
  6527. ' for c in TSetOfChar do ;',
  6528. ' for c in TCharRg do ;',
  6529. ' for c in soc do c2:=c;',
  6530. ' for c in TSetOfCharRg do ;',
  6531. ' for c in socr do ;',
  6532. ' for cr in TCharRg do ;',
  6533. ' for cr in TSetOfCharRg do ;',
  6534. ' for cr in socr do ;',
  6535. '']);
  6536. ConvertProgram;
  6537. CheckSource('TestForCharInDo',
  6538. LinesToStr([ // statements
  6539. 'this.Foo = "foo";',
  6540. 'this.c = "";',
  6541. 'this.c2 = "";',
  6542. 'this.s = "";',
  6543. 'this.a1 = [];',
  6544. 'this.a2 = rtl.arraySetLength(null, "", 3);',
  6545. 'this.soc = {};',
  6546. 'this.socr = {};',
  6547. 'this.cr = "a";',
  6548. '']),
  6549. LinesToStr([ // this.$main
  6550. 'for (var $in1 = $mod.Foo, $l2 = 0, $end3 = $in1.length - 1; $l2 <= $end3; $l2++) $mod.c = $in1.charAt($l2);',
  6551. 'for (var $in4 = $mod.s, $l5 = 0, $end6 = $in4.length - 1; $l5 <= $end6; $l5++) $mod.c = $in4.charAt($l5);',
  6552. 'for (var $l7 = 0; $l7 <= 65535; $l7++) $mod.c = String.fromCharCode($l7);',
  6553. 'for (var $in8 = $mod.a1, $l9 = 0, $end10 = rtl.length($in8) - 1; $l9 <= $end10; $l9++) $mod.c = $in8[$l9];',
  6554. 'for (var $in11 = $mod.a2, $l12 = 0, $end13 = rtl.length($in11) - 1; $l12 <= $end13; $l12++) $mod.c = $in11[$l12];',
  6555. 'for (var $l14 = 49; $l14 <= 51; $l14++) $mod.c = String.fromCharCode($l14);',
  6556. 'for (var $l15 = 0; $l15 <= 65535; $l15++) $mod.c = String.fromCharCode($l15);',
  6557. 'for (var $l16 = 97; $l16 <= 122; $l16++) $mod.c = String.fromCharCode($l16);',
  6558. 'for (var $l17 in $mod.soc) {',
  6559. ' $mod.c = String.fromCharCode($l17);',
  6560. ' $mod.c2 = $mod.c;',
  6561. '};',
  6562. 'for (var $l18 = 97; $l18 <= 122; $l18++) $mod.c = String.fromCharCode($l18);',
  6563. 'for (var $l19 in $mod.socr) $mod.c = String.fromCharCode($l19);',
  6564. 'for (var $l20 = 97; $l20 <= 122; $l20++) $mod.cr = String.fromCharCode($l20);',
  6565. 'for (var $l21 = 97; $l21 <= 122; $l21++) $mod.cr = String.fromCharCode($l21);',
  6566. 'for (var $l22 in $mod.socr) $mod.cr = String.fromCharCode($l22);',
  6567. '']));
  6568. end;
  6569. procedure TTestModule.TestProcTwoArgs;
  6570. begin
  6571. StartProgram(false);
  6572. Add('procedure Test(a,b: longint);');
  6573. Add('begin');
  6574. Add('end;');
  6575. Add('begin');
  6576. ConvertProgram;
  6577. CheckSource('TestProcTwoArgs',
  6578. LinesToStr([ // statements
  6579. 'this.Test = function (a,b) {',
  6580. '};'
  6581. ]),
  6582. LinesToStr([ // this.$main
  6583. ''
  6584. ]));
  6585. end;
  6586. procedure TTestModule.TestProc_DefaultValue;
  6587. begin
  6588. StartProgram(false);
  6589. Add('procedure p1(i: longint = 1);');
  6590. Add('begin');
  6591. Add('end;');
  6592. Add('procedure p2(i: longint = 1; c: char = ''a'');');
  6593. Add('begin');
  6594. Add('end;');
  6595. Add('procedure p3(d: double = 1.0; b: boolean = false; s: string = ''abc'');');
  6596. Add('begin');
  6597. Add('end;');
  6598. Add('begin');
  6599. Add(' p1;');
  6600. Add(' p1();');
  6601. Add(' p1(11);');
  6602. Add(' p2;');
  6603. Add(' p2();');
  6604. Add(' p2(12);');
  6605. Add(' p2(13,''b'');');
  6606. Add(' p3();');
  6607. ConvertProgram;
  6608. CheckSource('TestProc_DefaultValue',
  6609. LinesToStr([ // statements
  6610. 'this.p1 = function (i) {',
  6611. '};',
  6612. 'this.p2 = function (i,c) {',
  6613. '};',
  6614. 'this.p3 = function (d,b,s) {',
  6615. '};'
  6616. ]),
  6617. LinesToStr([ // this.$main
  6618. ' $mod.p1(1);',
  6619. ' $mod.p1(1);',
  6620. ' $mod.p1(11);',
  6621. ' $mod.p2(1,"a");',
  6622. ' $mod.p2(1,"a");',
  6623. ' $mod.p2(12,"a");',
  6624. ' $mod.p2(13,"b");',
  6625. ' $mod.p3(1.0,false,"abc");'
  6626. ]));
  6627. end;
  6628. procedure TTestModule.TestFunctionInt;
  6629. begin
  6630. StartProgram(false);
  6631. Add('function MyTest(Bar: longint): longint;');
  6632. Add('begin');
  6633. Add(' Result:=2*bar');
  6634. Add('end;');
  6635. Add('begin');
  6636. ConvertProgram;
  6637. CheckSource('TestFunctionInt',
  6638. LinesToStr([ // statements
  6639. 'this.MyTest = function (Bar) {',
  6640. ' var Result = 0;',
  6641. ' Result = 2*Bar;',
  6642. ' return Result;',
  6643. '};'
  6644. ]),
  6645. LinesToStr([ // this.$main
  6646. ''
  6647. ]));
  6648. end;
  6649. procedure TTestModule.TestFunctionString;
  6650. begin
  6651. StartProgram(false);
  6652. Add('function Test(Bar: string): string;');
  6653. Add('begin');
  6654. Add(' Result:=bar+BAR');
  6655. Add('end;');
  6656. Add('begin');
  6657. ConvertProgram;
  6658. CheckSource('TestFunctionString',
  6659. LinesToStr([ // statements
  6660. 'this.Test = function (Bar) {',
  6661. ' var Result = "";',
  6662. ' Result = Bar+Bar;',
  6663. ' return Result;',
  6664. '};'
  6665. ]),
  6666. LinesToStr([ // this.$main
  6667. ''
  6668. ]));
  6669. end;
  6670. procedure TTestModule.TestIfThen;
  6671. begin
  6672. StartProgram(false);
  6673. Add([
  6674. 'var b: boolean;',
  6675. 'begin',
  6676. ' if b then ;',
  6677. ' if b then else ;']);
  6678. ConvertProgram;
  6679. CheckSource('TestIfThen',
  6680. LinesToStr([ // statements
  6681. 'this.b = false;',
  6682. '']),
  6683. LinesToStr([ // this.$main
  6684. 'if ($mod.b) ;',
  6685. 'if ($mod.b) ;',
  6686. '']));
  6687. end;
  6688. procedure TTestModule.TestForLoop;
  6689. begin
  6690. StartProgram(false);
  6691. Add('var');
  6692. Add(' vI, vJ, vN: longint;');
  6693. Add('begin');
  6694. Add(' VJ:=0;');
  6695. Add(' VN:=3;');
  6696. Add(' for VI:=1 to VN do');
  6697. Add(' begin');
  6698. Add(' VJ:=VJ+VI;');
  6699. Add(' end;');
  6700. ConvertProgram;
  6701. CheckSource('TestForLoop',
  6702. LinesToStr([ // statements
  6703. 'this.vI = 0;',
  6704. 'this.vJ = 0;',
  6705. 'this.vN = 0;'
  6706. ]),
  6707. LinesToStr([ // this.$main
  6708. ' $mod.vJ = 0;',
  6709. ' $mod.vN = 3;',
  6710. ' for (var $l1 = 1, $end2 = $mod.vN; $l1 <= $end2; $l1++) {',
  6711. ' $mod.vI = $l1;',
  6712. ' $mod.vJ = $mod.vJ + $mod.vI;',
  6713. ' };',
  6714. '']));
  6715. end;
  6716. procedure TTestModule.TestForLoopInsideFunction;
  6717. begin
  6718. StartProgram(false);
  6719. Add('function SumNumbers(Count: longint): longint;');
  6720. Add('var');
  6721. Add(' vI, vJ: longint;');
  6722. Add('begin');
  6723. Add(' vj:=0;');
  6724. Add(' for vi:=1 to count do');
  6725. Add(' begin');
  6726. Add(' vj:=vj+vi;');
  6727. Add(' end;');
  6728. Add('end;');
  6729. Add('begin');
  6730. Add(' sumnumbers(3);');
  6731. ConvertProgram;
  6732. CheckSource('TestForLoopInsideFunction',
  6733. LinesToStr([ // statements
  6734. 'this.SumNumbers = function (Count) {',
  6735. ' var Result = 0;',
  6736. ' var vI = 0;',
  6737. ' var vJ = 0;',
  6738. ' vJ = 0;',
  6739. ' for (var $l1 = 1, $end2 = Count; $l1 <= $end2; $l1++) {',
  6740. ' vI = $l1;',
  6741. ' vJ = vJ + vI;',
  6742. ' };',
  6743. ' return Result;',
  6744. '};'
  6745. ]),
  6746. LinesToStr([ // $mod.$main
  6747. ' $mod.SumNumbers(3);'
  6748. ]));
  6749. end;
  6750. procedure TTestModule.TestForLoop_ReadVarAfter;
  6751. begin
  6752. StartProgram(false);
  6753. Add('var');
  6754. Add(' vI: longint;');
  6755. Add('begin');
  6756. Add(' for vi:=1 to 2 do ;');
  6757. Add(' if vi=3 then ;');
  6758. ConvertProgram;
  6759. CheckSource('TestForLoop',
  6760. LinesToStr([ // statements
  6761. 'this.vI = 0;'
  6762. ]),
  6763. LinesToStr([ // this.$main
  6764. ' for ($mod.vI = 1; $mod.vI <= 2; $mod.vI++) ;',
  6765. ' if ($mod.vI===3) ;'
  6766. ]));
  6767. end;
  6768. procedure TTestModule.TestForLoop_Nested;
  6769. begin
  6770. StartProgram(false);
  6771. Add('function SumNumbers(Count: longint): longint;');
  6772. Add('var');
  6773. Add(' vI, vJ, vK: longint;');
  6774. Add('begin');
  6775. Add(' VK:=0;');
  6776. Add(' for VI:=1 to count do');
  6777. Add(' begin');
  6778. Add(' for vj:=1 to vi do');
  6779. Add(' begin');
  6780. Add(' vk:=VK+VI;');
  6781. Add(' end;');
  6782. Add(' end;');
  6783. Add('end;');
  6784. Add('begin');
  6785. Add(' sumnumbers(3);');
  6786. ConvertProgram;
  6787. CheckSource('TestForLoopInFunction',
  6788. LinesToStr([ // statements
  6789. 'this.SumNumbers = function (Count) {',
  6790. ' var Result = 0;',
  6791. ' var vI = 0;',
  6792. ' var vJ = 0;',
  6793. ' var vK = 0;',
  6794. ' vK = 0;',
  6795. ' for (var $l1 = 1, $end2 = Count; $l1 <= $end2; $l1++) {',
  6796. ' vI = $l1;',
  6797. ' for (var $l3 = 1, $end4 = vI; $l3 <= $end4; $l3++) {',
  6798. ' vJ = $l3;',
  6799. ' vK = vK + vI;',
  6800. ' };',
  6801. ' };',
  6802. ' return Result;',
  6803. '};'
  6804. ]),
  6805. LinesToStr([ // $mod.$main
  6806. ' $mod.SumNumbers(3);'
  6807. ]));
  6808. end;
  6809. procedure TTestModule.TestRepeatUntil;
  6810. begin
  6811. StartProgram(false);
  6812. Add('var');
  6813. Add(' vI, vJ, vN: longint;');
  6814. Add('begin');
  6815. Add(' vn:=3;');
  6816. Add(' vj:=0;');
  6817. Add(' VI:=0;');
  6818. Add(' repeat');
  6819. Add(' VI:=vi+1;');
  6820. Add(' vj:=VJ+vI;');
  6821. Add(' until vi>=vn');
  6822. ConvertProgram;
  6823. CheckSource('TestRepeatUntil',
  6824. LinesToStr([ // statements
  6825. 'this.vI = 0;',
  6826. 'this.vJ = 0;',
  6827. 'this.vN = 0;'
  6828. ]),
  6829. LinesToStr([ // $mod.$main
  6830. ' $mod.vN = 3;',
  6831. ' $mod.vJ = 0;',
  6832. ' $mod.vI = 0;',
  6833. ' do{',
  6834. ' $mod.vI = $mod.vI + 1;',
  6835. ' $mod.vJ = $mod.vJ + $mod.vI;',
  6836. ' }while(!($mod.vI>=$mod.vN));'
  6837. ]));
  6838. end;
  6839. procedure TTestModule.TestAsmBlock;
  6840. begin
  6841. StartProgram(false);
  6842. Add([
  6843. 'var',
  6844. ' vI: longint;',
  6845. 'begin',
  6846. ' vi:=1;',
  6847. ' asm',
  6848. ' if (vI===1) {',
  6849. ' vI=2;',
  6850. //' console.log(''end;'');', ToDo
  6851. ' }',
  6852. ' if (vI===2){ vI=3; }',
  6853. ' end;',
  6854. ' VI:=4;']);
  6855. ConvertProgram;
  6856. CheckSource('TestAsmBlock',
  6857. LinesToStr([ // statements
  6858. 'this.vI = 0;'
  6859. ]),
  6860. LinesToStr([ // $mod.$main
  6861. '$mod.vI = 1;',
  6862. 'if (vI===1) {',
  6863. ' vI=2;',
  6864. '}',
  6865. 'if (vI===2){ vI=3; }',
  6866. ';',
  6867. '$mod.vI = 4;'
  6868. ]));
  6869. end;
  6870. procedure TTestModule.TestAsmPas_Impl;
  6871. begin
  6872. StartUnit(false);
  6873. Add('interface');
  6874. Add('const cIntf: longint = 1;');
  6875. Add('var vIntf: longint;');
  6876. Add('implementation');
  6877. Add('const cImpl: longint = 2;');
  6878. Add('var vImpl: longint;');
  6879. Add('procedure DoIt;');
  6880. Add('const cLoc: longint = 3;');
  6881. Add('var vLoc: longint;');
  6882. Add('begin;');
  6883. Add(' asm');
  6884. //Add(' pas(vIntf)=pas(cIntf);');
  6885. //Add(' pas(vImpl)=pas(cImpl);');
  6886. //Add(' pas(vLoc)=pas(cLoc);');
  6887. Add(' end;');
  6888. Add('end;');
  6889. ConvertUnit;
  6890. CheckSource('TestAsmPas_Impl',
  6891. LinesToStr([
  6892. 'var $impl = $mod.$impl;',
  6893. 'this.cIntf = 1;',
  6894. 'this.vIntf = 0;',
  6895. '']),
  6896. '', // this.$init
  6897. LinesToStr([ // implementation
  6898. '$impl.cImpl = 2;',
  6899. '$impl.vImpl = 0;',
  6900. 'var cLoc = 3;',
  6901. '$impl.DoIt = function () {',
  6902. ' var vLoc = 0;',
  6903. '};',
  6904. '']) );
  6905. end;
  6906. procedure TTestModule.TestTryFinally;
  6907. begin
  6908. StartProgram(false);
  6909. Add('var i: longint;');
  6910. Add('begin');
  6911. Add(' try');
  6912. Add(' i:=0; i:=2 div i;');
  6913. Add(' finally');
  6914. Add(' i:=3');
  6915. Add(' end;');
  6916. ConvertProgram;
  6917. CheckSource('TestTryFinally',
  6918. LinesToStr([ // statements
  6919. 'this.i = 0;'
  6920. ]),
  6921. LinesToStr([ // $mod.$main
  6922. 'try {',
  6923. ' $mod.i = 0;',
  6924. ' $mod.i = Math.floor(2 / $mod.i);',
  6925. '} finally {',
  6926. ' $mod.i = 3;',
  6927. '};'
  6928. ]));
  6929. end;
  6930. procedure TTestModule.TestTryExcept;
  6931. begin
  6932. StartProgram(false);
  6933. Add('type');
  6934. Add(' TObject = class end;');
  6935. Add(' Exception = class Msg: string; end;');
  6936. Add(' EInvalidCast = class(Exception) end;');
  6937. Add('var vI: longint;');
  6938. Add('begin');
  6939. Add(' try');
  6940. Add(' vi:=1;');
  6941. Add(' except');
  6942. Add(' vi:=2');
  6943. Add(' end;');
  6944. Add(' try');
  6945. Add(' vi:=3;');
  6946. Add(' except');
  6947. Add(' raise;');
  6948. Add(' end;');
  6949. Add(' try');
  6950. Add(' VI:=4;');
  6951. Add(' except');
  6952. Add(' on einvalidcast do');
  6953. Add(' raise;');
  6954. Add(' on E: exception do');
  6955. Add(' if e.msg='''' then');
  6956. Add(' raise e;');
  6957. Add(' else');
  6958. Add(' vi:=5');
  6959. Add(' end;');
  6960. Add(' try');
  6961. Add(' VI:=6;');
  6962. Add(' except');
  6963. Add(' on einvalidcast do ;');
  6964. Add(' end;');
  6965. ConvertProgram;
  6966. CheckSource('TestTryExcept',
  6967. LinesToStr([ // statements
  6968. 'rtl.createClass($mod, "TObject", null, function () {',
  6969. ' this.$init = function () {',
  6970. ' };',
  6971. ' this.$final = function () {',
  6972. ' };',
  6973. '});',
  6974. 'rtl.createClass($mod, "Exception", $mod.TObject, function () {',
  6975. ' this.$init = function () {',
  6976. ' $mod.TObject.$init.call(this);',
  6977. ' this.Msg = "";',
  6978. ' };',
  6979. '});',
  6980. 'rtl.createClass($mod, "EInvalidCast", $mod.Exception, function () {',
  6981. '});',
  6982. 'this.vI = 0;'
  6983. ]),
  6984. LinesToStr([ // $mod.$main
  6985. 'try {',
  6986. ' $mod.vI = 1;',
  6987. '} catch ($e) {',
  6988. ' $mod.vI = 2;',
  6989. '};',
  6990. 'try {',
  6991. ' $mod.vI = 3;',
  6992. '} catch ($e) {',
  6993. ' throw $e;',
  6994. '};',
  6995. 'try {',
  6996. ' $mod.vI = 4;',
  6997. '} catch ($e) {',
  6998. ' if ($mod.EInvalidCast.isPrototypeOf($e)){',
  6999. ' throw $e',
  7000. ' } else if ($mod.Exception.isPrototypeOf($e)) {',
  7001. ' var E = $e;',
  7002. ' if (E.Msg === "") throw E;',
  7003. ' } else {',
  7004. ' $mod.vI = 5;',
  7005. ' }',
  7006. '};',
  7007. 'try {',
  7008. ' $mod.vI = 6;',
  7009. '} catch ($e) {',
  7010. ' if ($mod.EInvalidCast.isPrototypeOf($e)){' ,
  7011. ' } else throw $e',
  7012. '};',
  7013. '']));
  7014. end;
  7015. procedure TTestModule.TestTryExcept_ReservedWords;
  7016. begin
  7017. StartProgram(false);
  7018. Add([
  7019. 'type',
  7020. ' TObject = class end;',
  7021. ' Exception = class',
  7022. ' Symbol: string;',
  7023. ' end;',
  7024. 'var &try: longint;',
  7025. 'begin',
  7026. ' try',
  7027. ' &try:=4;',
  7028. ' except',
  7029. ' on Error: exception do',
  7030. ' if errOR.symBol='''' then',
  7031. ' raise ERRor;',
  7032. ' end;',
  7033. '']);
  7034. ConvertProgram;
  7035. CheckSource('TestTryExcept_ReservedWords',
  7036. LinesToStr([ // statements
  7037. 'rtl.createClass($mod, "TObject", null, function () {',
  7038. ' this.$init = function () {',
  7039. ' };',
  7040. ' this.$final = function () {',
  7041. ' };',
  7042. '});',
  7043. 'rtl.createClass($mod, "Exception", $mod.TObject, function () {',
  7044. ' this.$init = function () {',
  7045. ' $mod.TObject.$init.call(this);',
  7046. ' this.Symbol = "";',
  7047. ' };',
  7048. '});',
  7049. 'this.Try = 0;',
  7050. '']),
  7051. LinesToStr([ // $mod.$main
  7052. 'try {',
  7053. ' $mod.Try = 4;',
  7054. '} catch ($e) {',
  7055. ' if ($mod.Exception.isPrototypeOf($e)) {',
  7056. ' var error = $e;',
  7057. ' if (error.Symbol === "") throw error;',
  7058. ' } else throw $e',
  7059. '};',
  7060. '']));
  7061. end;
  7062. procedure TTestModule.TestIfThenRaiseElse;
  7063. begin
  7064. StartProgram(false);
  7065. Add([
  7066. 'type',
  7067. ' TObject = class',
  7068. ' constructor Create;',
  7069. ' end;',
  7070. 'constructor TObject.Create;',
  7071. 'begin',
  7072. 'end;',
  7073. 'var b: boolean;',
  7074. 'begin',
  7075. ' if b then',
  7076. ' raise TObject.Create',
  7077. ' else',
  7078. ' b:=false;',
  7079. '']);
  7080. ConvertProgram;
  7081. CheckSource('TestIfThenRaiseElse',
  7082. LinesToStr([ // statements
  7083. 'rtl.createClass($mod, "TObject", null, function () {',
  7084. ' this.$init = function () {',
  7085. ' };',
  7086. ' this.$final = function () {',
  7087. ' };',
  7088. ' this.Create = function () {',
  7089. ' };',
  7090. '});',
  7091. 'this.b = false;',
  7092. '']),
  7093. LinesToStr([ // $mod.$main
  7094. 'if ($mod.b) {',
  7095. ' throw $mod.TObject.$create("Create")}',
  7096. ' else $mod.b = false;',
  7097. '']));
  7098. end;
  7099. procedure TTestModule.TestCaseOf;
  7100. begin
  7101. StartProgram(false);
  7102. Add([
  7103. 'const e: longint; external name ''$e'';',
  7104. 'var vI: longint;',
  7105. 'begin',
  7106. ' case vi of',
  7107. ' 1: ;',
  7108. ' 2: vi:=3;',
  7109. ' e: ;',
  7110. ' else',
  7111. ' VI:=4',
  7112. ' end;']);
  7113. ConvertProgram;
  7114. CheckSource('TestCaseOf',
  7115. LinesToStr([ // statements
  7116. 'this.vI = 0;'
  7117. ]),
  7118. LinesToStr([ // $mod.$main
  7119. 'var $tmp1 = $mod.vI;',
  7120. 'if ($tmp1 === 1) {}',
  7121. 'else if ($tmp1 === 2) {',
  7122. ' $mod.vI = 3}',
  7123. ' else if ($tmp1 === $e) {}',
  7124. 'else {',
  7125. ' $mod.vI = 4;',
  7126. '};'
  7127. ]));
  7128. end;
  7129. procedure TTestModule.TestCaseOf_UseSwitch;
  7130. begin
  7131. StartProgram(false);
  7132. Converter.UseSwitchStatement:=true;
  7133. Add('var Vi: longint;');
  7134. Add('begin');
  7135. Add(' case vi of');
  7136. Add(' 1: ;');
  7137. Add(' 2: VI:=3;');
  7138. Add(' else');
  7139. Add(' vi:=4');
  7140. Add(' end;');
  7141. ConvertProgram;
  7142. CheckSource('TestCaseOf_UseSwitch',
  7143. LinesToStr([ // statements
  7144. 'this.Vi = 0;'
  7145. ]),
  7146. LinesToStr([ // $mod.$main
  7147. 'switch ($mod.Vi) {',
  7148. 'case 1:',
  7149. ' break;',
  7150. 'case 2:',
  7151. ' $mod.Vi = 3;',
  7152. ' break;',
  7153. 'default:',
  7154. ' $mod.Vi = 4;',
  7155. '};'
  7156. ]));
  7157. end;
  7158. procedure TTestModule.TestCaseOfNoElse;
  7159. begin
  7160. StartProgram(false);
  7161. Add('var Vi: longint;');
  7162. Add('begin');
  7163. Add(' case vi of');
  7164. Add(' 1: begin vi:=2; VI:=3; end;');
  7165. Add(' end;');
  7166. ConvertProgram;
  7167. CheckSource('TestCaseOfNoElse',
  7168. LinesToStr([ // statements
  7169. 'this.Vi = 0;'
  7170. ]),
  7171. LinesToStr([ // $mod.$main
  7172. 'var $tmp1 = $mod.Vi;',
  7173. 'if ($tmp1 === 1) {',
  7174. ' $mod.Vi = 2;',
  7175. ' $mod.Vi = 3;',
  7176. '};'
  7177. ]));
  7178. end;
  7179. procedure TTestModule.TestCaseOfNoElse_UseSwitch;
  7180. begin
  7181. StartProgram(false);
  7182. Converter.UseSwitchStatement:=true;
  7183. Add('var vI: longint;');
  7184. Add('begin');
  7185. Add(' case vi of');
  7186. Add(' 1: begin VI:=2; vi:=3; end;');
  7187. Add(' end;');
  7188. ConvertProgram;
  7189. CheckSource('TestCaseOfNoElse_UseSwitch',
  7190. LinesToStr([ // statements
  7191. 'this.vI = 0;'
  7192. ]),
  7193. LinesToStr([ // $mod.$main
  7194. 'switch ($mod.vI) {',
  7195. 'case 1:',
  7196. ' $mod.vI = 2;',
  7197. ' $mod.vI = 3;',
  7198. ' break;',
  7199. '};'
  7200. ]));
  7201. end;
  7202. procedure TTestModule.TestCaseOfRange;
  7203. begin
  7204. StartProgram(false);
  7205. Add('var vI: longint;');
  7206. Add('begin');
  7207. Add(' case vi of');
  7208. Add(' 1..3: vi:=14;');
  7209. Add(' 4,5: vi:=16;');
  7210. Add(' 6..7,9..10: ;');
  7211. Add(' else ;');
  7212. Add(' end;');
  7213. ConvertProgram;
  7214. CheckSource('TestCaseOfRange',
  7215. LinesToStr([ // statements
  7216. 'this.vI = 0;'
  7217. ]),
  7218. LinesToStr([ // $mod.$main
  7219. 'var $tmp1 = $mod.vI;',
  7220. 'if (($tmp1 >= 1) && ($tmp1 <= 3)){',
  7221. ' $mod.vI = 14',
  7222. '} else if (($tmp1 === 4) || ($tmp1 === 5)){',
  7223. ' $mod.vI = 16',
  7224. '} else if ((($tmp1 >= 6) && ($tmp1 <= 7)) || (($tmp1 >= 9) && ($tmp1 <= 10))) ;'
  7225. ]));
  7226. end;
  7227. procedure TTestModule.TestCaseOfString;
  7228. begin
  7229. StartProgram(false);
  7230. Add([
  7231. 'var s,h: string;',
  7232. 'begin',
  7233. ' case s of',
  7234. ' ''foo'': s:=h;',
  7235. ' ''a''..''z'': h:=s;',
  7236. ' end;',
  7237. '']);
  7238. ConvertProgram;
  7239. CheckSource('TestCaseOfString',
  7240. LinesToStr([ // statements
  7241. 'this.s = "";',
  7242. 'this.h = "";',
  7243. '']),
  7244. LinesToStr([ // $mod.$main
  7245. 'var $tmp1 = $mod.s;',
  7246. 'if ($tmp1 === "foo") {',
  7247. ' $mod.s = $mod.h}',
  7248. ' else if (($tmp1.length === 1) && ($tmp1 >= "a") && ($tmp1 <= "z")) $mod.h = $mod.s;',
  7249. '']));
  7250. end;
  7251. procedure TTestModule.TestCaseOfExternalClassConst;
  7252. begin
  7253. StartProgram(false);
  7254. Add([
  7255. '{$modeswitch externalclass}',
  7256. 'type',
  7257. ' TBird = class external name ''Bird''',
  7258. ' const e: longint;',
  7259. ' end;',
  7260. 'var vI: longint;',
  7261. 'begin',
  7262. ' case vi of',
  7263. ' 1: vi:=3;',
  7264. ' TBird.e: ;',
  7265. ' end;']);
  7266. ConvertProgram;
  7267. CheckSource('TestCaseOfExternalClassConst',
  7268. LinesToStr([ // statements
  7269. 'this.vI = 0;'
  7270. ]),
  7271. LinesToStr([ // $mod.$main
  7272. 'var $tmp1 = $mod.vI;',
  7273. 'if ($tmp1 === 1) {',
  7274. ' $mod.vI = 3}',
  7275. ' else if ($tmp1 === Bird.e) ;'
  7276. ]));
  7277. end;
  7278. procedure TTestModule.TestDebugger;
  7279. begin
  7280. StartProgram(false);
  7281. Add([
  7282. 'procedure DoIt;',
  7283. 'begin',
  7284. ' deBugger;',
  7285. ' DeBugger();',
  7286. 'end;',
  7287. 'begin',
  7288. ' Debugger;']);
  7289. ConvertProgram;
  7290. CheckSource('TestDebugger',
  7291. LinesToStr([ // statements
  7292. 'this.DoIt = function () {',
  7293. ' debugger;',
  7294. ' debugger;',
  7295. '};',
  7296. '']),
  7297. LinesToStr([ // $mod.$main
  7298. 'debugger;',
  7299. '']));
  7300. end;
  7301. procedure TTestModule.TestArray_Dynamic;
  7302. begin
  7303. StartProgram(false);
  7304. Add(['type',
  7305. ' TArrayInt = array of longint;',
  7306. 'var',
  7307. ' Arr: TArrayInt;',
  7308. ' i: longint;',
  7309. ' b: boolean;',
  7310. 'begin',
  7311. ' SetLength(arr,3);',
  7312. ' arr[0]:=4;',
  7313. ' arr[1]:=length(arr)+arr[0];',
  7314. ' arr[i]:=5;',
  7315. ' arr[arr[i]]:=arr[6];',
  7316. ' i:=low(arr);',
  7317. ' i:=high(arr);',
  7318. ' b:=Assigned(arr);',
  7319. ' Arr:=default(TArrayInt);']);
  7320. ConvertProgram;
  7321. CheckSource('TestArray_Dynamic',
  7322. LinesToStr([ // statements
  7323. 'this.Arr = [];',
  7324. 'this.i = 0;',
  7325. 'this.b = false;'
  7326. ]),
  7327. LinesToStr([ // $mod.$main
  7328. '$mod.Arr = rtl.arraySetLength($mod.Arr,0,3);',
  7329. '$mod.Arr[0] = 4;',
  7330. '$mod.Arr[1] = rtl.length($mod.Arr) + $mod.Arr[0];',
  7331. '$mod.Arr[$mod.i] = 5;',
  7332. '$mod.Arr[$mod.Arr[$mod.i]] = $mod.Arr[6];',
  7333. '$mod.i = 0;',
  7334. '$mod.i = rtl.length($mod.Arr) - 1;',
  7335. '$mod.b = rtl.length($mod.Arr) > 0;',
  7336. '$mod.Arr = [];',
  7337. '']));
  7338. end;
  7339. procedure TTestModule.TestArray_Dynamic_Nil;
  7340. begin
  7341. StartProgram(false);
  7342. Add('type');
  7343. Add(' TArrayInt = array of longint;');
  7344. Add('var');
  7345. Add(' Arr: TArrayInt;');
  7346. Add('procedure DoIt(const i: TArrayInt; j: TArrayInt); begin end;');
  7347. Add('begin');
  7348. Add(' arr:=nil;');
  7349. Add(' if arr=nil then;');
  7350. Add(' if nil=arr then;');
  7351. Add(' if arr<>nil then;');
  7352. Add(' if nil<>arr then;');
  7353. Add(' DoIt(nil,nil);');
  7354. ConvertProgram;
  7355. CheckSource('TestArray_Dynamic',
  7356. LinesToStr([ // statements
  7357. 'this.Arr = [];',
  7358. 'this.DoIt = function(i,j){',
  7359. '};'
  7360. ]),
  7361. LinesToStr([ // $mod.$main
  7362. '$mod.Arr = [];',
  7363. 'if (rtl.length($mod.Arr) === 0) ;',
  7364. 'if (rtl.length($mod.Arr) === 0) ;',
  7365. 'if (rtl.length($mod.Arr) > 0) ;',
  7366. 'if (rtl.length($mod.Arr) > 0) ;',
  7367. '$mod.DoIt([],[]);',
  7368. '']));
  7369. end;
  7370. procedure TTestModule.TestArray_DynMultiDimensional;
  7371. begin
  7372. StartProgram(false);
  7373. Add('type');
  7374. Add(' TArrayInt = array of longint;');
  7375. Add(' TArrayArrayInt = array of TArrayInt;');
  7376. Add('var');
  7377. Add(' Arr: TArrayInt;');
  7378. Add(' Arr2: TArrayArrayInt;');
  7379. Add(' i: longint;');
  7380. Add('begin');
  7381. Add(' arr2:=nil;');
  7382. Add(' if arr2=nil then;');
  7383. Add(' if nil=arr2 then;');
  7384. Add(' i:=low(arr2);');
  7385. Add(' i:=low(arr2[1]);');
  7386. Add(' i:=high(arr2);');
  7387. Add(' i:=high(arr2[2]);');
  7388. Add(' arr2[3]:=arr;');
  7389. Add(' arr2[4][5]:=i;');
  7390. Add(' i:=arr2[6][7];');
  7391. Add(' arr2[8,9]:=i;');
  7392. Add(' i:=arr2[10,11];');
  7393. Add(' SetLength(arr2,14);');
  7394. Add(' SetLength(arr2[15],16);');
  7395. ConvertProgram;
  7396. CheckSource('TestArray_Dynamic',
  7397. LinesToStr([ // statements
  7398. 'this.Arr = [];',
  7399. 'this.Arr2 = [];',
  7400. 'this.i = 0;'
  7401. ]),
  7402. LinesToStr([ // $mod.$main
  7403. '$mod.Arr2 = [];',
  7404. 'if (rtl.length($mod.Arr2) === 0) ;',
  7405. 'if (rtl.length($mod.Arr2) === 0) ;',
  7406. '$mod.i = 0;',
  7407. '$mod.i = 0;',
  7408. '$mod.i = rtl.length($mod.Arr2) - 1;',
  7409. '$mod.i = rtl.length($mod.Arr2[2]) - 1;',
  7410. '$mod.Arr2[3] = $mod.Arr;',
  7411. '$mod.Arr2[4][5] = $mod.i;',
  7412. '$mod.i = $mod.Arr2[6][7];',
  7413. '$mod.Arr2[8][9] = $mod.i;',
  7414. '$mod.i = $mod.Arr2[10][11];',
  7415. '$mod.Arr2 = rtl.arraySetLength($mod.Arr2, [], 14);',
  7416. '$mod.Arr2[15] = rtl.arraySetLength($mod.Arr2[15], 0, 16);',
  7417. '']));
  7418. end;
  7419. procedure TTestModule.TestArray_StaticInt;
  7420. begin
  7421. StartProgram(false);
  7422. Add('type');
  7423. Add(' TArrayInt = array[2..4] of longint;');
  7424. Add('var');
  7425. Add(' Arr: TArrayInt;');
  7426. Add(' Arr2: TArrayInt = (5,6,7);');
  7427. Add(' i: longint;');
  7428. Add(' b: boolean;');
  7429. Add('begin');
  7430. Add(' arr[2]:=4;');
  7431. Add(' arr[3]:=arr[2]+arr[3];');
  7432. Add(' arr[i]:=5;');
  7433. Add(' arr[arr[i]]:=arr[high(arr)];');
  7434. Add(' i:=low(arr);');
  7435. Add(' i:=high(arr);');
  7436. Add(' b:=arr[2]=arr[3];');
  7437. Add(' arr:=default(TArrayInt);');
  7438. ConvertProgram;
  7439. CheckSource('TestArray_StaticInt',
  7440. LinesToStr([ // statements
  7441. 'this.Arr = rtl.arraySetLength(null,0,3);',
  7442. 'this.Arr2 = [5, 6, 7];',
  7443. 'this.i = 0;',
  7444. 'this.b = false;'
  7445. ]),
  7446. LinesToStr([ // $mod.$main
  7447. '$mod.Arr[0] = 4;',
  7448. '$mod.Arr[1] = $mod.Arr[0] + $mod.Arr[1];',
  7449. '$mod.Arr[$mod.i-2] = 5;',
  7450. '$mod.Arr[$mod.Arr[$mod.i-2]-2] = $mod.Arr[2];',
  7451. '$mod.i = 2;',
  7452. '$mod.i = 4;',
  7453. '$mod.b = $mod.Arr[0] === $mod.Arr[1];',
  7454. '$mod.Arr = rtl.arraySetLength(null,0,3).slice(0);',
  7455. '']));
  7456. end;
  7457. procedure TTestModule.TestArray_StaticBool;
  7458. begin
  7459. StartProgram(false);
  7460. Add('type');
  7461. Add(' TBools = array[boolean] of boolean;');
  7462. Add(' TBool2 = array[true..true] of boolean;');
  7463. Add('var');
  7464. Add(' Arr: TBools;');
  7465. Add(' Arr2: TBool2;');
  7466. Add(' Arr3: TBools = (true,false);');
  7467. Add(' b: boolean;');
  7468. Add('begin');
  7469. Add(' b:=low(arr);');
  7470. Add(' b:=high(arr);');
  7471. Add(' arr[true]:=false;');
  7472. Add(' arr[false]:=arr[b] or arr[true];');
  7473. Add(' arr[b]:=true;');
  7474. Add(' arr[arr[b]]:=arr[high(arr)];');
  7475. Add(' b:=arr[false]=arr[true];');
  7476. Add(' b:=low(arr2);');
  7477. Add(' b:=high(arr2);');
  7478. Add(' arr2[true]:=true;');
  7479. Add(' arr2[true]:=arr2[true] and arr2[b];');
  7480. Add(' arr2[b]:=false;');
  7481. ConvertProgram;
  7482. CheckSource('TestArray_StaticBool',
  7483. LinesToStr([ // statements
  7484. 'this.Arr = rtl.arraySetLength(null,false,2);',
  7485. 'this.Arr2 = rtl.arraySetLength(null,false,1);',
  7486. 'this.Arr3 = [true, false];',
  7487. 'this.b = false;'
  7488. ]),
  7489. LinesToStr([ // $mod.$main
  7490. '$mod.b = false;',
  7491. '$mod.b = true;',
  7492. '$mod.Arr[1] = false;',
  7493. '$mod.Arr[0] = $mod.Arr[+$mod.b] || $mod.Arr[1];',
  7494. '$mod.Arr[+$mod.b] = true;',
  7495. '$mod.Arr[+$mod.Arr[+$mod.b]] = $mod.Arr[1];',
  7496. '$mod.b = $mod.Arr[0] === $mod.Arr[1];',
  7497. '$mod.b = true;',
  7498. '$mod.b = true;',
  7499. '$mod.Arr2[0] = true;',
  7500. '$mod.Arr2[0] = $mod.Arr2[0] && $mod.Arr2[1-$mod.b];',
  7501. '$mod.Arr2[1-$mod.b] = false;',
  7502. '']));
  7503. end;
  7504. procedure TTestModule.TestArray_StaticChar;
  7505. begin
  7506. StartProgram(false);
  7507. Add([
  7508. 'type',
  7509. ' TChars = array[char] of char;',
  7510. ' TChars2 = array[''a''..''z''] of char;',
  7511. 'var',
  7512. ' Arr: TChars;',
  7513. ' Arr2: TChars2;',
  7514. ' Arr3: array[2..4] of char = (''p'',''a'',''s'');',
  7515. ' Arr4: array[11..13] of char = ''pas'';',
  7516. ' Arr5: array[21..22] of char = ''äö'';',
  7517. ' Arr6: array[31..32] of char = ''ä''+''ö'';',
  7518. ' c: char;',
  7519. ' b: boolean;',
  7520. 'begin',
  7521. ' c:=low(arr);',
  7522. ' c:=high(arr);',
  7523. ' arr[''B'']:=''a'';',
  7524. ' arr[''D'']:=arr[c];',
  7525. ' arr[c]:=arr[''d''];',
  7526. ' arr[arr[c]]:=arr[high(arr)];',
  7527. ' b:=arr[low(arr)]=arr[''e''];',
  7528. ' c:=low(arr2);',
  7529. ' c:=high(arr2);',
  7530. ' arr2[''b'']:=''f'';',
  7531. ' arr2[''a'']:=arr2[c];',
  7532. ' arr2[c]:=arr2[''g''];']);
  7533. ConvertProgram;
  7534. CheckSource('TestArray_StaticChar',
  7535. LinesToStr([ // statements
  7536. 'this.Arr = rtl.arraySetLength(null, "", 65536);',
  7537. 'this.Arr2 = rtl.arraySetLength(null, "", 26);',
  7538. 'this.Arr3 = ["p", "a", "s"];',
  7539. 'this.Arr4 = ["p", "a", "s"];',
  7540. 'this.Arr5 = ["ä", "ö"];',
  7541. 'this.Arr6 = ["ä", "ö"];',
  7542. 'this.c = "";',
  7543. 'this.b = false;',
  7544. '']),
  7545. LinesToStr([ // $mod.$main
  7546. '$mod.c = "\x00";',
  7547. '$mod.c = "\uFFFF";',
  7548. '$mod.Arr[66] = "a";',
  7549. '$mod.Arr[68] = $mod.Arr[$mod.c.charCodeAt()];',
  7550. '$mod.Arr[$mod.c.charCodeAt()] = $mod.Arr[100];',
  7551. '$mod.Arr[$mod.Arr[$mod.c.charCodeAt()].charCodeAt()] = $mod.Arr[65535];',
  7552. '$mod.b = $mod.Arr[0] === $mod.Arr[101];',
  7553. '$mod.c = "a";',
  7554. '$mod.c = "z";',
  7555. '$mod.Arr2[1] = "f";',
  7556. '$mod.Arr2[0] = $mod.Arr2[$mod.c.charCodeAt() - 97];',
  7557. '$mod.Arr2[$mod.c.charCodeAt() - 97] = $mod.Arr2[6];',
  7558. '']));
  7559. end;
  7560. procedure TTestModule.TestArray_StaticMultiDim;
  7561. begin
  7562. StartProgram(false);
  7563. Add([
  7564. 'type',
  7565. ' TArrayInt = array[1..3] of longint;',
  7566. ' TArrayArrayInt = array[5..6] of TArrayInt;',
  7567. 'var',
  7568. ' Arr: TArrayInt;',
  7569. ' Arr2: TArrayArrayInt;',
  7570. ' Arr3: array[boolean] of TArrayInt = ((11,12,13),(21,22,23));',
  7571. ' i: longint;',
  7572. 'begin',
  7573. ' i:=low(arr);',
  7574. ' i:=low(arr2);',
  7575. ' i:=low(arr2[5]);',
  7576. ' i:=high(arr);',
  7577. ' i:=high(arr2);',
  7578. ' i:=high(arr2[6]);',
  7579. ' arr2[5]:=arr;',
  7580. ' arr2[6][2]:=i;',
  7581. ' i:=arr2[6][3];',
  7582. ' arr2[6,3]:=i;',
  7583. ' i:=arr2[5,2];',
  7584. ' arr2:=arr2;',// clone multi dim static array
  7585. //' arr3:=arr3;',// clone anonymous multi dim static array
  7586. '']);
  7587. ConvertProgram;
  7588. CheckSource('TestArray_StaticMultiDim',
  7589. LinesToStr([ // statements
  7590. 'this.TArrayArrayInt$clone = function (a) {',
  7591. ' var r = [];',
  7592. ' for (var i = 0; i < 2; i++) r.push(a[i].slice(0));',
  7593. ' return r;',
  7594. '};',
  7595. 'this.Arr = rtl.arraySetLength(null, 0, 3);',
  7596. 'this.Arr2 = rtl.arraySetLength(null, 0, 2, 3);',
  7597. 'this.Arr3 = [[11, 12, 13], [21, 22, 23]];',
  7598. 'this.i = 0;'
  7599. ]),
  7600. LinesToStr([ // $mod.$main
  7601. '$mod.i = 1;',
  7602. '$mod.i = 5;',
  7603. '$mod.i = 1;',
  7604. '$mod.i = 3;',
  7605. '$mod.i = 6;',
  7606. '$mod.i = 3;',
  7607. '$mod.Arr2[0] = $mod.Arr.slice(0);',
  7608. '$mod.Arr2[1][1] = $mod.i;',
  7609. '$mod.i = $mod.Arr2[1][2];',
  7610. '$mod.Arr2[1][2] = $mod.i;',
  7611. '$mod.i = $mod.Arr2[0][1];',
  7612. '$mod.Arr2 = $mod.TArrayArrayInt$clone($mod.Arr2);',
  7613. '']));
  7614. end;
  7615. procedure TTestModule.TestArray_StaticInFunction;
  7616. begin
  7617. StartProgram(false);
  7618. Add([
  7619. 'const TArrayInt = 3;',
  7620. 'const TArrayArrayInt = 4;',
  7621. 'procedure DoIt;',
  7622. 'type',
  7623. ' TArrayInt = array[1..3] of longint;',
  7624. ' TArrayArrayInt = array[5..6] of TArrayInt;',
  7625. 'var',
  7626. ' Arr: TArrayInt;',
  7627. ' Arr2: TArrayArrayInt;',
  7628. ' Arr3: array[boolean] of TArrayInt = ((11,12,13),(21,22,23));',
  7629. ' i: longint;',
  7630. 'begin',
  7631. ' arr2[5]:=arr;',
  7632. ' arr2:=arr2;',// clone multi dim static array
  7633. 'end;',
  7634. 'begin',
  7635. '']);
  7636. ConvertProgram;
  7637. CheckSource('TestArray_StaticInFunction',
  7638. LinesToStr([ // statements
  7639. 'this.TArrayInt = 3;',
  7640. 'this.TArrayArrayInt = 4;',
  7641. 'var TArrayArrayInt$1$clone = function (a) {',
  7642. ' var r = [];',
  7643. ' for (var i = 0; i < 2; i++) r.push(a[i].slice(0));',
  7644. ' return r;',
  7645. '};',
  7646. 'this.DoIt = function () {',
  7647. ' var Arr = rtl.arraySetLength(null, 0, 3);',
  7648. ' var Arr2 = rtl.arraySetLength(null, 0, 2, 3);',
  7649. ' var Arr3 = [[11, 12, 13], [21, 22, 23]];',
  7650. ' var i = 0;',
  7651. ' Arr2[0] = Arr.slice(0);',
  7652. ' Arr2 = TArrayArrayInt$1$clone(Arr2);',
  7653. '};',
  7654. '']),
  7655. LinesToStr([ // $mod.$main
  7656. '']));
  7657. end;
  7658. procedure TTestModule.TestArrayOfRecord;
  7659. begin
  7660. StartProgram(false);
  7661. Add([
  7662. 'type',
  7663. ' TRec = record',
  7664. ' Int: longint;',
  7665. ' end;',
  7666. ' TArrayRec = array of TRec;',
  7667. 'var',
  7668. ' Arr: TArrayRec;',
  7669. ' r: TRec;',
  7670. ' i: longint;',
  7671. 'begin',
  7672. ' SetLength(arr,3);',
  7673. ' arr[0].int:=4;',
  7674. ' arr[1].int:=length(arr)+arr[2].int;',
  7675. ' arr[arr[i].int].int:=arr[5].int;',
  7676. ' arr[7]:=r;',
  7677. ' r:=arr[8];',
  7678. ' i:=low(arr);',
  7679. ' i:=high(arr);']);
  7680. ConvertProgram;
  7681. CheckSource('TestArrayOfRecord',
  7682. LinesToStr([ // statements
  7683. 'this.TRec = function (s) {',
  7684. ' if (s) {',
  7685. ' this.Int = s.Int;',
  7686. ' } else {',
  7687. ' this.Int = 0;',
  7688. ' };',
  7689. ' this.$equal = function (b) {',
  7690. ' return this.Int === b.Int;',
  7691. ' };',
  7692. '};',
  7693. 'this.Arr = [];',
  7694. 'this.r = new $mod.TRec();',
  7695. 'this.i = 0;'
  7696. ]),
  7697. LinesToStr([ // $mod.$main
  7698. '$mod.Arr = rtl.arraySetLength($mod.Arr,$mod.TRec,3);',
  7699. '$mod.Arr[0].Int = 4;',
  7700. '$mod.Arr[1].Int = rtl.length($mod.Arr)+$mod.Arr[2].Int;',
  7701. '$mod.Arr[$mod.Arr[$mod.i].Int].Int = $mod.Arr[5].Int;',
  7702. '$mod.Arr[7] = new $mod.TRec($mod.r);',
  7703. '$mod.r = new $mod.TRec($mod.Arr[8]);',
  7704. '$mod.i = 0;',
  7705. '$mod.i = rtl.length($mod.Arr)-1;',
  7706. '']));
  7707. end;
  7708. procedure TTestModule.TestArray_StaticRecord;
  7709. begin
  7710. StartProgram(false);
  7711. Add([
  7712. 'type',
  7713. ' TRec = record',
  7714. ' Int: longint;',
  7715. ' end;',
  7716. ' TArrayRec = array[1..2] of TRec;',
  7717. 'var',
  7718. ' Arr: TArrayRec;',
  7719. 'begin',
  7720. ' arr[1].int:=length(arr)+low(arr)+high(arr);',
  7721. '']);
  7722. ConvertProgram;
  7723. CheckSource('TestArray_StaticRecord',
  7724. LinesToStr([ // statements
  7725. 'this.TRec = function (s) {',
  7726. ' if (s) {',
  7727. ' this.Int = s.Int;',
  7728. ' } else {',
  7729. ' this.Int = 0;',
  7730. ' };',
  7731. ' this.$equal = function (b) {',
  7732. ' return this.Int === b.Int;',
  7733. ' };',
  7734. '};',
  7735. 'this.TArrayRec$clone = function (a) {',
  7736. ' var r = [];',
  7737. ' for (var i = 0; i < 2; i++) r.push(new $mod.TRec(a[i]));',
  7738. ' return r;',
  7739. '};',
  7740. 'this.Arr = rtl.arraySetLength(null, $mod.TRec, 2);',
  7741. '']),
  7742. LinesToStr([ // $mod.$main
  7743. '$mod.Arr[0].Int = 2 + 1 + 2;']));
  7744. end;
  7745. procedure TTestModule.TestArrayOfSet;
  7746. begin
  7747. StartProgram(false);
  7748. Add([
  7749. 'type',
  7750. ' TFlag = (big,small);',
  7751. ' TSetOfFlag = set of tflag;',
  7752. ' TArrayFlag = array of TSetOfFlag;',
  7753. 'procedure DoIt(const a: Tarrayflag);',
  7754. 'begin',
  7755. 'end;',
  7756. 'var',
  7757. ' f: TFlag;',
  7758. ' s: TSetOfFlag;',
  7759. ' Arr: TArrayFlag;',
  7760. ' i: longint;',
  7761. 'begin',
  7762. ' SetLength(arr,3);',
  7763. ' arr[0]:=s;',
  7764. ' arr[1]:=[big];',
  7765. ' arr[2]:=[big]+s;',
  7766. ' arr[3]:=s+[big];',
  7767. ' arr[4]:=arr[5];',
  7768. ' s:=arr[6];',
  7769. ' i:=low(arr);',
  7770. ' i:=high(arr);',
  7771. ' DoIt(arr);',
  7772. ' DoIt([s]);',
  7773. ' DoIt([[],s]);',
  7774. ' DoIt([s,[]]);',
  7775. '']);
  7776. ConvertProgram;
  7777. CheckSource('TestArrayOfSet',
  7778. LinesToStr([ // statements
  7779. 'this.TFlag = {',
  7780. ' "0": "big",',
  7781. ' big: 0,',
  7782. ' "1": "small",',
  7783. ' small: 1',
  7784. '};',
  7785. 'this.DoIt = function (a) {',
  7786. '};',
  7787. 'this.f = 0;',
  7788. 'this.s = {};',
  7789. 'this.Arr = [];',
  7790. 'this.i = 0;',
  7791. '']),
  7792. LinesToStr([ // $mod.$main
  7793. '$mod.Arr = rtl.arraySetLength($mod.Arr, {}, 3);',
  7794. '$mod.Arr[0] = rtl.refSet($mod.s);',
  7795. '$mod.Arr[1] = rtl.createSet($mod.TFlag.big);',
  7796. '$mod.Arr[2] = rtl.unionSet(rtl.createSet($mod.TFlag.big), $mod.s);',
  7797. '$mod.Arr[3] = rtl.unionSet($mod.s, rtl.createSet($mod.TFlag.big));',
  7798. '$mod.Arr[4] = rtl.refSet($mod.Arr[5]);',
  7799. '$mod.s = rtl.refSet($mod.Arr[6]);',
  7800. '$mod.i = 0;',
  7801. '$mod.i = rtl.length($mod.Arr) - 1;',
  7802. '$mod.DoIt($mod.Arr);',
  7803. '$mod.DoIt([rtl.refSet($mod.s)]);',
  7804. '$mod.DoIt([{}, rtl.refSet($mod.s)]);',
  7805. '$mod.DoIt([rtl.refSet($mod.s), {}]);',
  7806. '']));
  7807. end;
  7808. procedure TTestModule.TestArray_DynAsParam;
  7809. begin
  7810. StartProgram(false);
  7811. Add([
  7812. 'type integer = longint;',
  7813. 'type TArrInt = array of integer;',
  7814. 'procedure DoIt(vG: TArrInt; const vH: TArrInt; var vI: TArrInt);',
  7815. 'var vJ: TArrInt;',
  7816. 'begin',
  7817. ' vg:=vg;',
  7818. ' vj:=vh;',
  7819. ' vi:=vi;',
  7820. ' doit(vg,vg,vg);',
  7821. ' doit(vh,vh,vj);',
  7822. ' doit(vi,vi,vi);',
  7823. ' doit(vj,vj,vj);',
  7824. 'end;',
  7825. 'var i: TArrInt;',
  7826. 'begin',
  7827. ' doit(i,i,i);']);
  7828. ConvertProgram;
  7829. CheckSource('TestArray_DynAsParams',
  7830. LinesToStr([ // statements
  7831. 'this.DoIt = function (vG,vH,vI) {',
  7832. ' var vJ = [];',
  7833. ' vG = vG;',
  7834. ' vJ = vH;',
  7835. ' vI.set(vI.get());',
  7836. ' $mod.DoIt(vG, vG, {',
  7837. ' get: function () {',
  7838. ' return vG;',
  7839. ' },',
  7840. ' set: function (v) {',
  7841. ' vG = v;',
  7842. ' }',
  7843. ' });',
  7844. ' $mod.DoIt(vH, vH, {',
  7845. ' get: function () {',
  7846. ' return vJ;',
  7847. ' },',
  7848. ' set: function (v) {',
  7849. ' vJ = v;',
  7850. ' }',
  7851. ' });',
  7852. ' $mod.DoIt(vI.get(), vI.get(), vI);',
  7853. ' $mod.DoIt(vJ, vJ, {',
  7854. ' get: function () {',
  7855. ' return vJ;',
  7856. ' },',
  7857. ' set: function (v) {',
  7858. ' vJ = v;',
  7859. ' }',
  7860. ' });',
  7861. '};',
  7862. 'this.i = [];'
  7863. ]),
  7864. LinesToStr([
  7865. '$mod.DoIt($mod.i,$mod.i,{',
  7866. ' p: $mod,',
  7867. ' get: function () {',
  7868. ' return this.p.i;',
  7869. ' },',
  7870. ' set: function (v) {',
  7871. ' this.p.i = v;',
  7872. ' }',
  7873. '});'
  7874. ]));
  7875. end;
  7876. procedure TTestModule.TestArray_StaticAsParam;
  7877. begin
  7878. StartProgram(false);
  7879. Add([
  7880. 'type integer = longint;',
  7881. 'type TArrInt = array[1..2] of integer;',
  7882. 'procedure DoIt(vG: TArrInt; const vH: TArrInt; var vI: TArrInt);',
  7883. 'var vJ: TArrInt;',
  7884. 'begin',
  7885. ' vg:=vg;',
  7886. ' vj:=vh;',
  7887. ' vi:=vi;',
  7888. ' doit(vg,vg,vg);',
  7889. ' doit(vh,vh,vj);',
  7890. ' doit(vi,vi,vi);',
  7891. ' doit(vj,vj,vj);',
  7892. 'end;',
  7893. 'var i: TArrInt;',
  7894. 'begin',
  7895. ' doit(i,i,i);']);
  7896. ConvertProgram;
  7897. CheckSource('TestArray_StaticAsParams',
  7898. LinesToStr([ // statements
  7899. 'this.DoIt = function (vG,vH,vI) {',
  7900. ' var vJ = rtl.arraySetLength(null, 0, 2);',
  7901. ' vG = vG.slice(0);',
  7902. ' vJ = vH.slice(0);',
  7903. ' vI.set(vI.get().slice(0));',
  7904. ' $mod.DoIt(vG.slice(0), vG, {',
  7905. ' get: function () {',
  7906. ' return vG;',
  7907. ' },',
  7908. ' set: function (v) {',
  7909. ' vG = v;',
  7910. ' }',
  7911. ' });',
  7912. ' $mod.DoIt(vH.slice(0), vH, {',
  7913. ' get: function () {',
  7914. ' return vJ;',
  7915. ' },',
  7916. ' set: function (v) {',
  7917. ' vJ = v;',
  7918. ' }',
  7919. ' });',
  7920. ' $mod.DoIt(vI.get().slice(0), vI.get(), vI);',
  7921. ' $mod.DoIt(vJ.slice(0), vJ, {',
  7922. ' get: function () {',
  7923. ' return vJ;',
  7924. ' },',
  7925. ' set: function (v) {',
  7926. ' vJ = v;',
  7927. ' }',
  7928. ' });',
  7929. '};',
  7930. 'this.i = rtl.arraySetLength(null, 0, 2);'
  7931. ]),
  7932. LinesToStr([
  7933. '$mod.DoIt($mod.i.slice(0),$mod.i,{',
  7934. ' p: $mod,',
  7935. ' get: function () {',
  7936. ' return this.p.i;',
  7937. ' },',
  7938. ' set: function (v) {',
  7939. ' this.p.i = v;',
  7940. ' }',
  7941. '});'
  7942. ]));
  7943. end;
  7944. procedure TTestModule.TestArrayElement_AsParams;
  7945. begin
  7946. StartProgram(false);
  7947. Add('type integer = longint;');
  7948. Add('type TArrayInt = array of integer;');
  7949. Add('procedure DoIt(vG: Integer; const vH: Integer; var vI: Integer);');
  7950. Add('var vJ: tarrayint;');
  7951. Add('begin');
  7952. Add(' vi:=vi;');
  7953. Add(' doit(vi,vi,vi);');
  7954. Add(' doit(vj[1+1],vj[1+2],vj[1+3]);');
  7955. Add('end;');
  7956. Add('var a: TArrayInt;');
  7957. Add('begin');
  7958. Add(' doit(a[1+4],a[1+5],a[1+6]);');
  7959. ConvertProgram;
  7960. CheckSource('TestArrayElement_AsParams',
  7961. LinesToStr([ // statements
  7962. 'this.DoIt = function (vG,vH,vI) {',
  7963. ' var vJ = [];',
  7964. ' vI.set(vI.get());',
  7965. ' $mod.DoIt(vI.get(), vI.get(), vI);',
  7966. ' $mod.DoIt(vJ[1+1], vJ[1+2], {',
  7967. ' a:1+3,',
  7968. ' p:vJ,',
  7969. ' get: function () {',
  7970. ' return this.p[this.a];',
  7971. ' },',
  7972. ' set: function (v) {',
  7973. ' this.p[this.a] = v;',
  7974. ' }',
  7975. ' });',
  7976. '};',
  7977. 'this.a = [];'
  7978. ]),
  7979. LinesToStr([
  7980. '$mod.DoIt($mod.a[1+4],$mod.a[1+5],{',
  7981. ' a: 1+6,',
  7982. ' p: $mod.a,',
  7983. ' get: function () {',
  7984. ' return this.p[this.a];',
  7985. ' },',
  7986. ' set: function (v) {',
  7987. ' this.p[this.a] = v;',
  7988. ' }',
  7989. '});'
  7990. ]));
  7991. end;
  7992. procedure TTestModule.TestArrayElementFromFuncResult_AsParams;
  7993. begin
  7994. StartProgram(false);
  7995. Add('type Integer = longint;');
  7996. Add('type TArrayInt = array of integer;');
  7997. Add('function GetArr(vB: integer = 0): tarrayint;');
  7998. Add('begin');
  7999. Add('end;');
  8000. Add('procedure DoIt(vG: integer; const vH: integer; var vI: integer);');
  8001. Add('begin');
  8002. Add('end;');
  8003. Add('begin');
  8004. Add(' doit(getarr[1+1],getarr[1+2],getarr[1+3]);');
  8005. Add(' doit(getarr()[2+1],getarr()[2+2],getarr()[2+3]);');
  8006. Add(' doit(getarr(7)[3+1],getarr(8)[3+2],getarr(9)[3+3]);');
  8007. ConvertProgram;
  8008. CheckSource('TestArrayElementFromFuncResult_AsParams',
  8009. LinesToStr([ // statements
  8010. 'this.GetArr = function (vB) {',
  8011. ' var Result = [];',
  8012. ' return Result;',
  8013. '};',
  8014. 'this.DoIt = function (vG,vH,vI) {',
  8015. '};'
  8016. ]),
  8017. LinesToStr([
  8018. '$mod.DoIt($mod.GetArr(0)[1+1],$mod.GetArr(0)[1+2],{',
  8019. ' a: 1+3,',
  8020. ' p: $mod.GetArr(0),',
  8021. ' get: function () {',
  8022. ' return this.p[this.a];',
  8023. ' },',
  8024. ' set: function (v) {',
  8025. ' this.p[this.a] = v;',
  8026. ' }',
  8027. '});',
  8028. '$mod.DoIt($mod.GetArr(0)[2+1],$mod.GetArr(0)[2+2],{',
  8029. ' a: 2+3,',
  8030. ' p: $mod.GetArr(0),',
  8031. ' get: function () {',
  8032. ' return this.p[this.a];',
  8033. ' },',
  8034. ' set: function (v) {',
  8035. ' this.p[this.a] = v;',
  8036. ' }',
  8037. '});',
  8038. '$mod.DoIt($mod.GetArr(7)[3+1],$mod.GetArr(8)[3+2],{',
  8039. ' a: 3+3,',
  8040. ' p: $mod.GetArr(9),',
  8041. ' get: function () {',
  8042. ' return this.p[this.a];',
  8043. ' },',
  8044. ' set: function (v) {',
  8045. ' this.p[this.a] = v;',
  8046. ' }',
  8047. '});',
  8048. '']));
  8049. end;
  8050. procedure TTestModule.TestArrayEnumTypeRange;
  8051. begin
  8052. StartProgram(false);
  8053. Add([
  8054. 'type',
  8055. ' TEnum = (red,blue);',
  8056. ' TEnumArray = array[TEnum] of longint;',
  8057. 'var',
  8058. ' e: TEnum;',
  8059. ' i: longint;',
  8060. ' a: TEnumArray;',
  8061. ' numbers: TEnumArray = (1,2);',
  8062. ' names: array[TEnum] of string = (''red'',''blue'');',
  8063. 'begin',
  8064. ' e:=low(a);',
  8065. ' e:=high(a);',
  8066. ' i:=a[red];',
  8067. ' a[e]:=a[e];']);
  8068. ConvertProgram;
  8069. CheckSource('TestArrayEnumTypeRange',
  8070. LinesToStr([ // statements
  8071. ' this.TEnum = {',
  8072. ' "0": "red",',
  8073. ' red: 0,',
  8074. ' "1": "blue",',
  8075. ' blue: 1',
  8076. '};',
  8077. 'this.e = 0;',
  8078. 'this.i = 0;',
  8079. 'this.a = rtl.arraySetLength(null,0,2);',
  8080. 'this.numbers = [1, 2];',
  8081. 'this.names = ["red", "blue"];',
  8082. '']),
  8083. LinesToStr([ // $mod.$main
  8084. '$mod.e = $mod.TEnum.red;',
  8085. '$mod.e = $mod.TEnum.blue;',
  8086. '$mod.i = $mod.a[$mod.TEnum.red];',
  8087. '$mod.a[$mod.e] = $mod.a[$mod.e];',
  8088. '']));
  8089. end;
  8090. procedure TTestModule.TestArray_SetLengthOutArg;
  8091. begin
  8092. StartProgram(false);
  8093. Add([
  8094. 'type TArrInt = array of longint;',
  8095. 'procedure DoIt(out a: TArrInt);',
  8096. 'begin',
  8097. ' SetLength(a,2);',
  8098. 'end;',
  8099. 'begin',
  8100. '']);
  8101. ConvertProgram;
  8102. CheckSource('TestArray_SetLengthOutArg',
  8103. LinesToStr([ // statements
  8104. 'this.DoIt = function (a) {',
  8105. ' a.set(rtl.arraySetLength(a.get(), 0, 2));',
  8106. '};',
  8107. '']),
  8108. LinesToStr([
  8109. '']));
  8110. end;
  8111. procedure TTestModule.TestArray_SetLengthProperty;
  8112. begin
  8113. StartProgram(false);
  8114. Add('type');
  8115. Add(' TArrInt = array of longint;');
  8116. Add(' TObject = class');
  8117. Add(' function GetColors: TArrInt; external name ''GetColors'';');
  8118. Add(' procedure SetColors(const Value: TArrInt); external name ''SetColors'';');
  8119. Add(' property Colors: TArrInt read GetColors write SetColors;');
  8120. Add(' end;');
  8121. Add('var Obj: TObject;');
  8122. Add('begin');
  8123. Add(' SetLength(Obj.Colors,2);');
  8124. ConvertProgram;
  8125. CheckSource('TestArray_SetLengthProperty',
  8126. LinesToStr([ // statements
  8127. 'rtl.createClass($mod, "TObject", null, function () {',
  8128. ' this.$init = function () {',
  8129. ' };',
  8130. ' this.$final = function () {',
  8131. ' };',
  8132. '});',
  8133. 'this.Obj = null;',
  8134. '']),
  8135. LinesToStr([
  8136. '$mod.Obj.SetColors(rtl.arraySetLength($mod.Obj.GetColors(), 0, 2));',
  8137. '']));
  8138. end;
  8139. procedure TTestModule.TestArray_SetLengthMultiDim;
  8140. begin
  8141. StartProgram(false);
  8142. Add([
  8143. 'type',
  8144. ' TArrArrInt = array of array of longint;',
  8145. 'var',
  8146. ' a: TArrArrInt;',
  8147. 'begin',
  8148. ' SetLength(a,2);',
  8149. ' SetLength(a,3,4);',
  8150. '']);
  8151. ConvertProgram;
  8152. CheckSource('TestArray_SetLengthMultiDim',
  8153. LinesToStr([ // statements
  8154. 'this.a = [];']),
  8155. LinesToStr([
  8156. '$mod.a = rtl.arraySetLength($mod.a, [], 2);',
  8157. '$mod.a = rtl.arraySetLength($mod.a, 0, 3, 4);',
  8158. '']));
  8159. end;
  8160. procedure TTestModule.TestArray_OpenArrayOfString;
  8161. begin
  8162. StartProgram(false);
  8163. Add('procedure DoIt(const a: array of String);');
  8164. Add('var');
  8165. Add(' i: longint;');
  8166. Add(' s: string;');
  8167. Add('begin');
  8168. Add(' for i:=low(a) to high(a) do s:=a[length(a)-i-1];');
  8169. Add('end;');
  8170. Add('var s: string;');
  8171. Add('begin');
  8172. Add(' DoIt([]);');
  8173. Add(' DoIt([s,''foo'','''',s+s]);');
  8174. ConvertProgram;
  8175. CheckSource('TestArray_OpenArrayOfString',
  8176. LinesToStr([ // statements
  8177. 'this.DoIt = function (a) {',
  8178. ' var i = 0;',
  8179. ' var s = "";',
  8180. ' for (var $l1 = 0, $end2 = rtl.length(a) - 1; $l1 <= $end2; $l1++) {',
  8181. ' i = $l1;',
  8182. ' s = a[rtl.length(a) - i - 1];',
  8183. ' };',
  8184. '};',
  8185. 'this.s = "";',
  8186. '']),
  8187. LinesToStr([
  8188. '$mod.DoIt([]);',
  8189. '$mod.DoIt([$mod.s, "foo", "", $mod.s + $mod.s]);',
  8190. '']));
  8191. end;
  8192. procedure TTestModule.TestArray_Concat;
  8193. begin
  8194. StartProgram(false);
  8195. Add([
  8196. 'type',
  8197. ' integer = longint;',
  8198. ' TFlag = (big,small);',
  8199. ' TFlags = set of TFlag;',
  8200. ' TRec = record',
  8201. ' i: integer;',
  8202. ' end;',
  8203. ' TArrInt = array of integer;',
  8204. ' TArrRec = array of TRec;',
  8205. ' TArrFlag = array of TFlag;',
  8206. ' TArrSet = array of TFlags;',
  8207. ' TArrJSValue = array of jsvalue;',
  8208. 'var',
  8209. ' ArrInt: tarrint;',
  8210. ' ArrRec: tarrrec;',
  8211. ' ArrFlag: tarrflag;',
  8212. ' ArrSet: tarrset;',
  8213. ' ArrJSValue: tarrjsvalue;',
  8214. 'begin',
  8215. ' arrint:=concat(arrint);',
  8216. ' arrint:=concat(arrint,arrint);',
  8217. ' arrint:=concat(arrint,arrint,arrint);',
  8218. ' arrrec:=concat(arrrec);',
  8219. ' arrrec:=concat(arrrec,arrrec);',
  8220. ' arrrec:=concat(arrrec,arrrec,arrrec);',
  8221. ' arrset:=concat(arrset);',
  8222. ' arrset:=concat(arrset,arrset);',
  8223. ' arrset:=concat(arrset,arrset,arrset);',
  8224. ' arrjsvalue:=concat(arrjsvalue);',
  8225. ' arrjsvalue:=concat(arrjsvalue,arrjsvalue);',
  8226. ' arrjsvalue:=concat(arrjsvalue,arrjsvalue,arrjsvalue);',
  8227. ' arrint:=concat([1],arrint);',
  8228. ' arrflag:=concat([big]);',
  8229. ' arrflag:=concat([big],arrflag);',
  8230. ' arrflag:=concat(arrflag,[small]);',
  8231. '']);
  8232. ConvertProgram;
  8233. CheckSource('TestArray_Concat',
  8234. LinesToStr([ // statements
  8235. 'this.TFlag = {',
  8236. ' "0": "big",',
  8237. ' big: 0,',
  8238. ' "1": "small",',
  8239. ' small: 1',
  8240. '};',
  8241. 'this.TRec = function (s) {',
  8242. ' if (s) {',
  8243. ' this.i = s.i;',
  8244. ' } else {',
  8245. ' this.i = 0;',
  8246. ' };',
  8247. ' this.$equal = function (b) {',
  8248. ' return this.i === b.i;',
  8249. ' };',
  8250. '};',
  8251. 'this.ArrInt = [];',
  8252. 'this.ArrRec = [];',
  8253. 'this.ArrFlag = [];',
  8254. 'this.ArrSet = [];',
  8255. 'this.ArrJSValue = [];',
  8256. '']),
  8257. LinesToStr([ // $mod.$main
  8258. '$mod.ArrInt = $mod.ArrInt;',
  8259. '$mod.ArrInt = rtl.arrayConcatN($mod.ArrInt, $mod.ArrInt);',
  8260. '$mod.ArrInt = rtl.arrayConcatN($mod.ArrInt, $mod.ArrInt, $mod.ArrInt);',
  8261. '$mod.ArrRec = $mod.ArrRec;',
  8262. '$mod.ArrRec = rtl.arrayConcat($mod.TRec, $mod.ArrRec, $mod.ArrRec);',
  8263. '$mod.ArrRec = rtl.arrayConcat($mod.TRec, $mod.ArrRec, $mod.ArrRec, $mod.ArrRec);',
  8264. '$mod.ArrSet = $mod.ArrSet;',
  8265. '$mod.ArrSet = rtl.arrayConcat("refSet", $mod.ArrSet, $mod.ArrSet);',
  8266. '$mod.ArrSet = rtl.arrayConcat("refSet", $mod.ArrSet, $mod.ArrSet, $mod.ArrSet);',
  8267. '$mod.ArrJSValue = $mod.ArrJSValue;',
  8268. '$mod.ArrJSValue = rtl.arrayConcatN($mod.ArrJSValue, $mod.ArrJSValue);',
  8269. '$mod.ArrJSValue = rtl.arrayConcatN($mod.ArrJSValue, $mod.ArrJSValue, $mod.ArrJSValue);',
  8270. '$mod.ArrInt = rtl.arrayConcatN([1], $mod.ArrInt);',
  8271. '$mod.ArrFlag = [$mod.TFlag.big];',
  8272. '$mod.ArrFlag = rtl.arrayConcatN([$mod.TFlag.big], $mod.ArrFlag);',
  8273. '$mod.ArrFlag = rtl.arrayConcatN($mod.ArrFlag, [$mod.TFlag.small]);',
  8274. '']));
  8275. end;
  8276. procedure TTestModule.TestArray_Copy;
  8277. begin
  8278. StartProgram(false);
  8279. Add([
  8280. 'type',
  8281. ' integer = longint;',
  8282. ' TFlag = (big,small);',
  8283. ' TFlags = set of TFlag;',
  8284. ' TRec = record',
  8285. ' i: integer;',
  8286. ' end;',
  8287. ' TArrInt = array of integer;',
  8288. ' TArrRec = array of TRec;',
  8289. ' TArrSet = array of TFlags;',
  8290. ' TArrJSValue = array of jsvalue;',
  8291. 'var',
  8292. ' ArrInt: tarrint;',
  8293. ' ArrRec: tarrrec;',
  8294. ' ArrSet: tarrset;',
  8295. ' ArrJSValue: tarrjsvalue;',
  8296. 'begin',
  8297. ' arrint:=copy(arrint);',
  8298. ' arrint:=copy(arrint,2);',
  8299. ' arrint:=copy(arrint,3,4);',
  8300. ' arrint:=copy([1,1],1,2);',
  8301. ' arrrec:=copy(arrrec);',
  8302. ' arrrec:=copy(arrrec,5);',
  8303. ' arrrec:=copy(arrrec,6,7);',
  8304. ' arrset:=copy(arrset);',
  8305. ' arrset:=copy(arrset,8);',
  8306. ' arrset:=copy(arrset,9,10);',
  8307. ' arrjsvalue:=copy(arrjsvalue);',
  8308. ' arrjsvalue:=copy(arrjsvalue,11);',
  8309. ' arrjsvalue:=copy(arrjsvalue,12,13);',
  8310. ' ']);
  8311. ConvertProgram;
  8312. CheckSource('TestArray_Copy',
  8313. LinesToStr([ // statements
  8314. 'this.TFlag = {',
  8315. ' "0": "big",',
  8316. ' big: 0,',
  8317. ' "1": "small",',
  8318. ' small: 1',
  8319. '};',
  8320. 'this.TRec = function (s) {',
  8321. ' if (s) {',
  8322. ' this.i = s.i;',
  8323. ' } else {',
  8324. ' this.i = 0;',
  8325. ' };',
  8326. ' this.$equal = function (b) {',
  8327. ' return this.i === b.i;',
  8328. ' };',
  8329. '};',
  8330. 'this.ArrInt = [];',
  8331. 'this.ArrRec = [];',
  8332. 'this.ArrSet = [];',
  8333. 'this.ArrJSValue = [];',
  8334. '']),
  8335. LinesToStr([ // $mod.$main
  8336. '$mod.ArrInt = rtl.arrayCopy(0, $mod.ArrInt, 0);',
  8337. '$mod.ArrInt = rtl.arrayCopy(0, $mod.ArrInt, 2);',
  8338. '$mod.ArrInt = rtl.arrayCopy(0, $mod.ArrInt, 3, 4);',
  8339. '$mod.ArrInt = rtl.arrayCopy(0, [1, 1], 1, 2);',
  8340. '$mod.ArrRec = rtl.arrayCopy($mod.TRec, $mod.ArrRec, 0);',
  8341. '$mod.ArrRec = rtl.arrayCopy($mod.TRec, $mod.ArrRec, 5);',
  8342. '$mod.ArrRec = rtl.arrayCopy($mod.TRec, $mod.ArrRec, 6, 7);',
  8343. '$mod.ArrSet = rtl.arrayCopy("refSet", $mod.ArrSet, 0);',
  8344. '$mod.ArrSet = rtl.arrayCopy("refSet", $mod.ArrSet, 8);',
  8345. '$mod.ArrSet = rtl.arrayCopy("refSet", $mod.ArrSet, 9, 10);',
  8346. '$mod.ArrJSValue = rtl.arrayCopy(0, $mod.ArrJSValue, 0);',
  8347. '$mod.ArrJSValue = rtl.arrayCopy(0, $mod.ArrJSValue, 11);',
  8348. '$mod.ArrJSValue = rtl.arrayCopy(0, $mod.ArrJSValue, 12, 13);',
  8349. '']));
  8350. end;
  8351. procedure TTestModule.TestArray_InsertDelete;
  8352. begin
  8353. StartProgram(false);
  8354. Add([
  8355. 'type',
  8356. ' integer = longint;',
  8357. ' TFlag = (big,small);',
  8358. ' TFlags = set of TFlag;',
  8359. ' TRec = record',
  8360. ' i: integer;',
  8361. ' end;',
  8362. ' TArrInt = array of integer;',
  8363. ' TArrRec = array of TRec;',
  8364. ' TArrSet = array of TFlags;',
  8365. ' TArrJSValue = array of jsvalue;',
  8366. ' TArrArrInt = array of TArrInt;',
  8367. 'var',
  8368. ' ArrInt: tarrint;',
  8369. ' ArrRec: tarrrec;',
  8370. ' ArrSet: tarrset;',
  8371. ' ArrJSValue: tarrjsvalue;',
  8372. ' ArrArrInt: TArrArrInt;',
  8373. 'begin',
  8374. ' Insert(1,arrint,2);',
  8375. ' Insert(arrint[3],arrint,4);',
  8376. ' Insert(arrrec[5],arrrec,6);',
  8377. ' Insert(arrset[7],arrset,7);',
  8378. ' Insert(arrjsvalue[8],arrjsvalue,9);',
  8379. ' Insert(10,arrjsvalue,11);',
  8380. ' Insert([23],arrarrint,22);',
  8381. ' Delete(arrint,12,13);',
  8382. ' Delete(arrrec,14,15);',
  8383. ' Delete(arrset,17,18);',
  8384. ' Delete(arrjsvalue,19,10);']);
  8385. ConvertProgram;
  8386. CheckSource('TestArray_InsertDelete',
  8387. LinesToStr([ // statements
  8388. 'this.TFlag = {',
  8389. ' "0": "big",',
  8390. ' big: 0,',
  8391. ' "1": "small",',
  8392. ' small: 1',
  8393. '};',
  8394. 'this.TRec = function (s) {',
  8395. ' if (s) {',
  8396. ' this.i = s.i;',
  8397. ' } else {',
  8398. ' this.i = 0;',
  8399. ' };',
  8400. ' this.$equal = function (b) {',
  8401. ' return this.i === b.i;',
  8402. ' };',
  8403. '};',
  8404. 'this.ArrInt = [];',
  8405. 'this.ArrRec = [];',
  8406. 'this.ArrSet = [];',
  8407. 'this.ArrJSValue = [];',
  8408. 'this.ArrArrInt = [];',
  8409. '']),
  8410. LinesToStr([ // $mod.$main
  8411. '$mod.ArrInt.splice(2, 0, 1);',
  8412. '$mod.ArrInt.splice(4, 0, $mod.ArrInt[3]);',
  8413. '$mod.ArrRec.splice(6, 0, $mod.ArrRec[5]);',
  8414. '$mod.ArrSet.splice(7, 0, $mod.ArrSet[7]);',
  8415. '$mod.ArrJSValue.splice(9, 0, $mod.ArrJSValue[8]);',
  8416. '$mod.ArrJSValue.splice(11, 0, 10);',
  8417. '$mod.ArrArrInt.splice(22, 0, [23]);',
  8418. '$mod.ArrInt.splice(12, 13);',
  8419. '$mod.ArrRec.splice(14, 15);',
  8420. '$mod.ArrSet.splice(17, 18);',
  8421. '$mod.ArrJSValue.splice(19, 10);',
  8422. '']));
  8423. end;
  8424. procedure TTestModule.TestArray_DynArrayConstObjFPC;
  8425. begin
  8426. StartProgram(false);
  8427. Add([
  8428. '{$modeswitch arrayoperators}',
  8429. 'type',
  8430. ' integer = longint;',
  8431. ' TArrInt = array of integer;',
  8432. ' TArrStr = array of string;',
  8433. 'const',
  8434. ' Ints: TArrInt = (1,2,3);',
  8435. ' Aliases: TarrStr = (''foo'',''b'');',
  8436. ' OneInt: TArrInt = (7);',
  8437. ' OneStr: array of integer = (7);',
  8438. ' Chars: array of char = ''aoc'';',
  8439. ' Names: array of string = (''a'',''foo'');',
  8440. ' NameCount = low(Names)+high(Names)+length(Names);',
  8441. 'var i: integer;',
  8442. 'begin',
  8443. ' Ints:=[];',
  8444. ' Ints:=[1,1];',
  8445. ' Ints:=[1]+[2];',
  8446. ' Ints:=[2];',
  8447. ' Ints:=[]+ints;',
  8448. ' Ints:=Ints+[];',
  8449. ' Ints:=Ints+OneInt;',
  8450. ' Ints:=Ints+[1,1];',
  8451. ' Ints:=[i,i]+Ints;',
  8452. ' Ints:=[1]+[i]+[3];',
  8453. '']);
  8454. ConvertProgram;
  8455. CheckSource('TestArray_DynArrayConstObjFPC',
  8456. LinesToStr([ // statements
  8457. 'this.Ints = [1, 2, 3];',
  8458. 'this.Aliases = ["foo", "b"];',
  8459. 'this.OneInt = [7];',
  8460. 'this.OneStr = [7];',
  8461. 'this.Chars = ["a", "o", "c"];',
  8462. 'this.Names = ["a", "foo"];',
  8463. 'this.NameCount = 0 + (rtl.length($mod.Names) - 1) + rtl.length($mod.Names);',
  8464. 'this.i = 0;',
  8465. '']),
  8466. LinesToStr([ // $mod.$main
  8467. '$mod.Ints = [];',
  8468. '$mod.Ints = [1, 1];',
  8469. '$mod.Ints = rtl.arrayConcatN([1], [2]);',
  8470. '$mod.Ints = [2];',
  8471. '$mod.Ints = rtl.arrayConcatN([], $mod.Ints);',
  8472. '$mod.Ints = rtl.arrayConcatN($mod.Ints, []);',
  8473. '$mod.Ints = rtl.arrayConcatN($mod.Ints, $mod.OneInt);',
  8474. '$mod.Ints = rtl.arrayConcatN($mod.Ints, [1, 1]);',
  8475. '$mod.Ints = rtl.arrayConcatN([$mod.i, $mod.i], $mod.Ints);',
  8476. '$mod.Ints = rtl.arrayConcatN(rtl.arrayConcatN([1], [$mod.i]), [3]);',
  8477. '']));
  8478. end;
  8479. procedure TTestModule.TestArray_DynArrayConstDelphi;
  8480. begin
  8481. StartProgram(false);
  8482. // Note: const c = [1,1]; defines a set!
  8483. Add([
  8484. '{$mode delphi}',
  8485. 'type',
  8486. ' integer = longint;',
  8487. ' TArrInt = array of integer;',
  8488. ' TArrStr = array of string;',
  8489. 'const',
  8490. ' Ints: TArrInt = [1,1,2];',
  8491. ' Aliases: TarrStr = [''foo'',''b''];',
  8492. ' OneInt: TArrInt = [7];',
  8493. ' OneStr: array of integer = [7]+[8];',
  8494. ' Chars: array of char = ''aoc'';',
  8495. ' Names: array of string = [''a'',''a''];',
  8496. ' NameCount = low(Names)+high(Names)+length(Names);',
  8497. 'begin',
  8498. '']);
  8499. ConvertProgram;
  8500. CheckSource('TestArray_DynArrayConstDelphi',
  8501. LinesToStr([ // statements
  8502. 'this.Ints = [1, 1, 2];',
  8503. 'this.Aliases = ["foo", "b"];',
  8504. 'this.OneInt = [7];',
  8505. 'this.OneStr = rtl.arrayConcatN([7],[8]);',
  8506. 'this.Chars = ["a", "o", "c"];',
  8507. 'this.Names = ["a", "a"];',
  8508. 'this.NameCount = 0 + (rtl.length($mod.Names) - 1) + rtl.length($mod.Names);',
  8509. '']),
  8510. LinesToStr([ // $mod.$main
  8511. '']));
  8512. end;
  8513. procedure TTestModule.TestArray_ArrayLitAsParam;
  8514. begin
  8515. StartProgram(false);
  8516. Add([
  8517. '{$modeswitch arrayoperators}',
  8518. 'type',
  8519. ' integer = longint;',
  8520. ' TArrInt = array of integer;',
  8521. ' TArrSet = array of (red,green,blue);',
  8522. 'procedure DoOpenInt(a: array of integer); forward;',
  8523. 'procedure DoInt(a: TArrInt);',
  8524. 'begin',
  8525. ' DoInt(a+[1]);',
  8526. ' DoInt([1]+a);',
  8527. ' DoOpenInt(a);',
  8528. ' DoOpenInt(a+[1]);',
  8529. ' DoOpenInt([1]+a);',
  8530. 'end;',
  8531. 'procedure DoOpenInt(a: array of integer);',
  8532. 'begin',
  8533. ' DoOpenInt(a+[1]);',
  8534. ' DoOpenInt([1]+a);',
  8535. ' DoInt(a);',
  8536. ' DoInt(a+[1]);',
  8537. ' DoInt([1]+a);',
  8538. 'end;',
  8539. 'procedure DoSet(a: TArrSet);',
  8540. 'begin',
  8541. ' DoSet(a+[red]);',
  8542. ' DoSet([blue]+a);',
  8543. 'end;',
  8544. 'var',
  8545. ' i: TArrInt;',
  8546. ' s: TArrSet;',
  8547. 'begin',
  8548. ' DoInt([1]);',
  8549. ' DoInt([1]+[2]);',
  8550. ' DoInt(i+[1]);',
  8551. ' DoInt([1]+i);',
  8552. ' DoOpenInt([1]);',
  8553. ' DoOpenInt([1]+[2]);',
  8554. ' DoOpenInt(i+[1]);',
  8555. ' DoOpenInt([1]+i);',
  8556. ' DoSet([red]);',
  8557. ' DoSet([blue]+[green]);',
  8558. ' DoSet(s+[blue]);',
  8559. ' DoSet([red]+s);',
  8560. '']);
  8561. ConvertProgram;
  8562. CheckSource('TestArray_ArrayLitAsParam',
  8563. LinesToStr([ // statements
  8564. 'this.TArrSet$a = {',
  8565. ' "0": "red",',
  8566. ' red: 0,',
  8567. ' "1": "green",',
  8568. ' green: 1,',
  8569. ' "2": "blue",',
  8570. ' blue: 2',
  8571. '};',
  8572. 'this.DoInt = function (a) {',
  8573. ' $mod.DoInt(rtl.arrayConcatN(a, [1]));',
  8574. ' $mod.DoInt(rtl.arrayConcatN([1], a));',
  8575. ' $mod.DoOpenInt(a);',
  8576. ' $mod.DoOpenInt(rtl.arrayConcatN(a, [1]));',
  8577. ' $mod.DoOpenInt(rtl.arrayConcatN([1], a));',
  8578. '};',
  8579. 'this.DoOpenInt = function (a) {',
  8580. ' $mod.DoOpenInt(rtl.arrayConcatN(a, [1]));',
  8581. ' $mod.DoOpenInt(rtl.arrayConcatN([1], a));',
  8582. ' $mod.DoInt(a);',
  8583. ' $mod.DoInt(rtl.arrayConcatN(a, [1]));',
  8584. ' $mod.DoInt(rtl.arrayConcatN([1], a));',
  8585. '};',
  8586. 'this.DoSet = function (a) {',
  8587. ' $mod.DoSet(rtl.arrayConcatN(a, [$mod.TArrSet$a.red]));',
  8588. ' $mod.DoSet(rtl.arrayConcatN([$mod.TArrSet$a.blue], a));',
  8589. '};',
  8590. 'this.i = [];',
  8591. 'this.s = [];',
  8592. '']),
  8593. LinesToStr([ // $mod.$main
  8594. '$mod.DoInt([1]);',
  8595. '$mod.DoInt(rtl.arrayConcatN([1], [2]));',
  8596. '$mod.DoInt(rtl.arrayConcatN($mod.i, [1]));',
  8597. '$mod.DoInt(rtl.arrayConcatN([1], $mod.i));',
  8598. '$mod.DoOpenInt([1]);',
  8599. '$mod.DoOpenInt(rtl.arrayConcatN([1], [2]));',
  8600. '$mod.DoOpenInt(rtl.arrayConcatN($mod.i, [1]));',
  8601. '$mod.DoOpenInt(rtl.arrayConcatN([1], $mod.i));',
  8602. '$mod.DoSet([$mod.TArrSet$a.red]);',
  8603. '$mod.DoSet(rtl.arrayConcatN([$mod.TArrSet$a.blue], [$mod.TArrSet$a.green]));',
  8604. '$mod.DoSet(rtl.arrayConcatN($mod.s, [$mod.TArrSet$a.blue]));',
  8605. '$mod.DoSet(rtl.arrayConcatN([$mod.TArrSet$a.red], $mod.s));',
  8606. '']));
  8607. end;
  8608. procedure TTestModule.TestArray_ArrayLitMultiDimAsParam;
  8609. begin
  8610. StartProgram(false);
  8611. Add([
  8612. '{$modeswitch arrayoperators}',
  8613. 'type',
  8614. ' integer = longint;',
  8615. ' TArrInt = array of integer;',
  8616. ' TArrArrInt = array of TArrInt;',
  8617. 'procedure DoInt(a: TArrArrInt);',
  8618. 'begin',
  8619. ' DoInt(a+[[1]]);',
  8620. ' DoInt([[1]]+a);',
  8621. ' DoInt(a);',
  8622. 'end;',
  8623. 'var',
  8624. ' i: TArrInt;',
  8625. ' a: TArrArrInt;',
  8626. 'begin',
  8627. ' a:=[[1]];',
  8628. ' a:=[i];',
  8629. ' a:=a+[i];',
  8630. ' a:=[i]+a;',
  8631. ' a:=[[1]+i];',
  8632. ' a:=[[1]+[2]];',
  8633. ' a:=[i+[2]];',
  8634. ' DoInt([[1]]);',
  8635. ' DoInt([[1]+[2],[3,4],[5]]);',
  8636. ' DoInt([i+[1]]+a);',
  8637. ' DoInt([i]+a);',
  8638. '']);
  8639. ConvertProgram;
  8640. CheckSource('TestArray_ArrayLitMultiDimAsParam',
  8641. LinesToStr([ // statements
  8642. 'this.DoInt = function (a) {',
  8643. ' $mod.DoInt(rtl.arrayConcatN(a, [[1]]));',
  8644. ' $mod.DoInt(rtl.arrayConcatN([[1]], a));',
  8645. ' $mod.DoInt(a);',
  8646. '};',
  8647. 'this.i = [];',
  8648. 'this.a = [];',
  8649. '']),
  8650. LinesToStr([ // $mod.$main
  8651. '$mod.a = [[1]];',
  8652. '$mod.a = [$mod.i];',
  8653. '$mod.a = rtl.arrayConcatN($mod.a, [$mod.i]);',
  8654. '$mod.a = rtl.arrayConcatN([$mod.i], $mod.a);',
  8655. '$mod.a = [rtl.arrayConcatN([1], $mod.i)];',
  8656. '$mod.a = [rtl.arrayConcatN([1], [2])];',
  8657. '$mod.a = [rtl.arrayConcatN($mod.i, [2])];',
  8658. '$mod.DoInt([[1]]);',
  8659. '$mod.DoInt([rtl.arrayConcatN([1], [2]), [3, 4], [5]]);',
  8660. '$mod.DoInt(rtl.arrayConcatN([rtl.arrayConcatN($mod.i, [1])], $mod.a));',
  8661. '$mod.DoInt(rtl.arrayConcatN([$mod.i], $mod.a));',
  8662. '']));
  8663. end;
  8664. procedure TTestModule.TestArray_ArrayLitStaticAsParam;
  8665. begin
  8666. StartProgram(false);
  8667. Add([
  8668. '{$modeswitch arrayoperators}',
  8669. 'type',
  8670. ' integer = longint;',
  8671. ' TArrInt = array[1..2] of integer;',
  8672. ' TArrArrInt = array of TArrInt;',
  8673. 'procedure DoInt(a: TArrArrInt);',
  8674. 'begin',
  8675. ' DoInt(a+[[1,2]]);',
  8676. ' DoInt([[1,2]]+a);',
  8677. ' DoInt(a);',
  8678. 'end;',
  8679. 'var',
  8680. ' i: TArrInt;',
  8681. ' a: TArrArrInt;',
  8682. 'begin',
  8683. ' a:=[[1,1]];',
  8684. ' a:=[i];',
  8685. ' a:=a+[i];',
  8686. ' a:=[i]+a;',
  8687. ' DoInt([[1,1]]);',
  8688. ' DoInt([[1,2],[3,4]]);',
  8689. '']);
  8690. ConvertProgram;
  8691. CheckSource('TestArray_ArrayLitStaticAsParam',
  8692. LinesToStr([ // statements
  8693. 'this.DoInt = function (a) {',
  8694. ' $mod.DoInt(rtl.arrayConcatN(a, [[1, 2]]));',
  8695. ' $mod.DoInt(rtl.arrayConcatN([[1, 2]], a));',
  8696. ' $mod.DoInt(a);',
  8697. '};',
  8698. 'this.i = rtl.arraySetLength(null, 0, 2);',
  8699. 'this.a = [];',
  8700. '']),
  8701. LinesToStr([ // $mod.$main
  8702. '$mod.a = [[1, 1]];',
  8703. '$mod.a = [$mod.i.slice(0)];',
  8704. '$mod.a = rtl.arrayConcatN($mod.a, [$mod.i.slice(0)]);',
  8705. '$mod.a = rtl.arrayConcatN([$mod.i.slice(0)], $mod.a);',
  8706. '$mod.DoInt([[1, 1]]);',
  8707. '$mod.DoInt([[1, 2], [3, 4]]);',
  8708. '']));
  8709. end;
  8710. procedure TTestModule.TestArray_ForInArrOfString;
  8711. begin
  8712. StartProgram(false);
  8713. Add([
  8714. 'type',
  8715. 'type',
  8716. ' TMonthNameArray = array [1..12] of string;',
  8717. ' TMonthNames = TMonthNameArray;',
  8718. ' TObject = class',
  8719. ' private',
  8720. ' function GetLongMonthNames: TMonthNames; virtual; abstract;',
  8721. ' public',
  8722. ' Property LongMonthNames : TMonthNames Read GetLongMonthNames;',
  8723. ' end;',
  8724. 'var f: TObject;',
  8725. ' Month: string;',
  8726. 'begin',
  8727. ' for Month in f.LongMonthNames do ;',
  8728. '']);
  8729. ConvertProgram;
  8730. CheckSource('TestArray_ForInArrOfString',
  8731. LinesToStr([ // statements
  8732. 'rtl.createClass($mod, "TObject", null, function () {',
  8733. ' this.$init = function () {',
  8734. ' };',
  8735. ' this.$final = function () {',
  8736. ' };',
  8737. '});',
  8738. 'this.f = null;',
  8739. 'this.Month = "";',
  8740. '']),
  8741. LinesToStr([ // $mod.$main
  8742. 'for (var $in1 = $mod.f.GetLongMonthNames(), $l2 = 0, $end3 = rtl.length($in1) - 1; $l2 <= $end3; $l2++) $mod.Month = $in1[$l2];',
  8743. '']));
  8744. end;
  8745. procedure TTestModule.TestExternalClass_TypeCastArrayToExternalClass;
  8746. begin
  8747. StartProgram(false);
  8748. Add([
  8749. '{$modeswitch externalclass}',
  8750. 'type',
  8751. ' TJSObject = class external name ''Object''',
  8752. ' end;',
  8753. ' TJSArray = class external name ''Array''',
  8754. ' class function isArray(Value: JSValue) : boolean;',
  8755. ' function concat() : TJSArray; varargs;',
  8756. ' end;',
  8757. 'var',
  8758. ' aObj: TJSArray;',
  8759. ' a: array of longint;',
  8760. ' o: TJSObject;',
  8761. 'begin',
  8762. ' if TJSArray.isArray(65) then ;',
  8763. ' aObj:=TJSArray(a).concat(a);',
  8764. ' o:=TJSObject(a);']);
  8765. ConvertProgram;
  8766. CheckSource('TestExternalClass_TypeCastArrayToExternalClass',
  8767. LinesToStr([ // statements
  8768. 'this.aObj = null;',
  8769. 'this.a = [];',
  8770. 'this.o = null;',
  8771. '']),
  8772. LinesToStr([ // $mod.$main
  8773. 'if (Array.isArray(65)) ;',
  8774. '$mod.aObj = $mod.a.concat($mod.a);',
  8775. '$mod.o = $mod.a;',
  8776. '']));
  8777. end;
  8778. procedure TTestModule.TestExternalClass_TypeCastArrayFromExternalClass;
  8779. begin
  8780. StartProgram(false);
  8781. Add([
  8782. '{$modeswitch externalclass}',
  8783. 'type',
  8784. ' TArrStr = array of string;',
  8785. ' TJSArray = class external name ''Array''',
  8786. ' end;',
  8787. ' TJSObject = class external name ''Object''',
  8788. ' end;',
  8789. 'var',
  8790. ' aObj: TJSArray;',
  8791. ' a: TArrStr;',
  8792. ' jo: TJSObject;',
  8793. 'begin',
  8794. ' a:=TArrStr(aObj);',
  8795. ' TArrStr(aObj)[1]:=TArrStr(aObj)[2];',
  8796. ' a:=TarrStr(jo);',
  8797. '']);
  8798. ConvertProgram;
  8799. CheckSource('TestExternalClass_TypeCastArrayFromExternalClass',
  8800. LinesToStr([ // statements
  8801. 'this.aObj = null;',
  8802. 'this.a = [];',
  8803. 'this.jo = null;',
  8804. '']),
  8805. LinesToStr([ // $mod.$main
  8806. '$mod.a = $mod.aObj;',
  8807. '$mod.aObj[1] = $mod.aObj[2];',
  8808. '$mod.a = $mod.jo;',
  8809. '']));
  8810. end;
  8811. procedure TTestModule.TestRecord_Empty;
  8812. begin
  8813. StartProgram(false);
  8814. Add(['type',
  8815. ' TRecA = record',
  8816. ' end;',
  8817. 'var a,b: TRecA;',
  8818. 'begin',
  8819. ' if a=b then ;']);
  8820. ConvertProgram;
  8821. CheckSource('TestRecord_Empty',
  8822. LinesToStr([ // statements
  8823. 'this.TRecA = function (s) {',
  8824. ' this.$equal = function (b) {',
  8825. ' return true;',
  8826. ' };',
  8827. '};',
  8828. 'this.a = new $mod.TRecA();',
  8829. 'this.b = new $mod.TRecA();'
  8830. ]),
  8831. LinesToStr([ // $mod.$main
  8832. 'if ($mod.a.$equal($mod.b)) ;'
  8833. ]));
  8834. end;
  8835. procedure TTestModule.TestRecord_Var;
  8836. begin
  8837. StartProgram(false);
  8838. Add('type');
  8839. Add(' TRecA = record');
  8840. Add(' Bold: longint;');
  8841. Add(' end;');
  8842. Add('var Rec: TRecA;');
  8843. Add('begin');
  8844. Add(' rec.bold:=123');
  8845. ConvertProgram;
  8846. CheckSource('TestRecord_Var',
  8847. LinesToStr([ // statements
  8848. 'this.TRecA = function (s) {',
  8849. ' if (s) {',
  8850. ' this.Bold = s.Bold;',
  8851. ' } else {',
  8852. ' this.Bold = 0;',
  8853. ' };',
  8854. ' this.$equal = function (b) {',
  8855. ' return this.Bold === b.Bold;',
  8856. ' };',
  8857. '};',
  8858. 'this.Rec = new $mod.TRecA();'
  8859. ]),
  8860. LinesToStr([ // $mod.$main
  8861. '$mod.Rec.Bold = 123;'
  8862. ]));
  8863. end;
  8864. procedure TTestModule.TestRecord_VarExternal;
  8865. begin
  8866. StartProgram(false);
  8867. Add([
  8868. '{$modeswitch externalclass}',
  8869. 'type',
  8870. ' TRecA = record',
  8871. ' i: byte;',
  8872. ' length_: longint external name ''length'';',
  8873. ' end;',
  8874. 'var Rec: TRecA;',
  8875. 'begin',
  8876. ' rec.length_ := rec.length_',
  8877. '']);
  8878. ConvertProgram;
  8879. CheckSource('TestRecord_VarExternal',
  8880. LinesToStr([ // statements
  8881. 'this.TRecA = function (s) {',
  8882. ' if (s) {',
  8883. ' this.i = s.i;',
  8884. ' this.length = s.length;',
  8885. ' } else {',
  8886. ' this.i = 0;',
  8887. ' };',
  8888. ' this.$equal = function (b) {',
  8889. ' return (this.i === b.i) && (this.length === b.length);',
  8890. ' };',
  8891. '};',
  8892. 'this.Rec = new $mod.TRecA();',
  8893. '']),
  8894. LinesToStr([ // $mod.$main
  8895. '$mod.Rec.length = $mod.Rec.length;'
  8896. ]));
  8897. end;
  8898. procedure TTestModule.TestRecord_WithDo;
  8899. begin
  8900. StartProgram(false);
  8901. Add('type');
  8902. Add(' TRec = record');
  8903. Add(' vI: longint;');
  8904. Add(' end;');
  8905. Add('var');
  8906. Add(' Int: longint;');
  8907. Add(' r: TRec;');
  8908. Add('begin');
  8909. Add(' with r do');
  8910. Add(' int:=vi;');
  8911. Add(' with r do begin');
  8912. Add(' int:=vi;');
  8913. Add(' vi:=int;');
  8914. Add(' end;');
  8915. ConvertProgram;
  8916. CheckSource('TestWithRecordDo',
  8917. LinesToStr([ // statements
  8918. 'this.TRec = function (s) {',
  8919. ' if (s) {',
  8920. ' this.vI = s.vI;',
  8921. ' } else {',
  8922. ' this.vI = 0;',
  8923. ' };',
  8924. ' this.$equal = function (b) {',
  8925. ' return this.vI === b.vI;',
  8926. ' };',
  8927. '};',
  8928. 'this.Int = 0;',
  8929. 'this.r = new $mod.TRec();'
  8930. ]),
  8931. LinesToStr([ // $mod.$main
  8932. 'var $with1 = $mod.r;',
  8933. '$mod.Int = $with1.vI;',
  8934. 'var $with2 = $mod.r;',
  8935. '$mod.Int = $with2.vI;',
  8936. '$with2.vI = $mod.Int;'
  8937. ]));
  8938. end;
  8939. procedure TTestModule.TestRecord_Assign;
  8940. begin
  8941. StartProgram(false);
  8942. Add('type');
  8943. Add(' TEnum = (red,green);');
  8944. Add(' TEnums = set of TEnum;');
  8945. Add(' TSmallRec = record');
  8946. Add(' N: longint;');
  8947. Add(' end;');
  8948. Add(' TBigRec = record');
  8949. Add(' Int: longint;');
  8950. Add(' D: double;');
  8951. Add(' Arr: array of longint;');
  8952. Add(' Arr2: array[1..2] of longint;');
  8953. Add(' Small: TSmallRec;');
  8954. Add(' Enums: TEnums;');
  8955. Add(' end;');
  8956. Add('var');
  8957. Add(' r, s: TBigRec;');
  8958. Add('begin');
  8959. Add(' r:=s;');
  8960. Add(' r:=default(TBigRec);');
  8961. Add(' r:=default(s);');
  8962. ConvertProgram;
  8963. CheckSource('TestRecord_Assign',
  8964. LinesToStr([ // statements
  8965. 'this.TEnum = {',
  8966. ' "0": "red",',
  8967. ' red: 0,',
  8968. ' "1": "green",',
  8969. ' green: 1',
  8970. '};',
  8971. 'this.TSmallRec = function (s) {',
  8972. ' if(s){',
  8973. ' this.N = s.N;',
  8974. ' } else {',
  8975. ' this.N = 0;',
  8976. ' };',
  8977. ' this.$equal = function (b) {',
  8978. ' return this.N === b.N;',
  8979. ' };',
  8980. '};',
  8981. 'this.TBigRec = function (s) {',
  8982. ' if(s){',
  8983. ' this.Int = s.Int;',
  8984. ' this.D = s.D;',
  8985. ' this.Arr = s.Arr;',
  8986. ' this.Arr2 = s.Arr2.slice(0);',
  8987. ' this.Small = new $mod.TSmallRec(s.Small);',
  8988. ' this.Enums = rtl.refSet(s.Enums);',
  8989. ' } else {',
  8990. ' this.Int = 0;',
  8991. ' this.D = 0.0;',
  8992. ' this.Arr = [];',
  8993. ' this.Arr2 = rtl.arraySetLength(null, 0, 2);',
  8994. ' this.Small = new $mod.TSmallRec();',
  8995. ' this.Enums = {};',
  8996. ' };',
  8997. ' this.$equal = function (b) {',
  8998. ' return (this.Int === b.Int) && (this.D === b.D) && (this.Arr === b.Arr)',
  8999. ' && rtl.arrayEq(this.Arr2, b.Arr2)',
  9000. ' && this.Small.$equal(b.Small) && rtl.eqSet(this.Enums, b.Enums);',
  9001. ' };',
  9002. '};',
  9003. 'this.r = new $mod.TBigRec();',
  9004. 'this.s = new $mod.TBigRec();'
  9005. ]),
  9006. LinesToStr([ // $mod.$main
  9007. '$mod.r = new $mod.TBigRec($mod.s);',
  9008. '$mod.r = new $mod.TBigRec();',
  9009. '$mod.r = new $mod.TBigRec();',
  9010. '']));
  9011. end;
  9012. procedure TTestModule.TestRecord_PassAsArgClone;
  9013. begin
  9014. StartProgram(false);
  9015. Add('type');
  9016. Add(' TRecA = record');
  9017. Add(' Bold: longint;');
  9018. Add(' end;');
  9019. Add('procedure DoDefault(r: treca); begin end;');
  9020. Add('procedure DoConst(const r: treca); begin end;');
  9021. Add('var Rec: treca;');
  9022. Add('begin');
  9023. Add(' dodefault(rec);');
  9024. Add(' doconst(rec);');
  9025. ConvertProgram;
  9026. CheckSource('TestRecord_PassAsArgClone',
  9027. LinesToStr([ // statements
  9028. 'this.TRecA = function (s) {',
  9029. ' if (s) {',
  9030. ' this.Bold = s.Bold;',
  9031. ' } else {',
  9032. ' this.Bold = 0;',
  9033. ' };',
  9034. ' this.$equal = function (b) {',
  9035. ' return this.Bold === b.Bold;',
  9036. ' };',
  9037. '};',
  9038. 'this.DoDefault = function (r) {',
  9039. '};',
  9040. 'this.DoConst = function (r) {',
  9041. '};',
  9042. 'this.Rec = new $mod.TRecA();'
  9043. ]),
  9044. LinesToStr([ // $mod.$main
  9045. '$mod.DoDefault(new $mod.TRecA($mod.Rec));',
  9046. '$mod.DoConst($mod.Rec);',
  9047. '']));
  9048. end;
  9049. procedure TTestModule.TestRecord_AsParams;
  9050. begin
  9051. StartProgram(false);
  9052. Add('type');
  9053. Add(' integer = longint;');
  9054. Add(' TRecord = record');
  9055. Add(' i: integer;');
  9056. Add(' end;');
  9057. Add('procedure DoIt(vG: TRecord; const vH: TRecord; var vI: TRecord);');
  9058. Add('var vJ: TRecord;');
  9059. Add('begin');
  9060. Add(' vg:=vg;');
  9061. Add(' vj:=vh;');
  9062. Add(' vi:=vi;');
  9063. Add(' doit(vg,vg,vg);');
  9064. Add(' doit(vh,vh,vj);');
  9065. Add(' doit(vi,vi,vi);');
  9066. Add(' doit(vj,vj,vj);');
  9067. Add('end;');
  9068. Add('var i: TRecord;');
  9069. Add('begin');
  9070. Add(' doit(i,i,i);');
  9071. ConvertProgram;
  9072. CheckSource('TestRecord_AsParams',
  9073. LinesToStr([ // statements
  9074. 'this.TRecord = function (s) {',
  9075. ' if (s) {',
  9076. ' this.i = s.i;',
  9077. ' } else {',
  9078. ' this.i = 0;',
  9079. ' };',
  9080. ' this.$equal = function (b) {',
  9081. ' return this.i === b.i;',
  9082. ' };',
  9083. '};',
  9084. 'this.DoIt = function (vG,vH,vI) {',
  9085. ' var vJ = new $mod.TRecord();',
  9086. ' vG = new $mod.TRecord(vG);',
  9087. ' vJ = new $mod.TRecord(vH);',
  9088. ' vI.set(new $mod.TRecord(vI.get()));',
  9089. ' $mod.DoIt(new $mod.TRecord(vG), vG, {',
  9090. ' get: function () {',
  9091. ' return vG;',
  9092. ' },',
  9093. ' set: function (v) {',
  9094. ' vG = v;',
  9095. ' }',
  9096. ' });',
  9097. ' $mod.DoIt(new $mod.TRecord(vH), vH, {',
  9098. ' get: function () {',
  9099. ' return vJ;',
  9100. ' },',
  9101. ' set: function (v) {',
  9102. ' vJ = v;',
  9103. ' }',
  9104. ' });',
  9105. ' $mod.DoIt(new $mod.TRecord(vI.get()), vI.get(), vI);',
  9106. ' $mod.DoIt(new $mod.TRecord(vJ), vJ, {',
  9107. ' get: function () {',
  9108. ' return vJ;',
  9109. ' },',
  9110. ' set: function (v) {',
  9111. ' vJ = v;',
  9112. ' }',
  9113. ' });',
  9114. '};',
  9115. 'this.i = new $mod.TRecord();'
  9116. ]),
  9117. LinesToStr([
  9118. '$mod.DoIt(new $mod.TRecord($mod.i),$mod.i,{',
  9119. ' p: $mod,',
  9120. ' get: function () {',
  9121. ' return this.p.i;',
  9122. ' },',
  9123. ' set: function (v) {',
  9124. ' this.p.i = v;',
  9125. ' }',
  9126. '});'
  9127. ]));
  9128. end;
  9129. procedure TTestModule.TestRecordElement_AsParams;
  9130. begin
  9131. StartProgram(false);
  9132. Add('type');
  9133. Add(' integer = longint;');
  9134. Add(' TRecord = record');
  9135. Add(' i: integer;');
  9136. Add(' end;');
  9137. Add('procedure DoIt(vG: integer; const vH: integer; var vI: integer);');
  9138. Add('var vJ: TRecord;');
  9139. Add('begin');
  9140. Add(' doit(vj.i,vj.i,vj.i);');
  9141. Add('end;');
  9142. Add('var r: TRecord;');
  9143. Add('begin');
  9144. Add(' doit(r.i,r.i,r.i);');
  9145. ConvertProgram;
  9146. CheckSource('TestRecordElement_AsParams',
  9147. LinesToStr([ // statements
  9148. 'this.TRecord = function (s) {',
  9149. ' if (s) {',
  9150. ' this.i = s.i;',
  9151. ' } else {',
  9152. ' this.i = 0;',
  9153. ' };',
  9154. ' this.$equal = function (b) {',
  9155. ' return this.i === b.i;',
  9156. ' };',
  9157. '};',
  9158. 'this.DoIt = function (vG,vH,vI) {',
  9159. ' var vJ = new $mod.TRecord();',
  9160. ' $mod.DoIt(vJ.i, vJ.i, {',
  9161. ' p: vJ,',
  9162. ' get: function () {',
  9163. ' return this.p.i;',
  9164. ' },',
  9165. ' set: function (v) {',
  9166. ' this.p.i = v;',
  9167. ' }',
  9168. ' });',
  9169. '};',
  9170. 'this.r = new $mod.TRecord();'
  9171. ]),
  9172. LinesToStr([
  9173. '$mod.DoIt($mod.r.i,$mod.r.i,{',
  9174. ' p: $mod.r,',
  9175. ' get: function () {',
  9176. ' return this.p.i;',
  9177. ' },',
  9178. ' set: function (v) {',
  9179. ' this.p.i = v;',
  9180. ' }',
  9181. '});'
  9182. ]));
  9183. end;
  9184. procedure TTestModule.TestRecordElementFromFuncResult_AsParams;
  9185. begin
  9186. StartProgram(false);
  9187. Add('type');
  9188. Add(' integer = longint;');
  9189. Add(' TRecord = record');
  9190. Add(' i: integer;');
  9191. Add(' end;');
  9192. Add('function GetRec(vB: integer = 0): TRecord;');
  9193. Add('begin');
  9194. Add('end;');
  9195. Add('procedure DoIt(vG: integer; const vH: integer);');
  9196. Add('begin');
  9197. Add('end;');
  9198. Add('begin');
  9199. Add(' doit(getrec.i,getrec.i);');
  9200. Add(' doit(getrec().i,getrec().i);');
  9201. Add(' doit(getrec(1).i,getrec(2).i);');
  9202. ConvertProgram;
  9203. CheckSource('TestRecordElementFromFuncResult_AsParams',
  9204. LinesToStr([ // statements
  9205. 'this.TRecord = function (s) {',
  9206. ' if (s) {',
  9207. ' this.i = s.i;',
  9208. ' } else {',
  9209. ' this.i = 0;',
  9210. ' };',
  9211. ' this.$equal = function (b) {',
  9212. ' return this.i === b.i;',
  9213. ' };',
  9214. '};',
  9215. 'this.GetRec = function (vB) {',
  9216. ' var Result = new $mod.TRecord();',
  9217. ' return Result;',
  9218. '};',
  9219. 'this.DoIt = function (vG,vH) {',
  9220. '};'
  9221. ]),
  9222. LinesToStr([
  9223. '$mod.DoIt($mod.GetRec(0).i,$mod.GetRec(0).i);',
  9224. '$mod.DoIt($mod.GetRec(0).i,$mod.GetRec(0).i);',
  9225. '$mod.DoIt($mod.GetRec(1).i,$mod.GetRec(2).i);',
  9226. '']));
  9227. end;
  9228. procedure TTestModule.TestRecordElementFromWith_AsParams;
  9229. begin
  9230. StartProgram(false);
  9231. Add('type');
  9232. Add(' integer = longint;');
  9233. Add(' TRecord = record');
  9234. Add(' i: integer;');
  9235. Add(' end;');
  9236. Add('procedure DoIt(vG: integer; const vH: integer; var vI: integer);');
  9237. Add('begin');
  9238. Add('end;');
  9239. Add('var r: trecord;');
  9240. Add('begin');
  9241. Add(' with r do ');
  9242. Add(' doit(i,i,i);');
  9243. ConvertProgram;
  9244. CheckSource('TestRecordElementFromWith_AsParams',
  9245. LinesToStr([ // statements
  9246. 'this.TRecord = function (s) {',
  9247. ' if (s) {',
  9248. ' this.i = s.i;',
  9249. ' } else {',
  9250. ' this.i = 0;',
  9251. ' };',
  9252. ' this.$equal = function (b) {',
  9253. ' return this.i === b.i;',
  9254. ' };',
  9255. '};',
  9256. 'this.DoIt = function (vG,vH,vI) {',
  9257. '};',
  9258. 'this.r = new $mod.TRecord();'
  9259. ]),
  9260. LinesToStr([
  9261. 'var $with1 = $mod.r;',
  9262. '$mod.DoIt($with1.i,$with1.i,{',
  9263. ' p: $with1,',
  9264. ' get: function () {',
  9265. ' return this.p.i;',
  9266. ' },',
  9267. ' set: function (v) {',
  9268. ' this.p.i = v;',
  9269. ' }',
  9270. '});',
  9271. '']));
  9272. end;
  9273. procedure TTestModule.TestRecord_Equal;
  9274. begin
  9275. StartProgram(false);
  9276. Add('type');
  9277. Add(' integer = longint;');
  9278. Add(' TFlag = (red,blue);');
  9279. Add(' TFlags = set of TFlag;');
  9280. Add(' TProc = procedure;');
  9281. Add(' TRecord = record');
  9282. Add(' i: integer;');
  9283. Add(' Event: TProc;');
  9284. Add(' f: TFlags;');
  9285. Add(' end;');
  9286. Add(' TNested = record');
  9287. Add(' r: TRecord;');
  9288. Add(' end;');
  9289. Add('var');
  9290. Add(' b: boolean;');
  9291. Add(' r,s: trecord;');
  9292. Add('begin');
  9293. Add(' b:=r=s;');
  9294. Add(' b:=r<>s;');
  9295. ConvertProgram;
  9296. CheckSource('TestRecord_Equal',
  9297. LinesToStr([ // statements
  9298. 'this.TFlag = {',
  9299. ' "0": "red",',
  9300. ' red: 0,',
  9301. ' "1": "blue",',
  9302. ' blue: 1',
  9303. '};',
  9304. 'this.TRecord = function (s) {',
  9305. ' if (s) {',
  9306. ' this.i = s.i;',
  9307. ' this.Event = s.Event;',
  9308. ' this.f = rtl.refSet(s.f);',
  9309. ' } else {',
  9310. ' this.i = 0;',
  9311. ' this.Event = null;',
  9312. ' this.f = {};',
  9313. ' };',
  9314. ' this.$equal = function (b) {',
  9315. ' return (this.i === b.i) && rtl.eqCallback(this.Event, b.Event) && rtl.eqSet(this.f, b.f);',
  9316. ' };',
  9317. '};',
  9318. 'this.TNested = function (s) {',
  9319. ' if (s) {',
  9320. ' this.r = new $mod.TRecord(s.r);',
  9321. ' } else {',
  9322. ' this.r = new $mod.TRecord();',
  9323. ' };',
  9324. ' this.$equal = function (b) {',
  9325. ' return this.r.$equal(b.r);',
  9326. ' };',
  9327. '};',
  9328. 'this.b = false;',
  9329. 'this.r = new $mod.TRecord();',
  9330. 'this.s = new $mod.TRecord();'
  9331. ]),
  9332. LinesToStr([
  9333. '$mod.b = $mod.r.$equal($mod.s);',
  9334. '$mod.b = !$mod.r.$equal($mod.s);',
  9335. '']));
  9336. end;
  9337. procedure TTestModule.TestRecord_TypeCastJSValueToRecord;
  9338. begin
  9339. StartProgram(false);
  9340. Add('type');
  9341. Add(' TRecord = record');
  9342. Add(' i: longint;');
  9343. Add(' end;');
  9344. Add('var');
  9345. Add(' Jv: jsvalue;');
  9346. Add(' Rec: trecord;');
  9347. Add('begin');
  9348. Add(' rec:=trecord(jv);');
  9349. ConvertProgram;
  9350. CheckSource('TestRecord_TypeCastJSValueToRecord',
  9351. LinesToStr([ // statements
  9352. 'this.TRecord = function (s) {',
  9353. ' if (s) {',
  9354. ' this.i = s.i;',
  9355. ' } else {',
  9356. ' this.i = 0;',
  9357. ' };',
  9358. ' this.$equal = function (b) {',
  9359. ' return this.i === b.i;',
  9360. ' };',
  9361. '};',
  9362. 'this.Jv = undefined;',
  9363. 'this.Rec = new $mod.TRecord();'
  9364. ]),
  9365. LinesToStr([
  9366. '$mod.Rec = new $mod.TRecord(rtl.getObject($mod.Jv));',
  9367. '']));
  9368. end;
  9369. procedure TTestModule.TestRecord_VariantFail;
  9370. begin
  9371. StartProgram(false);
  9372. Add([
  9373. 'type',
  9374. ' TRec = record',
  9375. ' case word of',
  9376. ' 0: (b0, b1: Byte);',
  9377. ' 1: (i: word);',
  9378. ' end;',
  9379. 'begin']);
  9380. SetExpectedPasResolverError('variant record is not supported',
  9381. nXIsNotSupported);
  9382. ConvertProgram;
  9383. end;
  9384. procedure TTestModule.TestRecord_FieldArray;
  9385. begin
  9386. StartProgram(false);
  9387. Add([
  9388. 'type',
  9389. ' TArrInt = array[3..4] of longint;',
  9390. ' TArrArrInt = array[3..4] of longint;',
  9391. ' TRec = record',
  9392. ' a: array of longint;',
  9393. ' s: array[1..2] of longint;',
  9394. ' m: array[1..2,3..4] of longint;',
  9395. ' o: TArrArrInt;',
  9396. ' end;',
  9397. 'begin']);
  9398. ConvertProgram;
  9399. CheckSource('TestRecord_FieldArray',
  9400. LinesToStr([ // statements
  9401. 'this.TRec = function (s) {',
  9402. ' if (s) {',
  9403. ' this.a = s.a;',
  9404. ' this.s = s.s.slice(0);',
  9405. ' this.m = s.m.slice(0);',
  9406. ' this.o = s.o.slice(0);',
  9407. ' } else {',
  9408. ' this.a = [];',
  9409. ' this.s = rtl.arraySetLength(null, 0, 2);',
  9410. ' this.m = rtl.arraySetLength(null, 0, 2, 2);',
  9411. ' this.o = rtl.arraySetLength(null, 0, 2);',
  9412. ' };',
  9413. ' this.$equal = function (b) {',
  9414. ' return (this.a === b.a) && rtl.arrayEq(this.s, b.s) && rtl.arrayEq(this.m, b.m) && rtl.arrayEq(this.o, b.o);',
  9415. ' };',
  9416. '};',
  9417. '']),
  9418. LinesToStr([ // $mod.$main
  9419. '']));
  9420. end;
  9421. procedure TTestModule.TestRecord_Const;
  9422. begin
  9423. StartProgram(false);
  9424. Add([
  9425. 'type',
  9426. ' TArrInt = array[3..4] of longint;',
  9427. ' TPoint = record x,y: longint; end;',
  9428. ' TRec = record',
  9429. ' i: longint;',
  9430. ' a: array of longint;',
  9431. ' s: array[1..2] of longint;',
  9432. ' m: array[1..2,3..4] of longint;',
  9433. ' p: TPoint;',
  9434. ' end;',
  9435. ' TPoints = array of TPoint;',
  9436. 'const',
  9437. ' r: TRec = (',
  9438. ' i:1;',
  9439. ' a:(2,3);',
  9440. ' s:(4,5);',
  9441. ' m:( (11,12), (13,14) );',
  9442. ' p: (x:21; y:22)',
  9443. ' );',
  9444. ' p: TPoints = ( (x:1;y:2), (x:3;y:4) );',
  9445. 'begin']);
  9446. ConvertProgram;
  9447. CheckSource('TestRecord_Const',
  9448. LinesToStr([ // statements
  9449. 'this.TPoint = function (s) {',
  9450. ' if (s) {',
  9451. ' this.x = s.x;',
  9452. ' this.y = s.y;',
  9453. ' } else {',
  9454. ' this.x = 0;',
  9455. ' this.y = 0;',
  9456. ' };',
  9457. ' this.$equal = function (b) {',
  9458. ' return (this.x === b.x) && (this.y === b.y);',
  9459. ' };',
  9460. '};',
  9461. 'this.TRec = function (s) {',
  9462. ' if (s) {',
  9463. ' this.i = s.i;',
  9464. ' this.a = s.a;',
  9465. ' this.s = s.s.slice(0);',
  9466. ' this.m = s.m.slice(0);',
  9467. ' this.p = new $mod.TPoint(s.p);',
  9468. ' } else {',
  9469. ' this.i = 0;',
  9470. ' this.a = [];',
  9471. ' this.s = rtl.arraySetLength(null, 0, 2);',
  9472. ' this.m = rtl.arraySetLength(null, 0, 2, 2);',
  9473. ' this.p = new $mod.TPoint();',
  9474. ' };',
  9475. ' this.$equal = function (b) {',
  9476. ' return (this.i === b.i) && (this.a === b.a) && rtl.arrayEq(this.s, b.s) && rtl.arrayEq(this.m, b.m) && this.p.$equal(b.p);',
  9477. ' };',
  9478. '};',
  9479. 'this.r = new $mod.TRec({',
  9480. ' i: 1,',
  9481. ' a: [2, 3],',
  9482. ' s: [4, 5],',
  9483. ' m: [[11, 12], [13, 14]],',
  9484. ' p: new $mod.TPoint({',
  9485. ' x: 21,',
  9486. ' y: 22',
  9487. ' })',
  9488. '});',
  9489. 'this.p = [new $mod.TPoint({',
  9490. ' x: 1,',
  9491. ' y: 2',
  9492. '}), new $mod.TPoint({',
  9493. ' x: 3,',
  9494. ' y: 4',
  9495. '})];',
  9496. '']),
  9497. LinesToStr([ // $mod.$main
  9498. '']));
  9499. end;
  9500. procedure TTestModule.TestRecord_TypecastFail;
  9501. begin
  9502. StartProgram(false);
  9503. Add([
  9504. 'type',
  9505. ' TPoint = record x,y: longint; end;',
  9506. ' TRec = record l: longint end;',
  9507. 'var p: TPoint;',
  9508. 'begin',
  9509. ' if TRec(p).l=2 then ;']);
  9510. SetExpectedPasResolverError('Illegal type conversion: "TPoint" to "record TRec"',
  9511. nIllegalTypeConversionTo);
  9512. ConvertProgram;
  9513. end;
  9514. procedure TTestModule.TestRecord_InFunction;
  9515. begin
  9516. StartProgram(false);
  9517. Add([
  9518. 'var TPoint: longint = 3;',
  9519. 'procedure DoIt;',
  9520. 'type',
  9521. ' TPoint = record x,y: longint; end;',
  9522. ' TPoints = array of TPoint;',
  9523. 'var',
  9524. ' r: TPoint;',
  9525. ' p: TPoints;',
  9526. 'begin',
  9527. ' SetLength(p,2);',
  9528. 'end;',
  9529. 'begin']);
  9530. ConvertProgram;
  9531. CheckSource('TestRecord_InFunction',
  9532. LinesToStr([ // statements
  9533. 'this.TPoint = 3;',
  9534. 'var TPoint$1 = function (s) {',
  9535. ' if (s) {',
  9536. ' this.x = s.x;',
  9537. ' this.y = s.y;',
  9538. ' } else {',
  9539. ' this.x = 0;',
  9540. ' this.y = 0;',
  9541. ' };',
  9542. ' this.$equal = function (b) {',
  9543. ' return (this.x === b.x) && (this.y === b.y);',
  9544. ' };',
  9545. '};',
  9546. 'this.DoIt = function () {',
  9547. ' var r = new TPoint$1();',
  9548. ' var p = [];',
  9549. ' p = rtl.arraySetLength(p, TPoint$1, 2);',
  9550. '};',
  9551. '']),
  9552. LinesToStr([ // $mod.$main
  9553. '']));
  9554. end;
  9555. procedure TTestModule.TestClass_TObjectDefaultConstructor;
  9556. begin
  9557. StartProgram(false);
  9558. Add(['type',
  9559. ' TObject = class',
  9560. ' public',
  9561. ' constructor Create;',
  9562. ' destructor Destroy;',
  9563. ' end;',
  9564. ' TBird = TObject;',
  9565. 'constructor tobject.create;',
  9566. 'begin end;',
  9567. 'destructor tobject.destroy;',
  9568. 'begin end;',
  9569. 'var Obj: tobject;',
  9570. 'begin',
  9571. ' obj:=tobject.create;',
  9572. ' obj:=tobject.create();',
  9573. ' obj:=tbird.create;',
  9574. ' obj:=tbird.create();',
  9575. ' obj.destroy;',
  9576. '']);
  9577. ConvertProgram;
  9578. CheckSource('TestClass_TObjectDefaultConstructor',
  9579. LinesToStr([ // statements
  9580. 'rtl.createClass($mod,"TObject",null,function(){',
  9581. ' this.$init = function () {',
  9582. ' };',
  9583. ' this.$final = function () {',
  9584. ' };',
  9585. ' this.Create = function(){',
  9586. ' };',
  9587. ' this.Destroy = function(){',
  9588. ' };',
  9589. '});',
  9590. 'this.Obj = null;'
  9591. ]),
  9592. LinesToStr([ // $mod.$main
  9593. '$mod.Obj = $mod.TObject.$create("Create");',
  9594. '$mod.Obj = $mod.TObject.$create("Create");',
  9595. '$mod.Obj = $mod.TObject.$create("Create");',
  9596. '$mod.Obj = $mod.TObject.$create("Create");',
  9597. '$mod.Obj.$destroy("Destroy");',
  9598. '']));
  9599. end;
  9600. procedure TTestModule.TestClass_TObjectConstructorWithParams;
  9601. begin
  9602. StartProgram(false);
  9603. Add('type');
  9604. Add(' TObject = class');
  9605. Add(' public');
  9606. Add(' constructor Create(Par: longint);');
  9607. Add(' end;');
  9608. Add('constructor tobject.create(par: longint);');
  9609. Add('begin end;');
  9610. Add('var Obj: tobject;');
  9611. Add('begin');
  9612. Add(' obj:=tobject.create(3);');
  9613. ConvertProgram;
  9614. CheckSource('TestClass_TObjectConstructorWithParams',
  9615. LinesToStr([ // statements
  9616. 'rtl.createClass($mod,"TObject",null,function(){',
  9617. ' this.$init = function () {',
  9618. ' };',
  9619. ' this.$final = function () {',
  9620. ' };',
  9621. ' this.Create = function(Par){',
  9622. ' };',
  9623. '});',
  9624. 'this.Obj = null;'
  9625. ]),
  9626. LinesToStr([ // $mod.$main
  9627. '$mod.Obj = $mod.TObject.$create("Create",[3]);'
  9628. ]));
  9629. end;
  9630. procedure TTestModule.TestClass_TObjectConstructorWithDefaultParam;
  9631. begin
  9632. StartProgram(false);
  9633. Add('type');
  9634. Add(' TObject = class');
  9635. Add(' public');
  9636. Add(' constructor Create;');
  9637. Add(' end;');
  9638. Add(' TTest = class(TObject)');
  9639. Add(' public');
  9640. Add(' constructor Create(const Par: longint = 1);');
  9641. Add(' end;');
  9642. Add('constructor tobject.create;');
  9643. Add('begin end;');
  9644. Add('constructor ttest.create(const par: longint);');
  9645. Add('begin end;');
  9646. Add('var t: ttest;');
  9647. Add('begin');
  9648. Add(' t:=ttest.create;');
  9649. Add(' t:=ttest.create(2);');
  9650. ConvertProgram;
  9651. CheckSource('TestClass_TObjectConstructorWithDefaultParam',
  9652. LinesToStr([ // statements
  9653. 'rtl.createClass($mod,"TObject",null,function(){',
  9654. ' this.$init = function () {',
  9655. ' };',
  9656. ' this.$final = function () {',
  9657. ' };',
  9658. ' this.Create = function(){',
  9659. ' };',
  9660. '});',
  9661. 'rtl.createClass($mod, "TTest", $mod.TObject, function () {',
  9662. ' this.Create$1 = function (Par) {',
  9663. ' };',
  9664. '});',
  9665. 'this.t = null;'
  9666. ]),
  9667. LinesToStr([ // $mod.$main
  9668. '$mod.t = $mod.TTest.$create("Create$1", [1]);',
  9669. '$mod.t = $mod.TTest.$create("Create$1", [2]);'
  9670. ]));
  9671. end;
  9672. procedure TTestModule.TestClass_Var;
  9673. begin
  9674. StartProgram(false);
  9675. Add('type');
  9676. Add(' TObject = class');
  9677. Add(' public');
  9678. Add(' vI: longint;');
  9679. Add(' constructor Create(Par: longint);');
  9680. Add(' end;');
  9681. Add('constructor tobject.create(par: longint);');
  9682. Add('begin');
  9683. Add(' vi:=par+3');
  9684. Add('end;');
  9685. Add('var Obj: tobject;');
  9686. Add('begin');
  9687. Add(' obj:=tobject.create(4);');
  9688. Add(' obj.vi:=obj.VI+5;');
  9689. ConvertProgram;
  9690. CheckSource('TestClass_Var',
  9691. LinesToStr([ // statements
  9692. 'rtl.createClass($mod,"TObject",null,function(){',
  9693. ' this.$init = function () {',
  9694. ' this.vI = 0;',
  9695. ' };',
  9696. ' this.$final = function () {',
  9697. ' };',
  9698. ' this.Create = function(Par){',
  9699. ' this.vI = Par+3;',
  9700. ' };',
  9701. '});',
  9702. 'this.Obj = null;'
  9703. ]),
  9704. LinesToStr([ // $mod.$main
  9705. '$mod.Obj = $mod.TObject.$create("Create",[4]);',
  9706. '$mod.Obj.vI = $mod.Obj.vI + 5;'
  9707. ]));
  9708. end;
  9709. procedure TTestModule.TestClass_Method;
  9710. begin
  9711. StartProgram(false);
  9712. Add('type');
  9713. Add(' TObject = class');
  9714. Add(' public');
  9715. Add(' vI: longint;');
  9716. Add(' Sub: TObject;');
  9717. Add(' constructor Create;');
  9718. Add(' function GetIt(Par: longint): tobject;');
  9719. Add(' end;');
  9720. Add('constructor tobject.create; begin end;');
  9721. Add('function tobject.getit(par: longint): tobject;');
  9722. Add('begin');
  9723. Add(' Self.vi:=par+3;');
  9724. Add(' Result:=self.sub;');
  9725. Add('end;');
  9726. Add('var Obj: tobject;');
  9727. Add('begin');
  9728. Add(' obj:=tobject.create;');
  9729. Add(' obj.getit(4);');
  9730. Add(' obj.sub.sub:=nil;');
  9731. Add(' obj.sub.getit(5);');
  9732. Add(' obj.sub.getit(6).SUB:=nil;');
  9733. Add(' obj.sub.getit(7).GETIT(8);');
  9734. Add(' obj.sub.getit(9).SuB.getit(10);');
  9735. ConvertProgram;
  9736. CheckSource('TestClass_Method',
  9737. LinesToStr([ // statements
  9738. 'rtl.createClass($mod,"TObject",null,function(){',
  9739. ' this.$init = function () {',
  9740. ' this.vI = 0;',
  9741. ' this.Sub = null;',
  9742. ' };',
  9743. ' this.$final = function () {',
  9744. ' this.Sub = undefined;',
  9745. ' };',
  9746. ' this.Create = function(){',
  9747. ' };',
  9748. ' this.GetIt = function(Par){',
  9749. ' var Result = null;',
  9750. ' this.vI = Par + 3;',
  9751. ' Result = this.Sub;',
  9752. ' return Result;',
  9753. ' };',
  9754. '});',
  9755. 'this.Obj = null;'
  9756. ]),
  9757. LinesToStr([ // $mod.$main
  9758. '$mod.Obj = $mod.TObject.$create("Create");',
  9759. '$mod.Obj.GetIt(4);',
  9760. '$mod.Obj.Sub.Sub=null;',
  9761. '$mod.Obj.Sub.GetIt(5);',
  9762. '$mod.Obj.Sub.GetIt(6).Sub=null;',
  9763. '$mod.Obj.Sub.GetIt(7).GetIt(8);',
  9764. '$mod.Obj.Sub.GetIt(9).Sub.GetIt(10);'
  9765. ]));
  9766. end;
  9767. procedure TTestModule.TestClass_Implementation;
  9768. begin
  9769. StartUnit(false);
  9770. Add([
  9771. 'interface',
  9772. 'type',
  9773. ' TObject = class',
  9774. ' constructor Create;',
  9775. ' end;',
  9776. 'implementation',
  9777. 'type',
  9778. ' TIntClass = class',
  9779. ' constructor Create; reintroduce;',
  9780. ' class procedure DoGlob;',
  9781. ' end;',
  9782. 'constructor tintclass.create;',
  9783. 'begin',
  9784. ' inherited;',
  9785. ' inherited create;',
  9786. ' doglob;',
  9787. 'end;',
  9788. 'class procedure tintclass.doglob;',
  9789. 'begin',
  9790. 'end;',
  9791. 'constructor tobject.create;',
  9792. 'var',
  9793. ' iC: tintclass;',
  9794. 'begin',
  9795. ' ic:=tintclass.create;',
  9796. ' tintclass.doglob;',
  9797. ' ic.doglob;',
  9798. 'end;',
  9799. 'initialization',
  9800. ' tintclass.doglob;',
  9801. '']);
  9802. ConvertUnit;
  9803. CheckSource('TestClass_Implementation',
  9804. LinesToStr([ // statements
  9805. 'var $impl = $mod.$impl;',
  9806. 'rtl.createClass($mod, "TObject", null, function () {',
  9807. ' this.$init = function () {',
  9808. ' };',
  9809. ' this.$final = function () {',
  9810. ' };',
  9811. ' this.Create = function () {',
  9812. ' var iC = null;',
  9813. ' iC = $impl.TIntClass.$create("Create$1");',
  9814. ' $impl.TIntClass.DoGlob();',
  9815. ' iC.$class.DoGlob();',
  9816. ' };',
  9817. '});',
  9818. '']),
  9819. LinesToStr([ // $mod.$main
  9820. '$impl.TIntClass.DoGlob();',
  9821. '']),
  9822. LinesToStr([
  9823. 'rtl.createClass($impl, "TIntClass", $mod.TObject, function () {',
  9824. ' this.Create$1 = function () {',
  9825. ' $mod.TObject.Create.apply(this, arguments);',
  9826. ' $mod.TObject.Create.call(this);',
  9827. ' this.$class.DoGlob();',
  9828. ' };',
  9829. ' this.DoGlob = function () {',
  9830. ' };',
  9831. '});',
  9832. '']));
  9833. end;
  9834. procedure TTestModule.TestClass_Inheritance;
  9835. begin
  9836. StartProgram(false);
  9837. Add('type');
  9838. Add(' TObject = class');
  9839. Add(' public');
  9840. Add(' constructor Create;');
  9841. Add(' end;');
  9842. Add(' TClassA = class');
  9843. Add(' end;');
  9844. Add(' TClassB = class(TObject)');
  9845. Add(' procedure ProcB;');
  9846. Add(' end;');
  9847. Add('constructor tobject.create; begin end;');
  9848. Add('procedure tclassb.procb; begin end;');
  9849. Add('var');
  9850. Add(' oO: TObject;');
  9851. Add(' oA: TClassA;');
  9852. Add(' oB: TClassB;');
  9853. Add('begin');
  9854. Add(' oO:=tobject.Create;');
  9855. Add(' oA:=tclassa.Create;');
  9856. Add(' ob:=tclassb.Create;');
  9857. Add(' if oo is tclassa then ;');
  9858. Add(' ob:=oo as tclassb;');
  9859. Add(' (oo as tclassb).procb;');
  9860. ConvertProgram;
  9861. CheckSource('TestClass_Inheritance',
  9862. LinesToStr([ // statements
  9863. 'rtl.createClass($mod,"TObject",null,function(){',
  9864. ' this.$init = function () {',
  9865. ' };',
  9866. ' this.$final = function () {',
  9867. ' };',
  9868. ' this.Create = function () {',
  9869. ' };',
  9870. '});',
  9871. 'rtl.createClass($mod,"TClassA",$mod.TObject,function(){',
  9872. '});',
  9873. 'rtl.createClass($mod,"TClassB",$mod.TObject,function(){',
  9874. ' this.ProcB = function () {',
  9875. ' };',
  9876. '});',
  9877. 'this.oO = null;',
  9878. 'this.oA = null;',
  9879. 'this.oB = null;'
  9880. ]),
  9881. LinesToStr([ // $mod.$main
  9882. '$mod.oO = $mod.TObject.$create("Create");',
  9883. '$mod.oA = $mod.TClassA.$create("Create");',
  9884. '$mod.oB = $mod.TClassB.$create("Create");',
  9885. 'if ($mod.TClassA.isPrototypeOf($mod.oO));',
  9886. '$mod.oB = rtl.as($mod.oO, $mod.TClassB);',
  9887. 'rtl.as($mod.oO, $mod.TClassB).ProcB();'
  9888. ]));
  9889. end;
  9890. procedure TTestModule.TestClass_TypeAlias;
  9891. begin
  9892. StartProgram(false);
  9893. Add([
  9894. '{$interfaces corba}',
  9895. 'type',
  9896. ' IObject = interface',
  9897. ' end;',
  9898. ' IBird = type IObject;',
  9899. ' TObject = class',
  9900. ' end;',
  9901. ' TBird = type TObject;',
  9902. 'var',
  9903. ' oObj: TObject;',
  9904. ' oBird: TBird;',
  9905. ' IntfObj: IObject;',
  9906. ' IntfBird: IBird;',
  9907. 'begin',
  9908. ' oObj:=oBird;',
  9909. '']);
  9910. ConvertProgram;
  9911. CheckSource('TestClass_TypeAlias',
  9912. LinesToStr([ // statements
  9913. 'rtl.createInterface($mod, "IObject", "{B92D5841-6F2A-306A-8000-000000000000}", [], null);',
  9914. 'rtl.createInterface($mod, "IBird", "{4B0D080B-C0F6-387B-AE88-F10981585074}", [], $mod.IObject);',
  9915. 'rtl.createClass($mod, "TObject", null, function () {',
  9916. ' this.$init = function () {',
  9917. ' };',
  9918. ' this.$final = function () {',
  9919. ' };',
  9920. '});',
  9921. 'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
  9922. '});',
  9923. 'this.oObj = null;',
  9924. 'this.oBird = null;',
  9925. 'this.IntfObj = null;',
  9926. 'this.IntfBird = null;',
  9927. '']),
  9928. LinesToStr([ // $mod.$main
  9929. '$mod.oObj = $mod.oBird;',
  9930. '']));
  9931. end;
  9932. procedure TTestModule.TestClass_AbstractMethod;
  9933. begin
  9934. StartProgram(false);
  9935. Add('type');
  9936. Add(' TObject = class');
  9937. Add(' public');
  9938. Add(' procedure DoIt; virtual; abstract;');
  9939. Add(' end;');
  9940. Add('begin');
  9941. ConvertProgram;
  9942. CheckSource('TestClass_AbstractMethod',
  9943. LinesToStr([ // statements
  9944. 'rtl.createClass($mod,"TObject",null,function(){',
  9945. ' this.$init = function () {',
  9946. ' };',
  9947. ' this.$final = function () {',
  9948. ' };',
  9949. '});'
  9950. ]),
  9951. LinesToStr([ // this.$main
  9952. ''
  9953. ]));
  9954. end;
  9955. procedure TTestModule.TestClass_CallInherited_ProcNoParams;
  9956. begin
  9957. StartProgram(false);
  9958. Add([
  9959. 'type',
  9960. ' TObject = class',
  9961. ' procedure DoAbstract; virtual; abstract;',
  9962. ' procedure DoVirtual; virtual;',
  9963. ' procedure DoIt;',
  9964. ' end;',
  9965. ' TA = class',
  9966. ' procedure doabstract; override;',
  9967. ' procedure dovirtual; override;',
  9968. ' procedure DoSome;',
  9969. ' end;',
  9970. 'procedure tobject.dovirtual;',
  9971. 'begin',
  9972. ' inherited; // call non existing ancestor -> ignore silently',
  9973. 'end;',
  9974. 'procedure tobject.doit;',
  9975. 'begin',
  9976. 'end;',
  9977. 'procedure ta.doabstract;',
  9978. 'begin',
  9979. ' inherited dovirtual; // call TObject.DoVirtual',
  9980. 'end;',
  9981. 'procedure ta.dovirtual;',
  9982. 'begin',
  9983. ' inherited; // call TObject.DoVirtual',
  9984. ' inherited dovirtual; // call TObject.DoVirtual',
  9985. ' inherited dovirtual(); // call TObject.DoVirtual',
  9986. ' doit;',
  9987. ' doit();',
  9988. 'end;',
  9989. 'procedure ta.dosome;',
  9990. 'begin',
  9991. ' inherited; // call non existing ancestor method -> silently ignore',
  9992. 'end;',
  9993. 'begin']);
  9994. ConvertProgram;
  9995. CheckSource('TestClass_CallInherited_ProcNoParams',
  9996. LinesToStr([ // statements
  9997. 'rtl.createClass($mod,"TObject",null,function(){',
  9998. ' this.$init = function () {',
  9999. ' };',
  10000. ' this.$final = function () {',
  10001. ' };',
  10002. ' this.DoVirtual = function () {',
  10003. ' };',
  10004. ' this.DoIt = function () {',
  10005. ' };',
  10006. '});',
  10007. 'rtl.createClass($mod, "TA", $mod.TObject, function () {',
  10008. ' this.DoAbstract = function () {',
  10009. ' $mod.TObject.DoVirtual.call(this);',
  10010. ' };',
  10011. ' this.DoVirtual = function () {',
  10012. ' $mod.TObject.DoVirtual.apply(this, arguments);',
  10013. ' $mod.TObject.DoVirtual.call(this);',
  10014. ' $mod.TObject.DoVirtual.call(this);',
  10015. ' this.DoIt();',
  10016. ' this.DoIt();',
  10017. ' };',
  10018. ' this.DoSome = function () {',
  10019. ' };',
  10020. '});'
  10021. ]),
  10022. LinesToStr([ // this.$main
  10023. ''
  10024. ]));
  10025. end;
  10026. procedure TTestModule.TestClass_CallInherited_WithParams;
  10027. begin
  10028. StartProgram(false);
  10029. Add([
  10030. 'type',
  10031. ' TObject = class',
  10032. ' procedure DoAbstract(pA: longint; pB: longint = 0); virtual; abstract;',
  10033. ' procedure DoVirtual(pA: longint; pB: longint = 0); virtual;',
  10034. ' procedure DoIt(pA: longint; pB: longint = 0);',
  10035. ' procedure DoIt2(pA: longint = 1; pB: longint = 2);',
  10036. ' function GetIt(pA: longint = 1; pB: longint = 2): longint;',
  10037. ' end;',
  10038. ' TClassA = class',
  10039. ' procedure DoAbstract(pA: longint; pB: longint = 0); override;',
  10040. ' procedure DoVirtual(pA: longint; pB: longint = 0); override;',
  10041. ' function GetIt(pA: longint = 1; pB: longint = 2): longint;',
  10042. ' end;',
  10043. 'procedure tobject.dovirtual(pa: longint; pb: longint = 0);',
  10044. 'begin',
  10045. 'end;',
  10046. 'procedure tobject.doit(pa: longint; pb: longint = 0);',
  10047. 'begin',
  10048. 'end;',
  10049. 'procedure tobject.doit2(pa: longint; pb: longint = 0);',
  10050. 'begin',
  10051. 'end;',
  10052. 'function tobject.getit(pa: longint; pb: longint = 0): longint;',
  10053. 'begin',
  10054. 'end;',
  10055. 'procedure tclassa.doabstract(pa: longint; pb: longint = 0);',
  10056. 'begin',
  10057. ' inherited dovirtual(pa,pb); // call TObject.DoVirtual(pA,pB)',
  10058. ' inherited dovirtual(pa); // call TObject.DoVirtual(pA,0)',
  10059. 'end;',
  10060. 'procedure tclassa.dovirtual(pa: longint; pb: longint = 0);',
  10061. 'begin',
  10062. ' inherited; // call TObject.DoVirtual(pA,pB)',
  10063. ' inherited dovirtual(pa,pb); // call TObject.DoVirtual(pA,pB)',
  10064. ' inherited dovirtual(pa); // call TObject.DoVirtual(pA,0)',
  10065. ' doit(pa,pb);',
  10066. ' doit(pa);',
  10067. ' doit2(pa);',
  10068. ' doit2;',
  10069. 'end;',
  10070. 'function tclassa.getit(pa: longint; pb: longint = 0): longint;',
  10071. 'begin',
  10072. ' pa:=inherited;',
  10073. 'end;',
  10074. 'begin']);
  10075. ConvertProgram;
  10076. CheckSource('TestClass_CallInherited_WithParams',
  10077. LinesToStr([ // statements
  10078. 'rtl.createClass($mod,"TObject",null,function(){',
  10079. ' this.$init = function () {',
  10080. ' };',
  10081. ' this.$final = function () {',
  10082. ' };',
  10083. ' this.DoVirtual = function (pA,pB) {',
  10084. ' };',
  10085. ' this.DoIt = function (pA,pB) {',
  10086. ' };',
  10087. ' this.DoIt2 = function (pA,pB) {',
  10088. ' };',
  10089. ' this.GetIt = function (pA, pB) {',
  10090. ' var Result = 0;',
  10091. ' return Result;',
  10092. ' };',
  10093. '});',
  10094. 'rtl.createClass($mod, "TClassA", $mod.TObject, function () {',
  10095. ' this.DoAbstract = function (pA,pB) {',
  10096. ' $mod.TObject.DoVirtual.call(this,pA,pB);',
  10097. ' $mod.TObject.DoVirtual.call(this,pA,0);',
  10098. ' };',
  10099. ' this.DoVirtual = function (pA,pB) {',
  10100. ' $mod.TObject.DoVirtual.apply(this, arguments);',
  10101. ' $mod.TObject.DoVirtual.call(this,pA,pB);',
  10102. ' $mod.TObject.DoVirtual.call(this,pA,0);',
  10103. ' this.DoIt(pA,pB);',
  10104. ' this.DoIt(pA,0);',
  10105. ' this.DoIt2(pA,2);',
  10106. ' this.DoIt2(1,2);',
  10107. ' };',
  10108. ' this.GetIt$1 = function (pA, pB) {',
  10109. ' var Result = 0;',
  10110. ' pA = $mod.TObject.GetIt.apply(this, arguments);',
  10111. ' return Result;',
  10112. ' };',
  10113. '});'
  10114. ]),
  10115. LinesToStr([ // this.$main
  10116. ''
  10117. ]));
  10118. end;
  10119. procedure TTestModule.TestClasS_CallInheritedConstructor;
  10120. begin
  10121. StartProgram(false);
  10122. Add('type');
  10123. Add(' TObject = class');
  10124. Add(' constructor Create; virtual;');
  10125. Add(' constructor CreateWithB(b: boolean);');
  10126. Add(' end;');
  10127. Add(' TA = class');
  10128. Add(' constructor Create; override;');
  10129. Add(' constructor CreateWithC(c: char);');
  10130. Add(' procedure DoIt;');
  10131. Add(' class function DoSome: TObject;');
  10132. Add(' end;');
  10133. Add('constructor tobject.create;');
  10134. Add('begin');
  10135. Add(' inherited; // call non existing ancestor -> ignore silently');
  10136. Add('end;');
  10137. Add('constructor tobject.createwithb(b: boolean);');
  10138. Add('begin');
  10139. Add(' inherited; // call non existing ancestor -> ignore silently');
  10140. Add(' create; // normal call');
  10141. Add('end;');
  10142. Add('constructor ta.create;');
  10143. Add('begin');
  10144. Add(' inherited; // normal call TObject.Create');
  10145. Add(' inherited create; // normal call TObject.Create');
  10146. Add(' inherited createwithb(false); // normal call TObject.CreateWithB');
  10147. Add('end;');
  10148. Add('constructor ta.createwithc(c: char);');
  10149. Add('begin');
  10150. Add(' inherited create; // call TObject.Create');
  10151. Add(' inherited createwithb(true); // call TObject.CreateWithB');
  10152. Add(' doit;');
  10153. Add(' doit();');
  10154. Add(' dosome;');
  10155. Add('end;');
  10156. Add('procedure ta.doit;');
  10157. Add('begin');
  10158. Add(' create; // normal call');
  10159. Add(' createwithb(false); // normal call');
  10160. Add(' createwithc(''c''); // normal call');
  10161. Add('end;');
  10162. Add('class function ta.dosome: TObject;');
  10163. Add('begin');
  10164. Add(' Result:=create; // constructor');
  10165. Add(' Result:=createwithb(true); // constructor');
  10166. Add(' Result:=createwithc(''c''); // constructor');
  10167. Add('end;');
  10168. Add('begin');
  10169. ConvertProgram;
  10170. CheckSource('TestClass_CallInheritedConstructor',
  10171. LinesToStr([ // statements
  10172. 'rtl.createClass($mod,"TObject",null,function(){',
  10173. ' this.$init = function () {',
  10174. ' };',
  10175. ' this.$final = function () {',
  10176. ' };',
  10177. ' this.Create = function () {',
  10178. ' };',
  10179. ' this.CreateWithB = function (b) {',
  10180. ' this.Create();',
  10181. ' };',
  10182. '});',
  10183. 'rtl.createClass($mod, "TA", $mod.TObject, function () {',
  10184. ' this.Create = function () {',
  10185. ' $mod.TObject.Create.apply(this, arguments);',
  10186. ' $mod.TObject.Create.call(this);',
  10187. ' $mod.TObject.CreateWithB.call(this, false);',
  10188. ' };',
  10189. ' this.CreateWithC = function (c) {',
  10190. ' $mod.TObject.Create.call(this);',
  10191. ' $mod.TObject.CreateWithB.call(this, true);',
  10192. ' this.DoIt();',
  10193. ' this.DoIt();',
  10194. ' this.$class.DoSome();',
  10195. ' };',
  10196. ' this.DoIt = function () {',
  10197. ' this.Create();',
  10198. ' this.CreateWithB(false);',
  10199. ' this.CreateWithC("c");',
  10200. ' };',
  10201. ' this.DoSome = function () {',
  10202. ' var Result = null;',
  10203. ' Result = this.$create("Create");',
  10204. ' Result = this.$create("CreateWithB", [true]);',
  10205. ' Result = this.$create("CreateWithC", ["c"]);',
  10206. ' return Result;',
  10207. ' };',
  10208. '});'
  10209. ]),
  10210. LinesToStr([ // this.$main
  10211. ''
  10212. ]));
  10213. end;
  10214. procedure TTestModule.TestClass_ClassVar_Assign;
  10215. begin
  10216. StartProgram(false);
  10217. Add([
  10218. 'type',
  10219. ' TObject = class',
  10220. ' public',
  10221. ' class var vI: longint;',
  10222. ' class var Sub: TObject;',
  10223. ' constructor Create;',
  10224. ' class function GetIt(Par: longint): tobject;',
  10225. ' end;',
  10226. 'constructor tobject.create;',
  10227. 'begin',
  10228. ' vi:=vi+1;',
  10229. ' Self.vi:=Self.vi+1;',
  10230. ' inc(vi);',
  10231. 'end;',
  10232. 'class function tobject.getit(par: longint): tobject;',
  10233. 'begin',
  10234. ' vi:=vi+par;',
  10235. ' Self.vi:=Self.vi+par;',
  10236. ' inc(vi);',
  10237. ' Result:=self.sub;',
  10238. 'end;',
  10239. 'var Obj: tobject;',
  10240. 'begin',
  10241. ' obj:=tobject.create;',
  10242. ' tobject.vi:=3;',
  10243. ' if tobject.vi=4 then ;',
  10244. ' tobject.sub:=nil;',
  10245. ' obj.sub:=nil;',
  10246. ' obj.sub.sub:=nil;']);
  10247. ConvertProgram;
  10248. CheckSource('TestClass_ClassVar_Assign',
  10249. LinesToStr([ // statements
  10250. 'rtl.createClass($mod,"TObject",null,function(){',
  10251. ' this.vI = 0;',
  10252. ' this.Sub = null;',
  10253. ' this.$init = function () {',
  10254. ' };',
  10255. ' this.$final = function () {',
  10256. ' };',
  10257. ' this.Create = function(){',
  10258. ' $mod.TObject.vI = this.vI+1;',
  10259. ' $mod.TObject.vI = this.vI+1;',
  10260. ' $mod.TObject.vI += 1;',
  10261. ' };',
  10262. ' this.GetIt = function(Par){',
  10263. ' var Result = null;',
  10264. ' $mod.TObject.vI = this.vI + Par;',
  10265. ' $mod.TObject.vI = this.vI + Par;',
  10266. ' $mod.TObject.vI += 1;',
  10267. ' Result = this.Sub;',
  10268. ' return Result;',
  10269. ' };',
  10270. '});',
  10271. 'this.Obj = null;'
  10272. ]),
  10273. LinesToStr([ // $mod.$main
  10274. '$mod.Obj = $mod.TObject.$create("Create");',
  10275. '$mod.TObject.vI = 3;',
  10276. 'if ($mod.TObject.vI === 4);',
  10277. '$mod.TObject.Sub=null;',
  10278. '$mod.TObject.Sub=null;',
  10279. '$mod.TObject.Sub=null;',
  10280. '']));
  10281. end;
  10282. procedure TTestModule.TestClass_CallClassMethod;
  10283. begin
  10284. StartProgram(false);
  10285. Add('type');
  10286. Add(' TObject = class');
  10287. Add(' public');
  10288. Add(' class var vI: longint;');
  10289. Add(' class var Sub: TObject;');
  10290. Add(' constructor Create;');
  10291. Add(' function GetMore(Par: longint): longint;');
  10292. Add(' class function GetIt(Par: longint): tobject;');
  10293. Add(' end;');
  10294. Add('constructor tobject.create;');
  10295. Add('begin');
  10296. Add(' sub:=getit(3);');
  10297. Add(' vi:=getmore(4);');
  10298. Add(' sub:=Self.getit(5);');
  10299. Add(' vi:=Self.getmore(6);');
  10300. Add('end;');
  10301. Add('function tobject.getmore(par: longint): longint;');
  10302. Add('begin');
  10303. Add(' sub:=getit(11);');
  10304. Add(' vi:=getmore(12);');
  10305. Add(' sub:=self.getit(13);');
  10306. Add(' vi:=self.getmore(14);');
  10307. Add('end;');
  10308. Add('class function tobject.getit(par: longint): tobject;');
  10309. Add('begin');
  10310. Add(' sub:=getit(21);');
  10311. Add(' vi:=sub.getmore(22);');
  10312. Add(' sub:=self.getit(23);');
  10313. Add(' vi:=self.sub.getmore(24);');
  10314. Add('end;');
  10315. Add('var Obj: tobject;');
  10316. Add('begin');
  10317. Add(' obj:=tobject.create;');
  10318. Add(' tobject.getit(5);');
  10319. Add(' obj.getit(6);');
  10320. Add(' obj.sub.getit(7);');
  10321. Add(' obj.sub.getit(8).SUB:=nil;');
  10322. Add(' obj.sub.getit(9).GETIT(10);');
  10323. Add(' obj.sub.getit(11).SuB.getit(12);');
  10324. ConvertProgram;
  10325. CheckSource('TestClass_CallClassMethod',
  10326. LinesToStr([ // statements
  10327. 'rtl.createClass($mod,"TObject",null,function(){',
  10328. ' this.vI = 0;',
  10329. ' this.Sub = null;',
  10330. ' this.$init = function () {',
  10331. ' };',
  10332. ' this.$final = function () {',
  10333. ' };',
  10334. ' this.Create = function(){',
  10335. ' $mod.TObject.Sub = this.$class.GetIt(3);',
  10336. ' $mod.TObject.vI = this.GetMore(4);',
  10337. ' $mod.TObject.Sub = this.$class.GetIt(5);',
  10338. ' $mod.TObject.vI = this.GetMore(6);',
  10339. ' };',
  10340. ' this.GetMore = function(Par){',
  10341. ' var Result = 0;',
  10342. ' $mod.TObject.Sub = this.$class.GetIt(11);',
  10343. ' $mod.TObject.vI = this.GetMore(12);',
  10344. ' $mod.TObject.Sub = this.$class.GetIt(13);',
  10345. ' $mod.TObject.vI = this.GetMore(14);',
  10346. ' return Result;',
  10347. ' };',
  10348. ' this.GetIt = function(Par){',
  10349. ' var Result = null;',
  10350. ' $mod.TObject.Sub = this.GetIt(21);',
  10351. ' $mod.TObject.vI = this.Sub.GetMore(22);',
  10352. ' $mod.TObject.Sub = this.GetIt(23);',
  10353. ' $mod.TObject.vI = this.Sub.GetMore(24);',
  10354. ' return Result;',
  10355. ' };',
  10356. '});',
  10357. 'this.Obj = null;'
  10358. ]),
  10359. LinesToStr([ // $mod.$main
  10360. '$mod.Obj = $mod.TObject.$create("Create");',
  10361. '$mod.TObject.GetIt(5);',
  10362. '$mod.Obj.$class.GetIt(6);',
  10363. '$mod.Obj.Sub.$class.GetIt(7);',
  10364. '$mod.TObject.Sub=null;',
  10365. '$mod.Obj.Sub.$class.GetIt(9).$class.GetIt(10);',
  10366. '$mod.Obj.Sub.$class.GetIt(11).Sub.$class.GetIt(12);',
  10367. '']));
  10368. end;
  10369. procedure TTestModule.TestClass_Property;
  10370. begin
  10371. StartProgram(false);
  10372. Add('type');
  10373. Add(' TObject = class');
  10374. Add(' Fx: longint;');
  10375. Add(' Fy: longint;');
  10376. Add(' function GetInt: longint;');
  10377. Add(' procedure SetInt(Value: longint);');
  10378. Add(' procedure DoIt;');
  10379. Add(' property IntA: longint read Fx write Fy;');
  10380. Add(' property IntB: longint read GetInt write SetInt;');
  10381. Add(' end;');
  10382. Add('function tobject.getint: longint;');
  10383. Add('begin');
  10384. Add(' result:=fx;');
  10385. Add('end;');
  10386. Add('procedure tobject.setint(value: longint);');
  10387. Add('begin');
  10388. Add(' if value=fy then exit;');
  10389. Add(' fy:=value;');
  10390. Add('end;');
  10391. Add('procedure tobject.doit;');
  10392. Add('begin');
  10393. Add(' IntA:=IntA+1;');
  10394. Add(' Self.IntA:=Self.IntA+1;');
  10395. Add(' IntB:=IntB+1;');
  10396. Add(' Self.IntB:=Self.IntB+1;');
  10397. Add('end;');
  10398. Add('var Obj: tobject;');
  10399. Add('begin');
  10400. Add(' obj.inta:=obj.inta+1;');
  10401. Add(' if obj.intb=2 then;');
  10402. Add(' obj.intb:=obj.intb+2;');
  10403. Add(' obj.setint(obj.inta);');
  10404. ConvertProgram;
  10405. CheckSource('TestClass_Property',
  10406. LinesToStr([ // statements
  10407. 'rtl.createClass($mod, "TObject", null, function () {',
  10408. ' this.$init = function () {',
  10409. ' this.Fx = 0;',
  10410. ' this.Fy = 0;',
  10411. ' };',
  10412. ' this.$final = function () {',
  10413. ' };',
  10414. ' this.GetInt = function () {',
  10415. ' var Result = 0;',
  10416. ' Result = this.Fx;',
  10417. ' return Result;',
  10418. ' };',
  10419. ' this.SetInt = function (Value) {',
  10420. ' if (Value === this.Fy) return;',
  10421. ' this.Fy = Value;',
  10422. ' };',
  10423. ' this.DoIt = function () {',
  10424. ' this.Fy = this.Fx + 1;',
  10425. ' this.Fy = this.Fx + 1;',
  10426. ' this.SetInt(this.GetInt() + 1);',
  10427. ' this.SetInt(this.GetInt() + 1);',
  10428. ' };',
  10429. '});',
  10430. 'this.Obj = null;'
  10431. ]),
  10432. LinesToStr([ // $mod.$main
  10433. '$mod.Obj.Fy = $mod.Obj.Fx + 1;',
  10434. 'if ($mod.Obj.GetInt() === 2);',
  10435. '$mod.Obj.SetInt($mod.Obj.GetInt() + 2);',
  10436. '$mod.Obj.SetInt($mod.Obj.Fx);'
  10437. ]));
  10438. end;
  10439. procedure TTestModule.TestClass_Property_ClassMethod;
  10440. begin
  10441. StartProgram(false);
  10442. Add('type');
  10443. Add(' TObject = class');
  10444. Add(' class var Fx: longint;');
  10445. Add(' class var Fy: longint;');
  10446. Add(' class function GetInt: longint;');
  10447. Add(' class procedure SetInt(Value: longint);');
  10448. Add(' class procedure DoIt;');
  10449. Add(' class property IntA: longint read Fx write Fy;');
  10450. Add(' class property IntB: longint read GetInt write SetInt;');
  10451. Add(' end;');
  10452. Add('class function tobject.getint: longint;');
  10453. Add('begin');
  10454. Add(' result:=fx;');
  10455. Add('end;');
  10456. Add('class procedure tobject.setint(value: longint);');
  10457. Add('begin');
  10458. Add('end;');
  10459. Add('class procedure tobject.doit;');
  10460. Add('begin');
  10461. Add(' IntA:=IntA+1;');
  10462. Add(' Self.IntA:=Self.IntA+1;');
  10463. Add(' IntB:=IntB+1;');
  10464. Add(' Self.IntB:=Self.IntB+1;');
  10465. Add('end;');
  10466. Add('var Obj: tobject;');
  10467. Add('begin');
  10468. Add(' tobject.inta:=tobject.inta+1;');
  10469. Add(' if tobject.intb=2 then;');
  10470. Add(' tobject.intb:=tobject.intb+2;');
  10471. Add(' tobject.setint(tobject.inta);');
  10472. Add(' obj.inta:=obj.inta+1;');
  10473. Add(' if obj.intb=2 then;');
  10474. Add(' obj.intb:=obj.intb+2;');
  10475. Add(' obj.setint(obj.inta);');
  10476. ConvertProgram;
  10477. CheckSource('TestClass_Property_ClassMethod',
  10478. LinesToStr([ // statements
  10479. 'rtl.createClass($mod, "TObject", null, function () {',
  10480. ' this.Fx = 0;',
  10481. ' this.Fy = 0;',
  10482. ' this.$init = function () {',
  10483. ' };',
  10484. ' this.$final = function () {',
  10485. ' };',
  10486. ' this.GetInt = function () {',
  10487. ' var Result = 0;',
  10488. ' Result = this.Fx;',
  10489. ' return Result;',
  10490. ' };',
  10491. ' this.SetInt = function (Value) {',
  10492. ' };',
  10493. ' this.DoIt = function () {',
  10494. ' this.Fy = this.Fx + 1;',
  10495. ' this.Fy = this.Fx + 1;',
  10496. ' this.SetInt(this.GetInt() + 1);',
  10497. ' this.SetInt(this.GetInt() + 1);',
  10498. ' };',
  10499. '});',
  10500. 'this.Obj = null;'
  10501. ]),
  10502. LinesToStr([ // $mod.$main
  10503. '$mod.TObject.Fy = $mod.TObject.Fx + 1;',
  10504. 'if ($mod.TObject.GetInt() === 2);',
  10505. '$mod.TObject.SetInt($mod.TObject.GetInt() + 2);',
  10506. '$mod.TObject.SetInt($mod.TObject.Fx);',
  10507. '$mod.Obj.$class.Fy = $mod.Obj.Fx + 1;',
  10508. 'if ($mod.Obj.$class.GetInt() === 2);',
  10509. '$mod.Obj.$class.SetInt($mod.Obj.$class.GetInt() + 2);',
  10510. '$mod.Obj.$class.SetInt($mod.Obj.Fx);'
  10511. ]));
  10512. end;
  10513. procedure TTestModule.TestClass_Property_Indexed;
  10514. begin
  10515. StartProgram(false);
  10516. Add('type');
  10517. Add(' TObject = class');
  10518. Add(' FItems: array of longint;');
  10519. Add(' function GetItems(Index: longint): longint;');
  10520. Add(' procedure SetItems(Index: longint; Value: longint);');
  10521. Add(' procedure DoIt;');
  10522. Add(' property Items[Index: longint]: longint read getitems write setitems;');
  10523. Add(' end;');
  10524. Add('function tobject.getitems(index: longint): longint;');
  10525. Add('begin');
  10526. Add(' Result:=fitems[index];');
  10527. Add('end;');
  10528. Add('procedure tobject.setitems(index: longint; value: longint);');
  10529. Add('begin');
  10530. Add(' fitems[index]:=value;');
  10531. Add('end;');
  10532. Add('procedure tobject.doit;');
  10533. Add('begin');
  10534. Add(' items[1]:=2;');
  10535. Add(' items[3]:=items[4];');
  10536. Add(' self.items[5]:=self.items[6];');
  10537. Add(' items[items[7]]:=items[items[8]];');
  10538. Add('end;');
  10539. Add('var Obj: tobject;');
  10540. Add('begin');
  10541. Add(' obj.Items[11]:=obj.Items[12];');
  10542. ConvertProgram;
  10543. CheckSource('TestClass_Property_Indexed',
  10544. LinesToStr([ // statements
  10545. 'rtl.createClass($mod, "TObject", null, function () {',
  10546. ' this.$init = function () {',
  10547. ' this.FItems = [];',
  10548. ' };',
  10549. ' this.$final = function () {',
  10550. ' this.FItems = undefined;',
  10551. ' };',
  10552. ' this.GetItems = function (Index) {',
  10553. ' var Result = 0;',
  10554. ' Result = this.FItems[Index];',
  10555. ' return Result;',
  10556. ' };',
  10557. ' this.SetItems = function (Index, Value) {',
  10558. ' this.FItems[Index] = Value;',
  10559. ' };',
  10560. ' this.DoIt = function () {',
  10561. ' this.SetItems(1, 2);',
  10562. ' this.SetItems(3,this.GetItems(4));',
  10563. ' this.SetItems(5,this.GetItems(6));',
  10564. ' this.SetItems(this.GetItems(7), this.GetItems(this.GetItems(8)));',
  10565. ' };',
  10566. '});',
  10567. 'this.Obj = null;'
  10568. ]),
  10569. LinesToStr([ // $mod.$main
  10570. '$mod.Obj.SetItems(11,$mod.Obj.GetItems(12));'
  10571. ]));
  10572. end;
  10573. procedure TTestModule.TestClass_Property_IndexSpec;
  10574. begin
  10575. StartProgram(false);
  10576. Add([
  10577. 'type',
  10578. ' TEnum = (red, blue);',
  10579. ' TObject = class',
  10580. ' function GetIntBool(Index: longint): boolean; virtual; abstract;',
  10581. ' procedure SetIntBool(Index: longint; b: boolean); virtual; abstract;',
  10582. ' function GetEnumBool(Index: TEnum): boolean; virtual; abstract;',
  10583. ' procedure SetEnumBool(Index: TEnum; b: boolean); virtual; abstract;',
  10584. ' function GetStrIntBool(A: String; I: longint): boolean; virtual; abstract;',
  10585. ' procedure SetStrIntBool(A: String; I: longint; b: boolean); virtual; abstract;',
  10586. ' property B1: boolean index 1 read GetIntBool write SetIntBool;',
  10587. ' property B2: boolean index TEnum.blue read GetEnumBool write SetEnumBool;',
  10588. ' property B3: boolean index ord(red) read GetIntBool write SetIntBool;',
  10589. ' property I1[A: String]: boolean index ord(blue) read GetStrIntBool write SetStrIntBool;',
  10590. ' end;',
  10591. 'procedure DoIt(b: boolean); begin end;',
  10592. 'var',
  10593. ' o: TObject;',
  10594. 'begin',
  10595. ' o.B1:=o.B1;',
  10596. ' o.B2:=o.B2;',
  10597. ' o.B3:=o.B3;',
  10598. ' o.I1[''a'']:=o.I1[''b''];',
  10599. ' doit(o.b1);',
  10600. ' doit(o.b2);',
  10601. ' doit(o.i1[''c'']);',
  10602. '']);
  10603. ConvertProgram;
  10604. CheckSource('TestClass_Property_IndexSpec',
  10605. LinesToStr([ // statements
  10606. 'this.TEnum = {',
  10607. ' "0": "red",',
  10608. ' red: 0,',
  10609. ' "1": "blue",',
  10610. ' blue: 1',
  10611. '};',
  10612. 'rtl.createClass($mod, "TObject", null, function () {',
  10613. ' this.$init = function () {',
  10614. ' };',
  10615. ' this.$final = function () {',
  10616. ' };',
  10617. '});',
  10618. 'this.DoIt = function (b) {',
  10619. '};',
  10620. 'this.o = null;',
  10621. '']),
  10622. LinesToStr([ // $mod.$main
  10623. '$mod.o.SetIntBool(1, $mod.o.GetIntBool(1));',
  10624. '$mod.o.SetEnumBool($mod.TEnum.blue, $mod.o.GetEnumBool($mod.TEnum.blue));',
  10625. '$mod.o.SetIntBool(0, $mod.o.GetIntBool(0));',
  10626. '$mod.o.SetStrIntBool("a", 1, $mod.o.GetStrIntBool("b", 1));',
  10627. '$mod.DoIt($mod.o.GetIntBool(1));',
  10628. '$mod.DoIt($mod.o.GetEnumBool($mod.TEnum.blue));',
  10629. '$mod.DoIt($mod.o.GetStrIntBool("c", 1));',
  10630. '']));
  10631. end;
  10632. procedure TTestModule.TestClass_PropertyOfTypeArray;
  10633. begin
  10634. StartProgram(false);
  10635. Add('type');
  10636. Add(' TArray = array of longint;');
  10637. Add(' TObject = class');
  10638. Add(' FItems: TArray;');
  10639. Add(' function GetItems: tarray;');
  10640. Add(' procedure SetItems(Value: tarray);');
  10641. Add(' property Items: tarray read getitems write setitems;');
  10642. Add(' end;');
  10643. Add('function tobject.getitems: tarray;');
  10644. Add('begin');
  10645. Add(' Result:=fitems;');
  10646. Add('end;');
  10647. Add('procedure tobject.setitems(value: tarray);');
  10648. Add('begin');
  10649. Add(' fitems:=value;');
  10650. Add(' fitems:=nil;');
  10651. Add(' Items:=nil;');
  10652. Add(' Items:=Items;');
  10653. Add(' Items[1]:=2;');
  10654. Add(' fitems[3]:=Items[4];');
  10655. Add(' Items[5]:=Items[6];');
  10656. Add(' Self.Items[7]:=8;');
  10657. Add(' Self.Items[9]:=Self.Items[10];');
  10658. Add(' Items[Items[11]]:=Items[Items[12]];');
  10659. Add('end;');
  10660. Add('var Obj: tobject;');
  10661. Add('begin');
  10662. Add(' obj.items:=nil;');
  10663. Add(' obj.items:=obj.items;');
  10664. Add(' obj.items[11]:=obj.items[12];');
  10665. ConvertProgram;
  10666. CheckSource('TestClass_PropertyOfTypeArray',
  10667. LinesToStr([ // statements
  10668. 'rtl.createClass($mod, "TObject", null, function () {',
  10669. ' this.$init = function () {',
  10670. ' this.FItems = [];',
  10671. ' };',
  10672. ' this.$final = function () {',
  10673. ' this.FItems = undefined;',
  10674. ' };',
  10675. ' this.GetItems = function () {',
  10676. ' var Result = [];',
  10677. ' Result = this.FItems;',
  10678. ' return Result;',
  10679. ' };',
  10680. ' this.SetItems = function (Value) {',
  10681. ' this.FItems = Value;',
  10682. ' this.FItems = [];',
  10683. ' this.SetItems([]);',
  10684. ' this.SetItems(this.GetItems());',
  10685. ' this.GetItems()[1] = 2;',
  10686. ' this.FItems[3] = this.GetItems()[4];',
  10687. ' this.GetItems()[5] = this.GetItems()[6];',
  10688. ' this.GetItems()[7] = 8;',
  10689. ' this.GetItems()[9] = this.GetItems()[10];',
  10690. ' this.GetItems()[this.GetItems()[11]] = this.GetItems()[this.GetItems()[12]];',
  10691. ' };',
  10692. '});',
  10693. 'this.Obj = null;'
  10694. ]),
  10695. LinesToStr([ // $mod.$main
  10696. '$mod.Obj.SetItems([]);',
  10697. '$mod.Obj.SetItems($mod.Obj.GetItems());',
  10698. '$mod.Obj.GetItems()[11] = $mod.Obj.GetItems()[12];'
  10699. ]));
  10700. end;
  10701. procedure TTestModule.TestClass_PropertyDefault;
  10702. begin
  10703. StartProgram(false);
  10704. Add([
  10705. 'type',
  10706. ' TArray = array of longint;',
  10707. ' TObject = class',
  10708. ' FItems: TArray;',
  10709. ' function GetItems(Index: longint): longint;',
  10710. ' procedure SetItems(Index, Value: longint);',
  10711. ' property Items[Index: longint]: longint read getitems write setitems; default;',
  10712. ' end;',
  10713. 'function tobject.getitems(index: longint): longint;',
  10714. 'begin',
  10715. 'end;',
  10716. 'procedure tobject.setitems(index, value: longint);',
  10717. 'begin',
  10718. ' Self[1]:=2;',
  10719. ' Self[3]:=Self[index];',
  10720. ' Self[index]:=Self[Self[value]];',
  10721. ' Self[Self[4]]:=value;',
  10722. 'end;',
  10723. 'var Obj: tobject;',
  10724. 'begin',
  10725. ' obj[11]:=12;',
  10726. ' obj[13]:=obj[14];',
  10727. ' obj[obj[15]]:=obj[obj[15]];',
  10728. ' TObject(obj)[16]:=TObject(obj)[17];']);
  10729. ConvertProgram;
  10730. CheckSource('TestClass_PropertyDefault',
  10731. LinesToStr([ // statements
  10732. 'rtl.createClass($mod, "TObject", null, function () {',
  10733. ' this.$init = function () {',
  10734. ' this.FItems = [];',
  10735. ' };',
  10736. ' this.$final = function () {',
  10737. ' this.FItems = undefined;',
  10738. ' };',
  10739. ' this.GetItems = function (Index) {',
  10740. ' var Result = 0;',
  10741. ' return Result;',
  10742. ' };',
  10743. ' this.SetItems = function (Index, Value) {',
  10744. ' this.SetItems(1, 2);',
  10745. ' this.SetItems(3, this.GetItems(Index));',
  10746. ' this.SetItems(Index, this.GetItems(this.GetItems(Value)));',
  10747. ' this.SetItems(this.GetItems(4), Value);',
  10748. ' };',
  10749. '});',
  10750. 'this.Obj = null;'
  10751. ]),
  10752. LinesToStr([ // $mod.$main
  10753. '$mod.Obj.SetItems(11, 12);',
  10754. '$mod.Obj.SetItems(13, $mod.Obj.GetItems(14));',
  10755. '$mod.Obj.SetItems($mod.Obj.GetItems(15), $mod.Obj.GetItems($mod.Obj.GetItems(15)));',
  10756. '$mod.Obj.SetItems(16, $mod.Obj.GetItems(17));',
  10757. '']));
  10758. end;
  10759. procedure TTestModule.TestClass_PropertyDefault2;
  10760. begin
  10761. StartProgram(false);
  10762. Add([
  10763. 'type',
  10764. ' TObject = class end;',
  10765. ' TAlphaList = class',
  10766. ' function GetAlphas(Index: longint): Pointer; virtual; abstract;',
  10767. ' procedure SetAlphas(Index: longint; Value: Pointer); virtual; abstract;',
  10768. ' property Alphas[Index: longint]: Pointer read getAlphas write setAlphas; default;',
  10769. ' end;',
  10770. ' TBetaList = class',
  10771. ' function GetBetas(Index: longint): Pointer; virtual; abstract;',
  10772. ' procedure SetBetas(Index: longint; Value: Pointer); virtual; abstract;',
  10773. ' property Betas[Index: longint]: Pointer read getBetas write setBetas; default;',
  10774. ' end;',
  10775. ' TBird = class',
  10776. ' procedure DoIt;',
  10777. ' end;',
  10778. 'procedure TBird.DoIt;',
  10779. 'var',
  10780. ' List: TAlphaList;',
  10781. 'begin',
  10782. ' if TBetaList(List[2])[3]=nil then ;',
  10783. ' TBetaList(List[4])[5]:=nil;',
  10784. 'end;',
  10785. 'var',
  10786. ' List: TAlphaList;',
  10787. 'begin',
  10788. ' if TBetaList(List[2])[3]=nil then ;',
  10789. ' TBetaList(List[4])[5]:=nil;',
  10790. '']);
  10791. ConvertProgram;
  10792. CheckSource('TestClass_PropertyDefault2',
  10793. LinesToStr([ // statements
  10794. 'rtl.createClass($mod, "TObject", null, function () {',
  10795. ' this.$init = function () {',
  10796. ' };',
  10797. ' this.$final = function () {',
  10798. ' };',
  10799. '});',
  10800. 'rtl.createClass($mod, "TAlphaList", $mod.TObject, function () {',
  10801. '});',
  10802. 'rtl.createClass($mod, "TBetaList", $mod.TObject, function () {',
  10803. '});',
  10804. 'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
  10805. ' this.DoIt = function () {',
  10806. ' var List = null;',
  10807. ' if (List.GetAlphas(2).GetBetas(3) === null) ;',
  10808. ' List.GetAlphas(4).SetBetas(5, null);',
  10809. ' };',
  10810. '});',
  10811. 'this.List = null;',
  10812. '']),
  10813. LinesToStr([ // $mod.$main
  10814. 'if ($mod.List.GetAlphas(2).GetBetas(3) === null) ;',
  10815. '$mod.List.GetAlphas(4).SetBetas(5, null);',
  10816. '']));
  10817. end;
  10818. procedure TTestModule.TestClass_PropertyOverride;
  10819. begin
  10820. StartProgram(false);
  10821. Add('type');
  10822. Add(' integer = longint;');
  10823. Add(' TObject = class');
  10824. Add(' FItem: integer;');
  10825. Add(' function GetItem: integer; external name ''GetItem'';');
  10826. Add(' procedure SetItem(Value: integer); external name ''SetItem'';');
  10827. Add(' property Item: integer read getitem write setitem;');
  10828. Add(' end;');
  10829. Add(' TCar = class');
  10830. Add(' FBag: integer;');
  10831. Add(' function GetBag: integer; external name ''GetBag'';');
  10832. Add(' property Item read getbag;');
  10833. Add(' end;');
  10834. Add('var');
  10835. Add(' Obj: tobject;');
  10836. Add(' Car: tcar;');
  10837. Add('begin');
  10838. Add(' Obj.Item:=Obj.Item;');
  10839. Add(' Car.Item:=Car.Item;');
  10840. ConvertProgram;
  10841. CheckSource('TestClass_PropertyOverride',
  10842. LinesToStr([ // statements
  10843. 'rtl.createClass($mod, "TObject", null, function () {',
  10844. ' this.$init = function () {',
  10845. ' this.FItem = 0;',
  10846. ' };',
  10847. ' this.$final = function () {',
  10848. ' };',
  10849. '});',
  10850. 'rtl.createClass($mod, "TCar", $mod.TObject, function () {',
  10851. ' this.$init = function () {',
  10852. ' $mod.TObject.$init.call(this);',
  10853. ' this.FBag = 0;',
  10854. ' };',
  10855. '});',
  10856. 'this.Obj = null;',
  10857. 'this.Car = null;',
  10858. '']),
  10859. LinesToStr([ // $mod.$main
  10860. '$mod.Obj.SetItem($mod.Obj.GetItem());',
  10861. '$mod.Car.SetItem($mod.Car.GetBag());',
  10862. '']));
  10863. end;
  10864. procedure TTestModule.TestClass_PropertyIncVisibility;
  10865. begin
  10866. AddModuleWithIntfImplSrc('unit1.pp',
  10867. LinesToStr([
  10868. 'type',
  10869. ' TNumber = longint;',
  10870. ' TInteger = longint;',
  10871. ' TObject = class',
  10872. ' private',
  10873. ' function GetItems(Index: TNumber): TInteger; virtual; abstract;',
  10874. ' procedure SetItems(Index: TInteger; Value: TNumber); virtual; abstract;',
  10875. ' protected',
  10876. ' property Items[Index: TNumber]: longint read GetItems write SetItems;',
  10877. ' end;']),
  10878. LinesToStr([
  10879. '']));
  10880. StartProgram(true);
  10881. Add([
  10882. 'uses unit1;',
  10883. 'type',
  10884. ' TBird = class',
  10885. ' public',
  10886. ' property Items;',
  10887. ' end;',
  10888. 'procedure DoIt(i: TInteger);',
  10889. 'begin',
  10890. 'end;',
  10891. 'var b: TBird;',
  10892. 'begin',
  10893. ' b.Items[1]:=2;',
  10894. ' b.Items[3]:=b.Items[4];',
  10895. ' DoIt(b.Items[5]);',
  10896. '']);
  10897. ConvertProgram;
  10898. CheckSource('TestClass_PropertyIncVisibility',
  10899. LinesToStr([ // statements
  10900. 'rtl.createClass($mod, "TBird", pas.unit1.TObject, function () {',
  10901. '});',
  10902. 'this.DoIt = function (i) {',
  10903. '};',
  10904. 'this.b = null;'
  10905. ]),
  10906. LinesToStr([ // $mod.$main
  10907. '$mod.b.SetItems(1, 2);',
  10908. '$mod.b.SetItems(3, $mod.b.GetItems(4));',
  10909. '$mod.DoIt($mod.b.GetItems(5));'
  10910. ]));
  10911. end;
  10912. procedure TTestModule.TestClass_Assigned;
  10913. begin
  10914. StartProgram(false);
  10915. Add('type');
  10916. Add(' TObject = class');
  10917. Add(' end;');
  10918. Add('var');
  10919. Add(' Obj: tobject;');
  10920. Add(' b: boolean;');
  10921. Add('begin');
  10922. Add(' if Assigned(obj) then ;');
  10923. Add(' b:=Assigned(obj) or false;');
  10924. ConvertProgram;
  10925. CheckSource('TestClass_Assigned',
  10926. LinesToStr([ // statements
  10927. 'rtl.createClass($mod, "TObject", null, function () {',
  10928. ' this.$init = function () {',
  10929. ' };',
  10930. ' this.$final = function () {',
  10931. ' };',
  10932. '});',
  10933. 'this.Obj = null;',
  10934. 'this.b = false;'
  10935. ]),
  10936. LinesToStr([ // $mod.$main
  10937. 'if ($mod.Obj != null);',
  10938. '$mod.b = ($mod.Obj != null) || false;'
  10939. ]));
  10940. end;
  10941. procedure TTestModule.TestClass_WithClassDoCreate;
  10942. begin
  10943. StartProgram(false);
  10944. Add('type');
  10945. Add(' TObject = class');
  10946. Add(' aBool: boolean;');
  10947. Add(' Arr: array of boolean;');
  10948. Add(' constructor Create;');
  10949. Add(' end;');
  10950. Add('constructor TObject.Create; begin end;');
  10951. Add('var');
  10952. Add(' Obj: tobject;');
  10953. Add(' b: boolean;');
  10954. Add('begin');
  10955. Add(' with tobject.create do begin');
  10956. Add(' b:=abool;');
  10957. Add(' abool:=b;');
  10958. Add(' b:=arr[1];');
  10959. Add(' arr[2]:=b;');
  10960. Add(' end;');
  10961. Add(' with tobject do');
  10962. Add(' obj:=create;');
  10963. Add(' with obj do begin');
  10964. Add(' create;');
  10965. Add(' b:=abool;');
  10966. Add(' abool:=b;');
  10967. Add(' b:=arr[3];');
  10968. Add(' arr[4]:=b;');
  10969. Add(' end;');
  10970. ConvertProgram;
  10971. CheckSource('TestClass_WithClassDoCreate',
  10972. LinesToStr([ // statements
  10973. 'rtl.createClass($mod, "TObject", null, function () {',
  10974. ' this.$init = function () {',
  10975. ' this.aBool = false;',
  10976. ' this.Arr = [];',
  10977. ' };',
  10978. ' this.$final = function () {',
  10979. ' this.Arr = undefined;',
  10980. ' };',
  10981. ' this.Create = function () {',
  10982. ' };',
  10983. '});',
  10984. 'this.Obj = null;',
  10985. 'this.b = false;'
  10986. ]),
  10987. LinesToStr([ // $mod.$main
  10988. 'var $with1 = $mod.TObject.$create("Create");',
  10989. '$mod.b = $with1.aBool;',
  10990. '$with1.aBool = $mod.b;',
  10991. '$mod.b = $with1.Arr[1];',
  10992. '$with1.Arr[2] = $mod.b;',
  10993. 'var $with2 = $mod.TObject;',
  10994. '$mod.Obj = $with2.$create("Create");',
  10995. 'var $with3 = $mod.Obj;',
  10996. '$with3.Create();',
  10997. '$mod.b = $with3.aBool;',
  10998. '$with3.aBool = $mod.b;',
  10999. '$mod.b = $with3.Arr[3];',
  11000. '$with3.Arr[4] = $mod.b;',
  11001. '']));
  11002. end;
  11003. procedure TTestModule.TestClass_WithClassInstDoProperty;
  11004. begin
  11005. StartProgram(false);
  11006. Add('type');
  11007. Add(' TObject = class');
  11008. Add(' FInt: longint;');
  11009. Add(' constructor Create;');
  11010. Add(' function GetSize: longint;');
  11011. Add(' procedure SetSize(Value: longint);');
  11012. Add(' property Int: longint read FInt write FInt;');
  11013. Add(' property Size: longint read GetSize write SetSize;');
  11014. Add(' end;');
  11015. Add('constructor TObject.Create; begin end;');
  11016. Add('function TObject.GetSize: longint; begin; end;');
  11017. Add('procedure TObject.SetSize(Value: longint); begin; end;');
  11018. Add('var');
  11019. Add(' Obj: tobject;');
  11020. Add(' i: longint;');
  11021. Add('begin');
  11022. Add(' with TObject.Create do begin');
  11023. Add(' i:=int;');
  11024. Add(' int:=i;');
  11025. Add(' i:=size;');
  11026. Add(' size:=i;');
  11027. Add(' end;');
  11028. Add(' with obj do begin');
  11029. Add(' i:=int;');
  11030. Add(' int:=i;');
  11031. Add(' i:=size;');
  11032. Add(' size:=i;');
  11033. Add(' end;');
  11034. ConvertProgram;
  11035. CheckSource('TestClass_WithClassInstDoProperty',
  11036. LinesToStr([ // statements
  11037. 'rtl.createClass($mod, "TObject", null, function () {',
  11038. ' this.$init = function () {',
  11039. ' this.FInt = 0;',
  11040. ' };',
  11041. ' this.$final = function () {',
  11042. ' };',
  11043. ' this.Create = function () {',
  11044. ' };',
  11045. ' this.GetSize = function () {',
  11046. ' var Result = 0;',
  11047. ' return Result;',
  11048. ' };',
  11049. ' this.SetSize = function (Value) {',
  11050. ' };',
  11051. '});',
  11052. 'this.Obj = null;',
  11053. 'this.i = 0;'
  11054. ]),
  11055. LinesToStr([ // $mod.$main
  11056. 'var $with1 = $mod.TObject.$create("Create");',
  11057. '$mod.i = $with1.FInt;',
  11058. '$with1.FInt = $mod.i;',
  11059. '$mod.i = $with1.GetSize();',
  11060. '$with1.SetSize($mod.i);',
  11061. 'var $with2 = $mod.Obj;',
  11062. '$mod.i = $with2.FInt;',
  11063. '$with2.FInt = $mod.i;',
  11064. '$mod.i = $with2.GetSize();',
  11065. '$with2.SetSize($mod.i);',
  11066. '']));
  11067. end;
  11068. procedure TTestModule.TestClass_WithClassInstDoPropertyWithParams;
  11069. begin
  11070. StartProgram(false);
  11071. Add('type');
  11072. Add(' TObject = class');
  11073. Add(' constructor Create;');
  11074. Add(' function GetItems(Index: longint): longint;');
  11075. Add(' procedure SetItems(Index, Value: longint);');
  11076. Add(' property Items[Index: longint]: longint read GetItems write SetItems;');
  11077. Add(' end;');
  11078. Add('constructor TObject.Create; begin end;');
  11079. Add('function tobject.getitems(index: longint): longint; begin; end;');
  11080. Add('procedure tobject.setitems(index, value: longint); begin; end;');
  11081. Add('var');
  11082. Add(' Obj: tobject;');
  11083. Add(' i: longint;');
  11084. Add('begin');
  11085. Add(' with TObject.Create do begin');
  11086. Add(' i:=Items[1];');
  11087. Add(' Items[2]:=i;');
  11088. Add(' end;');
  11089. Add(' with obj do begin');
  11090. Add(' i:=Items[3];');
  11091. Add(' Items[4]:=i;');
  11092. Add(' end;');
  11093. ConvertProgram;
  11094. CheckSource('TestClass_WithClassInstDoPropertyWithParams',
  11095. LinesToStr([ // statements
  11096. 'rtl.createClass($mod, "TObject", null, function () {',
  11097. ' this.$init = function () {',
  11098. ' };',
  11099. ' this.$final = function () {',
  11100. ' };',
  11101. ' this.Create = function () {',
  11102. ' };',
  11103. ' this.GetItems = function (Index) {',
  11104. ' var Result = 0;',
  11105. ' return Result;',
  11106. ' };',
  11107. ' this.SetItems = function (Index, Value) {',
  11108. ' };',
  11109. '});',
  11110. 'this.Obj = null;',
  11111. 'this.i = 0;'
  11112. ]),
  11113. LinesToStr([ // $mod.$main
  11114. 'var $with1 = $mod.TObject.$create("Create");',
  11115. '$mod.i = $with1.GetItems(1);',
  11116. '$with1.SetItems(2, $mod.i);',
  11117. 'var $with2 = $mod.Obj;',
  11118. '$mod.i = $with2.GetItems(3);',
  11119. '$with2.SetItems(4, $mod.i);',
  11120. '']));
  11121. end;
  11122. procedure TTestModule.TestClass_WithClassInstDoFunc;
  11123. begin
  11124. StartProgram(false);
  11125. Add('type');
  11126. Add(' TObject = class');
  11127. Add(' constructor Create;');
  11128. Add(' function GetSize: longint;');
  11129. Add(' procedure SetSize(Value: longint);');
  11130. Add(' end;');
  11131. Add('constructor TObject.Create; begin end;');
  11132. Add('function TObject.GetSize: longint; begin; end;');
  11133. Add('procedure TObject.SetSize(Value: longint); begin; end;');
  11134. Add('var');
  11135. Add(' Obj: tobject;');
  11136. Add(' i: longint;');
  11137. Add('begin');
  11138. Add(' with TObject.Create do begin');
  11139. Add(' i:=GetSize;');
  11140. Add(' i:=GetSize();');
  11141. Add(' SetSize(i);');
  11142. Add(' end;');
  11143. Add(' with obj do begin');
  11144. Add(' i:=GetSize;');
  11145. Add(' i:=GetSize();');
  11146. Add(' SetSize(i);');
  11147. Add(' end;');
  11148. ConvertProgram;
  11149. CheckSource('TestClass_WithClassInstDoFunc',
  11150. LinesToStr([ // statements
  11151. 'rtl.createClass($mod, "TObject", null, function () {',
  11152. ' this.$init = function () {',
  11153. ' };',
  11154. ' this.$final = function () {',
  11155. ' };',
  11156. ' this.Create = function () {',
  11157. ' };',
  11158. ' this.GetSize = function () {',
  11159. ' var Result = 0;',
  11160. ' return Result;',
  11161. ' };',
  11162. ' this.SetSize = function (Value) {',
  11163. ' };',
  11164. '});',
  11165. 'this.Obj = null;',
  11166. 'this.i = 0;'
  11167. ]),
  11168. LinesToStr([ // $mod.$main
  11169. 'var $with1 = $mod.TObject.$create("Create");',
  11170. '$mod.i = $with1.GetSize();',
  11171. '$mod.i = $with1.GetSize();',
  11172. '$with1.SetSize($mod.i);',
  11173. 'var $with2 = $mod.Obj;',
  11174. '$mod.i = $with2.GetSize();',
  11175. '$mod.i = $with2.GetSize();',
  11176. '$with2.SetSize($mod.i);',
  11177. '']));
  11178. end;
  11179. procedure TTestModule.TestClass_TypeCast;
  11180. begin
  11181. StartProgram(false);
  11182. Add('type');
  11183. Add(' TObject = class');
  11184. Add(' Next: TObject;');
  11185. Add(' constructor Create;');
  11186. Add(' end;');
  11187. Add(' TControl = class(TObject)');
  11188. Add(' Arr: array of TObject;');
  11189. Add(' function GetIt(vI: longint = 0): TObject;');
  11190. Add(' end;');
  11191. Add('constructor tobject.create; begin end;');
  11192. Add('function tcontrol.getit(vi: longint = 0): tobject; begin end;');
  11193. Add('var');
  11194. Add(' Obj: tobject;');
  11195. Add('begin');
  11196. Add(' obj:=tcontrol(obj).next;');
  11197. Add(' tcontrol(obj):=nil;');
  11198. Add(' obj:=tcontrol(obj);');
  11199. Add(' tcontrol(obj):=tcontrol(tcontrol(obj).getit);');
  11200. Add(' tcontrol(obj):=tcontrol(tcontrol(obj).getit());');
  11201. Add(' tcontrol(obj):=tcontrol(tcontrol(obj).getit(1));');
  11202. Add(' tcontrol(obj):=tcontrol(tcontrol(tcontrol(obj).getit).arr[2]);');
  11203. ConvertProgram;
  11204. CheckSource('TestClass_TypeCast',
  11205. LinesToStr([ // statements
  11206. 'rtl.createClass($mod, "TObject", null, function () {',
  11207. ' this.$init = function () {',
  11208. ' this.Next = null;',
  11209. ' };',
  11210. ' this.$final = function () {',
  11211. ' this.Next = undefined;',
  11212. ' };',
  11213. ' this.Create = function () {',
  11214. ' };',
  11215. '});',
  11216. 'rtl.createClass($mod, "TControl", $mod.TObject, function () {',
  11217. ' this.$init = function () {',
  11218. ' $mod.TObject.$init.call(this);',
  11219. ' this.Arr = [];',
  11220. ' };',
  11221. ' this.$final = function () {',
  11222. ' this.Arr = undefined;',
  11223. ' $mod.TObject.$final.call(this);',
  11224. ' };',
  11225. ' this.GetIt = function (vI) {',
  11226. ' var Result = null;',
  11227. ' return Result;',
  11228. ' };',
  11229. '});',
  11230. 'this.Obj = null;'
  11231. ]),
  11232. LinesToStr([ // $mod.$main
  11233. '$mod.Obj = $mod.Obj.Next;',
  11234. '$mod.Obj = null;',
  11235. '$mod.Obj = $mod.Obj;',
  11236. '$mod.Obj = $mod.Obj.GetIt(0);',
  11237. '$mod.Obj = $mod.Obj.GetIt(0);',
  11238. '$mod.Obj = $mod.Obj.GetIt(1);',
  11239. '$mod.Obj = $mod.Obj.GetIt(0).Arr[2];',
  11240. '']));
  11241. end;
  11242. procedure TTestModule.TestClass_TypeCastUntypedParam;
  11243. begin
  11244. StartProgram(false);
  11245. Add('type');
  11246. Add(' TObject = class end;');
  11247. Add('procedure ProcA(var A);');
  11248. Add('begin');
  11249. Add(' TObject(A):=nil;');
  11250. Add(' TObject(A):=TObject(A);');
  11251. Add(' if TObject(A)=nil then ;');
  11252. Add(' if nil=TObject(A) then ;');
  11253. Add('end;');
  11254. Add('procedure ProcB(out A);');
  11255. Add('begin');
  11256. Add(' TObject(A):=nil;');
  11257. Add(' TObject(A):=TObject(A);');
  11258. Add(' if TObject(A)=nil then ;');
  11259. Add(' if nil=TObject(A) then ;');
  11260. Add('end;');
  11261. Add('procedure ProcC(const A);');
  11262. Add('begin');
  11263. Add(' if TObject(A)=nil then ;');
  11264. Add(' if nil=TObject(A) then ;');
  11265. Add('end;');
  11266. Add('var o: TObject;');
  11267. Add('begin');
  11268. Add(' ProcA(o);');
  11269. Add(' ProcB(o);');
  11270. Add(' ProcC(o);');
  11271. ConvertProgram;
  11272. CheckSource('TestClass_TypeCastUntypedParam',
  11273. LinesToStr([ // statements
  11274. 'rtl.createClass($mod, "TObject", null, function () {',
  11275. ' this.$init = function () {',
  11276. ' };',
  11277. ' this.$final = function () {',
  11278. ' };',
  11279. '});',
  11280. 'this.ProcA = function (A) {',
  11281. ' A.set(null);',
  11282. ' A.set(A.get());',
  11283. ' if (A.get() === null);',
  11284. ' if (null === A.get());',
  11285. '};',
  11286. 'this.ProcB = function (A) {',
  11287. ' A.set(null);',
  11288. ' A.set(A.get());',
  11289. ' if (A.get() === null);',
  11290. ' if (null === A.get());',
  11291. '};',
  11292. 'this.ProcC = function (A) {',
  11293. ' if (A === null);',
  11294. ' if (null === A);',
  11295. '};',
  11296. 'this.o = null;',
  11297. '']),
  11298. LinesToStr([ // $mod.$main
  11299. '$mod.ProcA({',
  11300. ' p: $mod,',
  11301. ' get: function () {',
  11302. ' return this.p.o;',
  11303. ' },',
  11304. ' set: function (v) {',
  11305. ' this.p.o = v;',
  11306. ' }',
  11307. '});',
  11308. '$mod.ProcB({',
  11309. ' p: $mod,',
  11310. ' get: function () {',
  11311. ' return this.p.o;',
  11312. ' },',
  11313. ' set: function (v) {',
  11314. ' this.p.o = v;',
  11315. ' }',
  11316. '});',
  11317. '$mod.ProcC($mod.o);',
  11318. '']));
  11319. end;
  11320. procedure TTestModule.TestClass_Overloads;
  11321. begin
  11322. StartProgram(false);
  11323. Add('type');
  11324. Add(' TObject = class');
  11325. Add(' procedure DoIt;');
  11326. Add(' procedure DoIt(vI: longint);');
  11327. Add(' end;');
  11328. Add('procedure TObject.DoIt;');
  11329. Add('begin');
  11330. Add(' DoIt;');
  11331. Add(' DoIt(1);');
  11332. Add('end;');
  11333. Add('procedure TObject.DoIt(vI: longint); begin end;');
  11334. Add('begin');
  11335. ConvertProgram;
  11336. CheckSource('TestClass_Overloads',
  11337. LinesToStr([ // statements
  11338. 'rtl.createClass($mod, "TObject", null, function () {',
  11339. ' this.$init = function () {',
  11340. ' };',
  11341. ' this.$final = function () {',
  11342. ' };',
  11343. ' this.DoIt = function () {',
  11344. ' this.DoIt();',
  11345. ' this.DoIt$1(1);',
  11346. ' };',
  11347. ' this.DoIt$1 = function (vI) {',
  11348. ' };',
  11349. '});',
  11350. '']),
  11351. LinesToStr([ // $mod.$main
  11352. '']));
  11353. end;
  11354. procedure TTestModule.TestClass_OverloadsAncestor;
  11355. begin
  11356. StartProgram(false);
  11357. Add('type');
  11358. Add(' TObject = class;');
  11359. Add(' TObject = class');
  11360. Add(' procedure DoIt(vA: longint);');
  11361. Add(' procedure DoIt(vA, vB: longint);');
  11362. Add(' end;');
  11363. Add(' TCar = class;');
  11364. Add(' TCar = class');
  11365. Add(' procedure DoIt(vA: longint);');
  11366. Add(' procedure DoIt(vA, vB: longint);');
  11367. Add(' end;');
  11368. Add('procedure tobject.doit(va: longint);');
  11369. Add('begin');
  11370. Add(' doit(1);');
  11371. Add(' doit(1,2);');
  11372. Add('end;');
  11373. Add('procedure tobject.doit(va, vb: longint); begin end;');
  11374. Add('procedure tcar.doit(va: longint);');
  11375. Add('begin');
  11376. Add(' doit(1);');
  11377. Add(' doit(1,2);');
  11378. Add(' inherited doit(1);');
  11379. Add(' inherited doit(1,2);');
  11380. Add('end;');
  11381. Add('procedure tcar.doit(va, vb: longint); begin end;');
  11382. Add('begin');
  11383. ConvertProgram;
  11384. CheckSource('TestClass_OverloadsAncestor',
  11385. LinesToStr([ // statements
  11386. 'rtl.createClass($mod, "TObject", null, function () {',
  11387. ' this.$init = function () {',
  11388. ' };',
  11389. ' this.$final = function () {',
  11390. ' };',
  11391. ' this.DoIt = function (vA) {',
  11392. ' this.DoIt(1);',
  11393. ' this.DoIt$1(1,2);',
  11394. ' };',
  11395. ' this.DoIt$1 = function (vA, vB) {',
  11396. ' };',
  11397. '});',
  11398. 'rtl.createClass($mod, "TCar", $mod.TObject, function () {',
  11399. ' this.DoIt$2 = function (vA) {',
  11400. ' this.DoIt$2(1);',
  11401. ' this.DoIt$3(1, 2);',
  11402. ' $mod.TObject.DoIt.call(this, 1);',
  11403. ' $mod.TObject.DoIt$1.call(this, 1, 2);',
  11404. ' };',
  11405. ' this.DoIt$3 = function (vA, vB) {',
  11406. ' };',
  11407. '});',
  11408. '']),
  11409. LinesToStr([ // $mod.$main
  11410. '']));
  11411. end;
  11412. procedure TTestModule.TestClass_OverloadConstructor;
  11413. begin
  11414. StartProgram(false);
  11415. Add('type');
  11416. Add(' TObject = class');
  11417. Add(' constructor Create(vA: longint);');
  11418. Add(' constructor Create(vA, vB: longint);');
  11419. Add(' end;');
  11420. Add(' TCar = class');
  11421. Add(' constructor Create(vA: longint);');
  11422. Add(' constructor Create(vA, vB: longint);');
  11423. Add(' end;');
  11424. Add('constructor tobject.create(va: longint);');
  11425. Add('begin');
  11426. Add(' create(1);');
  11427. Add(' create(1,2);');
  11428. Add('end;');
  11429. Add('constructor tobject.create(va, vb: longint); begin end;');
  11430. Add('constructor tcar.create(va: longint);');
  11431. Add('begin');
  11432. Add(' create(1);');
  11433. Add(' create(1,2);');
  11434. Add(' inherited create(1);');
  11435. Add(' inherited create(1,2);');
  11436. Add('end;');
  11437. Add('constructor tcar.create(va, vb: longint); begin end;');
  11438. Add('begin');
  11439. Add(' tobject.create(1);');
  11440. Add(' tobject.create(1,2);');
  11441. Add(' tcar.create(1);');
  11442. Add(' tcar.create(1,2);');
  11443. ConvertProgram;
  11444. CheckSource('TestClass_OverloadConstructor',
  11445. LinesToStr([ // statements
  11446. 'rtl.createClass($mod, "TObject", null, function () {',
  11447. ' this.$init = function () {',
  11448. ' };',
  11449. ' this.$final = function () {',
  11450. ' };',
  11451. ' this.Create = function (vA) {',
  11452. ' this.Create(1);',
  11453. ' this.Create$1(1,2);',
  11454. ' };',
  11455. ' this.Create$1 = function (vA, vB) {',
  11456. ' };',
  11457. '});',
  11458. 'rtl.createClass($mod, "TCar", $mod.TObject, function () {',
  11459. ' this.Create$2 = function (vA) {',
  11460. ' this.Create$2(1);',
  11461. ' this.Create$3(1, 2);',
  11462. ' $mod.TObject.Create.call(this, 1);',
  11463. ' $mod.TObject.Create$1.call(this, 1, 2);',
  11464. ' };',
  11465. ' this.Create$3 = function (vA, vB) {',
  11466. ' };',
  11467. '});',
  11468. '']),
  11469. LinesToStr([ // $mod.$main
  11470. '$mod.TObject.$create("Create", [1]);',
  11471. '$mod.TObject.$create("Create$1", [1, 2]);',
  11472. '$mod.TCar.$create("Create$2", [1]);',
  11473. '$mod.TCar.$create("Create$3", [1, 2]);',
  11474. '']));
  11475. end;
  11476. procedure TTestModule.TestClass_OverloadDelphiOverride;
  11477. begin
  11478. StartProgram(false);
  11479. Add([
  11480. '{$mode delphi}',
  11481. 'type',
  11482. ' TObject = class end;',
  11483. ' TBird = class',
  11484. ' function {#a}GetValue: longint; overload; virtual;',
  11485. ' function {#b}GetValue(AValue: longint): longint; overload; virtual;',
  11486. ' end;',
  11487. ' TEagle = class(TBird)',
  11488. ' function {#c}GetValue: longint; overload; override;',
  11489. ' function {#d}GetValue(AValue: longint): longint; overload; override;',
  11490. ' end;',
  11491. 'function TBird.GetValue: longint;',
  11492. 'begin',
  11493. ' if 3={@a}GetValue then ;',
  11494. ' if 4={@b}GetValue(5) then ;',
  11495. 'end;',
  11496. 'function TBird.GetValue(AValue: longint): longint;',
  11497. 'begin',
  11498. 'end;',
  11499. 'function TEagle.GetValue: longint;',
  11500. 'begin',
  11501. ' if 13={@c}GetValue then ;',
  11502. ' if 14={@d}GetValue(15) then ;',
  11503. ' if 15=inherited {@a}GetValue then ;',
  11504. ' if 16=inherited {@b}GetValue(17) then ;',
  11505. 'end;',
  11506. 'function TEagle.GetValue(AValue: longint): longint;',
  11507. 'begin',
  11508. 'end;',
  11509. 'var',
  11510. ' e: TEagle;',
  11511. 'begin',
  11512. ' if 23=e.{@c}GetValue then ;',
  11513. ' if 24=e.{@d}GetValue(25) then ;']);
  11514. ConvertProgram;
  11515. CheckSource('TestClass_OverloadDelphiOverride',
  11516. LinesToStr([ // statements
  11517. 'rtl.createClass($mod, "TObject", null, function () {',
  11518. ' this.$init = function () {',
  11519. ' };',
  11520. ' this.$final = function () {',
  11521. ' };',
  11522. '});',
  11523. 'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
  11524. ' this.GetValue = function () {',
  11525. ' var Result = 0;',
  11526. ' if (3 === this.GetValue()) ;',
  11527. ' if (4 === this.GetValue$1(5)) ;',
  11528. ' return Result;',
  11529. ' };',
  11530. ' this.GetValue$1 = function (AValue) {',
  11531. ' var Result = 0;',
  11532. ' return Result;',
  11533. ' };',
  11534. '});',
  11535. 'rtl.createClass($mod, "TEagle", $mod.TBird, function () {',
  11536. ' this.GetValue = function () {',
  11537. ' var Result = 0;',
  11538. ' if (13 === this.GetValue()) ;',
  11539. ' if (14 === this.GetValue$1(15)) ;',
  11540. ' if (15 === $mod.TBird.GetValue.call(this)) ;',
  11541. ' if (16 === $mod.TBird.GetValue$1.call(this, 17)) ;',
  11542. ' return Result;',
  11543. ' };',
  11544. ' this.GetValue$1 = function (AValue) {',
  11545. ' var Result = 0;',
  11546. ' return Result;',
  11547. ' };',
  11548. '});',
  11549. 'this.e = null;',
  11550. '']),
  11551. LinesToStr([ // $mod.$main
  11552. 'if (23 === $mod.e.GetValue()) ;',
  11553. 'if (24 === $mod.e.GetValue$1(25)) ;',
  11554. '']));
  11555. end;
  11556. procedure TTestModule.TestClass_ReintroducedVar;
  11557. begin
  11558. StartProgram(false);
  11559. Add('type');
  11560. Add(' TObject = class');
  11561. Add(' strict private');
  11562. Add(' Some: longint;');
  11563. Add(' end;');
  11564. Add(' TMobile = class');
  11565. Add(' strict private');
  11566. Add(' Some: string;');
  11567. Add(' end;');
  11568. Add(' TCar = class(tmobile)');
  11569. Add(' procedure Some;');
  11570. Add(' procedure Some(vA: longint);');
  11571. Add(' end;');
  11572. Add('procedure tcar.some;');
  11573. Add('begin');
  11574. Add(' Some;');
  11575. Add(' Some(1);');
  11576. Add('end;');
  11577. Add('procedure tcar.some(va: longint); begin end;');
  11578. Add('begin');
  11579. ConvertProgram;
  11580. CheckSource('TestClass_ReintroducedVar',
  11581. LinesToStr([ // statements
  11582. 'rtl.createClass($mod, "TObject", null, function () {',
  11583. ' this.$init = function () {',
  11584. ' this.Some = 0;',
  11585. ' };',
  11586. ' this.$final = function () {',
  11587. ' };',
  11588. '});',
  11589. 'rtl.createClass($mod, "TMobile", $mod.TObject, function () {',
  11590. ' this.$init = function () {',
  11591. ' $mod.TObject.$init.call(this);',
  11592. ' this.Some$1 = "";',
  11593. ' };',
  11594. '});',
  11595. 'rtl.createClass($mod, "TCar", $mod.TMobile, function () {',
  11596. ' this.Some$2 = function () {',
  11597. ' this.Some$2();',
  11598. ' this.Some$3(1);',
  11599. ' };',
  11600. ' this.Some$3 = function (vA) {',
  11601. ' };',
  11602. '});',
  11603. '']),
  11604. LinesToStr([ // $mod.$main
  11605. '']));
  11606. end;
  11607. procedure TTestModule.TestClass_RaiseDescendant;
  11608. begin
  11609. StartProgram(false);
  11610. Add([
  11611. 'type',
  11612. ' TObject = class',
  11613. ' constructor Create(Msg: string);',
  11614. ' end;',
  11615. ' Exception = class',
  11616. ' end;',
  11617. ' EConvertError = class(Exception)',
  11618. ' end;',
  11619. 'constructor TObject.Create(Msg: string); begin end;',
  11620. 'function AssertConv(Msg: string = ''def''): EConvertError; begin end;',
  11621. 'begin',
  11622. ' raise Exception.Create(''Bar1'');',
  11623. ' raise EConvertError.Create(''Bar2'');',
  11624. ' raise AssertConv(''Bar2'');',
  11625. ' raise AssertConv;',
  11626. '']);
  11627. ConvertProgram;
  11628. CheckSource('TestClass_RaiseDescendant',
  11629. LinesToStr([ // statements
  11630. 'rtl.createClass($mod, "TObject", null, function () {',
  11631. ' this.$init = function () {',
  11632. ' };',
  11633. ' this.$final = function () {',
  11634. ' };',
  11635. ' this.Create = function (Msg) {',
  11636. ' };',
  11637. '});',
  11638. 'rtl.createClass($mod, "Exception", $mod.TObject, function () {',
  11639. '});',
  11640. 'rtl.createClass($mod, "EConvertError", $mod.Exception, function () {',
  11641. '});',
  11642. 'this.AssertConv = function (Msg) {',
  11643. ' var Result = null;',
  11644. ' return Result;',
  11645. '};',
  11646. '']),
  11647. LinesToStr([ // $mod.$main
  11648. 'throw $mod.Exception.$create("Create",["Bar1"]);',
  11649. 'throw $mod.EConvertError.$create("Create",["Bar2"]);',
  11650. 'throw $mod.AssertConv("Bar2");',
  11651. 'throw $mod.AssertConv("def");',
  11652. '']));
  11653. end;
  11654. procedure TTestModule.TestClass_ExternalMethod;
  11655. begin
  11656. AddModuleWithIntfImplSrc('unit2.pas',
  11657. LinesToStr([
  11658. 'type',
  11659. ' TObject = class',
  11660. ' public',
  11661. ' procedure Intern; external name ''$DoIntern'';',
  11662. ' end;',
  11663. '']),
  11664. LinesToStr([
  11665. '']));
  11666. StartUnit(true);
  11667. Add('interface');
  11668. Add('uses unit2;');
  11669. Add('type');
  11670. Add(' TCar = class(TObject)');
  11671. Add(' public');
  11672. Add(' procedure Intern2; external name ''$DoIntern2'';');
  11673. Add(' procedure DoIt;');
  11674. Add(' end;');
  11675. Add('implementation');
  11676. Add('procedure tcar.doit;');
  11677. Add('begin');
  11678. Add(' Intern;');
  11679. Add(' Intern();');
  11680. Add(' Intern2;');
  11681. Add(' Intern2();');
  11682. Add('end;');
  11683. Add('var Obj: TCar;');
  11684. Add('begin');
  11685. Add(' obj.intern;');
  11686. Add(' obj.intern();');
  11687. Add(' obj.intern2;');
  11688. Add(' obj.intern2();');
  11689. Add(' obj.doit;');
  11690. Add(' obj.doit();');
  11691. Add(' with obj do begin');
  11692. Add(' Intern;');
  11693. Add(' Intern();');
  11694. Add(' Intern2;');
  11695. Add(' Intern2();');
  11696. Add(' end;');
  11697. ConvertUnit;
  11698. CheckSource('TestClass_ExternalMethod',
  11699. LinesToStr([
  11700. 'var $impl = $mod.$impl;',
  11701. 'rtl.createClass($mod, "TCar", pas.unit2.TObject, function () {',
  11702. ' this.DoIt = function () {',
  11703. ' this.$DoIntern();',
  11704. ' this.$DoIntern();',
  11705. ' this.$DoIntern2();',
  11706. ' this.$DoIntern2();',
  11707. ' };',
  11708. ' });',
  11709. '']),
  11710. LinesToStr([ // this.$init
  11711. '$impl.Obj.$DoIntern();',
  11712. '$impl.Obj.$DoIntern();',
  11713. '$impl.Obj.$DoIntern2();',
  11714. '$impl.Obj.$DoIntern2();',
  11715. '$impl.Obj.DoIt();',
  11716. '$impl.Obj.DoIt();',
  11717. 'var $with1 = $impl.Obj;',
  11718. '$with1.$DoIntern();',
  11719. '$with1.$DoIntern();',
  11720. '$with1.$DoIntern2();',
  11721. '$with1.$DoIntern2();',
  11722. '']),
  11723. LinesToStr([ // implementation
  11724. '$impl.Obj = null;',
  11725. '']) );
  11726. end;
  11727. procedure TTestModule.TestClass_ExternalVirtualNameMismatchFail;
  11728. begin
  11729. StartProgram(false);
  11730. Add('type');
  11731. Add(' TObject = class');
  11732. Add(' procedure DoIt; virtual; external name ''Foo'';');
  11733. Add(' end;');
  11734. Add('begin');
  11735. SetExpectedPasResolverError('Virtual method name must match external',
  11736. nVirtualMethodNameMustMatchExternal);
  11737. ConvertProgram;
  11738. end;
  11739. procedure TTestModule.TestClass_ExternalOverrideFail;
  11740. begin
  11741. StartProgram(false);
  11742. Add('type');
  11743. Add(' TObject = class');
  11744. Add(' procedure DoIt; virtual; external name ''DoIt'';');
  11745. Add(' end;');
  11746. Add(' TCar = class');
  11747. Add(' procedure DoIt; override; external name ''DoIt'';');
  11748. Add(' end;');
  11749. Add('begin');
  11750. SetExpectedPasResolverError('Invalid procedure modifier override,external',
  11751. nInvalidXModifierY);
  11752. ConvertProgram;
  11753. end;
  11754. procedure TTestModule.TestClass_ExternalVar;
  11755. begin
  11756. AddModuleWithIntfImplSrc('unit2.pas',
  11757. LinesToStr([
  11758. '{$modeswitch externalclass}',
  11759. 'type',
  11760. ' TObject = class',
  11761. ' public',
  11762. ' Intern: longint external name ''$Intern'';',
  11763. ' Bracket: longint external name ''["A B"]'';',
  11764. ' end;',
  11765. '']),
  11766. LinesToStr([
  11767. '']));
  11768. StartUnit(true);
  11769. Add([
  11770. 'interface',
  11771. 'uses unit2;',
  11772. '{$modeswitch externalclass}',
  11773. 'type',
  11774. ' TCar = class(tobject)',
  11775. ' public',
  11776. ' Intern2: longint external name ''$Intern2'';',
  11777. ' procedure DoIt;',
  11778. ' end;',
  11779. 'implementation',
  11780. 'procedure tcar.doit;',
  11781. 'begin',
  11782. ' Intern:=Intern+1;',
  11783. ' Intern2:=Intern2+2;',
  11784. ' Bracket:=Bracket+3;',
  11785. 'end;',
  11786. 'var Obj: TCar;',
  11787. 'begin',
  11788. ' obj.intern:=obj.intern+1;',
  11789. ' obj.intern2:=obj.intern2+2;',
  11790. ' obj.Bracket:=obj.Bracket+3;',
  11791. ' with obj do begin',
  11792. ' intern:=intern+1;',
  11793. ' intern2:=intern2+2;',
  11794. ' Bracket:=Bracket+3;',
  11795. ' end;']);
  11796. ConvertUnit;
  11797. CheckSource('TestClass_ExternalVar',
  11798. LinesToStr([
  11799. 'var $impl = $mod.$impl;',
  11800. 'rtl.createClass($mod, "TCar", pas.unit2.TObject, function () {',
  11801. ' this.DoIt = function () {',
  11802. ' this.$Intern = this.$Intern + 1;',
  11803. ' this.$Intern2 = this.$Intern2 + 2;',
  11804. ' this["A B"] = this["A B"] + 3;',
  11805. ' };',
  11806. ' });',
  11807. '']),
  11808. LinesToStr([
  11809. '$impl.Obj.$Intern = $impl.Obj.$Intern + 1;',
  11810. '$impl.Obj.$Intern2 = $impl.Obj.$Intern2 + 2;',
  11811. '$impl.Obj["A B"] = $impl.Obj["A B"] + 3;',
  11812. 'var $with1 = $impl.Obj;',
  11813. '$with1.$Intern = $with1.$Intern + 1;',
  11814. '$with1.$Intern2 = $with1.$Intern2 + 2;',
  11815. '$with1["A B"] = $with1["A B"] + 3;',
  11816. '']),
  11817. LinesToStr([ // implementation
  11818. '$impl.Obj = null;',
  11819. '']));
  11820. end;
  11821. procedure TTestModule.TestClass_Const;
  11822. begin
  11823. StartProgram(false);
  11824. Add('type');
  11825. Add(' integer = longint;');
  11826. Add(' TClass = class of TObject;');
  11827. Add(' TObject = class');
  11828. Add(' public');
  11829. Add(' const cI: integer = 3;');
  11830. Add(' procedure DoIt;');
  11831. Add(' class procedure DoMore;');
  11832. Add(' end;');
  11833. Add('implementation');
  11834. Add('procedure tobject.doit;');
  11835. Add('begin');
  11836. Add(' if cI=4 then;');
  11837. Add(' if 5=cI then;');
  11838. Add(' if Self.cI=6 then;');
  11839. Add(' if 7=Self.cI then;');
  11840. Add(' with Self do begin');
  11841. Add(' if cI=11 then;');
  11842. Add(' if 12=cI then;');
  11843. Add(' end;');
  11844. Add('end;');
  11845. Add('class procedure tobject.domore;');
  11846. Add('begin');
  11847. Add(' if cI=8 then;');
  11848. Add(' if Self.cI=9 then;');
  11849. Add(' if 10=cI then;');
  11850. Add(' if 11=Self.cI then;');
  11851. Add(' with Self do begin');
  11852. Add(' if cI=13 then;');
  11853. Add(' if 14=cI then;');
  11854. Add(' end;');
  11855. Add('end;');
  11856. Add('var');
  11857. Add(' Obj: TObject;');
  11858. Add(' Cla: TClass;');
  11859. Add('begin');
  11860. Add(' if TObject.cI=21 then ;');
  11861. Add(' if Obj.cI=22 then ;');
  11862. Add(' if Cla.cI=23 then ;');
  11863. Add(' with obj do if ci=24 then;');
  11864. Add(' with TObject do if ci=25 then;');
  11865. Add(' with Cla do if ci=26 then;');
  11866. ConvertProgram;
  11867. CheckSource('TestClass_Const',
  11868. LinesToStr([
  11869. 'rtl.createClass($mod, "TObject", null, function () {',
  11870. ' this.cI = 3;',
  11871. ' this.$init = function () {',
  11872. ' };',
  11873. ' this.$final = function () {',
  11874. ' };',
  11875. ' this.DoIt = function () {',
  11876. ' if (this.cI === 4) ;',
  11877. ' if (5 === this.cI) ;',
  11878. ' if (this.cI === 6) ;',
  11879. ' if (7 === this.cI) ;',
  11880. ' if (this.cI === 11) ;',
  11881. ' if (12 === this.cI) ;',
  11882. ' };',
  11883. ' this.DoMore = function () {',
  11884. ' if (this.cI === 8) ;',
  11885. ' if (this.cI === 9) ;',
  11886. ' if (10 === this.cI) ;',
  11887. ' if (11 === this.cI) ;',
  11888. ' if (this.cI === 13) ;',
  11889. ' if (14 === this.cI) ;',
  11890. ' };',
  11891. '});',
  11892. 'this.Obj = null;',
  11893. 'this.Cla = null;',
  11894. '']),
  11895. LinesToStr([
  11896. 'if ($mod.TObject.cI === 21) ;',
  11897. 'if ($mod.Obj.cI === 22) ;',
  11898. 'if ($mod.Cla.cI === 23) ;',
  11899. 'var $with1 = $mod.Obj;',
  11900. 'if ($with1.cI === 24) ;',
  11901. 'var $with2 = $mod.TObject;',
  11902. 'if ($with2.cI === 25) ;',
  11903. 'var $with3 = $mod.Cla;',
  11904. 'if ($with3.cI === 26) ;',
  11905. '']));
  11906. end;
  11907. procedure TTestModule.TestClass_LocalVarSelfFail;
  11908. begin
  11909. StartProgram(false);
  11910. Add([
  11911. 'type',
  11912. ' TObject = class',
  11913. ' constructor Create;',
  11914. ' end;',
  11915. 'constructor tobject.create;',
  11916. 'var self: longint;',
  11917. 'begin',
  11918. 'end',
  11919. 'begin',
  11920. '']);
  11921. SetExpectedPasResolverError('Duplicate identifier "self" at (0)',nDuplicateIdentifier);
  11922. ConvertProgram;
  11923. end;
  11924. procedure TTestModule.TestClass_ArgSelfFail;
  11925. begin
  11926. StartProgram(false);
  11927. Add([
  11928. 'type',
  11929. ' TObject = class',
  11930. ' procedure DoIt(Self: longint);',
  11931. ' end;',
  11932. 'procedure tobject.doit(self: longint);',
  11933. 'begin',
  11934. 'end',
  11935. 'begin',
  11936. '']);
  11937. SetExpectedPasResolverError('Duplicate identifier "Self" at test1.pp(5,24)',nDuplicateIdentifier);
  11938. ConvertProgram;
  11939. end;
  11940. procedure TTestModule.TestClass_NestedProcSelf;
  11941. begin
  11942. StartProgram(false);
  11943. Add([
  11944. 'type',
  11945. ' TObject = class',
  11946. ' Key: longint;',
  11947. ' class var State: longint;',
  11948. ' procedure DoIt;',
  11949. ' function GetSize: longint; virtual; abstract;',
  11950. ' procedure SetSize(Value: longint); virtual; abstract;',
  11951. ' property Size: longint read GetSize write SetSize;',
  11952. ' end;',
  11953. 'procedure tobject.doit;',
  11954. ' procedure Sub;',
  11955. ' begin',
  11956. ' key:=key+2;',
  11957. ' self.key:=self.key+3;',
  11958. ' state:=state+4;',
  11959. ' self.state:=self.state+5;',
  11960. ' tobject.state:=tobject.state+6;',
  11961. ' size:=size+7;',
  11962. ' self.size:=self.size+8;',
  11963. ' end;',
  11964. 'begin',
  11965. ' sub;',
  11966. ' key:=key+12;',
  11967. ' self.key:=self.key+13;',
  11968. ' state:=state+14;',
  11969. ' self.state:=self.state+15;',
  11970. ' tobject.state:=tobject.state+16;',
  11971. ' size:=size+17;',
  11972. ' self.size:=self.size+18;',
  11973. 'end;',
  11974. 'begin',
  11975. '']);
  11976. ConvertProgram;
  11977. CheckSource('TestClass_NestedProcSelf',
  11978. LinesToStr([ // statements
  11979. 'rtl.createClass($mod, "TObject", null, function () {',
  11980. ' this.State = 0;',
  11981. ' this.$init = function () {',
  11982. ' this.Key = 0;',
  11983. ' };',
  11984. ' this.$final = function () {',
  11985. ' };',
  11986. ' this.DoIt = function () {',
  11987. ' var Self = this;',
  11988. ' function Sub() {',
  11989. ' Self.Key = Self.Key + 2;',
  11990. ' Self.Key = Self.Key + 3;',
  11991. ' $mod.TObject.State = Self.State + 4;',
  11992. ' $mod.TObject.State = Self.State + 5;',
  11993. ' $mod.TObject.State = $mod.TObject.State + 6;',
  11994. ' Self.SetSize(Self.GetSize() + 7);',
  11995. ' Self.SetSize(Self.GetSize() + 8);',
  11996. ' };',
  11997. ' Sub();',
  11998. ' Self.Key = Self.Key + 12;',
  11999. ' Self.Key = Self.Key + 13;',
  12000. ' $mod.TObject.State = Self.State + 14;',
  12001. ' $mod.TObject.State = Self.State + 15;',
  12002. ' $mod.TObject.State = $mod.TObject.State + 16;',
  12003. ' Self.SetSize(Self.GetSize() + 17);',
  12004. ' Self.SetSize(Self.GetSize() + 18);',
  12005. ' };',
  12006. '});',
  12007. '']),
  12008. LinesToStr([ // $mod.$main
  12009. '']));
  12010. end;
  12011. procedure TTestModule.TestClass_NestedProcSelf2;
  12012. begin
  12013. StartProgram(false);
  12014. Add([
  12015. 'type',
  12016. ' TObject = class',
  12017. ' Key: longint;',
  12018. ' class var State: longint;',
  12019. ' function GetSize: longint; virtual; abstract;',
  12020. ' procedure SetSize(Value: longint); virtual; abstract;',
  12021. ' property Size: longint read GetSize write SetSize;',
  12022. ' end;',
  12023. ' TBird = class',
  12024. ' procedure DoIt;',
  12025. ' end;',
  12026. 'procedure tbird.doit;',
  12027. ' procedure Sub;',
  12028. ' begin',
  12029. ' key:=key+2;',
  12030. ' self.key:=self.key+3;',
  12031. ' state:=state+4;',
  12032. ' self.state:=self.state+5;',
  12033. ' tobject.state:=tobject.state+6;',
  12034. ' size:=size+7;',
  12035. ' self.size:=self.size+8;',
  12036. ' end;',
  12037. 'begin',
  12038. ' sub;',
  12039. ' key:=key+12;',
  12040. ' self.key:=self.key+13;',
  12041. ' state:=state+14;',
  12042. ' self.state:=self.state+15;',
  12043. ' tobject.state:=tobject.state+16;',
  12044. ' size:=size+17;',
  12045. ' self.size:=self.size+18;',
  12046. 'end;',
  12047. 'begin',
  12048. '']);
  12049. ConvertProgram;
  12050. CheckSource('TestClass_NestedProcSelf2',
  12051. LinesToStr([ // statements
  12052. 'rtl.createClass($mod, "TObject", null, function () {',
  12053. ' this.State = 0;',
  12054. ' this.$init = function () {',
  12055. ' this.Key = 0;',
  12056. ' };',
  12057. ' this.$final = function () {',
  12058. ' };',
  12059. '});',
  12060. 'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
  12061. ' this.DoIt = function () {',
  12062. ' var Self = this;',
  12063. ' function Sub() {',
  12064. ' Self.Key = Self.Key + 2;',
  12065. ' Self.Key = Self.Key + 3;',
  12066. ' $mod.TObject.State = Self.State + 4;',
  12067. ' $mod.TObject.State = Self.State + 5;',
  12068. ' $mod.TObject.State = $mod.TObject.State + 6;',
  12069. ' Self.SetSize(Self.GetSize() + 7);',
  12070. ' Self.SetSize(Self.GetSize() + 8);',
  12071. ' };',
  12072. ' Sub();',
  12073. ' Self.Key = Self.Key + 12;',
  12074. ' Self.Key = Self.Key + 13;',
  12075. ' $mod.TObject.State = Self.State + 14;',
  12076. ' $mod.TObject.State = Self.State + 15;',
  12077. ' $mod.TObject.State = $mod.TObject.State + 16;',
  12078. ' Self.SetSize(Self.GetSize() + 17);',
  12079. ' Self.SetSize(Self.GetSize() + 18);',
  12080. ' };',
  12081. '});',
  12082. '']),
  12083. LinesToStr([ // $mod.$main
  12084. '']));
  12085. end;
  12086. procedure TTestModule.TestClass_NestedProcClassSelf;
  12087. begin
  12088. StartProgram(false);
  12089. Add([
  12090. 'type',
  12091. ' TObject = class',
  12092. ' class var State: longint;',
  12093. ' class procedure DoIt;',
  12094. ' class function GetSize: longint; virtual; abstract;',
  12095. ' class procedure SetSize(Value: longint); virtual; abstract;',
  12096. ' class property Size: longint read GetSize write SetSize;',
  12097. ' end;',
  12098. 'class procedure tobject.doit;',
  12099. ' procedure Sub;',
  12100. ' begin',
  12101. ' state:=state+2;',
  12102. ' self.state:=self.state+3;',
  12103. ' tobject.state:=tobject.state+4;',
  12104. ' size:=size+5;',
  12105. ' self.size:=self.size+6;',
  12106. ' tobject.size:=tobject.size+7;',
  12107. ' end;',
  12108. 'begin',
  12109. ' sub;',
  12110. ' state:=state+12;',
  12111. ' self.state:=self.state+13;',
  12112. ' tobject.state:=tobject.state+14;',
  12113. ' size:=size+15;',
  12114. ' self.size:=self.size+16;',
  12115. ' tobject.size:=tobject.size+17;',
  12116. 'end;',
  12117. 'begin',
  12118. '']);
  12119. ConvertProgram;
  12120. CheckSource('TestClass_NestedProcClassSelf',
  12121. LinesToStr([ // statements
  12122. 'rtl.createClass($mod, "TObject", null, function () {',
  12123. ' this.State = 0;',
  12124. ' this.$init = function () {',
  12125. ' };',
  12126. ' this.$final = function () {',
  12127. ' };',
  12128. ' this.DoIt = function () {',
  12129. ' var Self = this;',
  12130. ' function Sub() {',
  12131. ' $mod.TObject.State = Self.State + 2;',
  12132. ' $mod.TObject.State = Self.State + 3;',
  12133. ' $mod.TObject.State = $mod.TObject.State + 4;',
  12134. ' Self.SetSize(Self.GetSize() + 5);',
  12135. ' Self.SetSize(Self.GetSize() + 6);',
  12136. ' $mod.TObject.SetSize($mod.TObject.GetSize() + 7);',
  12137. ' };',
  12138. ' Sub();',
  12139. ' $mod.TObject.State = Self.State + 12;',
  12140. ' $mod.TObject.State = Self.State + 13;',
  12141. ' $mod.TObject.State = $mod.TObject.State + 14;',
  12142. ' Self.SetSize(Self.GetSize() + 15);',
  12143. ' Self.SetSize(Self.GetSize() + 16);',
  12144. ' $mod.TObject.SetSize($mod.TObject.GetSize() + 17);',
  12145. ' };',
  12146. '});',
  12147. '']),
  12148. LinesToStr([ // $mod.$main
  12149. '']));
  12150. end;
  12151. procedure TTestModule.TestClass_NestedProcCallInherited;
  12152. begin
  12153. StartProgram(false);
  12154. Add([
  12155. 'type',
  12156. ' TObject = class',
  12157. ' function DoIt(k: boolean): longint; virtual;',
  12158. ' end;',
  12159. ' TBird = class',
  12160. ' function DoIt(k: boolean): longint; override;',
  12161. ' end;',
  12162. 'function tobject.doit(k: boolean): longint;',
  12163. 'begin',
  12164. 'end;',
  12165. 'function tbird.doit(k: boolean): longint;',
  12166. ' procedure Sub;',
  12167. ' begin',
  12168. ' inherited DoIt(true);',
  12169. //' if inherited DoIt(false)=4 then ;',
  12170. ' end;',
  12171. 'begin',
  12172. ' Sub;',
  12173. ' inherited;',
  12174. ' inherited DoIt(true);',
  12175. //' if inherited DoIt(false)=14 then ;',
  12176. 'end;',
  12177. 'begin',
  12178. '']);
  12179. ConvertProgram;
  12180. CheckSource('TestClass_NestedProcCallInherited',
  12181. LinesToStr([ // statements
  12182. 'rtl.createClass($mod, "TObject", null, function () {',
  12183. ' this.$init = function () {',
  12184. ' };',
  12185. ' this.$final = function () {',
  12186. ' };',
  12187. ' this.DoIt = function (k) {',
  12188. ' var Result = 0;',
  12189. ' return Result;',
  12190. ' };',
  12191. '});',
  12192. 'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
  12193. ' this.DoIt = function (k) {',
  12194. ' var Self = this;',
  12195. ' var Result = 0;',
  12196. ' function Sub() {',
  12197. ' $mod.TObject.DoIt.call(Self, true);',
  12198. ' };',
  12199. ' Sub();',
  12200. ' $mod.TObject.DoIt.apply(Self, arguments);',
  12201. ' $mod.TObject.DoIt.call(Self, true);',
  12202. ' return Result;',
  12203. ' };',
  12204. '});',
  12205. '']),
  12206. LinesToStr([ // $mod.$main
  12207. '']));
  12208. end;
  12209. procedure TTestModule.TestClass_TObjectFree;
  12210. begin
  12211. StartProgram(false);
  12212. Add([
  12213. 'type',
  12214. ' TObject = class',
  12215. ' Obj: tobject;',
  12216. ' procedure Free;',
  12217. ' procedure Release;',
  12218. ' end;',
  12219. 'procedure tobject.free;',
  12220. 'begin',
  12221. 'end;',
  12222. 'procedure tobject.release;',
  12223. 'begin',
  12224. ' free;',
  12225. ' if true then free;',
  12226. 'end;',
  12227. 'function DoIt(o: tobject): tobject;',
  12228. 'var l: tobject;',
  12229. 'begin',
  12230. ' o.free;',
  12231. ' o.free();',
  12232. ' l.free;',
  12233. ' l.free();',
  12234. ' o.obj.free;',
  12235. ' o.obj.free();',
  12236. ' with o do obj.free;',
  12237. ' with o do obj.free();',
  12238. ' result.Free;',
  12239. ' result.Free();',
  12240. 'end;',
  12241. 'var o: tobject;',
  12242. ' a: array of tobject;',
  12243. 'begin',
  12244. ' o.free;',
  12245. ' o.obj.free;',
  12246. ' a[1+2].free;',
  12247. '']);
  12248. ConvertProgram;
  12249. CheckSource('TestClass_TObjectFree',
  12250. LinesToStr([ // statements
  12251. 'rtl.createClass($mod, "TObject", null, function () {',
  12252. ' this.$init = function () {',
  12253. ' this.Obj = null;',
  12254. ' };',
  12255. ' this.$final = function () {',
  12256. ' this.Obj = undefined;',
  12257. ' };',
  12258. ' this.Free = function () {',
  12259. ' };',
  12260. ' this.Release = function () {',
  12261. ' this.Free();',
  12262. ' if (true) this.Free();',
  12263. ' };',
  12264. '});',
  12265. 'this.DoIt = function (o) {',
  12266. ' var Result = null;',
  12267. ' var l = null;',
  12268. ' o = rtl.freeLoc(o);',
  12269. ' o = rtl.freeLoc(o);',
  12270. ' l = rtl.freeLoc(l);',
  12271. ' l = rtl.freeLoc(l);',
  12272. ' rtl.free(o, "Obj");',
  12273. ' rtl.free(o, "Obj");',
  12274. ' rtl.free(o, "Obj");',
  12275. ' rtl.free(o, "Obj");',
  12276. ' Result = rtl.freeLoc(Result);',
  12277. ' Result = rtl.freeLoc(Result);',
  12278. ' return Result;',
  12279. '};',
  12280. 'this.o = null;',
  12281. 'this.a = [];',
  12282. '']),
  12283. LinesToStr([ // $mod.$main
  12284. 'rtl.free($mod, "o");',
  12285. 'rtl.free($mod.o, "Obj");',
  12286. 'rtl.free($mod.a, 1 + 2);',
  12287. '']));
  12288. end;
  12289. procedure TTestModule.TestClass_TObjectFreeNewInstance;
  12290. begin
  12291. StartProgram(false);
  12292. Add([
  12293. 'type',
  12294. ' TObject = class',
  12295. ' constructor Create;',
  12296. ' procedure Free;',
  12297. ' end;',
  12298. 'constructor TObject.Create; begin end;',
  12299. 'procedure tobject.free; begin end;',
  12300. 'begin',
  12301. ' with tobject.create do free;',
  12302. '']);
  12303. ConvertProgram;
  12304. CheckSource('TestClass_TObjectFreeNewInstance',
  12305. LinesToStr([ // statements
  12306. 'rtl.createClass($mod, "TObject", null, function () {',
  12307. ' this.$init = function () {',
  12308. ' };',
  12309. ' this.$final = function () {',
  12310. ' };',
  12311. ' this.Create = function () {',
  12312. ' };',
  12313. ' this.Free = function () {',
  12314. ' };',
  12315. '});',
  12316. '']),
  12317. LinesToStr([ // $mod.$main
  12318. 'var $with1 = $mod.TObject.$create("Create");',
  12319. '$with1=rtl.freeLoc($with1);',
  12320. '']));
  12321. end;
  12322. procedure TTestModule.TestClass_TObjectFreeLowerCase;
  12323. begin
  12324. StartProgram(false);
  12325. Add([
  12326. 'type',
  12327. ' TObject = class',
  12328. ' destructor Destroy;',
  12329. ' procedure Free;',
  12330. ' end;',
  12331. 'destructor TObject.Destroy; begin end;',
  12332. 'procedure tobject.free; begin end;',
  12333. 'var o: tobject;',
  12334. 'begin',
  12335. ' o.free;',
  12336. '']);
  12337. Converter.UseLowerCase:=true;
  12338. ConvertProgram;
  12339. CheckSource('TestClass_TObjectFreeLowerCase',
  12340. LinesToStr([ // statements
  12341. 'rtl.createClass($mod, "tobject", null, function () {',
  12342. ' this.$init = function () {',
  12343. ' };',
  12344. ' this.$final = function () {',
  12345. ' };',
  12346. ' rtl.tObjectDestroy = "destroy";',
  12347. ' this.destroy = function () {',
  12348. ' };',
  12349. ' this.free = function () {',
  12350. ' };',
  12351. '});',
  12352. 'this.o = null;',
  12353. '']),
  12354. LinesToStr([ // $mod.$main
  12355. 'rtl.free($mod, "o");',
  12356. '']));
  12357. end;
  12358. procedure TTestModule.TestClass_TObjectFreeFunctionFail;
  12359. begin
  12360. StartProgram(false);
  12361. Add([
  12362. 'type',
  12363. ' TObject = class',
  12364. ' procedure Free;',
  12365. ' function GetObj: tobject; virtual; abstract;',
  12366. ' end;',
  12367. 'procedure tobject.free;',
  12368. 'begin',
  12369. 'end;',
  12370. 'var o: tobject;',
  12371. 'begin',
  12372. ' o.getobj.free;',
  12373. '']);
  12374. SetExpectedPasResolverError(sFreeNeedsVar,nFreeNeedsVar);
  12375. ConvertProgram;
  12376. end;
  12377. procedure TTestModule.TestClass_TObjectFreePropertyFail;
  12378. begin
  12379. StartProgram(false);
  12380. Add([
  12381. 'type',
  12382. ' TObject = class',
  12383. ' procedure Free;',
  12384. ' FObj: TObject;',
  12385. ' property Obj: tobject read FObj write FObj;',
  12386. ' end;',
  12387. 'procedure tobject.free;',
  12388. 'begin',
  12389. 'end;',
  12390. 'var o: tobject;',
  12391. 'begin',
  12392. ' o.obj.free;',
  12393. '']);
  12394. SetExpectedPasResolverError(sFreeNeedsVar,nFreeNeedsVar);
  12395. ConvertProgram;
  12396. end;
  12397. procedure TTestModule.TestClass_ForIn;
  12398. begin
  12399. StartProgram(false);
  12400. Add([
  12401. 'type',
  12402. ' TObject = class end;',
  12403. ' TItem = TObject;',
  12404. ' TEnumerator = class',
  12405. ' FCurrent: TItem;',
  12406. ' property Current: TItem read FCurrent;',
  12407. ' function MoveNext: boolean;',
  12408. ' end;',
  12409. ' TBird = class',
  12410. ' function GetEnumerator: TEnumerator;',
  12411. ' end;',
  12412. 'function TEnumerator.MoveNext: boolean;',
  12413. 'begin',
  12414. 'end;',
  12415. 'function TBird.GetEnumerator: TEnumerator;',
  12416. 'begin',
  12417. 'end;',
  12418. 'var',
  12419. ' b: TBird;',
  12420. ' i, i2: TItem;',
  12421. 'begin',
  12422. ' for i in b do i2:=i;']);
  12423. ConvertProgram;
  12424. CheckSource('TestClass_ForIn',
  12425. LinesToStr([ // statements
  12426. 'rtl.createClass($mod, "TObject", null, function () {',
  12427. ' this.$init = function () {',
  12428. ' };',
  12429. ' this.$final = function () {',
  12430. ' };',
  12431. '});',
  12432. 'rtl.createClass($mod, "TEnumerator", $mod.TObject, function () {',
  12433. ' this.$init = function () {',
  12434. ' $mod.TObject.$init.call(this);',
  12435. ' this.FCurrent = null;',
  12436. ' };',
  12437. ' this.$final = function () {',
  12438. ' this.FCurrent = undefined;',
  12439. ' $mod.TObject.$final.call(this);',
  12440. ' };',
  12441. ' this.MoveNext = function () {',
  12442. ' var Result = false;',
  12443. ' return Result;',
  12444. ' };',
  12445. '});',
  12446. 'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
  12447. ' this.GetEnumerator = function () {',
  12448. ' var Result = null;',
  12449. ' return Result;',
  12450. ' };',
  12451. '});',
  12452. 'this.b = null;',
  12453. 'this.i = null;',
  12454. 'this.i2 = null;'
  12455. ]),
  12456. LinesToStr([ // $mod.$main
  12457. 'var $in1 = $mod.b.GetEnumerator();',
  12458. 'try {',
  12459. ' while ($in1.MoveNext()){',
  12460. ' $mod.i = $in1.FCurrent;',
  12461. ' $mod.i2 = $mod.i;',
  12462. ' }',
  12463. '} finally {',
  12464. ' $in1 = rtl.freeLoc($in1)',
  12465. '};',
  12466. '']));
  12467. end;
  12468. procedure TTestModule.TestClassOf_Create;
  12469. begin
  12470. StartProgram(false);
  12471. Add('type');
  12472. Add(' TObject = class');
  12473. Add(' constructor Create;');
  12474. Add(' end;');
  12475. Add(' TClass = class of TObject;');
  12476. Add('constructor tobject.create; begin end;');
  12477. Add('var');
  12478. Add(' Obj: tobject;');
  12479. Add(' C: tclass;');
  12480. Add('begin');
  12481. Add(' obj:=C.create;');
  12482. Add(' with c do obj:=create;');
  12483. ConvertProgram;
  12484. CheckSource('TestClassOf_Create',
  12485. LinesToStr([ // statements
  12486. 'rtl.createClass($mod, "TObject", null, function () {',
  12487. ' this.$init = function () {',
  12488. ' };',
  12489. ' this.$final = function () {',
  12490. ' };',
  12491. ' this.Create = function () {',
  12492. ' };',
  12493. '});',
  12494. 'this.Obj = null;',
  12495. 'this.C = null;'
  12496. ]),
  12497. LinesToStr([ // $mod.$main
  12498. '$mod.Obj = $mod.C.$create("Create");',
  12499. 'var $with1 = $mod.C;',
  12500. '$mod.Obj = $with1.$create("Create");',
  12501. '']));
  12502. end;
  12503. procedure TTestModule.TestClassOf_Call;
  12504. begin
  12505. StartProgram(false);
  12506. Add('type');
  12507. Add(' TObject = class');
  12508. Add(' class procedure DoIt;');
  12509. Add(' end;');
  12510. Add(' TClass = class of TObject;');
  12511. Add('class procedure tobject.doit; begin end;');
  12512. Add('var');
  12513. Add(' C: tclass;');
  12514. Add('begin');
  12515. Add(' c.doit;');
  12516. Add(' with c do doit;');
  12517. ConvertProgram;
  12518. CheckSource('TestClassOf_Call',
  12519. LinesToStr([ // statements
  12520. 'rtl.createClass($mod, "TObject", null, function () {',
  12521. ' this.$init = function () {',
  12522. ' };',
  12523. ' this.$final = function () {',
  12524. ' };',
  12525. ' this.DoIt = function () {',
  12526. ' };',
  12527. '});',
  12528. 'this.C = null;'
  12529. ]),
  12530. LinesToStr([ // $mod.$main
  12531. '$mod.C.DoIt();',
  12532. 'var $with1 = $mod.C;',
  12533. '$with1.DoIt();',
  12534. '']));
  12535. end;
  12536. procedure TTestModule.TestClassOf_Assign;
  12537. begin
  12538. StartProgram(false);
  12539. Add('type');
  12540. Add(' TClass = class of TObject;');
  12541. Add(' TObject = class');
  12542. Add(' ClassType: TClass; ');
  12543. Add(' end;');
  12544. Add('var');
  12545. Add(' Obj: tobject;');
  12546. Add(' C: tclass;');
  12547. Add('begin');
  12548. Add(' c:=nil;');
  12549. Add(' c:=obj.classtype;');
  12550. ConvertProgram;
  12551. CheckSource('TestClassOf_Assign',
  12552. LinesToStr([ // statements
  12553. 'rtl.createClass($mod, "TObject", null, function () {',
  12554. ' this.$init = function () {',
  12555. ' this.ClassType = null;',
  12556. ' };',
  12557. ' this.$final = function () {',
  12558. ' this.ClassType = undefined;',
  12559. ' };',
  12560. '});',
  12561. 'this.Obj = null;',
  12562. 'this.C = null;'
  12563. ]),
  12564. LinesToStr([ // $mod.$main
  12565. '$mod.C = null;',
  12566. '$mod.C = $mod.Obj.ClassType;',
  12567. '']));
  12568. end;
  12569. procedure TTestModule.TestClassOf_Is;
  12570. begin
  12571. StartProgram(false);
  12572. Add('type');
  12573. Add(' TClass = class of TObject;');
  12574. Add(' TObject = class');
  12575. Add(' end;');
  12576. Add(' TCar = class');
  12577. Add(' end;');
  12578. Add(' TCars = class of TCar;');
  12579. Add('var');
  12580. Add(' Obj: tobject;');
  12581. Add(' C: tclass;');
  12582. Add(' Cars: tcars;');
  12583. Add('begin');
  12584. Add(' if c is tcar then ;');
  12585. Add(' if c is tcars then ;');
  12586. ConvertProgram;
  12587. CheckSource('TestClassOf_Is',
  12588. LinesToStr([ // statements
  12589. 'rtl.createClass($mod, "TObject", null, function () {',
  12590. ' this.$init = function () {',
  12591. ' };',
  12592. ' this.$final = function () {',
  12593. ' };',
  12594. '});',
  12595. 'rtl.createClass($mod, "TCar", $mod.TObject, function () {',
  12596. '});',
  12597. 'this.Obj = null;',
  12598. 'this.C = null;',
  12599. 'this.Cars = null;'
  12600. ]),
  12601. LinesToStr([ // $mod.$main
  12602. 'if(rtl.is($mod.C,$mod.TCar));',
  12603. 'if(rtl.is($mod.C,$mod.TCar));',
  12604. '']));
  12605. end;
  12606. procedure TTestModule.TestClassOf_Compare;
  12607. begin
  12608. StartProgram(false);
  12609. Add('type');
  12610. Add(' TClass = class of TObject;');
  12611. Add(' TObject = class');
  12612. Add(' ClassType: TClass; ');
  12613. Add(' end;');
  12614. Add('var');
  12615. Add(' b: boolean;');
  12616. Add(' Obj: tobject;');
  12617. Add(' C: tclass;');
  12618. Add('begin');
  12619. Add(' b:=c=nil;');
  12620. Add(' b:=nil=c;');
  12621. Add(' b:=c=obj.classtype;');
  12622. Add(' b:=obj.classtype=c;');
  12623. Add(' b:=c=TObject;');
  12624. Add(' b:=TObject=c;');
  12625. Add(' b:=c<>nil;');
  12626. Add(' b:=nil<>c;');
  12627. Add(' b:=c<>obj.classtype;');
  12628. Add(' b:=obj.classtype<>c;');
  12629. Add(' b:=c<>TObject;');
  12630. Add(' b:=TObject<>c;');
  12631. ConvertProgram;
  12632. CheckSource('TestClassOf_Compare',
  12633. LinesToStr([ // statements
  12634. 'rtl.createClass($mod, "TObject", null, function () {',
  12635. ' this.$init = function () {',
  12636. ' this.ClassType = null;',
  12637. ' };',
  12638. ' this.$final = function () {',
  12639. ' this.ClassType = undefined;',
  12640. ' };',
  12641. '});',
  12642. 'this.b = false;',
  12643. 'this.Obj = null;',
  12644. 'this.C = null;'
  12645. ]),
  12646. LinesToStr([ // $mod.$main
  12647. '$mod.b = $mod.C === null;',
  12648. '$mod.b = null === $mod.C;',
  12649. '$mod.b = $mod.C === $mod.Obj.ClassType;',
  12650. '$mod.b = $mod.Obj.ClassType === $mod.C;',
  12651. '$mod.b = $mod.C === $mod.TObject;',
  12652. '$mod.b = $mod.TObject === $mod.C;',
  12653. '$mod.b = $mod.C !== null;',
  12654. '$mod.b = null !== $mod.C;',
  12655. '$mod.b = $mod.C !== $mod.Obj.ClassType;',
  12656. '$mod.b = $mod.Obj.ClassType !== $mod.C;',
  12657. '$mod.b = $mod.C !== $mod.TObject;',
  12658. '$mod.b = $mod.TObject !== $mod.C;',
  12659. '']));
  12660. end;
  12661. procedure TTestModule.TestClassOf_ClassVar;
  12662. begin
  12663. StartProgram(false);
  12664. Add('type');
  12665. Add(' TObject = class');
  12666. Add(' class var id: longint;');
  12667. Add(' end;');
  12668. Add(' TClass = class of TObject;');
  12669. Add('var');
  12670. Add(' C: tclass;');
  12671. Add('begin');
  12672. Add(' C.id:=C.id;');
  12673. ConvertProgram;
  12674. CheckSource('TestClassOf_ClassVar',
  12675. LinesToStr([ // statements
  12676. 'rtl.createClass($mod, "TObject", null, function () {',
  12677. ' this.id = 0;',
  12678. ' this.$init = function () {',
  12679. ' };',
  12680. ' this.$final = function () {',
  12681. ' };',
  12682. '});',
  12683. 'this.C = null;'
  12684. ]),
  12685. LinesToStr([ // $mod.$main
  12686. '$mod.TObject.id = $mod.C.id;',
  12687. '']));
  12688. end;
  12689. procedure TTestModule.TestClassOf_ClassMethod;
  12690. begin
  12691. StartProgram(false);
  12692. Add('type');
  12693. Add(' TObject = class');
  12694. Add(' class function DoIt(i: longint = 0): longint;');
  12695. Add(' end;');
  12696. Add(' TClass = class of TObject;');
  12697. Add('class function tobject.doit(i: longint = 0): longint; begin end;');
  12698. Add('var');
  12699. Add(' i: longint;');
  12700. Add(' C: tclass;');
  12701. Add('begin');
  12702. Add(' C.DoIt;');
  12703. Add(' C.DoIt();');
  12704. Add(' i:=C.DoIt;');
  12705. Add(' i:=C.DoIt();');
  12706. ConvertProgram;
  12707. CheckSource('TestClassOf_ClassMethod',
  12708. LinesToStr([ // statements
  12709. 'rtl.createClass($mod, "TObject", null, function () {',
  12710. ' this.$init = function () {',
  12711. ' };',
  12712. ' this.$final = function () {',
  12713. ' };',
  12714. ' this.DoIt = function (i) {',
  12715. ' var Result = 0;',
  12716. ' return Result;',
  12717. ' };',
  12718. '});',
  12719. 'this.i = 0;',
  12720. 'this.C = null;'
  12721. ]),
  12722. LinesToStr([ // $mod.$main
  12723. '$mod.C.DoIt(0);',
  12724. '$mod.C.DoIt(0);',
  12725. '$mod.i = $mod.C.DoIt(0);',
  12726. '$mod.i = $mod.C.DoIt(0);',
  12727. '']));
  12728. end;
  12729. procedure TTestModule.TestClassOf_ClassProperty;
  12730. begin
  12731. StartProgram(false);
  12732. Add('type');
  12733. Add(' TObject = class');
  12734. Add(' class var FA: longint;');
  12735. Add(' class function GetA: longint;');
  12736. Add(' class procedure SetA(Value: longint);');
  12737. Add(' class property pA: longint read fa write fa;');
  12738. Add(' class property pB: longint read geta write seta;');
  12739. Add(' end;');
  12740. Add(' TObjectClass = class of tobject;');
  12741. Add('class function tobject.geta: longint; begin end;');
  12742. Add('class procedure tobject.seta(value: longint); begin end;');
  12743. Add('var');
  12744. Add(' b: boolean;');
  12745. Add(' Obj: tobject;');
  12746. Add(' Cla: tobjectclass;');
  12747. Add('begin');
  12748. Add(' obj.pa:=obj.pa;');
  12749. Add(' obj.pb:=obj.pb;');
  12750. Add(' b:=obj.pa=4;');
  12751. Add(' b:=obj.pb=obj.pb;');
  12752. Add(' b:=5=obj.pa;');
  12753. Add(' cla.pa:=6;');
  12754. Add(' cla.pa:=cla.pa;');
  12755. Add(' cla.pb:=cla.pb;');
  12756. Add(' b:=cla.pa=7;');
  12757. Add(' b:=cla.pb=cla.pb;');
  12758. Add(' b:=8=cla.pa;');
  12759. Add(' tobject.pa:=9;');
  12760. Add(' tobject.pb:=tobject.pb;');
  12761. Add(' b:=tobject.pa=10;');
  12762. Add(' b:=11=tobject.pa;');
  12763. ConvertProgram;
  12764. CheckSource('TestClassOf_ClassProperty',
  12765. LinesToStr([ // statements
  12766. 'rtl.createClass($mod, "TObject", null, function () {',
  12767. ' this.FA = 0;',
  12768. ' this.$init = function () {',
  12769. ' };',
  12770. ' this.$final = function () {',
  12771. ' };',
  12772. ' this.GetA = function () {',
  12773. ' var Result = 0;',
  12774. ' return Result;',
  12775. ' };',
  12776. ' this.SetA = function (Value) {',
  12777. ' };',
  12778. '});',
  12779. 'this.b = false;',
  12780. 'this.Obj = null;',
  12781. 'this.Cla = null;'
  12782. ]),
  12783. LinesToStr([ // $mod.$main
  12784. '$mod.Obj.$class.FA = $mod.Obj.FA;',
  12785. '$mod.Obj.$class.SetA($mod.Obj.$class.GetA());',
  12786. '$mod.b = $mod.Obj.FA === 4;',
  12787. '$mod.b = $mod.Obj.$class.GetA() === $mod.Obj.$class.GetA();',
  12788. '$mod.b = 5 === $mod.Obj.FA;',
  12789. '$mod.Cla.FA = 6;',
  12790. '$mod.Cla.FA = $mod.Cla.FA;',
  12791. '$mod.Cla.SetA($mod.Cla.GetA());',
  12792. '$mod.b = $mod.Cla.FA === 7;',
  12793. '$mod.b = $mod.Cla.GetA() === $mod.Cla.GetA();',
  12794. '$mod.b = 8 === $mod.Cla.FA;',
  12795. '$mod.TObject.FA = 9;',
  12796. '$mod.TObject.SetA($mod.TObject.GetA());',
  12797. '$mod.b = $mod.TObject.FA === 10;',
  12798. '$mod.b = 11 === $mod.TObject.FA;',
  12799. '']));
  12800. end;
  12801. procedure TTestModule.TestClassOf_ClassMethodSelf;
  12802. begin
  12803. StartProgram(false);
  12804. Add('type');
  12805. Add(' TObject = class');
  12806. Add(' class var GlobalId: longint;');
  12807. Add(' class procedure ProcA;');
  12808. Add(' end;');
  12809. Add('class procedure tobject.proca;');
  12810. Add('var b: boolean;');
  12811. Add('begin');
  12812. Add(' b:=self=nil;');
  12813. Add(' b:=self.globalid=3;');
  12814. Add(' b:=4=self.globalid;');
  12815. Add(' self.globalid:=5;');
  12816. Add(' self.proca;');
  12817. Add('end;');
  12818. Add('begin');
  12819. ConvertProgram;
  12820. CheckSource('TestClassOf_ClassMethodSelf',
  12821. LinesToStr([ // statements
  12822. 'rtl.createClass($mod, "TObject", null, function () {',
  12823. ' this.GlobalId = 0;',
  12824. ' this.$init = function () {',
  12825. ' };',
  12826. ' this.$final = function () {',
  12827. ' };',
  12828. ' this.ProcA = function () {',
  12829. ' var b = false;',
  12830. ' b = this === null;',
  12831. ' b = this.GlobalId === 3;',
  12832. ' b = 4 === this.GlobalId;',
  12833. ' $mod.TObject.GlobalId = 5;',
  12834. ' this.ProcA();',
  12835. ' };',
  12836. '});'
  12837. ]),
  12838. LinesToStr([ // $mod.$main
  12839. '']));
  12840. end;
  12841. procedure TTestModule.TestClassOf_TypeCast;
  12842. begin
  12843. StartProgram(false);
  12844. Add('type');
  12845. Add(' TObject = class');
  12846. Add(' class procedure {#TObject_DoIt}DoIt;');
  12847. Add(' end;');
  12848. Add(' TClass = class of TObject;');
  12849. Add(' TMobile = class');
  12850. Add(' class procedure {#TMobile_DoIt}DoIt;');
  12851. Add(' end;');
  12852. Add(' TMobileClass = class of TMobile;');
  12853. Add(' TCar = class(TMobile)');
  12854. Add(' class procedure {#TCar_DoIt}DoIt;');
  12855. Add(' end;');
  12856. Add(' TCarClass = class of TCar;');
  12857. Add('class procedure TObject.DoIt;');
  12858. Add('begin');
  12859. Add(' TClass(Self).{@TObject_DoIt}DoIt;');
  12860. Add(' TMobileClass(Self).{@TMobile_DoIt}DoIt;');
  12861. Add('end;');
  12862. Add('class procedure TMobile.DoIt;');
  12863. Add('begin');
  12864. Add(' TClass(Self).{@TObject_DoIt}DoIt;');
  12865. Add(' TMobileClass(Self).{@TMobile_DoIt}DoIt;');
  12866. Add(' TCarClass(Self).{@TCar_DoIt}DoIt;');
  12867. Add('end;');
  12868. Add('class procedure TCar.DoIt; begin end;');
  12869. Add('var');
  12870. Add(' ObjC: TClass;');
  12871. Add(' MobileC: TMobileClass;');
  12872. Add(' CarC: TCarClass;');
  12873. Add('begin');
  12874. Add(' ObjC.{@TObject_DoIt}DoIt;');
  12875. Add(' MobileC.{@TMobile_DoIt}DoIt;');
  12876. Add(' CarC.{@TCar_DoIt}DoIt;');
  12877. Add(' TClass(ObjC).{@TObject_DoIt}DoIt;');
  12878. Add(' TMobileClass(ObjC).{@TMobile_DoIt}DoIt;');
  12879. Add(' TCarClass(ObjC).{@TCar_DoIt}DoIt;');
  12880. Add(' TClass(MobileC).{@TObject_DoIt}DoIt;');
  12881. Add(' TMobileClass(MobileC).{@TMobile_DoIt}DoIt;');
  12882. Add(' TCarClass(MobileC).{@TCar_DoIt}DoIt;');
  12883. Add(' TClass(CarC).{@TObject_DoIt}DoIt;');
  12884. Add(' TMobileClass(CarC).{@TMobile_DoIt}DoIt;');
  12885. Add(' TCarClass(CarC).{@TCar_DoIt}DoIt;');
  12886. ConvertProgram;
  12887. CheckSource('TestClassOf_TypeCast',
  12888. LinesToStr([ // statements
  12889. 'rtl.createClass($mod, "TObject", null, function () {',
  12890. ' this.$init = function () {',
  12891. ' };',
  12892. ' this.$final = function () {',
  12893. ' };',
  12894. ' this.DoIt = function () {',
  12895. ' this.DoIt();',
  12896. ' this.DoIt$1();',
  12897. ' };',
  12898. '});',
  12899. 'rtl.createClass($mod, "TMobile", $mod.TObject, function () {',
  12900. ' this.DoIt$1 = function () {',
  12901. ' this.DoIt();',
  12902. ' this.DoIt$1();',
  12903. ' this.DoIt$2();',
  12904. ' };',
  12905. '});',
  12906. 'rtl.createClass($mod, "TCar", $mod.TMobile, function () {',
  12907. ' this.DoIt$2 = function () {',
  12908. ' };',
  12909. '});',
  12910. 'this.ObjC = null;',
  12911. 'this.MobileC = null;',
  12912. 'this.CarC = null;',
  12913. '']),
  12914. LinesToStr([ // $mod.$main
  12915. '$mod.ObjC.DoIt();',
  12916. '$mod.MobileC.DoIt$1();',
  12917. '$mod.CarC.DoIt$2();',
  12918. '$mod.ObjC.DoIt();',
  12919. '$mod.ObjC.DoIt$1();',
  12920. '$mod.ObjC.DoIt$2();',
  12921. '$mod.MobileC.DoIt();',
  12922. '$mod.MobileC.DoIt$1();',
  12923. '$mod.MobileC.DoIt$2();',
  12924. '$mod.CarC.DoIt();',
  12925. '$mod.CarC.DoIt$1();',
  12926. '$mod.CarC.DoIt$2();',
  12927. '']));
  12928. end;
  12929. procedure TTestModule.TestClassOf_ImplicitFunctionCall;
  12930. begin
  12931. StartProgram(false);
  12932. Add('type');
  12933. Add(' TObject = class');
  12934. Add(' function CurNow: longint; ');
  12935. Add(' class function Now: longint; ');
  12936. Add(' end;');
  12937. Add('function TObject.CurNow: longint; begin end;');
  12938. Add('class function TObject.Now: longint; begin end;');
  12939. Add('var');
  12940. Add(' Obj: tobject;');
  12941. Add(' vI: longint;');
  12942. Add('begin');
  12943. Add(' obj.curnow;');
  12944. Add(' vi:=obj.curnow;');
  12945. Add(' tobject.now;');
  12946. Add(' vi:=tobject.now;');
  12947. ConvertProgram;
  12948. CheckSource('TestClassOf_ImplicitFunctionCall',
  12949. LinesToStr([ // statements
  12950. 'rtl.createClass($mod, "TObject", null, function () {',
  12951. ' this.$init = function () {',
  12952. ' };',
  12953. ' this.$final = function () {',
  12954. ' };',
  12955. ' this.CurNow = function () {',
  12956. ' var Result = 0;',
  12957. ' return Result;',
  12958. ' };',
  12959. ' this.Now = function () {',
  12960. ' var Result = 0;',
  12961. ' return Result;',
  12962. ' };',
  12963. '});',
  12964. 'this.Obj = null;',
  12965. 'this.vI = 0;',
  12966. '']),
  12967. LinesToStr([ // $mod.$main
  12968. '$mod.Obj.CurNow();',
  12969. '$mod.vI = $mod.Obj.CurNow();',
  12970. '$mod.TObject.Now();',
  12971. '$mod.vI = $mod.TObject.Now();',
  12972. '']));
  12973. end;
  12974. procedure TTestModule.TestClassOf_Const;
  12975. begin
  12976. StartProgram(false);
  12977. Add([
  12978. 'type',
  12979. ' TObject = class',
  12980. ' end;',
  12981. ' TBird = TObject;',
  12982. ' TBirds = class of TBird;',
  12983. ' TEagles = TBirds;',
  12984. ' THawk = class(TBird);',
  12985. 'const',
  12986. ' Hawk: TEagles = THawk;',
  12987. ' DefaultBirdClasses : Array [1..2] of TEagles = (',
  12988. ' TBird,',
  12989. ' THawk',
  12990. ' );',
  12991. 'begin']);
  12992. ConvertProgram;
  12993. CheckSource('TestClassOf_Const',
  12994. LinesToStr([ // statements
  12995. 'rtl.createClass($mod, "TObject", null, function () {',
  12996. ' this.$init = function () {',
  12997. ' };',
  12998. ' this.$final = function () {',
  12999. ' };',
  13000. '});',
  13001. 'rtl.createClass($mod, "THawk", $mod.TObject, function () {',
  13002. '});',
  13003. 'this.Hawk = $mod.THawk;',
  13004. 'this.DefaultBirdClasses = [$mod.TObject, $mod.THawk];',
  13005. '']),
  13006. LinesToStr([ // $mod.$main
  13007. '']));
  13008. end;
  13009. procedure TTestModule.TestNestedClass_Alias;
  13010. begin
  13011. Converter.Options:=Converter.Options-[coNoTypeInfo];
  13012. StartProgram(false);
  13013. Add([
  13014. 'type',
  13015. ' TObject = class',
  13016. ' type TNested = type longint;',
  13017. ' end;',
  13018. 'type TAlias = type tobject.tnested;',
  13019. 'var i: tobject.tnested = 3;',
  13020. 'var j: TAlias = 4;',
  13021. 'begin',
  13022. ' if typeinfo(TAlias)=nil then ;',
  13023. ' if typeinfo(tobject.tnested)=nil then ;',
  13024. '']);
  13025. ConvertProgram;
  13026. CheckSource('TestNestedClass_Alias',
  13027. LinesToStr([ // statements
  13028. 'rtl.createClass($mod, "TObject", null, function () {',
  13029. ' $mod.$rtti.$inherited("TObject.TNested", rtl.longint, {});',
  13030. ' this.$init = function () {',
  13031. ' };',
  13032. ' this.$final = function () {',
  13033. ' };',
  13034. '});',
  13035. '$mod.$rtti.$inherited("TAlias", $mod.$rtti["TObject.TNested"], {});',
  13036. 'this.i = 3;',
  13037. 'this.j = 4;',
  13038. '']),
  13039. LinesToStr([ // $mod.$main
  13040. 'if ($mod.$rtti["TAlias"] === null) ;',
  13041. 'if ($mod.$rtti["TObject.TNested"] === null) ;',
  13042. '']));
  13043. end;
  13044. procedure TTestModule.TestNestedClass_Record;
  13045. begin
  13046. Converter.Options:=Converter.Options-[coNoTypeInfo];
  13047. StartProgram(false);
  13048. Add([
  13049. 'type',
  13050. ' TObject = class',
  13051. ' type TPoint = record',
  13052. ' x,y: byte;',
  13053. ' end;',
  13054. ' procedure DoIt(t: TPoint);',
  13055. ' end;',
  13056. 'procedure tobject.DoIt(t: TPoint);',
  13057. 'var p: TPoint;',
  13058. 'begin',
  13059. ' t.x:=t.y;',
  13060. ' p:=t;',
  13061. 'end;',
  13062. 'var',
  13063. ' p: tobject.tpoint = (x:2; y:4);',
  13064. ' o: TObject;',
  13065. 'begin',
  13066. ' p:=p;',
  13067. ' o.doit(p);',
  13068. '']);
  13069. ConvertProgram;
  13070. CheckSource('TestNestedClass_Record',
  13071. LinesToStr([ // statements
  13072. 'rtl.createClass($mod, "TObject", null, function () {',
  13073. ' this.TPoint = function (s) {',
  13074. ' if (s) {',
  13075. ' this.x = s.x;',
  13076. ' this.y = s.y;',
  13077. ' } else {',
  13078. ' this.x = 0;',
  13079. ' this.y = 0;',
  13080. ' };',
  13081. ' this.$equal = function (b) {',
  13082. ' return (this.x === b.x) && (this.y === b.y);',
  13083. ' };',
  13084. ' };',
  13085. ' $mod.$rtti.$Record("TObject.TPoint", {}).addFields("x", rtl.byte, "y", rtl.byte);',
  13086. ' this.$init = function () {',
  13087. ' };',
  13088. ' this.$final = function () {',
  13089. ' };',
  13090. ' this.DoIt = function (t) {',
  13091. ' var p = new this.TPoint();',
  13092. ' t.x = t.y;',
  13093. ' p = new this.TPoint(t);',
  13094. ' };',
  13095. '});',
  13096. 'this.p = new $mod.TObject.TPoint({',
  13097. ' x: 2,',
  13098. ' y: 4',
  13099. '});',
  13100. 'this.o = null;',
  13101. '']),
  13102. LinesToStr([ // $mod.$main
  13103. '$mod.p = new $mod.TObject.TPoint($mod.p);',
  13104. '$mod.o.DoIt(new $mod.TObject.TPoint($mod.p));',
  13105. '']));
  13106. end;
  13107. procedure TTestModule.TestNestedClass_Class;
  13108. begin
  13109. Converter.Options:=Converter.Options-[coNoTypeInfo];
  13110. StartProgram(false);
  13111. Add([
  13112. 'type',
  13113. ' TObject = class end;',
  13114. ' TBird = class',
  13115. ' type TLeg = class',
  13116. ' FId: longint;',
  13117. ' constructor Create;',
  13118. ' function Create(i: longint): TLeg;',
  13119. ' end;',
  13120. ' function DoIt(b: TBird): Tleg;',
  13121. ' end;',
  13122. 'constructor tbird.tleg.create;',
  13123. 'begin',
  13124. ' FId:=3;',
  13125. 'end;',
  13126. 'function tbird.tleg.Create(i: longint): TLeg;',
  13127. 'begin',
  13128. ' Create;',
  13129. ' Result:=TLeg.Create;',
  13130. ' Result:=TBird.TLeg.Create;',
  13131. ' Result:=Create(3);',
  13132. ' FId:=i;',
  13133. 'end;',
  13134. 'function tbird.DoIt(b: tbird): tleg;',
  13135. 'begin',
  13136. ' Result.Create;',
  13137. ' Result:=TLeg.Create;',
  13138. ' Result:=TBird.TLeg.Create;',
  13139. ' Result:=Result.Create(3);',
  13140. 'end;',
  13141. 'var',
  13142. ' b: Tbird.tleg;',
  13143. 'begin',
  13144. ' b.Create;',
  13145. ' b:=TBird.TLeg.Create;',
  13146. ' b:=b.Create(3);',
  13147. '']);
  13148. ConvertProgram;
  13149. CheckSource('TestNestedClass_Class',
  13150. LinesToStr([ // statements
  13151. 'rtl.createClass($mod, "TObject", null, function () {',
  13152. ' this.$init = function () {',
  13153. ' };',
  13154. ' this.$final = function () {',
  13155. ' };',
  13156. '});',
  13157. 'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
  13158. ' rtl.createClass(this, "TLeg", $mod.TObject, function () {',
  13159. ' this.$init = function () {',
  13160. ' $mod.TObject.$init.call(this);',
  13161. ' this.FId = 0;',
  13162. ' };',
  13163. ' this.Create = function () {',
  13164. ' this.FId = 3;',
  13165. ' };',
  13166. ' this.Create$1 = function (i) {',
  13167. ' var Result = null;',
  13168. ' this.Create();',
  13169. ' Result = $mod.TBird.TLeg.$create("Create");',
  13170. ' Result = $mod.TBird.TLeg.$create("Create");',
  13171. ' Result = this.Create$1(3);',
  13172. ' this.FId = i;',
  13173. ' return Result;',
  13174. ' };',
  13175. ' });',
  13176. ' this.DoIt = function (b) {',
  13177. ' var Result = null;',
  13178. ' Result.Create();',
  13179. ' Result = this.TLeg.$create("Create");',
  13180. ' Result = $mod.TBird.TLeg.$create("Create");',
  13181. ' Result = Result.Create$1(3);',
  13182. ' return Result;',
  13183. ' };',
  13184. '});',
  13185. 'this.b = null;',
  13186. '']),
  13187. LinesToStr([ // $mod.$main
  13188. '$mod.b.Create();',
  13189. '$mod.b = $mod.TBird.TLeg.$create("Create");',
  13190. '$mod.b = $mod.b.Create$1(3);',
  13191. '']));
  13192. end;
  13193. procedure TTestModule.TestExternalClass_Var;
  13194. begin
  13195. StartProgram(false);
  13196. Add([
  13197. '{$modeswitch externalclass}',
  13198. 'type',
  13199. ' TExtA = class external name ''ExtObj''',
  13200. ' Id: longint external name ''$Id'';',
  13201. ' B: longint;',
  13202. ' end;',
  13203. 'var Obj: TExtA;',
  13204. 'begin',
  13205. ' obj.id:=obj.id+1;',
  13206. ' obj.B:=obj.B+1;']);
  13207. ConvertProgram;
  13208. CheckSource('TestExternalClass_Var',
  13209. LinesToStr([ // statements
  13210. 'this.Obj = null;',
  13211. '']),
  13212. LinesToStr([ // $mod.$main
  13213. '$mod.Obj.$Id = $mod.Obj.$Id + 1;',
  13214. '$mod.Obj.B = $mod.Obj.B + 1;',
  13215. '']));
  13216. end;
  13217. procedure TTestModule.TestExternalClass_Const;
  13218. begin
  13219. StartProgram(false);
  13220. Add([
  13221. '{$modeswitch externalclass}',
  13222. 'type',
  13223. ' TExtA = class external name ''ExtObj''',
  13224. ' const Two: longint = 2;',
  13225. ' const Three = 3;',
  13226. ' const Id: longint;',
  13227. ' end;',
  13228. ' TExtB = class external name ''ExtB''',
  13229. ' A: TExtA;',
  13230. ' end;',
  13231. 'var',
  13232. ' A: texta;',
  13233. ' B: textb;',
  13234. ' i: longint;',
  13235. 'begin',
  13236. ' i:=a.two;',
  13237. ' i:=texta.two;',
  13238. ' i:=a.three;',
  13239. ' i:=texta.three;',
  13240. ' i:=a.id;',
  13241. ' i:=texta.id;',
  13242. '']);
  13243. ConvertProgram;
  13244. CheckSource('TestExternalClass_Const',
  13245. LinesToStr([ // statements
  13246. 'this.A = null;',
  13247. 'this.B = null;',
  13248. 'this.i = 0;',
  13249. '']),
  13250. LinesToStr([ // $mod.$main
  13251. '$mod.i = 2;',
  13252. '$mod.i = 2;',
  13253. '$mod.i = 3;',
  13254. '$mod.i = 3;',
  13255. '$mod.i = $mod.A.Id;',
  13256. '$mod.i = ExtObj.Id;',
  13257. '']));
  13258. end;
  13259. procedure TTestModule.TestExternalClass_Dollar;
  13260. begin
  13261. StartProgram(false);
  13262. Add([
  13263. '{$modeswitch externalclass}',
  13264. 'type',
  13265. ' TExtA = class external name ''$''',
  13266. ' Id: longint external name ''$'';',
  13267. ' function Bla(i: longint): longint; external name ''$'';',
  13268. ' end;',
  13269. 'function dollar(k: longint): longint; external name ''$'';',
  13270. 'var Obj: TExtA;',
  13271. 'begin',
  13272. ' dollar(1);',
  13273. ' obj.id:=obj.id+2;',
  13274. ' obj.Bla(3);',
  13275. '']);
  13276. ConvertProgram;
  13277. CheckSource('TestExternalClass_Dollar',
  13278. LinesToStr([ // statements
  13279. 'this.Obj = null;',
  13280. '']),
  13281. LinesToStr([ // $mod.$main
  13282. '$(1);',
  13283. '$mod.Obj.$ = $mod.Obj.$ + 2;',
  13284. '$mod.Obj.$(3);',
  13285. '']));
  13286. end;
  13287. procedure TTestModule.TestExternalClass_DuplicateVarFail;
  13288. begin
  13289. StartProgram(false);
  13290. Add('{$modeswitch externalclass}');
  13291. Add('type');
  13292. Add(' TExtA = class external name ''ExtA''');
  13293. Add(' Id: longint external name ''$Id'';');
  13294. Add(' end;');
  13295. Add(' TExtB = class external ''lib'' name ''ExtB''(TExtA)');
  13296. Add(' Id: longint;');
  13297. Add(' end;');
  13298. Add('begin');
  13299. SetExpectedPasResolverError('Duplicate identifier "Id" at test1.pp(6,5)',nDuplicateIdentifier);
  13300. ConvertProgram;
  13301. end;
  13302. procedure TTestModule.TestExternalClass_Method;
  13303. begin
  13304. StartProgram(false);
  13305. Add('{$modeswitch externalclass}');
  13306. Add('type');
  13307. Add(' TExtA = class external name ''ExtObj''');
  13308. Add(' procedure DoIt(Id: longint = 1); external name ''$Execute'';');
  13309. Add(' procedure DoSome(Id: longint = 1);');
  13310. Add(' end;');
  13311. Add('var Obj: texta;');
  13312. Add('begin');
  13313. Add(' obj.doit;');
  13314. Add(' obj.doit();');
  13315. Add(' obj.doit(2);');
  13316. Add(' with obj do begin');
  13317. Add(' doit;');
  13318. Add(' doit();');
  13319. Add(' doit(3);');
  13320. Add(' end;');
  13321. ConvertProgram;
  13322. CheckSource('TestExternalClass_Method',
  13323. LinesToStr([ // statements
  13324. 'this.Obj = null;',
  13325. '']),
  13326. LinesToStr([ // $mod.$main
  13327. '$mod.Obj.$Execute(1);',
  13328. '$mod.Obj.$Execute(1);',
  13329. '$mod.Obj.$Execute(2);',
  13330. 'var $with1 = $mod.Obj;',
  13331. '$with1.$Execute(1);',
  13332. '$with1.$Execute(1);',
  13333. '$with1.$Execute(3);',
  13334. '']));
  13335. end;
  13336. procedure TTestModule.TestExternalClass_ClassMethod;
  13337. begin
  13338. StartProgram(false);
  13339. Add([
  13340. '{$modeswitch externalclass}',
  13341. 'type',
  13342. ' TExtA = class external name ''ExtObj''',
  13343. ' class procedure DoIt(Id: longint = 1); external name ''$Execute'';',
  13344. ' end;',
  13345. ' TExtB = TExtA;',
  13346. 'begin',
  13347. ' texta.doit;',
  13348. ' texta.doit();',
  13349. ' texta.doit(2);',
  13350. ' with texta do begin',
  13351. ' doit;',
  13352. ' doit();',
  13353. ' doit(3);',
  13354. ' end;',
  13355. ' textb.doit;',
  13356. ' textb.doit();',
  13357. ' textb.doit(4);',
  13358. ' with textb do begin',
  13359. ' doit;',
  13360. ' doit();',
  13361. ' doit(5);',
  13362. ' end;',
  13363. '']);
  13364. ConvertProgram;
  13365. CheckSource('TestExternalClass_ClassMethod',
  13366. LinesToStr([ // statements
  13367. '']),
  13368. LinesToStr([ // $mod.$main
  13369. 'ExtObj.$Execute(1);',
  13370. 'ExtObj.$Execute(1);',
  13371. 'ExtObj.$Execute(2);',
  13372. 'ExtObj.$Execute(1);',
  13373. 'ExtObj.$Execute(1);',
  13374. 'ExtObj.$Execute(3);',
  13375. 'ExtObj.$Execute(1);',
  13376. 'ExtObj.$Execute(1);',
  13377. 'ExtObj.$Execute(4);',
  13378. 'ExtObj.$Execute(1);',
  13379. 'ExtObj.$Execute(1);',
  13380. 'ExtObj.$Execute(5);',
  13381. '']));
  13382. end;
  13383. procedure TTestModule.TestExternalClass_FunctionResultInTypeCast;
  13384. begin
  13385. StartProgram(false);
  13386. Add([
  13387. '{$modeswitch externalclass}',
  13388. 'type',
  13389. ' TBird = class external name ''Array''',
  13390. ' end;',
  13391. 'function GetPtr: Pointer;',
  13392. 'begin',
  13393. 'end;',
  13394. 'procedure Write(const p);',
  13395. 'begin',
  13396. 'end;',
  13397. 'procedure WriteLn; varargs;',
  13398. 'begin',
  13399. 'end;',
  13400. 'begin',
  13401. ' if TBird(GetPtr)=nil then ;',
  13402. ' Write(GetPtr);',
  13403. ' WriteLn(GetPtr);',
  13404. ' Write(TBird(GetPtr));',
  13405. ' WriteLn(TBird(GetPtr));',
  13406. '']);
  13407. ConvertProgram;
  13408. CheckSource('TestFunctionResultInTypeCast',
  13409. LinesToStr([ // statements
  13410. 'this.GetPtr = function () {',
  13411. ' var Result = null;',
  13412. ' return Result;',
  13413. '};',
  13414. 'this.Write = function (p) {',
  13415. '};',
  13416. 'this.WriteLn = function () {',
  13417. '};',
  13418. '']),
  13419. LinesToStr([
  13420. 'if ($mod.GetPtr() === null) ;',
  13421. '$mod.Write($mod.GetPtr());',
  13422. '$mod.WriteLn($mod.GetPtr());',
  13423. '$mod.Write($mod.GetPtr());',
  13424. '$mod.WriteLn($mod.GetPtr());',
  13425. '']));
  13426. end;
  13427. procedure TTestModule.TestExternalClass_NonExternalOverride;
  13428. begin
  13429. StartProgram(false);
  13430. Add('{$modeswitch externalclass}');
  13431. Add('type');
  13432. Add(' TExtA = class external name ''ExtObjA''');
  13433. Add(' procedure ProcA; virtual;');
  13434. Add(' procedure ProcB; virtual;');
  13435. Add(' end;');
  13436. Add(' TExtB = class external name ''ExtObjB'' (TExtA)');
  13437. Add(' end;');
  13438. Add(' TExtC = class (TExtB)');
  13439. Add(' procedure ProcA; override;');
  13440. Add(' end;');
  13441. Add('procedure TExtC.ProcA;');
  13442. Add('begin');
  13443. Add(' ProcA;');
  13444. Add(' Self.ProcA;');
  13445. Add(' ProcB;');
  13446. Add(' Self.ProcB;');
  13447. Add('end;');
  13448. Add('var');
  13449. Add(' A: texta;');
  13450. Add(' B: textb;');
  13451. Add(' C: textc;');
  13452. Add('begin');
  13453. Add(' a.proca;');
  13454. Add(' b.proca;');
  13455. Add(' c.proca;');
  13456. ConvertProgram;
  13457. CheckSource('TestExternalClass_NonExternalOverride',
  13458. LinesToStr([ // statements
  13459. 'rtl.createClassExt($mod, "TExtC", ExtObjB, "", function () {',
  13460. ' this.$init = function () {',
  13461. ' };',
  13462. ' this.$final = function () {',
  13463. ' };',
  13464. ' this.ProcA = function () {',
  13465. ' this.ProcA();',
  13466. ' this.ProcA();',
  13467. ' this.ProcB();',
  13468. ' this.ProcB();',
  13469. ' };',
  13470. '});',
  13471. 'this.A = null;',
  13472. 'this.B = null;',
  13473. 'this.C = null;',
  13474. '']),
  13475. LinesToStr([ // $mod.$main
  13476. '$mod.A.ProcA();',
  13477. '$mod.B.ProcA();',
  13478. '$mod.C.ProcA();',
  13479. '']));
  13480. end;
  13481. procedure TTestModule.TestExternalClass_OverloadHint;
  13482. begin
  13483. StartProgram(false);
  13484. Add([
  13485. '{$modeswitch externalclass}',
  13486. 'type',
  13487. ' TExtA = class external name ''ExtObjA''',
  13488. ' procedure DoIt;',
  13489. ' procedure DoIt(i: longint);',
  13490. ' end;',
  13491. 'begin',
  13492. '']);
  13493. ConvertProgram;
  13494. CheckResolverUnexpectedHints(true);
  13495. CheckSource('TestExternalClass_OverloadHint',
  13496. LinesToStr([ // statements
  13497. '']),
  13498. LinesToStr([ // $mod.$main
  13499. '']));
  13500. end;
  13501. procedure TTestModule.TestExternalClass_SameNamePublishedProperty;
  13502. begin
  13503. StartProgram(false);
  13504. Add([
  13505. '{$modeswitch externalclass}',
  13506. 'type',
  13507. ' JSwiper = class external name ''Swiper''',
  13508. ' constructor New;',
  13509. ' end;',
  13510. ' TObject = class',
  13511. ' private',
  13512. ' FSwiper: JSwiper;',
  13513. ' published',
  13514. ' property Swiper: JSwiper read FSwiper write FSwiper;',
  13515. ' end;',
  13516. 'begin',
  13517. ' JSwiper.new;',
  13518. '']);
  13519. ConvertProgram;
  13520. CheckSource('TestExternalClass_SameNamePublishedProperty',
  13521. LinesToStr([ // statements
  13522. 'rtl.createClass($mod, "TObject", null, function () {',
  13523. ' this.$init = function () {',
  13524. ' this.FSwiper = null;',
  13525. ' };',
  13526. ' this.$final = function () {',
  13527. ' this.FSwiper = undefined;',
  13528. ' };',
  13529. ' var $r = this.$rtti;',
  13530. ' $r.addProperty("Swiper", 0, $mod.$rtti["JSwiper"], "FSwiper", "FSwiper");',
  13531. '});',
  13532. '']),
  13533. LinesToStr([ // $mod.$main
  13534. 'new Swiper();',
  13535. '']));
  13536. end;
  13537. procedure TTestModule.TestExternalClass_Property;
  13538. begin
  13539. StartProgram(false);
  13540. Add([
  13541. '{$modeswitch externalclass}',
  13542. 'type',
  13543. ' TExtA = class external name ''ExtA''',
  13544. ' function getYear: longint;',
  13545. ' procedure setYear(Value: longint);',
  13546. ' property Year: longint read getyear write setyear;',
  13547. ' end;',
  13548. ' TExtB = class (TExtA)',
  13549. ' procedure OtherSetYear(Value: longint);',
  13550. ' property year write othersetyear;',
  13551. ' end;',
  13552. 'procedure textb.othersetyear(value: longint);',
  13553. 'begin',
  13554. ' setYear(Value+4);',
  13555. 'end;',
  13556. 'var',
  13557. ' A: texta;',
  13558. ' B: textb;',
  13559. 'begin',
  13560. ' a.year:=a.year+1;',
  13561. ' b.year:=b.year+2;']);
  13562. ConvertProgram;
  13563. CheckSource('TestExternalClass_NonExternalOverride',
  13564. LinesToStr([ // statements
  13565. 'rtl.createClassExt($mod, "TExtB", ExtA, "", function () {',
  13566. ' this.$init = function () {',
  13567. ' };',
  13568. ' this.$final = function () {',
  13569. ' };',
  13570. ' this.OtherSetYear = function (Value) {',
  13571. ' this.setYear(Value+4);',
  13572. ' };',
  13573. '});',
  13574. 'this.A = null;',
  13575. 'this.B = null;',
  13576. '']),
  13577. LinesToStr([ // $mod.$main
  13578. '$mod.A.setYear($mod.A.getYear()+1);',
  13579. '$mod.B.OtherSetYear($mod.B.getYear()+2);',
  13580. '']));
  13581. end;
  13582. procedure TTestModule.TestExternalClass_PropertyDate;
  13583. begin
  13584. StartProgram(false);
  13585. Add([
  13586. '{$modeswitch externalclass}',
  13587. 'type',
  13588. ' TExtA = class external name ''ExtA''',
  13589. ' end;',
  13590. ' TExtB = class (TExtA)',
  13591. ' FDate: string;',
  13592. ' property Date: string read FDate write FDate;',
  13593. ' property ExtA: string read FDate write FDate;',
  13594. ' end;',
  13595. ' {$M+}',
  13596. ' TObject = class',
  13597. ' FDate: string;',
  13598. ' published',
  13599. ' property Date: string read FDate write FDate;',
  13600. ' property ExtA: string read FDate write FDate;',
  13601. ' end;',
  13602. 'var',
  13603. ' B: textb;',
  13604. ' o: TObject;',
  13605. 'begin',
  13606. ' b.date:=b.exta;',
  13607. ' o.date:=o.exta;']);
  13608. ConvertProgram;
  13609. CheckSource('TestExternalClass_PropertyDate',
  13610. LinesToStr([ // statements
  13611. 'rtl.createClassExt($mod, "TExtB", ExtA, "", function () {',
  13612. ' this.$init = function () {',
  13613. ' this.FDate = "";',
  13614. ' };',
  13615. ' this.$final = function () {',
  13616. ' };',
  13617. '});',
  13618. 'rtl.createClass($mod, "TObject", null, function () {',
  13619. ' this.$init = function () {',
  13620. ' this.FDate = "";',
  13621. ' };',
  13622. ' this.$final = function () {',
  13623. ' };',
  13624. ' var $r = this.$rtti;',
  13625. ' $r.addField("FDate", rtl.string);',
  13626. ' $r.addProperty("Date", 0, rtl.string, "FDate", "FDate");',
  13627. ' $r.addProperty("ExtA", 0, rtl.string, "FDate", "FDate");',
  13628. '});',
  13629. 'this.B = null;',
  13630. 'this.o = null;',
  13631. '']),
  13632. LinesToStr([ // $mod.$main
  13633. '$mod.B.FDate = $mod.B.FDate;',
  13634. '$mod.o.FDate = $mod.o.FDate;',
  13635. '']));
  13636. end;
  13637. procedure TTestModule.TestExternalClass_ClassProperty;
  13638. begin
  13639. StartProgram(false);
  13640. Add('{$modeswitch externalclass}');
  13641. Add('type');
  13642. Add(' TExtA = class external name ''ExtA''');
  13643. Add(' class function getYear: longint;');
  13644. Add(' class procedure setYear(Value: longint);');
  13645. Add(' class property Year: longint read getyear write setyear;');
  13646. Add(' end;');
  13647. Add(' TExtB = class (TExtA)');
  13648. Add(' class function GetCentury: longint;');
  13649. Add(' class procedure SetCentury(Value: longint);');
  13650. Add(' class property Century: longint read getcentury write setcentury;');
  13651. Add(' end;');
  13652. Add('class function textb.getcentury: longint;');
  13653. Add('begin');
  13654. Add('end;');
  13655. Add('class procedure textb.setcentury(value: longint);');
  13656. Add('begin');
  13657. Add(' setyear(value+11);');
  13658. Add(' texta.year:=texta.year+12;');
  13659. Add(' year:=year+13;');
  13660. Add(' textb.century:=textb.century+14;');
  13661. Add(' century:=century+15;');
  13662. Add('end;');
  13663. Add('var');
  13664. Add(' A: texta;');
  13665. Add(' B: textb;');
  13666. Add('begin');
  13667. Add(' texta.year:=texta.year+1;');
  13668. Add(' textb.year:=textb.year+2;');
  13669. Add(' TextA.year:=TextA.year+3;');
  13670. Add(' b.year:=b.year+4;');
  13671. Add(' textb.century:=textb.century+5;');
  13672. Add(' b.century:=b.century+6;');
  13673. ConvertProgram;
  13674. CheckSource('TestExternalClass_ClassProperty',
  13675. LinesToStr([ // statements
  13676. 'rtl.createClassExt($mod, "TExtB", ExtA, "", function () {',
  13677. ' this.$init = function () {',
  13678. ' };',
  13679. ' this.$final = function () {',
  13680. ' };',
  13681. ' this.GetCentury = function () {',
  13682. ' var Result = 0;',
  13683. ' return Result;',
  13684. ' };',
  13685. ' this.SetCentury = function (Value) {',
  13686. ' this.setYear(Value + 11);',
  13687. ' ExtA.setYear(ExtA.getYear() + 12);',
  13688. ' this.setYear(this.getYear() + 13);',
  13689. ' $mod.TExtB.SetCentury($mod.TExtB.GetCentury() + 14);',
  13690. ' this.SetCentury(this.GetCentury() + 15);',
  13691. ' };',
  13692. '});',
  13693. 'this.A = null;',
  13694. 'this.B = null;',
  13695. '']),
  13696. LinesToStr([ // $mod.$main
  13697. 'ExtA.setYear(ExtA.getYear() + 1);',
  13698. '$mod.TExtB.setYear($mod.TExtB.getYear() + 2);',
  13699. 'ExtA.setYear(ExtA.getYear() + 3);',
  13700. '$mod.B.setYear($mod.B.getYear() + 4);',
  13701. '$mod.TExtB.SetCentury($mod.TExtB.GetCentury() + 5);',
  13702. '$mod.B.$class.SetCentury($mod.B.$class.GetCentury() + 6);',
  13703. '']));
  13704. end;
  13705. procedure TTestModule.TestExternalClass_ClassOf;
  13706. begin
  13707. StartProgram(false);
  13708. Add('{$modeswitch externalclass}');
  13709. Add('type');
  13710. Add(' TExtA = class external name ''ExtA''');
  13711. Add(' procedure ProcA; virtual;');
  13712. Add(' procedure ProcB; virtual;');
  13713. Add(' end;');
  13714. Add(' TExtAClass = class of TExtA;');
  13715. Add(' TExtB = class external name ''ExtB'' (TExtA)');
  13716. Add(' end;');
  13717. Add(' TExtBClass = class of TExtB;');
  13718. Add(' TExtC = class (TExtB)');
  13719. Add(' procedure ProcA; override;');
  13720. Add(' end;');
  13721. Add(' TExtCClass = class of TExtC;');
  13722. Add('procedure TExtC.ProcA; begin end;');
  13723. Add('var');
  13724. Add(' A: texta; ClA: TExtAClass;');
  13725. Add(' B: textb; ClB: TExtBClass;');
  13726. Add(' C: textc; ClC: TExtCClass;');
  13727. Add('begin');
  13728. Add(' ClA:=texta;');
  13729. Add(' ClA:=textb;');
  13730. Add(' ClA:=textc;');
  13731. Add(' ClB:=textb;');
  13732. Add(' ClB:=textc;');
  13733. Add(' ClC:=textc;');
  13734. ConvertProgram;
  13735. CheckSource('TestExternalClass_ClassOf',
  13736. LinesToStr([ // statements
  13737. 'rtl.createClassExt($mod, "TExtC", ExtB, "", function () {',
  13738. ' this.$init = function () {',
  13739. ' };',
  13740. ' this.$final = function () {',
  13741. ' };',
  13742. ' this.ProcA = function () {',
  13743. ' };',
  13744. '});',
  13745. 'this.A = null;',
  13746. 'this.ClA = null;',
  13747. 'this.B = null;',
  13748. 'this.ClB = null;',
  13749. 'this.C = null;',
  13750. 'this.ClC = null;',
  13751. '']),
  13752. LinesToStr([ // $mod.$main
  13753. '$mod.ClA = ExtA;',
  13754. '$mod.ClA = ExtB;',
  13755. '$mod.ClA = $mod.TExtC;',
  13756. '$mod.ClB = ExtB;',
  13757. '$mod.ClB = $mod.TExtC;',
  13758. '$mod.ClC = $mod.TExtC;',
  13759. '']));
  13760. end;
  13761. procedure TTestModule.TestExternalClass_ClassOtherUnit;
  13762. begin
  13763. AddModuleWithIntfImplSrc('unit2.pas',
  13764. LinesToStr([
  13765. '{$modeswitch externalclass}',
  13766. 'type',
  13767. ' TExtA = class external name ''ExtA''',
  13768. ' class var Id: longint;',
  13769. ' end;',
  13770. '']),
  13771. '');
  13772. StartUnit(true);
  13773. Add('interface');
  13774. Add('uses unit2;');
  13775. Add('implementation');
  13776. Add('begin');
  13777. Add(' unit2.texta.id:=unit2.texta.id+1;');
  13778. ConvertUnit;
  13779. CheckSource('TestExternalClass_ClassOtherUnit',
  13780. LinesToStr([
  13781. '']),
  13782. LinesToStr([
  13783. 'ExtA.Id = ExtA.Id + 1;',
  13784. '']));
  13785. end;
  13786. procedure TTestModule.TestExternalClass_Is;
  13787. begin
  13788. StartProgram(false);
  13789. Add('{$modeswitch externalclass}');
  13790. Add('type');
  13791. Add(' TExtA = class external name ''ExtA''');
  13792. Add(' end;');
  13793. Add(' TExtAClass = class of TExtA;');
  13794. Add(' TExtB = class external name ''ExtB'' (TExtA)');
  13795. Add(' end;');
  13796. Add(' TExtBClass = class of TExtB;');
  13797. Add(' TExtC = class (TExtB)');
  13798. Add(' end;');
  13799. Add(' TExtCClass = class of TExtC;');
  13800. Add('var');
  13801. Add(' A: texta; ClA: TExtAClass;');
  13802. Add(' B: textb; ClB: TExtBClass;');
  13803. Add(' C: textc; ClC: TExtCClass;');
  13804. Add('begin');
  13805. Add(' if a is textb then ;');
  13806. Add(' if a is textc then ;');
  13807. Add(' if b is textc then ;');
  13808. Add(' if cla is textb then ;');
  13809. Add(' if cla is textc then ;');
  13810. Add(' if clb is textc then ;');
  13811. ConvertProgram;
  13812. CheckSource('TestExternalClass_Is',
  13813. LinesToStr([ // statements
  13814. 'rtl.createClassExt($mod, "TExtC", ExtB, "", function () {',
  13815. ' this.$init = function () {',
  13816. ' };',
  13817. ' this.$final = function () {',
  13818. ' };',
  13819. '});',
  13820. 'this.A = null;',
  13821. 'this.ClA = null;',
  13822. 'this.B = null;',
  13823. 'this.ClB = null;',
  13824. 'this.C = null;',
  13825. 'this.ClC = null;',
  13826. '']),
  13827. LinesToStr([ // $mod.$main
  13828. 'if (rtl.isExt($mod.A, ExtB)) ;',
  13829. 'if ($mod.TExtC.isPrototypeOf($mod.A)) ;',
  13830. 'if ($mod.TExtC.isPrototypeOf($mod.B)) ;',
  13831. 'if (rtl.isExt($mod.ClA, ExtB)) ;',
  13832. 'if (rtl.is($mod.ClA, $mod.TExtC)) ;',
  13833. 'if (rtl.is($mod.ClB, $mod.TExtC)) ;',
  13834. '']));
  13835. end;
  13836. procedure TTestModule.TestExternalClass_As;
  13837. begin
  13838. StartProgram(false);
  13839. Add('{$modeswitch externalclass}');
  13840. Add('type');
  13841. Add(' TExtA = class external name ''ExtA''');
  13842. Add(' end;');
  13843. Add(' TExtB = class external name ''ExtB'' (TExtA)');
  13844. Add(' end;');
  13845. Add(' TExtC = class (TExtB)');
  13846. Add(' end;');
  13847. Add('var');
  13848. Add(' A: texta;');
  13849. Add(' B: textb;');
  13850. Add(' C: textc;');
  13851. Add('begin');
  13852. Add(' b:=a as textb;');
  13853. Add(' c:=a as textc;');
  13854. Add(' c:=b as textc;');
  13855. ConvertProgram;
  13856. CheckSource('TestExternalClass_Is',
  13857. LinesToStr([ // statements
  13858. 'rtl.createClassExt($mod, "TExtC", ExtB, "", function () {',
  13859. ' this.$init = function () {',
  13860. ' };',
  13861. ' this.$final = function () {',
  13862. ' };',
  13863. '});',
  13864. 'this.A = null;',
  13865. 'this.B = null;',
  13866. 'this.C = null;',
  13867. '']),
  13868. LinesToStr([ // $mod.$main
  13869. '$mod.B = rtl.asExt($mod.A, ExtB);',
  13870. '$mod.C = rtl.as($mod.A, $mod.TExtC);',
  13871. '$mod.C = rtl.as($mod.B, $mod.TExtC);',
  13872. '']));
  13873. end;
  13874. procedure TTestModule.TestExternalClass_DestructorFail;
  13875. begin
  13876. StartProgram(false);
  13877. Add('{$modeswitch externalclass}');
  13878. Add('type');
  13879. Add(' TExtA = class external name ''ExtA''');
  13880. Add(' destructor Free;');
  13881. Add(' end;');
  13882. SetExpectedPasResolverError('Pascal element not supported: destructor',
  13883. nPasElementNotSupported);
  13884. ConvertProgram;
  13885. end;
  13886. procedure TTestModule.TestExternalClass_New;
  13887. begin
  13888. StartProgram(false);
  13889. Add('{$modeswitch externalclass}');
  13890. Add('type');
  13891. Add(' TExtA = class external name ''ExtA''');
  13892. Add(' constructor New;');
  13893. Add(' constructor New(i: longint; j: longint = 2);');
  13894. Add(' end;');
  13895. Add('var');
  13896. Add(' A: texta;');
  13897. Add('begin');
  13898. Add(' a:=texta.new;');
  13899. Add(' a:=texta.new();');
  13900. Add(' a:=texta.new(1);');
  13901. Add(' with texta do begin');
  13902. Add(' a:=new;');
  13903. Add(' a:=new();');
  13904. Add(' a:=new(2);');
  13905. Add(' end;');
  13906. Add(' a:=test1.texta.new;');
  13907. Add(' a:=test1.texta.new();');
  13908. Add(' a:=test1.texta.new(3);');
  13909. ConvertProgram;
  13910. CheckSource('TestExternalClass_New',
  13911. LinesToStr([ // statements
  13912. 'this.A = null;',
  13913. '']),
  13914. LinesToStr([ // $mod.$main
  13915. '$mod.A = new ExtA();',
  13916. '$mod.A = new ExtA();',
  13917. '$mod.A = new ExtA(1,2);',
  13918. '$mod.A = new ExtA();',
  13919. '$mod.A = new ExtA();',
  13920. '$mod.A = new ExtA(2,2);',
  13921. '$mod.A = new ExtA();',
  13922. '$mod.A = new ExtA();',
  13923. '$mod.A = new ExtA(3,2);',
  13924. '']));
  13925. end;
  13926. procedure TTestModule.TestExternalClass_ClassOf_New;
  13927. begin
  13928. StartProgram(false);
  13929. Add('{$modeswitch externalclass}');
  13930. Add('type');
  13931. Add(' TExtAClass = class of TExtA;');
  13932. Add(' TExtA = class external name ''ExtA''');
  13933. Add(' constructor New;');
  13934. Add(' end;');
  13935. Add('var');
  13936. Add(' A: texta;');
  13937. Add(' C: textaclass;');
  13938. Add('begin');
  13939. Add(' a:=c.new;');
  13940. Add(' a:=c.new();');
  13941. Add(' with C do begin');
  13942. Add(' a:=new;');
  13943. Add(' a:=new();');
  13944. Add(' end;');
  13945. Add(' a:=test1.c.new;');
  13946. Add(' a:=test1.c.new();');
  13947. ConvertProgram;
  13948. CheckSource('TestExternalClass_ClassOf_New',
  13949. LinesToStr([ // statements
  13950. 'this.A = null;',
  13951. 'this.C = null;',
  13952. '']),
  13953. LinesToStr([ // $mod.$main
  13954. '$mod.A = new $mod.C();',
  13955. '$mod.A = new $mod.C();',
  13956. 'var $with1 = $mod.C;',
  13957. '$mod.A = new $with1();',
  13958. '$mod.A = new $with1();',
  13959. '$mod.A = new $mod.C();',
  13960. '$mod.A = new $mod.C();',
  13961. '']));
  13962. end;
  13963. procedure TTestModule.TestExternalClass_FuncClassOf_New;
  13964. begin
  13965. StartProgram(false);
  13966. Add([
  13967. '{$modeswitch externalclass}',
  13968. 'type',
  13969. ' TExtAClass = class of TExtA;',
  13970. ' TExtA = class external name ''ExtA''',
  13971. ' constructor New;',
  13972. ' end;',
  13973. 'function GetCreator: TExtAClass;',
  13974. 'begin',
  13975. ' Result:=TExtA;',
  13976. 'end;',
  13977. 'var',
  13978. ' A: texta;',
  13979. 'begin',
  13980. ' a:=getcreator.new;',
  13981. ' a:=getcreator().new;',
  13982. ' a:=getcreator().new();',
  13983. ' a:=getcreator.new();',
  13984. ' with getcreator do begin',
  13985. ' a:=new;',
  13986. ' a:=new();',
  13987. ' end;']);
  13988. ConvertProgram;
  13989. CheckSource('TestExternalClass_FuncClassOf_New',
  13990. LinesToStr([ // statements
  13991. 'this.GetCreator = function () {',
  13992. ' var Result = null;',
  13993. ' Result = ExtA;',
  13994. ' return Result;',
  13995. '};',
  13996. 'this.A = null;',
  13997. '']),
  13998. LinesToStr([ // $mod.$main
  13999. '$mod.A = new ($mod.GetCreator())();',
  14000. '$mod.A = new ($mod.GetCreator())();',
  14001. '$mod.A = new ($mod.GetCreator())();',
  14002. '$mod.A = new ($mod.GetCreator())();',
  14003. 'var $with1 = $mod.GetCreator();',
  14004. '$mod.A = new $with1();',
  14005. '$mod.A = new $with1();',
  14006. '']));
  14007. end;
  14008. procedure TTestModule.TestExternalClass_New_PasClassFail;
  14009. begin
  14010. StartProgram(false);
  14011. Add([
  14012. '{$modeswitch externalclass}',
  14013. 'type',
  14014. ' TExtA = class external name ''ExtA''',
  14015. ' constructor New;',
  14016. ' end;',
  14017. ' TBird = class(TExtA)',
  14018. ' end;',
  14019. 'begin',
  14020. ' TBird.new;',
  14021. '']);
  14022. SetExpectedPasResolverError(sJSNewNotSupported,nJSNewNotSupported);
  14023. ConvertProgram;
  14024. end;
  14025. procedure TTestModule.TestExternalClass_New_PasClassBracketsFail;
  14026. begin
  14027. StartProgram(false);
  14028. Add([
  14029. '{$modeswitch externalclass}',
  14030. 'type',
  14031. ' TExtA = class external name ''ExtA''',
  14032. ' constructor New;',
  14033. ' end;',
  14034. ' TBird = class(TExtA)',
  14035. ' end;',
  14036. 'begin',
  14037. ' TBird.new();',
  14038. '']);
  14039. SetExpectedPasResolverError(sJSNewNotSupported,nJSNewNotSupported);
  14040. ConvertProgram;
  14041. end;
  14042. procedure TTestModule.TestExternalClass_LocalConstSameName;
  14043. begin
  14044. StartProgram(false);
  14045. Add('{$modeswitch externalclass}');
  14046. Add('type');
  14047. Add(' TExtA = class external name ''ExtA''');
  14048. Add(' constructor New;');
  14049. Add(' end;');
  14050. Add('function DoIt: longint;');
  14051. Add('const ExtA: longint = 3;');
  14052. Add('begin');
  14053. Add(' Result:=ExtA;');
  14054. Add('end;');
  14055. Add('var');
  14056. Add(' A: texta;');
  14057. Add('begin');
  14058. Add(' a:=texta.new;');
  14059. ConvertProgram;
  14060. CheckSource('TestExternalClass_LocalConstSameName',
  14061. LinesToStr([ // statements
  14062. 'var ExtA$1 = 3;',
  14063. 'this.DoIt = function () {',
  14064. ' var Result = 0;',
  14065. ' Result = ExtA$1;',
  14066. ' return Result;',
  14067. '};',
  14068. 'this.A = null;',
  14069. '']),
  14070. LinesToStr([ // $mod.$main
  14071. '$mod.A = new ExtA();',
  14072. '']));
  14073. end;
  14074. procedure TTestModule.TestExternalClass_ReintroduceOverload;
  14075. begin
  14076. StartProgram(false);
  14077. Add('{$modeswitch externalclass}');
  14078. Add('type');
  14079. Add(' TExtA = class external name ''ExtA''');
  14080. Add(' procedure DoIt;');
  14081. Add(' end;');
  14082. Add(' TMyA = class(TExtA)');
  14083. Add(' procedure DoIt;');
  14084. Add(' end;');
  14085. Add('procedure TMyA.DoIt; begin end;');
  14086. Add('begin');
  14087. ConvertProgram;
  14088. CheckSource('TestExternalClass_ReintroduceOverload',
  14089. LinesToStr([ // statements
  14090. 'rtl.createClassExt($mod, "TMyA", ExtA, "", function () {',
  14091. ' this.$init = function () {',
  14092. ' };',
  14093. ' this.$final = function () {',
  14094. ' };',
  14095. ' this.DoIt$1 = function () {',
  14096. ' };',
  14097. '});',
  14098. '']),
  14099. LinesToStr([ // $mod.$main
  14100. '']));
  14101. end;
  14102. procedure TTestModule.TestExternalClass_Inherited;
  14103. begin
  14104. StartProgram(false);
  14105. Add('{$modeswitch externalclass}');
  14106. Add('type');
  14107. Add(' TExtA = class external name ''ExtA''');
  14108. Add(' procedure DoIt(i: longint = 1); virtual;');
  14109. Add(' procedure DoSome(j: longint = 2);');
  14110. Add(' end;');
  14111. Add(' TExtB = class external name ''ExtB''(TExtA)');
  14112. Add(' end;');
  14113. Add(' TMyC = class(TExtB)');
  14114. Add(' procedure DoIt(i: longint = 1); override;');
  14115. Add(' procedure DoSome(j: longint = 2); reintroduce;');
  14116. Add(' end;');
  14117. Add('procedure TMyC.DoIt(i: longint);');
  14118. Add('begin');
  14119. Add(' inherited;');
  14120. Add(' inherited DoIt;');
  14121. Add(' inherited DoIt();');
  14122. Add(' inherited DoIt(3);');
  14123. Add(' inherited DoSome;');
  14124. Add(' inherited DoSome();');
  14125. Add(' inherited DoSome(4);');
  14126. Add('end;');
  14127. Add('procedure TMyC.DoSome(j: longint);');
  14128. Add('begin');
  14129. Add(' inherited;');
  14130. Add('end;');
  14131. Add('begin');
  14132. ConvertProgram;
  14133. CheckSource('TestExternalClass_ReintroduceOverload',
  14134. LinesToStr([ // statements
  14135. 'rtl.createClassExt($mod, "TMyC", ExtB, "", function () {',
  14136. ' this.$init = function () {',
  14137. ' };',
  14138. ' this.$final = function () {',
  14139. ' };',
  14140. ' this.DoIt = function (i) {',
  14141. ' ExtB.DoIt.apply(this, arguments);',
  14142. ' ExtB.DoIt.call(this, 1);',
  14143. ' ExtB.DoIt.call(this, 1);',
  14144. ' ExtB.DoIt.call(this, 3);',
  14145. ' ExtB.DoSome.call(this, 2);',
  14146. ' ExtB.DoSome.call(this, 2);',
  14147. ' ExtB.DoSome.call(this, 4);',
  14148. ' };',
  14149. ' this.DoSome$1 = function (j) {',
  14150. ' ExtB.DoSome.apply(this, arguments);',
  14151. ' };',
  14152. '});',
  14153. '']),
  14154. LinesToStr([ // $mod.$main
  14155. '']));
  14156. end;
  14157. procedure TTestModule.TestExternalClass_PascalAncestorFail;
  14158. begin
  14159. StartProgram(false);
  14160. Add('{$modeswitch externalclass}');
  14161. Add('type');
  14162. Add(' TObject = class');
  14163. Add(' end;');
  14164. Add(' TExtA = class external name ''ExtA''(TObject)');
  14165. Add(' end;');
  14166. Add('begin');
  14167. SetExpectedPasResolverError('Ancestor "TObject" is not external',nAncestorIsNotExternal);
  14168. ConvertProgram;
  14169. end;
  14170. procedure TTestModule.TestExternalClass_NewInstance;
  14171. begin
  14172. StartProgram(false);
  14173. Add('{$modeswitch externalclass}');
  14174. Add('type');
  14175. Add(' TExtA = class external name ''ExtA''');
  14176. Add(' end;');
  14177. Add(' TMyB = class(TExtA)');
  14178. Add(' protected');
  14179. Add(' class function NewInstance(fnname: string; const paramarray): TMyB; virtual;');
  14180. Add(' end;');
  14181. Add('class function TMyB.NewInstance(fnname: string; const paramarray): TMyB;');
  14182. Add('begin end;');
  14183. Add('begin');
  14184. ConvertProgram;
  14185. CheckSource('TestExternalClass_NewInstance',
  14186. LinesToStr([ // statements
  14187. 'rtl.createClassExt($mod, "TMyB", ExtA, "NewInstance", function () {',
  14188. ' this.$init = function () {',
  14189. ' };',
  14190. ' this.$final = function () {',
  14191. ' };',
  14192. ' this.NewInstance = function (fnname, paramarray) {',
  14193. ' var Result = null;',
  14194. ' return Result;',
  14195. ' };',
  14196. '});',
  14197. '']),
  14198. LinesToStr([ // $mod.$main
  14199. '']));
  14200. end;
  14201. procedure TTestModule.TestExternalClass_NewInstance_NonVirtualFail;
  14202. begin
  14203. StartProgram(false);
  14204. Add('{$modeswitch externalclass}');
  14205. Add('type');
  14206. Add(' TExtA = class external name ''ExtA''');
  14207. Add(' end;');
  14208. Add(' TMyB = class(TExtA)');
  14209. Add(' protected');
  14210. Add(' class function NewInstance(fnname: string; const paramarray): TMyB;');
  14211. Add(' end;');
  14212. Add('class function TMyB.NewInstance(fnname: string; const paramarray): TMyB;');
  14213. Add('begin end;');
  14214. Add('begin');
  14215. SetExpectedPasResolverError(sNewInstanceFunctionMustBeVirtual,nNewInstanceFunctionMustBeVirtual);
  14216. ConvertProgram;
  14217. end;
  14218. procedure TTestModule.TestExternalClass_NewInstance_FirstParamNotString_Fail;
  14219. begin
  14220. StartProgram(false);
  14221. Add('{$modeswitch externalclass}');
  14222. Add('type');
  14223. Add(' TExtA = class external name ''ExtA''');
  14224. Add(' end;');
  14225. Add(' TMyB = class(TExtA)');
  14226. Add(' protected');
  14227. Add(' class function NewInstance(fnname: longint; const paramarray): TMyB; virtual;');
  14228. Add(' end;');
  14229. Add('class function TMyB.NewInstance(fnname: longint; const paramarray): TMyB;');
  14230. Add('begin end;');
  14231. Add('begin');
  14232. SetExpectedPasResolverError('Incompatible type arg no. 1: Got "Longint", expected "String"',
  14233. nIncompatibleTypeArgNo);
  14234. ConvertProgram;
  14235. end;
  14236. procedure TTestModule.TestExternalClass_NewInstance_SecondParamTyped_Fail;
  14237. begin
  14238. StartProgram(false);
  14239. Add('{$modeswitch externalclass}');
  14240. Add('type');
  14241. Add(' TExtA = class external name ''ExtA''');
  14242. Add(' end;');
  14243. Add(' TMyB = class(TExtA)');
  14244. Add(' protected');
  14245. Add(' class function NewInstance(fnname: string; const paramarray: string): TMyB; virtual;');
  14246. Add(' end;');
  14247. Add('class function TMyB.NewInstance(fnname: string; const paramarray: string): TMyB;');
  14248. Add('begin end;');
  14249. Add('begin');
  14250. SetExpectedPasResolverError('Incompatible type arg no. 2: Got "type", expected "untyped"',
  14251. nIncompatibleTypeArgNo);
  14252. ConvertProgram;
  14253. end;
  14254. procedure TTestModule.TestExternalClass_PascalProperty;
  14255. begin
  14256. StartProgram(false);
  14257. Add('{$modeswitch externalclass}');
  14258. Add('type');
  14259. Add(' TJSElement = class;');
  14260. Add(' TJSNotifyEvent = procedure(Sender: TJSElement) of object;');
  14261. Add(' TJSElement = class external name ''ExtA''');
  14262. Add(' end;');
  14263. Add(' TControl = class(TJSElement)');
  14264. Add(' private');
  14265. Add(' FOnClick: TJSNotifyEvent;');
  14266. Add(' property OnClick: TJSNotifyEvent read FOnClick write FOnClick;');
  14267. Add(' procedure Click(Sender: TJSElement);');
  14268. Add(' end;');
  14269. Add('procedure TControl.Click(Sender: TJSElement);');
  14270. Add('begin');
  14271. Add(' OnClick(Self);');
  14272. Add('end;');
  14273. Add('var');
  14274. Add(' Ctrl: TControl;');
  14275. Add('begin');
  14276. Add(' Ctrl.OnClick:[email protected];');
  14277. Add(' Ctrl.OnClick(Ctrl);');
  14278. ConvertProgram;
  14279. CheckSource('TestExternalClass_PascalProperty',
  14280. LinesToStr([ // statements
  14281. 'rtl.createClassExt($mod, "TControl", ExtA, "", function () {',
  14282. ' this.$init = function () {',
  14283. ' this.FOnClick = null;',
  14284. ' };',
  14285. ' this.$final = function () {',
  14286. ' this.FOnClick = undefined;',
  14287. ' };',
  14288. ' this.Click = function (Sender) {',
  14289. ' this.FOnClick(this);',
  14290. ' };',
  14291. '});',
  14292. 'this.Ctrl = null;',
  14293. '']),
  14294. LinesToStr([ // $mod.$main
  14295. '$mod.Ctrl.FOnClick = rtl.createCallback($mod.Ctrl, "Click");',
  14296. '$mod.Ctrl.FOnClick($mod.Ctrl);',
  14297. '']));
  14298. end;
  14299. procedure TTestModule.TestExternalClass_TypeCastToRootClass;
  14300. begin
  14301. StartProgram(false);
  14302. Add([
  14303. '{$modeswitch externalclass}',
  14304. 'type',
  14305. ' IUnknown = interface end;',
  14306. ' TObject = class',
  14307. ' end;',
  14308. ' TChild = class',
  14309. ' end;',
  14310. ' TExtRootA = class external name ''ExtRootA''',
  14311. ' end;',
  14312. ' TExtChildA = class external name ''ExtChildA''(TExtRootA)',
  14313. ' end;',
  14314. ' TExtRootB = class external name ''ExtRootB''',
  14315. ' end;',
  14316. ' TExtChildB = class external name ''ExtChildB''(TExtRootB)',
  14317. ' end;',
  14318. 'var',
  14319. ' Obj: TObject;',
  14320. ' Child: TChild;',
  14321. ' RootA: TExtRootA;',
  14322. ' ChildA: TExtChildA;',
  14323. ' RootB: TExtRootB;',
  14324. ' ChildB: TExtChildB;',
  14325. ' i: IUnknown;',
  14326. 'begin',
  14327. ' obj:=tobject(roota);',
  14328. ' obj:=tobject(childa);',
  14329. ' child:=tchild(tobject(roota));',
  14330. ' roota:=textroota(obj);',
  14331. ' roota:=textroota(child);',
  14332. ' roota:=textroota(rootb);',
  14333. ' roota:=textroota(childb);',
  14334. ' childa:=textchilda(textroota(obj));',
  14335. ' roota:=TExtRootA(i)',
  14336. '']);
  14337. ConvertProgram;
  14338. CheckSource('TestExternalClass_TypeCastToRootClass',
  14339. LinesToStr([ // statements
  14340. 'rtl.createInterface($mod, "IUnknown", "{B92D5841-758A-322B-B800-000000000000}", [], null);',
  14341. 'rtl.createClass($mod, "TObject", null, function () {',
  14342. ' this.$init = function () {',
  14343. ' };',
  14344. ' this.$final = function () {',
  14345. ' };',
  14346. '});',
  14347. 'rtl.createClass($mod, "TChild", $mod.TObject, function () {',
  14348. '});',
  14349. 'this.Obj = null;',
  14350. 'this.Child = null;',
  14351. 'this.RootA = null;',
  14352. 'this.ChildA = null;',
  14353. 'this.RootB = null;',
  14354. 'this.ChildB = null;',
  14355. 'this.i = null;',
  14356. '']),
  14357. LinesToStr([ // $mod.$main
  14358. '$mod.Obj = $mod.RootA;',
  14359. '$mod.Obj = $mod.ChildA;',
  14360. '$mod.Child = $mod.RootA;',
  14361. '$mod.RootA = $mod.Obj;',
  14362. '$mod.RootA = $mod.Child;',
  14363. '$mod.RootA = $mod.RootB;',
  14364. '$mod.RootA = $mod.ChildB;',
  14365. '$mod.ChildA = $mod.Obj;',
  14366. '$mod.RootA = $mod.i;',
  14367. '']));
  14368. end;
  14369. procedure TTestModule.TestExternalClass_TypeCastToJSObject;
  14370. begin
  14371. StartProgram(false);
  14372. Add([
  14373. '{$modeswitch externalclass}',
  14374. 'type',
  14375. ' IUnknown = interface end;',
  14376. ' IBird = interface(IUnknown) end;',
  14377. ' TClass = class of TObject;',
  14378. ' TObject = class',
  14379. ' end;',
  14380. ' TChild = class',
  14381. ' end;',
  14382. ' TJSObject = class external name ''Object''',
  14383. ' end;',
  14384. ' TRec = record end;',
  14385. 'var',
  14386. ' Obj: TObject;',
  14387. ' Child: TChild;',
  14388. ' i: IUnknown;',
  14389. ' Bird: IBird;',
  14390. ' j: TJSObject;',
  14391. ' r: TRec;',
  14392. ' c: TClass;',
  14393. 'begin',
  14394. ' j:=tjsobject(IUnknown);',
  14395. ' j:=tjsobject(IBird);',
  14396. ' j:=tjsobject(TObject);',
  14397. ' j:=tjsobject(TChild);',
  14398. ' j:=tjsobject(TRec);',
  14399. ' j:=tjsobject(Obj);',
  14400. ' j:=tjsobject(Child);',
  14401. ' j:=tjsobject(i);',
  14402. ' j:=tjsobject(Bird);',
  14403. ' j:=tjsobject(r);',
  14404. ' j:=tjsobject(c);',
  14405. '']);
  14406. ConvertProgram;
  14407. CheckSource('TestExternalClass_TypeCastToJSObject',
  14408. LinesToStr([ // statements
  14409. 'rtl.createInterface($mod, "IUnknown", "{B92D5841-758A-322B-B800-000000000000}", [], null);',
  14410. 'rtl.createInterface($mod, "IBird", "{4B0D080B-C0F6-396E-AE88-000B87785074}", [], $mod.IUnknown);',
  14411. 'rtl.createClass($mod, "TObject", null, function () {',
  14412. ' this.$init = function () {',
  14413. ' };',
  14414. ' this.$final = function () {',
  14415. ' };',
  14416. '});',
  14417. 'rtl.createClass($mod, "TChild", $mod.TObject, function () {',
  14418. '});',
  14419. 'this.TRec = function (s) {',
  14420. ' this.$equal = function (b) {',
  14421. ' return true;',
  14422. ' };',
  14423. '};',
  14424. 'this.Obj = null;',
  14425. 'this.Child = null;',
  14426. 'this.i = null;',
  14427. 'this.Bird = null;',
  14428. 'this.j = null;',
  14429. 'this.r = new $mod.TRec();',
  14430. 'this.c = null;',
  14431. '']),
  14432. LinesToStr([ // $mod.$main
  14433. '$mod.j = $mod.IUnknown;',
  14434. '$mod.j = $mod.IBird;',
  14435. '$mod.j = $mod.TObject;',
  14436. '$mod.j = $mod.TChild;',
  14437. '$mod.j = $mod.TRec;',
  14438. '$mod.j = $mod.Obj;',
  14439. '$mod.j = $mod.Child;',
  14440. '$mod.j = $mod.i;',
  14441. '$mod.j = $mod.Bird;',
  14442. '$mod.j = $mod.r;',
  14443. '$mod.j = $mod.c;',
  14444. '']));
  14445. end;
  14446. procedure TTestModule.TestExternalClass_TypeCastStringToExternalString;
  14447. begin
  14448. StartProgram(false);
  14449. Add('{$modeswitch externalclass}');
  14450. Add('type');
  14451. Add(' TJSString = class external name ''String''');
  14452. Add(' class function fromCharCode() : string; varargs;');
  14453. Add(' function anchor(const aName : string) : string;');
  14454. Add(' end;');
  14455. Add('var');
  14456. Add(' s: string;');
  14457. Add('begin');
  14458. Add(' s:=TJSString.fromCharCode(65,66);');
  14459. Add(' s:=TJSString(s).anchor(s);');
  14460. Add(' s:=TJSString(''foo'').anchor(s);');
  14461. ConvertProgram;
  14462. CheckSource('TestExternalClass_TypeCastStringToExternalString',
  14463. LinesToStr([ // statements
  14464. 'this.s = "";',
  14465. '']),
  14466. LinesToStr([ // $mod.$main
  14467. '$mod.s = String.fromCharCode(65, 66);',
  14468. '$mod.s = $mod.s.anchor($mod.s);',
  14469. '$mod.s = "foo".anchor($mod.s);',
  14470. '']));
  14471. end;
  14472. procedure TTestModule.TestExternalClass_TypeCastToJSFunction;
  14473. begin
  14474. StartProgram(false);
  14475. Add([
  14476. '{$modeswitch externalclass}',
  14477. 'type',
  14478. ' TJSObject = class external name ''Object'' end;',
  14479. ' TJSFunction = class external name ''Function''',
  14480. ' function bind(thisArg: TJSObject): TJSFunction; varargs;',
  14481. ' function call(thisArg: TJSObject): JSValue; varargs;',
  14482. ' end;',
  14483. ' TObject = class',
  14484. ' procedure DoIt(i: longint);',
  14485. ' end;',
  14486. ' TFuncInt = function(o: TObject): longint;',
  14487. 'function GetIt(o: TObject): longint;',
  14488. ' procedure Sub; begin end;',
  14489. 'var',
  14490. ' f: TJSFunction;',
  14491. ' fi: TFuncInt;',
  14492. 'begin',
  14493. ' fi:=TFuncInt(f);',
  14494. ' f:=TJSFunction(fi);',
  14495. ' f:=TJSFunction(@GetIt);',
  14496. ' f:=TJSFunction(@GetIt).bind(nil,3);',
  14497. ' f:=TJSFunction(@Sub);',
  14498. ' f:=TJSFunction(@o.doit);',
  14499. ' f:=TJSFunction(fi).bind(nil,4)',
  14500. 'end;',
  14501. 'procedure TObject.DoIt(i: longint);',
  14502. ' procedure Sub; begin end;',
  14503. 'var f: TJSFunction;',
  14504. 'begin',
  14505. ' f:=TJSFunction(@DoIt);',
  14506. ' f:=TJSFunction(@DoIt).bind(nil,13);',
  14507. ' f:=TJSFunction(@Sub);',
  14508. ' f:=TJSFunction(@GetIt);',
  14509. 'end;',
  14510. 'begin']);
  14511. ConvertProgram;
  14512. CheckSource('TestExternalClass_TypeCastToJSFunction',
  14513. LinesToStr([ // statements
  14514. 'rtl.createClass($mod, "TObject", null, function () {',
  14515. ' this.$init = function () {',
  14516. ' };',
  14517. ' this.$final = function () {',
  14518. ' };',
  14519. ' this.DoIt = function (i) {',
  14520. ' var Self = this;',
  14521. ' function Sub() {',
  14522. ' };',
  14523. ' var f = null;',
  14524. ' f = rtl.createCallback(Self, "DoIt");',
  14525. ' f = rtl.createCallback(Self, "DoIt").bind(null, 13);',
  14526. ' f = Sub;',
  14527. ' f = $mod.GetIt;',
  14528. ' };',
  14529. '});',
  14530. 'this.GetIt = function (o) {',
  14531. ' var Result = 0;',
  14532. ' function Sub() {',
  14533. ' };',
  14534. ' var f = null;',
  14535. ' var fi = null;',
  14536. ' fi = f;',
  14537. ' f = fi;',
  14538. ' f = $mod.GetIt;',
  14539. ' f = $mod.GetIt.bind(null, 3);',
  14540. ' f = Sub;',
  14541. ' f = rtl.createCallback(o, "DoIt");',
  14542. ' f = fi.bind(null, 4);',
  14543. ' return Result;',
  14544. '};',
  14545. '']),
  14546. LinesToStr([ // $mod.$main
  14547. '']));
  14548. end;
  14549. procedure TTestModule.TestExternalClass_CallClassFunctionOfInstanceFail;
  14550. begin
  14551. StartProgram(false);
  14552. Add('{$modeswitch externalclass}');
  14553. Add('type');
  14554. Add(' TJSString = class external name ''String''');
  14555. Add(' class function fromCharCode() : string; varargs;');
  14556. Add(' end;');
  14557. Add('var');
  14558. Add(' s: string;');
  14559. Add(' sObj: TJSString;');
  14560. Add('begin');
  14561. Add(' s:=sObj.fromCharCode(65,66);');
  14562. SetExpectedPasResolverError('External class instance cannot access static class function fromCharCode',
  14563. nExternalClassInstanceCannotAccessStaticX);
  14564. ConvertProgram;
  14565. end;
  14566. procedure TTestModule.TestExternalClass_BracketAccessor;
  14567. begin
  14568. StartProgram(false);
  14569. Add([
  14570. '{$modeswitch externalclass}',
  14571. 'type',
  14572. ' TJSArray = class external name ''Array2''',
  14573. ' function GetItems(Index: longint): jsvalue; external name ''[]'';',
  14574. ' procedure SetItems(Index: longint; Value: jsvalue); external name ''[]'';',
  14575. ' property Items[Index: longint]: jsvalue read GetItems write SetItems; default;',
  14576. ' end;',
  14577. 'procedure DoIt(vI: JSValue; const vJ: jsvalue; var vK: jsvalue; out vL: jsvalue);',
  14578. 'begin end;',
  14579. 'var',
  14580. ' Arr: tjsarray;',
  14581. ' s: string;',
  14582. ' i: longint;',
  14583. ' v: jsvalue;',
  14584. 'begin',
  14585. ' v:=arr[0];',
  14586. ' v:=arr.items[1];',
  14587. ' arr[2]:=s;',
  14588. ' arr.items[3]:=s;',
  14589. ' arr[4]:=i;',
  14590. ' arr[5]:=arr[6];',
  14591. ' arr.items[7]:=arr.items[8];',
  14592. ' with arr do items[9]:=items[10];',
  14593. ' doit(arr[7],arr[8],arr[9],arr[10]);',
  14594. ' with arr do begin',
  14595. ' v:=GetItems(14);',
  14596. ' setitems(15,16);',
  14597. ' end;',
  14598. '']);
  14599. ConvertProgram;
  14600. CheckSource('TestExternalClass_BracketAccessor',
  14601. LinesToStr([ // statements
  14602. 'this.DoIt = function (vI, vJ, vK, vL) {',
  14603. '};',
  14604. 'this.Arr = null;',
  14605. 'this.s = "";',
  14606. 'this.i = 0;',
  14607. 'this.v = undefined;',
  14608. '']),
  14609. LinesToStr([ // $mod.$main
  14610. '$mod.v = $mod.Arr[0];',
  14611. '$mod.v = $mod.Arr[1];',
  14612. '$mod.Arr[2] = $mod.s;',
  14613. '$mod.Arr[3] = $mod.s;',
  14614. '$mod.Arr[4] = $mod.i;',
  14615. '$mod.Arr[5] = $mod.Arr[6];',
  14616. '$mod.Arr[7] = $mod.Arr[8];',
  14617. 'var $with1 = $mod.Arr;',
  14618. '$with1[9] = $with1[10];',
  14619. '$mod.DoIt($mod.Arr[7], $mod.Arr[8], {',
  14620. ' a: 9,',
  14621. ' p: $mod.Arr,',
  14622. ' get: function () {',
  14623. ' return this.p[this.a];',
  14624. ' },',
  14625. ' set: function (v) {',
  14626. ' this.p[this.a] = v;',
  14627. ' }',
  14628. '}, {',
  14629. ' a: 10,',
  14630. ' p: $mod.Arr,',
  14631. ' get: function () {',
  14632. ' return this.p[this.a];',
  14633. ' },',
  14634. ' set: function (v) {',
  14635. ' this.p[this.a] = v;',
  14636. ' }',
  14637. '});',
  14638. 'var $with2 = $mod.Arr;',
  14639. '$mod.v = $with2[14];',
  14640. '$with2[15] = 16;',
  14641. '']));
  14642. end;
  14643. procedure TTestModule.TestExternalClass_BracketAccessor_Call;
  14644. begin
  14645. StartProgram(false);
  14646. Add([
  14647. '{$modeswitch externalclass}',
  14648. 'type',
  14649. ' TJSArray = class external name ''Array2''',
  14650. ' function GetItems(Index: longint): jsvalue; external name ''[]'';',
  14651. ' procedure SetItems(Index: longint; Value: jsvalue); external name ''[]'';',
  14652. ' property Items[Index: longint]: jsvalue read GetItems write SetItems; default;',
  14653. ' end;',
  14654. ' TMyArr = class(TJSArray)',
  14655. ' procedure DoIt;',
  14656. ' end;',
  14657. 'procedure tmyarr.DoIt;',
  14658. 'begin',
  14659. ' Items[1]:=Items[2];',
  14660. ' SetItems(3,getItems(4));',
  14661. 'end;',
  14662. 'var',
  14663. ' Arr: tmyarr;',
  14664. ' s: string;',
  14665. ' i: longint;',
  14666. ' v: jsvalue;',
  14667. 'begin',
  14668. ' v:=arr[0];',
  14669. ' v:=arr.items[1];',
  14670. ' arr[2]:=s;',
  14671. ' arr.items[3]:=s;',
  14672. ' arr[4]:=i;',
  14673. ' arr[5]:=arr[6];',
  14674. ' arr.items[7]:=arr.items[8];',
  14675. ' with arr do items[9]:=items[10];',
  14676. ' with arr do begin',
  14677. ' v:=GetItems(14);',
  14678. ' setitems(15,16);',
  14679. ' end;',
  14680. '']);
  14681. ConvertProgram;
  14682. CheckSource('TestExternalClass_BracketAccessor_Call',
  14683. LinesToStr([ // statements
  14684. 'rtl.createClassExt($mod, "TMyArr", Array2, "", function () {',
  14685. ' this.$init = function () {',
  14686. ' };',
  14687. ' this.$final = function () {',
  14688. ' };',
  14689. ' this.DoIt = function () {',
  14690. ' this[1] = this[2];',
  14691. ' this[3] = this[4];',
  14692. ' };',
  14693. '});',
  14694. 'this.Arr = null;',
  14695. 'this.s = "";',
  14696. 'this.i = 0;',
  14697. 'this.v = undefined;',
  14698. '']),
  14699. LinesToStr([ // $mod.$main
  14700. '$mod.v = $mod.Arr[0];',
  14701. '$mod.v = $mod.Arr[1];',
  14702. '$mod.Arr[2] = $mod.s;',
  14703. '$mod.Arr[3] = $mod.s;',
  14704. '$mod.Arr[4] = $mod.i;',
  14705. '$mod.Arr[5] = $mod.Arr[6];',
  14706. '$mod.Arr[7] = $mod.Arr[8];',
  14707. 'var $with1 = $mod.Arr;',
  14708. '$with1[9] = $with1[10];',
  14709. 'var $with2 = $mod.Arr;',
  14710. '$mod.v = $with2[14];',
  14711. '$with2[15] = 16;',
  14712. '']));
  14713. end;
  14714. procedure TTestModule.TestExternalClass_BracketAccessor_2ParamsFail;
  14715. begin
  14716. StartProgram(false);
  14717. Add('{$modeswitch externalclass}');
  14718. Add('type');
  14719. Add(' TJSArray = class external name ''Array2''');
  14720. Add(' function GetItems(Index1, Index2: longint): jsvalue; external name ''[]'';');
  14721. Add(' procedure SetItems(Index1, Index2: longint; Value: jsvalue); external name ''[]'';');
  14722. Add(' property Items[Index1, Index2: longint]: jsvalue read GetItems write SetItems; default;');
  14723. Add(' end;');
  14724. Add('begin');
  14725. SetExpectedPasResolverError(sBracketAccessorOfExternalClassMustHaveOneParameter,
  14726. nBracketAccessorOfExternalClassMustHaveOneParameter);
  14727. ConvertProgram;
  14728. end;
  14729. procedure TTestModule.TestExternalClass_BracketAccessor_ReadOnly;
  14730. begin
  14731. StartProgram(false);
  14732. Add('{$modeswitch externalclass}');
  14733. Add('type');
  14734. Add(' TJSArray = class external name ''Array2''');
  14735. Add(' function GetItems(Index: longint): jsvalue; external name ''[]'';');
  14736. Add(' property Items[Index: longint]: jsvalue read GetItems; default;');
  14737. Add(' end;');
  14738. Add('procedure DoIt(vI: JSValue; const vJ: jsvalue);');
  14739. Add('begin end;');
  14740. Add('var');
  14741. Add(' Arr: tjsarray;');
  14742. Add(' v: jsvalue;');
  14743. Add('begin');
  14744. Add(' v:=arr[0];');
  14745. Add(' v:=arr.items[1];');
  14746. Add(' with arr do v:=items[2];');
  14747. Add(' doit(arr[3],arr[4]);');
  14748. ConvertProgram;
  14749. CheckSource('TestExternalClass_BracketAccessor_ReadOnly',
  14750. LinesToStr([ // statements
  14751. 'this.DoIt = function (vI, vJ) {',
  14752. '};',
  14753. 'this.Arr = null;',
  14754. 'this.v = undefined;',
  14755. '']),
  14756. LinesToStr([ // $mod.$main
  14757. '$mod.v = $mod.Arr[0];',
  14758. '$mod.v = $mod.Arr[1];',
  14759. 'var $with1 = $mod.Arr;',
  14760. '$mod.v = $with1[2];',
  14761. '$mod.DoIt($mod.Arr[3], $mod.Arr[4]);',
  14762. '']));
  14763. end;
  14764. procedure TTestModule.TestExternalClass_BracketAccessor_WriteOnly;
  14765. begin
  14766. StartProgram(false);
  14767. Add('{$modeswitch externalclass}');
  14768. Add('type');
  14769. Add(' TJSArray = class external name ''Array2''');
  14770. Add(' procedure SetItems(Index: longint; Value: jsvalue); external name ''[]'';');
  14771. Add(' property Items[Index: longint]: jsvalue write SetItems; default;');
  14772. Add(' end;');
  14773. Add('var');
  14774. Add(' Arr: tjsarray;');
  14775. Add(' s: string;');
  14776. Add(' i: longint;');
  14777. Add(' v: jsvalue;');
  14778. Add('begin');
  14779. Add(' arr[2]:=s;');
  14780. Add(' arr.items[3]:=s;');
  14781. Add(' arr[4]:=i;');
  14782. Add(' with arr do items[5]:=i;');
  14783. ConvertProgram;
  14784. CheckSource('TestExternalClass_BracketAccessor_WriteOnly',
  14785. LinesToStr([ // statements
  14786. 'this.Arr = null;',
  14787. 'this.s = "";',
  14788. 'this.i = 0;',
  14789. 'this.v = undefined;',
  14790. '']),
  14791. LinesToStr([ // $mod.$main
  14792. '$mod.Arr[2] = $mod.s;',
  14793. '$mod.Arr[3] = $mod.s;',
  14794. '$mod.Arr[4] = $mod.i;',
  14795. 'var $with1 = $mod.Arr;',
  14796. '$with1[5] = $mod.i;',
  14797. '']));
  14798. end;
  14799. procedure TTestModule.TestExternalClass_BracketAccessor_MultiType;
  14800. begin
  14801. StartProgram(false);
  14802. Add('{$modeswitch externalclass}');
  14803. Add('type');
  14804. Add(' TJSArray = class external name ''Array2''');
  14805. Add(' procedure SetItems(Index: longint; Value: jsvalue); external name ''[]'';');
  14806. Add(' property Items[Index: longint]: jsvalue write SetItems; default;');
  14807. Add(' procedure SetNumbers(Index: longint; Value: longint); external name ''[]'';');
  14808. Add(' property Numbers[Index: longint]: longint write SetNumbers;');
  14809. Add(' end;');
  14810. Add('var');
  14811. Add(' Arr: tjsarray;');
  14812. Add(' s: string;');
  14813. Add(' i: longint;');
  14814. Add(' v: jsvalue;');
  14815. Add('begin');
  14816. Add(' arr[2]:=s;');
  14817. Add(' arr.items[3]:=s;');
  14818. Add(' arr.numbers[4]:=i;');
  14819. Add(' with arr do items[5]:=i;');
  14820. Add(' with arr do numbers[6]:=i;');
  14821. ConvertProgram;
  14822. CheckSource('TestExternalClass_BracketAccessor_MultiType',
  14823. LinesToStr([ // statements
  14824. 'this.Arr = null;',
  14825. 'this.s = "";',
  14826. 'this.i = 0;',
  14827. 'this.v = undefined;',
  14828. '']),
  14829. LinesToStr([ // $mod.$main
  14830. '$mod.Arr[2] = $mod.s;',
  14831. '$mod.Arr[3] = $mod.s;',
  14832. '$mod.Arr[4] = $mod.i;',
  14833. 'var $with1 = $mod.Arr;',
  14834. '$with1[5] = $mod.i;',
  14835. 'var $with2 = $mod.Arr;',
  14836. '$with2[6] = $mod.i;',
  14837. '']));
  14838. end;
  14839. procedure TTestModule.TestExternalClass_BracketAccessor_Index;
  14840. begin
  14841. StartProgram(false);
  14842. Add('{$modeswitch externalclass}');
  14843. Add('type');
  14844. Add(' TJSArray = class external name ''Array2''');
  14845. Add(' function GetItems(Index: longint): jsvalue; external name ''[]'';');
  14846. Add(' procedure SetItems(Index: longint; Value: jsvalue); external name ''[]'';');
  14847. Add(' property Items[Index: longint]: jsvalue read GetItems write SetItems; default;');
  14848. Add(' end;');
  14849. Add('var');
  14850. Add(' Arr: tjsarray;');
  14851. Add(' i: longint;');
  14852. Add(' IntArr: array of longint;');
  14853. Add(' v: jsvalue;');
  14854. Add('begin');
  14855. Add(' v:=arr.items[i];');
  14856. Add(' arr[longint(v)]:=arr.items[intarr[0]];');
  14857. Add(' arr.items[intarr[1]]:=arr[IntArr[2]];');
  14858. ConvertProgram;
  14859. CheckSource('TestExternalClass_BracketAccessor_Index',
  14860. LinesToStr([ // statements
  14861. 'this.Arr = null;',
  14862. 'this.i = 0;',
  14863. 'this.IntArr = [];',
  14864. 'this.v = undefined;',
  14865. '']),
  14866. LinesToStr([ // $mod.$main
  14867. '$mod.v = $mod.Arr[$mod.i];',
  14868. '$mod.Arr[Math.floor($mod.v)] = $mod.Arr[$mod.IntArr[0]];',
  14869. '$mod.Arr[$mod.IntArr[1]] = $mod.Arr[$mod.IntArr[2]];',
  14870. '']));
  14871. end;
  14872. procedure TTestModule.TestExternalClass_ForInJSObject;
  14873. begin
  14874. StartProgram(false);
  14875. Add([
  14876. '{$modeswitch externalclass}',
  14877. 'type',
  14878. ' TJSObject = class external name ''Object''',
  14879. ' end;',
  14880. 'var',
  14881. ' o: TJSObject;',
  14882. ' key: string;',
  14883. 'begin',
  14884. ' for key in o do',
  14885. ' if key=''abc'' then ;',
  14886. '']);
  14887. ConvertProgram;
  14888. CheckSource('TestExternalClass_ForInJSObject',
  14889. LinesToStr([ // statements
  14890. 'this.o = null;',
  14891. 'this.key = "";',
  14892. '']),
  14893. LinesToStr([ // $mod.$main
  14894. 'for ($mod.key in $mod.o) if ($mod.key === "abc") ;',
  14895. '']));
  14896. end;
  14897. procedure TTestModule.TestExternalClass_ForInJSArray;
  14898. begin
  14899. StartProgram(false);
  14900. Add([
  14901. '{$modeswitch externalclass}',
  14902. 'type',
  14903. ' TJSInt8Array = class external name ''Int8Array''',
  14904. ' private',
  14905. ' flength: NativeInt external name ''length'';',
  14906. ' function getValue(Index: NativeInt): shortint; external name ''[]'';',
  14907. ' public',
  14908. ' property values[Index: NativeInt]: Shortint Read getValue; default;',
  14909. ' property Length: NativeInt read flength;',
  14910. ' end;',
  14911. 'var',
  14912. ' a: TJSInt8Array;',
  14913. ' value: shortint;',
  14914. 'begin',
  14915. ' for value in a do',
  14916. ' if value=3 then ;',
  14917. '']);
  14918. ConvertProgram;
  14919. CheckSource('TestExternalClass_ForInJSArray',
  14920. LinesToStr([ // statements
  14921. 'this.a = null;',
  14922. 'this.value = 0;',
  14923. '']),
  14924. LinesToStr([ // $mod.$main
  14925. 'for (var $in1 = $mod.a, $l2 = 0, $end3 = rtl.length($in1) - 1; $l2 <= $end3; $l2++) {',
  14926. ' $mod.value = $in1[$l2];',
  14927. ' if ($mod.value === 3) ;',
  14928. '};',
  14929. '']));
  14930. end;
  14931. procedure TTestModule.TestExternalClass_IncompatibleArgDuplicateIdentifier;
  14932. begin
  14933. AddModuleWithIntfImplSrc('unit2.pas',
  14934. LinesToStr([
  14935. '{$modeswitch externalclass}',
  14936. 'type',
  14937. ' TJSBufferSource = class external name ''BufferSource''',
  14938. ' end;',
  14939. 'procedure DoIt(s: TJSBufferSource); external name ''DoIt'';',
  14940. '']),
  14941. '');
  14942. AddModuleWithIntfImplSrc('unit3.pas',
  14943. LinesToStr([
  14944. '{$modeswitch externalclass}',
  14945. 'type',
  14946. ' TJSBufferSource = class external name ''BufferSource''',
  14947. ' end;',
  14948. '']),
  14949. '');
  14950. StartUnit(true);
  14951. Add([
  14952. 'interface',
  14953. 'uses unit2, unit3;',
  14954. 'procedure DoSome(s: TJSBufferSource);',
  14955. 'implementation',
  14956. 'procedure DoSome(s: TJSBufferSource);',
  14957. 'begin',
  14958. ' DoIt(s);',
  14959. 'end;',
  14960. '']);
  14961. SetExpectedPasResolverError('Incompatible type arg no. 1: Got "unit3.TJSBufferSource", expected "unit2.TJSBufferSource"',
  14962. nIncompatibleTypeArgNo);
  14963. ConvertUnit;
  14964. end;
  14965. procedure TTestModule.TestClassInterface_Corba;
  14966. begin
  14967. StartProgram(false);
  14968. Add([
  14969. '{$interfaces corba}',
  14970. 'type',
  14971. ' IUnknown = interface;',
  14972. ' IUnknown = interface',
  14973. ' [''{00000000-0000-0000-C000-000000000046}'']',
  14974. ' end;',
  14975. ' IInterface = IUnknown;',
  14976. ' IBird = interface(IInterface)',
  14977. ' function GetSize: longint;',
  14978. ' procedure SetSize(i: longint);',
  14979. ' property Size: longint read GetSize write SetSize;',
  14980. ' procedure DoIt(i: longint);',
  14981. ' end;',
  14982. ' TObject = class',
  14983. ' end;',
  14984. ' TBird = class(TObject,IBird)',
  14985. ' function GetSize: longint; virtual; abstract;',
  14986. ' procedure SetSize(i: longint); virtual; abstract;',
  14987. ' procedure DoIt(i: longint); virtual; abstract;',
  14988. ' end;',
  14989. 'var',
  14990. ' BirdIntf: IBird;',
  14991. 'begin',
  14992. ' BirdIntf.Size:=BirdIntf.Size;',
  14993. '']);
  14994. ConvertProgram;
  14995. CheckSource('TestClassInterface_Corba',
  14996. LinesToStr([ // statements
  14997. 'rtl.createInterface($mod, "IUnknown", "{00000000-0000-0000-C000-000000000046}", [], null);',
  14998. 'rtl.createInterface($mod, "IBird", "{5BD1A53B-69BB-37EE-AF32-BEFB86D85B03}", ["GetSize", "SetSize", "DoIt"], $mod.IUnknown);',
  14999. 'rtl.createClass($mod, "TObject", null, function () {',
  15000. ' this.$init = function () {',
  15001. ' };',
  15002. ' this.$final = function () {',
  15003. ' };',
  15004. '});',
  15005. 'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
  15006. ' rtl.addIntf(this, $mod.IBird);',
  15007. '});',
  15008. 'this.BirdIntf = null;',
  15009. '']),
  15010. LinesToStr([ // $mod.$main
  15011. ' $mod.BirdIntf.SetSize($mod.BirdIntf.GetSize());',
  15012. '']));
  15013. end;
  15014. procedure TTestModule.TestClassInterface_ProcExternalFail;
  15015. begin
  15016. StartProgram(false);
  15017. Add([
  15018. '{$interfaces corba}',
  15019. 'type',
  15020. ' IUnknown = interface',
  15021. ' procedure DoIt; external name ''foo'';',
  15022. ' end;',
  15023. 'begin']);
  15024. SetExpectedParserError(
  15025. 'Fields are not allowed in Interfaces at token "Identifier external" in file test1.pp at line 6 column 21',
  15026. nParserNoFieldsAllowed);
  15027. ConvertProgram;
  15028. end;
  15029. procedure TTestModule.TestClassInterface_Overloads;
  15030. begin
  15031. StartProgram(false);
  15032. Add([
  15033. '{$interfaces corba}',
  15034. 'type',
  15035. ' integer = longint;',
  15036. ' IUnknown = interface',
  15037. ' procedure DoIt(i: integer);',
  15038. ' procedure DoIt(s: string);',
  15039. ' end;',
  15040. ' IBird = interface(IUnknown)',
  15041. ' procedure DoIt(b: boolean); overload;',
  15042. ' end;',
  15043. ' TObject = class',
  15044. ' end;',
  15045. ' TBird = class(TObject,IBird)',
  15046. ' procedure DoIt(o: TObject);',
  15047. ' procedure DoIt(s: string);',
  15048. ' procedure DoIt(i: integer);',
  15049. ' procedure DoIt(b: boolean);',
  15050. ' end;',
  15051. 'procedure TBird.DoIt(o: TObject); begin end;',
  15052. 'procedure TBird.DoIt(s: string); begin end;',
  15053. 'procedure TBird.DoIt(i: integer); begin end;',
  15054. 'procedure TBird.DoIt(b: boolean); begin end;',
  15055. 'var',
  15056. ' BirdIntf: IBird;',
  15057. 'begin',
  15058. ' BirdIntf.DoIt(3);',
  15059. ' BirdIntf.DoIt(''abc'');',
  15060. ' BirdIntf.DoIt(true);',
  15061. '']);
  15062. ConvertProgram;
  15063. CheckSource('TestClassInterface_Overloads',
  15064. LinesToStr([ // statements
  15065. 'rtl.createInterface($mod, "IUnknown", "{B92D5841-758A-322B-BDC4-8A2AE2C59400}", ["DoIt", "DoIt$1"], null);',
  15066. 'rtl.createInterface($mod, "IBird", "{8285DD5E-EA3E-396E-AE88-000B86AABF05}", ["DoIt$2"], $mod.IUnknown);',
  15067. 'rtl.createClass($mod, "TObject", null, function () {',
  15068. ' this.$init = function () {',
  15069. ' };',
  15070. ' this.$final = function () {',
  15071. ' };',
  15072. '});',
  15073. 'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
  15074. ' this.DoIt = function (o) {',
  15075. ' };',
  15076. ' this.DoIt$1 = function (s) {',
  15077. ' };',
  15078. ' this.DoIt$2 = function (i) {',
  15079. ' };',
  15080. ' this.DoIt$3 = function (b) {',
  15081. ' };',
  15082. ' rtl.addIntf(this, $mod.IBird, {',
  15083. ' DoIt$2: "DoIt$3",',
  15084. ' DoIt: "DoIt$2"',
  15085. ' });',
  15086. '});',
  15087. 'this.BirdIntf = null;',
  15088. '']),
  15089. LinesToStr([ // $mod.$main
  15090. '$mod.BirdIntf.DoIt(3);',
  15091. '$mod.BirdIntf.DoIt$1("abc");',
  15092. '$mod.BirdIntf.DoIt$2(true);',
  15093. '']));
  15094. end;
  15095. procedure TTestModule.TestClassInterface_DuplicateGUIInIntfListFail;
  15096. begin
  15097. StartProgram(false);
  15098. Add([
  15099. '{$interfaces corba}',
  15100. 'type',
  15101. ' IBird = interface',
  15102. ' [''{4B3BA825-E0EC-4799-A19C-55F714A07959}'']',
  15103. ' end;',
  15104. ' IDog = interface',
  15105. ' [''{4B3BA825-E0EC-4799-A19C-55F714A07959}'']',
  15106. ' end;',
  15107. ' TObject = class(IBird,IDog)',
  15108. ' end;',
  15109. 'begin']);
  15110. SetExpectedPasResolverError('Duplicate GUID {4B3BA825-E0EC-4799-A19C-55F714A07959} in IDog and IBird',
  15111. nDuplicateGUIDXInYZ);
  15112. ConvertProgram;
  15113. end;
  15114. procedure TTestModule.TestClassInterface_DuplicateGUIInAncestorFail;
  15115. begin
  15116. StartProgram(false);
  15117. Add([
  15118. '{$interfaces corba}',
  15119. 'type',
  15120. ' IAnimal = interface',
  15121. ' [''{4B3BA825-E0EC-4799-A19C-55F714A07959}'']',
  15122. ' end;',
  15123. ' IBird = interface(IAnimal)',
  15124. ' end;',
  15125. ' IHawk = interface(IBird)',
  15126. ' [''{4B3BA825-E0EC-4799-A19C-55F714A07959}'']',
  15127. ' end;',
  15128. 'begin']);
  15129. SetExpectedPasResolverError('Duplicate GUID {4B3BA825-E0EC-4799-A19C-55F714A07959} in IHawk and IAnimal',
  15130. nDuplicateGUIDXInYZ);
  15131. ConvertProgram;
  15132. end;
  15133. procedure TTestModule.TestClassInterface_AncestorImpl;
  15134. begin
  15135. StartProgram(false);
  15136. Add([
  15137. '{$interfaces corba}',
  15138. 'type',
  15139. ' integer = longint;',
  15140. ' IUnknown = interface',
  15141. ' procedure DoIt(i: integer);',
  15142. ' end;',
  15143. ' IBird = interface',
  15144. ' procedure Fly(i: integer);',
  15145. ' end;',
  15146. ' TObject = class(IUnknown)',
  15147. ' procedure DoIt(i: integer);',
  15148. ' end;',
  15149. ' TBird = class(IBird)',
  15150. ' procedure Fly(i: integer);',
  15151. ' end;',
  15152. 'procedure TObject.DoIt(i: integer); begin end;',
  15153. 'procedure TBird.Fly(i: integer); begin end;',
  15154. 'begin',
  15155. '']);
  15156. ConvertProgram;
  15157. CheckSource('TestClassInterface_AncestorIntf',
  15158. LinesToStr([ // statements
  15159. 'rtl.createInterface($mod, "IUnknown", "{B92D5841-758A-322B-BDC4-8A2800000000}", ["DoIt"], null);',
  15160. 'rtl.createInterface($mod, "IBird", "{B92D5841-6264-3AE3-BF20-000000000000}", ["Fly"], null);',
  15161. 'rtl.createClass($mod, "TObject", null, function () {',
  15162. ' this.$init = function () {',
  15163. ' };',
  15164. ' this.$final = function () {',
  15165. ' };',
  15166. ' this.DoIt = function (i) {',
  15167. ' };',
  15168. ' rtl.addIntf(this, $mod.IUnknown);',
  15169. '});',
  15170. 'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
  15171. ' this.Fly = function (i) {',
  15172. ' };',
  15173. ' rtl.addIntf(this, $mod.IBird);',
  15174. ' rtl.addIntf(this, $mod.IUnknown);',
  15175. '});',
  15176. '']),
  15177. LinesToStr([ // $mod.$main
  15178. '']));
  15179. end;
  15180. procedure TTestModule.TestClassInterface_ImplReintroduce;
  15181. begin
  15182. StartProgram(false);
  15183. Add([
  15184. '{$interfaces corba}',
  15185. 'type',
  15186. ' integer = longint;',
  15187. ' IBird = interface',
  15188. ' procedure DoIt(i: integer);',
  15189. ' end;',
  15190. ' TObject = class',
  15191. ' procedure DoIt(i: integer);',
  15192. ' end;',
  15193. ' TBird = class(IBird)',
  15194. ' procedure DoIt(i: integer); virtual; reintroduce;',
  15195. ' end;',
  15196. 'procedure TObject.DoIt(i: integer); begin end;',
  15197. 'procedure TBird.DoIt(i: integer); begin end;',
  15198. 'begin',
  15199. '']);
  15200. ConvertProgram;
  15201. CheckSource('TestClassInterface_ImplReintroduce',
  15202. LinesToStr([ // statements
  15203. 'rtl.createInterface($mod, "IBird", "{B92D5841-6264-3AE2-8594-000000000000}", ["DoIt"], null);',
  15204. 'rtl.createClass($mod, "TObject", null, function () {',
  15205. ' this.$init = function () {',
  15206. ' };',
  15207. ' this.$final = function () {',
  15208. ' };',
  15209. ' this.DoIt = function (i) {',
  15210. ' };',
  15211. '});',
  15212. 'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
  15213. ' this.DoIt$1 = function (i) {',
  15214. ' };',
  15215. ' rtl.addIntf(this, $mod.IBird, {',
  15216. ' DoIt: "DoIt$1"',
  15217. ' });',
  15218. '});',
  15219. '']),
  15220. LinesToStr([ // $mod.$main
  15221. '']));
  15222. end;
  15223. procedure TTestModule.TestClassInterface_MethodResolution;
  15224. begin
  15225. StartProgram(false);
  15226. Add([
  15227. '{$interfaces corba}',
  15228. 'type',
  15229. ' IUnknown = interface',
  15230. ' procedure Walk(i: longint);',
  15231. ' end;',
  15232. ' IBird = interface(IUnknown)',
  15233. ' procedure Walk(b: boolean); overload;',
  15234. ' procedure Fly(s: string);',
  15235. ' end;',
  15236. ' TObject = class',
  15237. ' end;',
  15238. ' TBird = class(TObject,IBird)',
  15239. ' procedure IBird.Fly = Move;',
  15240. ' procedure IBird.Walk = Hop;',
  15241. ' procedure Hop(i: longint);',
  15242. ' procedure Move(s: string);',
  15243. ' procedure Hop(b: boolean);',
  15244. ' end;',
  15245. 'procedure TBird.Move(s: string); begin end;',
  15246. 'procedure TBird.Hop(i: longint); begin end;',
  15247. 'procedure TBird.Hop(b: boolean); begin end;',
  15248. 'var',
  15249. ' BirdIntf: IBird;',
  15250. 'begin',
  15251. ' BirdIntf.Walk(3);',
  15252. ' BirdIntf.Walk(true);',
  15253. ' BirdIntf.Fly(''abc'');',
  15254. '']);
  15255. ConvertProgram;
  15256. CheckSource('TestClassInterface_MethodResolution',
  15257. LinesToStr([ // statements
  15258. 'rtl.createInterface($mod, "IUnknown", "{B92D5841-758A-322B-BDD7-23D600000000}", ["Walk"], null);',
  15259. 'rtl.createInterface($mod, "IBird", "{CF8A4986-80F6-396E-AE88-000B86AAE208}", ["Walk$1", "Fly"], $mod.IUnknown);',
  15260. 'rtl.createClass($mod, "TObject", null, function () {',
  15261. ' this.$init = function () {',
  15262. ' };',
  15263. ' this.$final = function () {',
  15264. ' };',
  15265. '});',
  15266. 'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
  15267. ' this.Hop = function (i) {',
  15268. ' };',
  15269. ' this.Move = function (s) {',
  15270. ' };',
  15271. ' this.Hop$1 = function (b) {',
  15272. ' };',
  15273. ' rtl.addIntf(this, $mod.IBird, {',
  15274. ' Walk$1: "Hop$1",',
  15275. ' Fly: "Move",',
  15276. ' Walk: "Hop"',
  15277. ' });',
  15278. '});',
  15279. 'this.BirdIntf = null;',
  15280. '']),
  15281. LinesToStr([ // $mod.$main
  15282. '$mod.BirdIntf.Walk(3);',
  15283. '$mod.BirdIntf.Walk$1(true);',
  15284. '$mod.BirdIntf.Fly("abc");',
  15285. '']));
  15286. end;
  15287. procedure TTestModule.TestClassInterface_AncestorMoreInterfaces;
  15288. begin
  15289. StartProgram(false);
  15290. Add([
  15291. '{$interfaces com}',
  15292. 'type',
  15293. ' IUnknown = interface',
  15294. ' function _AddRef: longint;',
  15295. ' procedure Walk;',
  15296. ' end;',
  15297. ' IBird = interface end;',
  15298. ' IDog = interface end;',
  15299. ' TObject = class(IBird,IDog)',
  15300. ' function _AddRef: longint; virtual; abstract;',
  15301. ' procedure Walk; virtual; abstract;',
  15302. ' end;',
  15303. ' TBird = class(IUnknown)',
  15304. ' end;',
  15305. 'begin',
  15306. '']);
  15307. ConvertProgram;
  15308. CheckSource('TestClassInterface_COM_AncestorLess',
  15309. LinesToStr([ // statements
  15310. 'rtl.createInterface($mod, "IUnknown", "{8F2D5841-758A-322B-BDDF-21CD521DD723}", ["_AddRef", "Walk"], null);',
  15311. 'rtl.createInterface($mod, "IBird", "{CCE11D4C-6504-3AEE-AE88-000B86AAE675}", [], $mod.IUnknown);',
  15312. 'rtl.createInterface($mod, "IDog", "{CCE11D4C-6504-3AEE-AE88-000B8E5FC675}", [], $mod.IUnknown);',
  15313. 'rtl.createClass($mod, "TObject", null, function () {',
  15314. ' this.$init = function () {',
  15315. ' };',
  15316. ' this.$final = function () {',
  15317. ' };',
  15318. ' rtl.addIntf(this, $mod.IBird);',
  15319. ' rtl.addIntf(this, $mod.IDog);',
  15320. '});',
  15321. 'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
  15322. ' rtl.addIntf(this, $mod.IUnknown);',
  15323. ' rtl.addIntf(this, $mod.IBird);',
  15324. ' rtl.addIntf(this, $mod.IDog);',
  15325. '});',
  15326. '']),
  15327. LinesToStr([ // $mod.$main
  15328. '']));
  15329. end;
  15330. procedure TTestModule.TestClassInterface_MethodOverride;
  15331. begin
  15332. StartProgram(false);
  15333. Add([
  15334. '{$interfaces corba}',
  15335. 'type',
  15336. ' IUnknown = interface',
  15337. ' [''{D6D98E5B-8A10-4FEC-856A-7BFC847FE74B}'']',
  15338. ' procedure Go;',
  15339. ' end;',
  15340. ' TObject = class(IUnknown)',
  15341. ' procedure Go; virtual; abstract;',
  15342. ' end;',
  15343. ' TBird = class',
  15344. ' procedure Go; override;',
  15345. ' end;',
  15346. ' TCat = class(TObject)',
  15347. ' procedure Go; override;',
  15348. ' end;',
  15349. ' TDog = class(TObject, IUnknown)',
  15350. ' procedure Go; override;',
  15351. ' end;',
  15352. 'procedure TBird.Go; begin end;',
  15353. 'procedure TCat.Go; begin end;',
  15354. 'procedure TDog.Go; begin end;',
  15355. 'begin',
  15356. '']);
  15357. ConvertProgram;
  15358. CheckSource('TestClassInterface_MethodOverride',
  15359. LinesToStr([ // statements
  15360. 'rtl.createInterface($mod, "IUnknown", "{D6D98E5B-8A10-4FEC-856A-7BFC847FE74B}", ["Go"], null);',
  15361. 'rtl.createClass($mod, "TObject", null, function () {',
  15362. ' this.$init = function () {',
  15363. ' };',
  15364. ' this.$final = function () {',
  15365. ' };',
  15366. ' rtl.addIntf(this, $mod.IUnknown);',
  15367. '});',
  15368. 'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
  15369. ' this.Go = function () {',
  15370. ' };',
  15371. ' rtl.addIntf(this, $mod.IUnknown);',
  15372. '});',
  15373. 'rtl.createClass($mod, "TCat", $mod.TObject, function () {',
  15374. ' this.Go = function () {',
  15375. ' };',
  15376. ' rtl.addIntf(this, $mod.IUnknown);',
  15377. '});',
  15378. 'rtl.createClass($mod, "TDog", $mod.TObject, function () {',
  15379. ' this.Go = function () {',
  15380. ' };',
  15381. ' rtl.addIntf(this, $mod.IUnknown);',
  15382. '});',
  15383. '']),
  15384. LinesToStr([ // $mod.$main
  15385. '']));
  15386. end;
  15387. procedure TTestModule.TestClassInterface_Corba_Delegation;
  15388. begin
  15389. StartProgram(false);
  15390. Add([
  15391. '{$interfaces corba}',
  15392. 'type',
  15393. ' IUnknown = interface',
  15394. ' end;',
  15395. ' IBird = interface(IUnknown)',
  15396. ' procedure Fly(s: string);',
  15397. ' end;',
  15398. ' IEagle = interface(IBird)',
  15399. ' end;',
  15400. ' IDove = interface(IBird)',
  15401. ' end;',
  15402. ' ISwallow = interface(IBird)',
  15403. ' end;',
  15404. ' TObject = class',
  15405. ' end;',
  15406. ' TBird = class(TObject,IBird,IEagle,IDove,ISwallow)',
  15407. ' procedure Fly(s: string); virtual; abstract;',
  15408. ' end;',
  15409. ' TBat = class(IBird,IEagle,IDove,ISwallow)',
  15410. ' FBirdIntf: IBird;',
  15411. ' property BirdIntf: IBird read FBirdIntf implements IBird;',
  15412. ' function GetEagleIntf: IEagle; virtual; abstract;',
  15413. ' property EagleIntf: IEagle read GetEagleIntf implements IEagle;',
  15414. ' FDoveObj: TBird;',
  15415. ' property DoveObj: TBird read FDoveObj implements IDove;',
  15416. ' function GetSwallowObj: TBird; virtual; abstract;',
  15417. ' property SwallowObj: TBird read GetSwallowObj implements ISwallow;',
  15418. ' end;',
  15419. 'begin',
  15420. '']);
  15421. ConvertProgram;
  15422. CheckSource('TestClassInterface_Delegation',
  15423. LinesToStr([ // statements
  15424. 'rtl.createInterface($mod, "IUnknown", "{B92D5841-758A-322B-B800-000000000000}", [], null);',
  15425. 'rtl.createInterface($mod, "IBird", "{478D080B-C0F6-396E-AE88-000B87785B07}", ["Fly"], $mod.IUnknown);',
  15426. 'rtl.createInterface($mod, "IEagle", "{489289DE-FDE2-34A6-8288-39119022B1B4}", [], $mod.IBird);',
  15427. 'rtl.createInterface($mod, "IDove", "{489289DE-FDE2-34A6-8288-39118EF16074}", [], $mod.IBird);',
  15428. 'rtl.createInterface($mod, "ISwallow", "{B89289DE-FDE2-34A6-8288-3911CBDCB359}", [], $mod.IBird);',
  15429. 'rtl.createClass($mod, "TObject", null, function () {',
  15430. ' this.$init = function () {',
  15431. ' };',
  15432. ' this.$final = function () {',
  15433. ' };',
  15434. '});',
  15435. 'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
  15436. ' rtl.addIntf(this, $mod.IBird);',
  15437. ' rtl.addIntf(this, $mod.IEagle);',
  15438. ' rtl.addIntf(this, $mod.IDove);',
  15439. ' rtl.addIntf(this, $mod.ISwallow);',
  15440. '});',
  15441. 'rtl.createClass($mod, "TBat", $mod.TObject, function () {',
  15442. ' this.$init = function () {',
  15443. ' $mod.TObject.$init.call(this);',
  15444. ' this.FBirdIntf = null;',
  15445. ' this.FDoveObj = null;',
  15446. ' };',
  15447. ' this.$final = function () {',
  15448. ' this.FBirdIntf = undefined;',
  15449. ' this.FDoveObj = undefined;',
  15450. ' $mod.TObject.$final.call(this);',
  15451. ' };',
  15452. ' this.$intfmaps = {',
  15453. ' "{478D080B-C0F6-396E-AE88-000B87785B07}": function () {',
  15454. ' return this.FBirdIntf;',
  15455. ' },',
  15456. ' "{489289DE-FDE2-34A6-8288-39119022B1B4}": function () {',
  15457. ' return this.GetEagleIntf();',
  15458. ' },',
  15459. ' "{489289DE-FDE2-34A6-8288-39118EF16074}": function () {',
  15460. ' return rtl.getIntfT(this.FDoveObj, $mod.IDove);',
  15461. ' },',
  15462. ' "{B89289DE-FDE2-34A6-8288-3911CBDCB359}": function () {',
  15463. ' return rtl.getIntfT(this.GetSwallowObj(), $mod.ISwallow);',
  15464. ' }',
  15465. ' };',
  15466. '});',
  15467. '']),
  15468. LinesToStr([ // $mod.$main
  15469. '']));
  15470. end;
  15471. procedure TTestModule.TestClassInterface_Corba_DelegationStatic;
  15472. begin
  15473. StartProgram(false);
  15474. Add([
  15475. '{$interfaces corba}',
  15476. 'type',
  15477. ' IUnknown = interface',
  15478. ' end;',
  15479. ' IBird = interface(IUnknown)',
  15480. ' procedure Fly(s: string);',
  15481. ' end;',
  15482. ' IEagle = interface(IBird)',
  15483. ' end;',
  15484. ' IDove = interface(IBird)',
  15485. ' end;',
  15486. ' ISwallow = interface(IBird)',
  15487. ' end;',
  15488. ' TObject = class',
  15489. ' end;',
  15490. ' TBird = class(TObject,IBird,IEagle,IDove,ISwallow)',
  15491. ' procedure Fly(s: string); virtual; abstract;',
  15492. ' end;',
  15493. ' TBat = class(IBird,IEagle,IDove,ISwallow)',
  15494. ' private',
  15495. ' class var FBirdIntf: IBird;',
  15496. ' class var FDoveObj: TBird;',
  15497. ' class function GetEagleIntf: IEagle; virtual; abstract;',
  15498. ' class function GetSwallowObj: TBird; virtual; abstract;',
  15499. ' protected',
  15500. ' class property BirdIntf: IBird read FBirdIntf implements IBird;',
  15501. ' class property EagleIntf: IEagle read GetEagleIntf implements IEagle;',
  15502. ' class property DoveObj: TBird read FDoveObj implements IDove;',
  15503. ' class property SwallowObj: TBird read GetSwallowObj implements ISwallow;',
  15504. ' end;',
  15505. 'begin',
  15506. '']);
  15507. ConvertProgram;
  15508. CheckSource('TestClassInterface_DelegationStatic',
  15509. LinesToStr([ // statements
  15510. 'rtl.createInterface($mod, "IUnknown", "{B92D5841-758A-322B-B800-000000000000}", [], null);',
  15511. 'rtl.createInterface($mod, "IBird", "{478D080B-C0F6-396E-AE88-000B87785B07}", ["Fly"], $mod.IUnknown);',
  15512. 'rtl.createInterface($mod, "IEagle", "{489289DE-FDE2-34A6-8288-39119022B1B4}", [], $mod.IBird);',
  15513. 'rtl.createInterface($mod, "IDove", "{489289DE-FDE2-34A6-8288-39118EF16074}", [], $mod.IBird);',
  15514. 'rtl.createInterface($mod, "ISwallow", "{B89289DE-FDE2-34A6-8288-3911CBDCB359}", [], $mod.IBird);',
  15515. 'rtl.createClass($mod, "TObject", null, function () {',
  15516. ' this.$init = function () {',
  15517. ' };',
  15518. ' this.$final = function () {',
  15519. ' };',
  15520. '});',
  15521. 'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
  15522. ' rtl.addIntf(this, $mod.IBird);',
  15523. ' rtl.addIntf(this, $mod.IEagle);',
  15524. ' rtl.addIntf(this, $mod.IDove);',
  15525. ' rtl.addIntf(this, $mod.ISwallow);',
  15526. '});',
  15527. 'rtl.createClass($mod, "TBat", $mod.TObject, function () {',
  15528. ' this.FBirdIntf = null;',
  15529. ' this.FDoveObj = null;',
  15530. ' this.$intfmaps = {',
  15531. ' "{478D080B-C0F6-396E-AE88-000B87785B07}": function () {',
  15532. ' return this.FBirdIntf;',
  15533. ' },',
  15534. ' "{489289DE-FDE2-34A6-8288-39119022B1B4}": function () {',
  15535. ' return this.$class.GetEagleIntf();',
  15536. ' },',
  15537. ' "{489289DE-FDE2-34A6-8288-39118EF16074}": function () {',
  15538. ' return rtl.getIntfT(this.FDoveObj, $mod.IDove);',
  15539. ' },',
  15540. ' "{B89289DE-FDE2-34A6-8288-3911CBDCB359}": function () {',
  15541. ' return rtl.getIntfT(this.$class.GetSwallowObj(), $mod.ISwallow);',
  15542. ' }',
  15543. ' };',
  15544. '});',
  15545. '']),
  15546. LinesToStr([ // $mod.$main
  15547. '']));
  15548. end;
  15549. procedure TTestModule.TestClassInterface_Corba_Operators;
  15550. begin
  15551. StartProgram(false);
  15552. Add([
  15553. '{$interfaces corba}',
  15554. 'type',
  15555. ' IUnknown = interface',
  15556. ' end;',
  15557. ' IBird = interface(IUnknown)',
  15558. ' function GetItems(Index: longint): longint;',
  15559. ' procedure SetItems(Index: longint; Value: longint);',
  15560. ' property Items[Index: longint]: longint read GetItems write SetItems; default;',
  15561. ' end;',
  15562. ' TObject = class',
  15563. ' end;',
  15564. ' TBird = class(TObject,IBird)',
  15565. ' function GetItems(Index: longint): longint; virtual; abstract;',
  15566. ' procedure SetItems(Index: longint; Value: longint); virtual; abstract;',
  15567. ' end;',
  15568. 'var',
  15569. ' IntfVar: IBird = nil;',
  15570. ' IntfVar2: IBird;',
  15571. ' ObjVar: TBird;',
  15572. ' v: JSValue;',
  15573. 'begin',
  15574. ' IntfVar:=nil;',
  15575. ' IntfVar[3]:=IntfVar[4];',
  15576. ' if Assigned(IntfVar) then ;',
  15577. ' IntfVar:=IntfVar2;',
  15578. ' IntfVar:=ObjVar;',
  15579. ' if IntfVar=IntfVar2 then ;',
  15580. ' if IntfVar<>IntfVar2 then ;',
  15581. ' if IntfVar is IBird then ;',
  15582. ' if IntfVar is TBird then ;',
  15583. ' if ObjVar is IBird then ;',
  15584. ' IntfVar:=IntfVar2 as IBird;',
  15585. ' ObjVar:=IntfVar2 as TBird;',
  15586. ' IntfVar:=ObjVar as IBird;',
  15587. ' IntfVar:=IBird(IntfVar2);',
  15588. ' ObjVar:=TBird(IntfVar);',
  15589. ' IntfVar:=IBird(ObjVar);',
  15590. ' v:=IntfVar;',
  15591. ' IntfVar:=IBird(v);',
  15592. ' if v is IBird then ;',
  15593. ' v:=JSValue(IntfVar);',
  15594. ' v:=IBird;',
  15595. '']);
  15596. ConvertProgram;
  15597. CheckSource('TestClassInterface_Corba_Operators',
  15598. LinesToStr([ // statements
  15599. 'rtl.createInterface($mod, "IUnknown", "{B92D5841-758A-322B-B800-000000000000}", [], null);',
  15600. 'rtl.createInterface($mod, "IBird", "{D53FED90-DE59-3202-B1AE-000B87785B08}", ["GetItems", "SetItems"], $mod.IUnknown);',
  15601. 'rtl.createClass($mod, "TObject", null, function () {',
  15602. ' this.$init = function () {',
  15603. ' };',
  15604. ' this.$final = function () {',
  15605. ' };',
  15606. '});',
  15607. 'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
  15608. ' rtl.addIntf(this, $mod.IBird);',
  15609. '});',
  15610. 'this.IntfVar = null;',
  15611. 'this.IntfVar2 = null;',
  15612. 'this.ObjVar = null;',
  15613. 'this.v = undefined;',
  15614. '']),
  15615. LinesToStr([ // $mod.$main
  15616. '$mod.IntfVar = null;',
  15617. '$mod.IntfVar.SetItems(3, $mod.IntfVar.GetItems(4));',
  15618. 'if ($mod.IntfVar != null) ;',
  15619. '$mod.IntfVar = $mod.IntfVar2;',
  15620. '$mod.IntfVar = rtl.getIntfT($mod.ObjVar,$mod.IBird);',
  15621. 'if ($mod.IntfVar === $mod.IntfVar2) ;',
  15622. 'if ($mod.IntfVar !== $mod.IntfVar2) ;',
  15623. 'if ($mod.IBird.isPrototypeOf($mod.IntfVar)) ;',
  15624. 'if (rtl.intfIsClass($mod.IntfVar, $mod.TBird)) ;',
  15625. 'if (rtl.getIntfT($mod.ObjVar, $mod.IBird) !== null) ;',
  15626. '$mod.IntfVar = rtl.as($mod.IntfVar2, $mod.IBird);',
  15627. '$mod.ObjVar = rtl.intfAsClass($mod.IntfVar2, $mod.TBird);',
  15628. '$mod.IntfVar = rtl.getIntfT($mod.ObjVar, $mod.IBird);',
  15629. '$mod.IntfVar = $mod.IntfVar2;',
  15630. '$mod.ObjVar = rtl.intfToClass($mod.IntfVar, $mod.TBird);',
  15631. '$mod.IntfVar = rtl.getIntfT($mod.ObjVar, $mod.IBird);',
  15632. '$mod.v = $mod.IntfVar;',
  15633. '$mod.IntfVar = rtl.getObject($mod.v);',
  15634. 'if (rtl.isExt($mod.v, $mod.IBird, 1)) ;',
  15635. '$mod.v = rtl.getObject($mod.IntfVar);',
  15636. '$mod.v = $mod.IBird;',
  15637. '']));
  15638. end;
  15639. procedure TTestModule.TestClassInterface_Corba_Args;
  15640. begin
  15641. StartProgram(false);
  15642. Add([
  15643. '{$interfaces corba}',
  15644. 'type',
  15645. ' IUnknown = interface',
  15646. ' end;',
  15647. ' IBird = interface(IUnknown)',
  15648. ' end;',
  15649. ' TObject = class',
  15650. ' end;',
  15651. ' TBird = class(TObject,IBird)',
  15652. ' end;',
  15653. 'procedure DoIt(var u; i: IBird; const j: IBird);',
  15654. 'begin',
  15655. ' DoIt(i,i,i);',
  15656. 'end;',
  15657. 'procedure Change(var i: IBird; out j: IBird);',
  15658. 'begin',
  15659. ' DoIt(i,i,i);',
  15660. ' Change(i,i);',
  15661. 'end;',
  15662. 'var',
  15663. ' i: IBird;',
  15664. ' o: TBird;',
  15665. 'begin',
  15666. ' DoIt(i,i,i);',
  15667. ' Change(i,i);',
  15668. ' DoIt(o,o,o);',
  15669. '']);
  15670. ConvertProgram;
  15671. CheckSource('TestClassInterface_Corba_Args',
  15672. LinesToStr([ // statements
  15673. 'rtl.createInterface($mod, "IUnknown", "{B92D5841-758A-322B-B800-000000000000}", [], null);',
  15674. 'rtl.createInterface($mod, "IBird", "{4B0D080B-C0F6-396E-AE88-000B87785074}", [], $mod.IUnknown);',
  15675. 'rtl.createClass($mod, "TObject", null, function () {',
  15676. ' this.$init = function () {',
  15677. ' };',
  15678. ' this.$final = function () {',
  15679. ' };',
  15680. '});',
  15681. 'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
  15682. ' rtl.addIntf(this, $mod.IBird);',
  15683. '});',
  15684. 'this.DoIt = function (u, i, j) {',
  15685. ' $mod.DoIt({',
  15686. ' get: function () {',
  15687. ' return i;',
  15688. ' },',
  15689. ' set: function (v) {',
  15690. ' i = v;',
  15691. ' }',
  15692. ' }, i, i);',
  15693. '};',
  15694. 'this.Change = function (i, j) {',
  15695. ' $mod.DoIt(i, i.get(), i.get());',
  15696. ' $mod.Change(i, i);',
  15697. '};',
  15698. 'this.i = null;',
  15699. 'this.o = null;',
  15700. '']),
  15701. LinesToStr([ // $mod.$main
  15702. '$mod.DoIt({',
  15703. ' p: $mod,',
  15704. ' get: function () {',
  15705. ' return this.p.i;',
  15706. ' },',
  15707. ' set: function (v) {',
  15708. ' this.p.i = v;',
  15709. ' }',
  15710. '}, $mod.i, $mod.i);',
  15711. '$mod.Change({',
  15712. ' p: $mod,',
  15713. ' get: function () {',
  15714. ' return this.p.i;',
  15715. ' },',
  15716. ' set: function (v) {',
  15717. ' this.p.i = v;',
  15718. ' }',
  15719. '}, {',
  15720. ' p: $mod,',
  15721. ' get: function () {',
  15722. ' return this.p.i;',
  15723. ' },',
  15724. ' set: function (v) {',
  15725. ' this.p.i = v;',
  15726. ' }',
  15727. '});',
  15728. '$mod.DoIt({',
  15729. ' p: $mod,',
  15730. ' get: function () {',
  15731. ' return this.p.o;',
  15732. ' },',
  15733. ' set: function (v) {',
  15734. ' this.p.o = v;',
  15735. ' }',
  15736. '}, rtl.getIntfT($mod.o, $mod.IBird), rtl.getIntfT($mod.o, $mod.IBird));',
  15737. '']));
  15738. end;
  15739. procedure TTestModule.TestClassInterface_Corba_ForIn;
  15740. begin
  15741. StartProgram(false);
  15742. Add([
  15743. '{$interfaces corba}',
  15744. 'type',
  15745. ' IUnknown = interface end;',
  15746. ' TObject = class',
  15747. ' Id: longint;',
  15748. ' end;',
  15749. ' IEnumerator = interface(IUnknown)',
  15750. ' function GetCurrent: TObject;',
  15751. ' function MoveNext: Boolean;',
  15752. ' property Current: TObject read GetCurrent;',
  15753. ' end;',
  15754. ' IEnumerable = interface(IUnknown)',
  15755. ' function GetEnumerator: IEnumerator;',
  15756. ' end;',
  15757. 'var',
  15758. ' o: TObject;',
  15759. ' i: IEnumerable;',
  15760. 'begin',
  15761. ' for o in i do o.Id:=3;',
  15762. '']);
  15763. ConvertProgram;
  15764. CheckSource('TestClassInterface_Corba_ForIn',
  15765. LinesToStr([ // statements
  15766. 'rtl.createInterface($mod, "IUnknown", "{B92D5841-758A-322B-B800-000000000000}", [], null);',
  15767. 'rtl.createClass($mod, "TObject", null, function () {',
  15768. ' this.$init = function () {',
  15769. ' this.Id = 0;',
  15770. ' };',
  15771. ' this.$final = function () {',
  15772. ' };',
  15773. '});',
  15774. 'rtl.createInterface($mod, "IEnumerator", "{95D7745D-ED61-3F13-BBE4-07708161999E}", ["GetCurrent", "MoveNext"], $mod.IUnknown);',
  15775. 'rtl.createInterface($mod, "IEnumerable", "{8CC9D45D-ED7D-3B73-96B6-290B931BB19E}", ["GetEnumerator"], $mod.IUnknown);',
  15776. 'this.o = null;',
  15777. 'this.i = null;',
  15778. '']),
  15779. LinesToStr([ // $mod.$main
  15780. 'var $in1 = $mod.i.GetEnumerator();',
  15781. 'while ($in1.MoveNext()) {',
  15782. ' $mod.o = $in1.GetCurrent();',
  15783. ' $mod.o.Id = 3;',
  15784. '};',
  15785. '']));
  15786. end;
  15787. procedure TTestModule.TestClassInterface_COM_AssignVar;
  15788. begin
  15789. StartProgram(false);
  15790. Add([
  15791. '{$interfaces com}',
  15792. 'type',
  15793. ' IUnknown = interface',
  15794. ' function _AddRef: longint;',
  15795. ' function _Release: longint;',
  15796. ' end;',
  15797. ' TObject = class(IUnknown)',
  15798. ' function _AddRef: longint; virtual; abstract;',
  15799. ' function _Release: longint; virtual; abstract;',
  15800. ' end;',
  15801. 'var',
  15802. ' i: IUnknown;',
  15803. 'procedure DoGlobal(o: TObject);',
  15804. 'begin',
  15805. ' i:=nil;',
  15806. ' i:=o;',
  15807. ' i:=i;',
  15808. 'end;',
  15809. 'procedure DoLocal(o: TObject);',
  15810. 'const k: IUnknown = nil;',
  15811. 'var j: IUnknown;',
  15812. 'begin',
  15813. ' k:=o;',
  15814. ' k:=i;',
  15815. ' j:=o;',
  15816. ' j:=i;',
  15817. 'end;',
  15818. 'var o: TObject;',
  15819. 'begin',
  15820. ' i:=nil;',
  15821. ' i:=o;',
  15822. '']);
  15823. ConvertProgram;
  15824. CheckSource('TestClassInterface_COM_AssignVar',
  15825. LinesToStr([ // statements
  15826. 'rtl.createInterface($mod, "IUnknown", "{D7ADB0E1-758A-322B-BDDF-21CD521DDFA9}", ["_AddRef", "_Release"], null);',
  15827. 'rtl.createClass($mod, "TObject", null, function () {',
  15828. ' this.$init = function () {',
  15829. ' };',
  15830. ' this.$final = function () {',
  15831. ' };',
  15832. ' rtl.addIntf(this, $mod.IUnknown);',
  15833. '});',
  15834. 'this.i = null;',
  15835. 'this.DoGlobal = function (o) {',
  15836. ' rtl.setIntfP($mod, "i", null);',
  15837. ' rtl.setIntfP($mod, "i", rtl.queryIntfT(o, $mod.IUnknown), true);',
  15838. ' rtl.setIntfP($mod, "i", $mod.i);',
  15839. '};',
  15840. 'var k = null;',
  15841. 'this.DoLocal = function (o) {',
  15842. ' var j = null;',
  15843. ' try{',
  15844. ' k = rtl.setIntfL(k, rtl.queryIntfT(o, $mod.IUnknown), true);',
  15845. ' k = rtl.setIntfL(k, $mod.i);',
  15846. ' j = rtl.setIntfL(j, rtl.queryIntfT(o, $mod.IUnknown), true);',
  15847. ' j = rtl.setIntfL(j, $mod.i);',
  15848. ' }finally{',
  15849. ' rtl._Release(j);',
  15850. ' };',
  15851. '};',
  15852. 'this.o = null;',
  15853. '']),
  15854. LinesToStr([ // $mod.$main
  15855. 'rtl.setIntfP($mod, "i", null);',
  15856. 'rtl.setIntfP($mod, "i", rtl.queryIntfT($mod.o, $mod.IUnknown), true);',
  15857. '']));
  15858. end;
  15859. procedure TTestModule.TestClassInterface_COM_AssignArg;
  15860. begin
  15861. StartProgram(false);
  15862. Add([
  15863. '{$interfaces com}',
  15864. 'type',
  15865. ' IUnknown = interface',
  15866. ' function _AddRef: longint;',
  15867. ' function _Release: longint;',
  15868. ' end;',
  15869. ' TObject = class(IUnknown)',
  15870. ' function _AddRef: longint; virtual; abstract;',
  15871. ' function _Release: longint; virtual; abstract;',
  15872. ' end;',
  15873. 'procedure DoDefault(i, j: IUnknown);',
  15874. 'begin',
  15875. ' i:=nil;',
  15876. ' i:=j;',
  15877. 'end;',
  15878. 'begin',
  15879. '']);
  15880. ConvertProgram;
  15881. CheckSource('TestClassInterface_COM_AssignArg',
  15882. LinesToStr([ // statements
  15883. 'rtl.createInterface($mod, "IUnknown", "{D7ADB0E1-758A-322B-BDDF-21CD521DDFA9}", ["_AddRef", "_Release"], null);',
  15884. 'rtl.createClass($mod, "TObject", null, function () {',
  15885. ' this.$init = function () {',
  15886. ' };',
  15887. ' this.$final = function () {',
  15888. ' };',
  15889. ' rtl.addIntf(this, $mod.IUnknown);',
  15890. '});',
  15891. 'this.DoDefault = function (i, j) {',
  15892. ' rtl._AddRef(i);',
  15893. ' try {',
  15894. ' i = rtl.setIntfL(i, null);',
  15895. ' i = rtl.setIntfL(i, j);',
  15896. ' } finally {',
  15897. ' rtl._Release(i);',
  15898. ' };',
  15899. '};',
  15900. '']),
  15901. LinesToStr([ // $mod.$main
  15902. '']));
  15903. end;
  15904. procedure TTestModule.TestClassInterface_COM_FunctionResult;
  15905. begin
  15906. StartProgram(false);
  15907. Add([
  15908. '{$interfaces com}',
  15909. 'type',
  15910. ' IUnknown = interface',
  15911. ' function _AddRef: longint;',
  15912. ' function _Release: longint;',
  15913. ' end;',
  15914. ' TObject = class(IUnknown)',
  15915. ' function _AddRef: longint; virtual; abstract;',
  15916. ' function _Release: longint; virtual; abstract;',
  15917. ' end;',
  15918. 'function DoDefault(i: IUnknown): IUnknown;',
  15919. 'begin',
  15920. ' Result:=i;',
  15921. ' if Result<>nil then exit;',
  15922. 'end;',
  15923. 'begin',
  15924. '']);
  15925. ConvertProgram;
  15926. CheckSource('TestClassInterface_COM_FunctionResult',
  15927. LinesToStr([ // statements
  15928. 'rtl.createInterface($mod, "IUnknown", "{D7ADB0E1-758A-322B-BDDF-21CD521DDFA9}", ["_AddRef", "_Release"], null);',
  15929. 'rtl.createClass($mod, "TObject", null, function () {',
  15930. ' this.$init = function () {',
  15931. ' };',
  15932. ' this.$final = function () {',
  15933. ' };',
  15934. ' rtl.addIntf(this, $mod.IUnknown);',
  15935. '});',
  15936. 'this.DoDefault = function (i) {',
  15937. ' var Result = null;',
  15938. ' var $ok = false;',
  15939. ' try {',
  15940. ' Result = rtl.setIntfL(Result, i);',
  15941. ' if(Result !== null){',
  15942. ' $ok = true;',
  15943. ' return Result;',
  15944. ' };',
  15945. ' $ok = true;',
  15946. ' } finally {',
  15947. ' if(!$ok) rtl._Release(Result);',
  15948. ' };',
  15949. ' return Result;',
  15950. '};',
  15951. '']),
  15952. LinesToStr([ // $mod.$main
  15953. '']));
  15954. end;
  15955. procedure TTestModule.TestClassInterface_COM_InheritedFuncResult;
  15956. begin
  15957. StartProgram(false);
  15958. Add([
  15959. '{$interfaces com}',
  15960. 'type',
  15961. ' IUnknown = interface',
  15962. ' function _AddRef: longint;',
  15963. ' function _Release: longint;',
  15964. ' end;',
  15965. ' TObject = class(IUnknown)',
  15966. ' function _AddRef: longint; virtual; abstract;',
  15967. ' function _Release: longint; virtual; abstract;',
  15968. ' function GetIntf: IUnknown; virtual;',
  15969. ' end;',
  15970. ' TMouse = class',
  15971. ' function GetIntf: IUnknown; override;',
  15972. ' end;',
  15973. 'function TObject.GetIntf: IUnknown; begin end;',
  15974. 'function TMouse.GetIntf: IUnknown;',
  15975. 'var i: IUnknown;',
  15976. 'begin',
  15977. ' inherited;',
  15978. ' inherited GetIntf;',
  15979. ' inherited GetIntf();',
  15980. ' Result:=inherited GetIntf;',
  15981. ' Result:=inherited GetIntf();',
  15982. ' i:=inherited GetIntf;',
  15983. ' i:=inherited GetIntf();',
  15984. 'end;',
  15985. 'begin',
  15986. '']);
  15987. ConvertProgram;
  15988. CheckSource('TestClassInterface_COM_InheritedFuncResult',
  15989. LinesToStr([ // statements
  15990. 'rtl.createInterface($mod, "IUnknown", "{D7ADB0E1-758A-322B-BDDF-21CD521DDFA9}", ["_AddRef", "_Release"], null);',
  15991. 'rtl.createClass($mod, "TObject", null, function () {',
  15992. ' this.$init = function () {',
  15993. ' };',
  15994. ' this.$final = function () {',
  15995. ' };',
  15996. ' this.GetIntf = function () {',
  15997. ' var Result = null;',
  15998. ' return Result;',
  15999. ' };',
  16000. ' rtl.addIntf(this, $mod.IUnknown);',
  16001. '});',
  16002. 'rtl.createClass($mod, "TMouse", $mod.TObject, function () {',
  16003. ' this.GetIntf = function () {',
  16004. ' var Result = null;',
  16005. ' var i = null;',
  16006. ' var $ir = rtl.createIntfRefs();',
  16007. ' var $ok = false;',
  16008. ' try {',
  16009. ' $ir.ref(1, $mod.TObject.GetIntf.apply(this, arguments));',
  16010. ' $ir.ref(2, $mod.TObject.GetIntf.call(this));',
  16011. ' $ir.ref(3, $mod.TObject.GetIntf.call(this));',
  16012. ' Result = rtl.setIntfL(Result, $mod.TObject.GetIntf.call(this), true);',
  16013. ' Result = rtl.setIntfL(Result, $mod.TObject.GetIntf.call(this), true);',
  16014. ' i = rtl.setIntfL(i, $mod.TObject.GetIntf.call(this), true);',
  16015. ' i = rtl.setIntfL(i, $mod.TObject.GetIntf.call(this), true);',
  16016. ' $ok = true;',
  16017. ' } finally {',
  16018. ' $ir.free();',
  16019. ' rtl._Release(i);',
  16020. ' if (!$ok) rtl._Release(Result);',
  16021. ' };',
  16022. ' return Result;',
  16023. ' };',
  16024. ' rtl.addIntf(this, $mod.IUnknown);',
  16025. '});',
  16026. '']),
  16027. LinesToStr([ // $mod.$main
  16028. '']));
  16029. end;
  16030. procedure TTestModule.TestClassInterface_COM_IsAsTypeCasts;
  16031. begin
  16032. StartProgram(false);
  16033. Add([
  16034. '{$interfaces com}',
  16035. 'type',
  16036. ' IUnknown = interface',
  16037. ' function _AddRef: longint;',
  16038. ' function _Release: longint;',
  16039. ' end;',
  16040. ' TObject = class(IUnknown)',
  16041. ' function _AddRef: longint; virtual; abstract;',
  16042. ' function _Release: longint; virtual; abstract;',
  16043. ' end;',
  16044. 'procedure DoDefault(i, j: IUnknown; o: TObject);',
  16045. 'begin',
  16046. ' if i is IUnknown then ;',
  16047. ' if o is IUnknown then ;',
  16048. ' if i is TObject then ;',
  16049. ' i:=j as IUnknown;',
  16050. ' i:=o as IUnknown;',
  16051. ' o:=j as TObject;',
  16052. ' i:=IUnknown(j);',
  16053. ' i:=IUnknown(o);',
  16054. ' o:=TObject(i);',
  16055. 'end;',
  16056. 'begin',
  16057. '']);
  16058. ConvertProgram;
  16059. CheckSource('TestClassInterface_COM_IsAsTypeCasts',
  16060. LinesToStr([ // statements
  16061. 'rtl.createInterface($mod, "IUnknown", "{D7ADB0E1-758A-322B-BDDF-21CD521DDFA9}", ["_AddRef", "_Release"], null);',
  16062. 'rtl.createClass($mod, "TObject", null, function () {',
  16063. ' this.$init = function () {',
  16064. ' };',
  16065. ' this.$final = function () {',
  16066. ' };',
  16067. ' rtl.addIntf(this, $mod.IUnknown);',
  16068. '});',
  16069. 'this.DoDefault = function (i, j, o) {',
  16070. ' rtl._AddRef(i);',
  16071. ' try {',
  16072. ' if ($mod.IUnknown.isPrototypeOf(i)) ;',
  16073. ' if (rtl.queryIntfIsT(o, $mod.IUnknown)) ;',
  16074. ' if (rtl.intfIsClass(i, $mod.TObject)) ;',
  16075. ' i = rtl.setIntfL(i, rtl.as(j, $mod.IUnknown));',
  16076. ' i = rtl.setIntfL(i, rtl.queryIntfT(o, $mod.IUnknown), true);',
  16077. ' o = rtl.intfAsClass(j, $mod.TObject);',
  16078. ' i = rtl.setIntfL(i, j);',
  16079. ' i = rtl.setIntfL(i, rtl.queryIntfT(o, $mod.IUnknown), true);',
  16080. ' o = rtl.intfToClass(i, $mod.TObject);',
  16081. ' } finally {',
  16082. ' rtl._Release(i);',
  16083. ' };',
  16084. '};',
  16085. '']),
  16086. LinesToStr([ // $mod.$main
  16087. '']));
  16088. end;
  16089. procedure TTestModule.TestClassInterface_COM_PassAsArg;
  16090. begin
  16091. StartProgram(false);
  16092. Add([
  16093. '{$interfaces com}',
  16094. 'type',
  16095. ' IUnknown = interface',
  16096. ' function _AddRef: longint;',
  16097. ' function _Release: longint;',
  16098. ' end;',
  16099. ' TObject = class(IUnknown)',
  16100. ' function _AddRef: longint; virtual; abstract;',
  16101. ' function _Release: longint; virtual; abstract;',
  16102. ' end;',
  16103. 'procedure DoIt(v: IUnknown; const j: IUnknown; var k: IUnknown; out l: IUnknown);',
  16104. 'var o: TObject;',
  16105. 'begin',
  16106. ' DoIt(v,v,v,v);',
  16107. ' DoIt(o,o,k,k);',
  16108. 'end;',
  16109. 'procedure DoSome;',
  16110. 'var v: IUnknown;',
  16111. 'begin',
  16112. ' DoIt(v,v,v,v);',
  16113. 'end;',
  16114. 'var i: IUnknown;',
  16115. 'begin',
  16116. ' DoIt(i,i,i,i);',
  16117. '']);
  16118. ConvertProgram;
  16119. CheckSource('TestClassInterface_COM_PassAsArg',
  16120. LinesToStr([ // statements
  16121. 'rtl.createInterface($mod, "IUnknown", "{D7ADB0E1-758A-322B-BDDF-21CD521DDFA9}", ["_AddRef", "_Release"], null);',
  16122. 'rtl.createClass($mod, "TObject", null, function () {',
  16123. ' this.$init = function () {',
  16124. ' };',
  16125. ' this.$final = function () {',
  16126. ' };',
  16127. ' rtl.addIntf(this, $mod.IUnknown);',
  16128. '});',
  16129. 'this.DoIt = function (v, j, k, l) {',
  16130. ' var o = null;',
  16131. ' var $ir = rtl.createIntfRefs();',
  16132. ' rtl._AddRef(v);',
  16133. ' try {',
  16134. ' $mod.DoIt(v, v, {',
  16135. ' get: function () {',
  16136. ' return v;',
  16137. ' },',
  16138. ' set: function (w) {',
  16139. ' v = rtl.setIntfL(v, w);',
  16140. ' }',
  16141. ' }, {',
  16142. ' get: function () {',
  16143. ' return v;',
  16144. ' },',
  16145. ' set: function (w) {',
  16146. ' v = rtl.setIntfL(v, w);',
  16147. ' }',
  16148. ' });',
  16149. ' $mod.DoIt($ir.ref(1, rtl.queryIntfT(o, $mod.IUnknown)), $ir.ref(2, rtl.queryIntfT(o, $mod.IUnknown)), k, k);',
  16150. ' } finally {',
  16151. ' $ir.free();',
  16152. ' rtl._Release(v);',
  16153. ' };',
  16154. '};',
  16155. 'this.DoSome = function () {',
  16156. ' var v = null;',
  16157. ' try {',
  16158. ' $mod.DoIt(v, v, {',
  16159. ' get: function () {',
  16160. ' return v;',
  16161. ' },',
  16162. ' set: function (w) {',
  16163. ' v = rtl.setIntfL(v, w);',
  16164. ' }',
  16165. ' }, {',
  16166. ' get: function () {',
  16167. ' return v;',
  16168. ' },',
  16169. ' set: function (w) {',
  16170. ' v = rtl.setIntfL(v, w);',
  16171. ' }',
  16172. ' });',
  16173. ' } finally {',
  16174. ' rtl._Release(v);',
  16175. ' };',
  16176. '};',
  16177. 'this.i = null;',
  16178. '']),
  16179. LinesToStr([ // $mod.$main
  16180. '$mod.DoIt($mod.i, $mod.i, {',
  16181. ' p: $mod,',
  16182. ' get: function () {',
  16183. ' return this.p.i;',
  16184. ' },',
  16185. ' set: function (v) {',
  16186. ' rtl.setIntfP(this.p, "i", v);',
  16187. ' }',
  16188. '}, {',
  16189. ' p: $mod,',
  16190. ' get: function () {',
  16191. ' return this.p.i;',
  16192. ' },',
  16193. ' set: function (v) {',
  16194. ' rtl.setIntfP(this.p, "i", v);',
  16195. ' }',
  16196. '});',
  16197. '']));
  16198. end;
  16199. procedure TTestModule.TestClassInterface_COM_PassToUntypedParam;
  16200. begin
  16201. StartProgram(false);
  16202. Add([
  16203. '{$interfaces com}',
  16204. 'type',
  16205. ' IUnknown = interface',
  16206. ' function _AddRef: longint;',
  16207. ' function _Release: longint;',
  16208. ' end;',
  16209. ' TObject = class(IUnknown)',
  16210. ' function _AddRef: longint; virtual; abstract;',
  16211. ' function _Release: longint; virtual; abstract;',
  16212. ' end;',
  16213. 'procedure DoIt(out i);',
  16214. 'begin end;',
  16215. 'procedure DoSome;',
  16216. 'var v: IUnknown;',
  16217. 'begin',
  16218. ' DoIt(v);',
  16219. 'end;',
  16220. 'function GetIt: IUnknown;',
  16221. 'begin',
  16222. ' DoIt(Result);',
  16223. 'end;',
  16224. 'var i: IUnknown;',
  16225. 'begin',
  16226. ' DoIt(i);',
  16227. '']);
  16228. ConvertProgram;
  16229. CheckSource('TestClassInterface_COM_PassToUntypedParam',
  16230. LinesToStr([ // statements
  16231. 'rtl.createInterface($mod, "IUnknown", "{D7ADB0E1-758A-322B-BDDF-21CD521DDFA9}", ["_AddRef", "_Release"], null);',
  16232. 'rtl.createClass($mod, "TObject", null, function () {',
  16233. ' this.$init = function () {',
  16234. ' };',
  16235. ' this.$final = function () {',
  16236. ' };',
  16237. ' rtl.addIntf(this, $mod.IUnknown);',
  16238. '});',
  16239. 'this.DoIt = function (i) {',
  16240. '};',
  16241. 'this.DoSome = function () {',
  16242. ' var v = null;',
  16243. ' try {',
  16244. ' $mod.DoIt({',
  16245. ' get: function () {',
  16246. ' return v;',
  16247. ' },',
  16248. ' set: function (w) {',
  16249. ' v = w;',
  16250. ' }',
  16251. ' });',
  16252. ' } finally {',
  16253. ' rtl._Release(v);',
  16254. ' };',
  16255. '};',
  16256. 'this.GetIt = function () {',
  16257. ' var Result = null;',
  16258. ' var $ok = false;',
  16259. ' try {',
  16260. ' $mod.DoIt({',
  16261. ' get: function () {',
  16262. ' return Result;',
  16263. ' },',
  16264. ' set: function (v) {',
  16265. ' Result = v;',
  16266. ' }',
  16267. ' });',
  16268. ' $ok = true;',
  16269. ' } finally {',
  16270. ' if (!$ok) rtl._Release(Result);',
  16271. ' };',
  16272. ' return Result;',
  16273. '};',
  16274. 'this.i = null;',
  16275. '']),
  16276. LinesToStr([ // $mod.$main
  16277. 'try {',
  16278. ' $mod.DoIt({',
  16279. ' p: $mod,',
  16280. ' get: function () {',
  16281. ' return this.p.i;',
  16282. ' },',
  16283. ' set: function (v) {',
  16284. ' this.p.i = v;',
  16285. ' }',
  16286. ' });',
  16287. '} finally {',
  16288. ' rtl._Release($mod.i);',
  16289. '};',
  16290. '']));
  16291. end;
  16292. procedure TTestModule.TestClassInterface_COM_FunctionInExpr;
  16293. begin
  16294. StartProgram(false);
  16295. Add([
  16296. '{$interfaces com}',
  16297. 'type',
  16298. ' IUnknown = interface',
  16299. ' function _AddRef: longint;',
  16300. ' function _Release: longint;',
  16301. ' end;',
  16302. ' TObject = class(IUnknown)',
  16303. ' function _AddRef: longint; virtual; abstract;',
  16304. ' function _Release: longint; virtual; abstract;',
  16305. ' end;',
  16306. 'function GetIt: IUnknown;',
  16307. 'begin',
  16308. 'end;',
  16309. 'procedure DoSome;',
  16310. 'var v: IUnknown;',
  16311. ' i: longint;',
  16312. 'begin',
  16313. ' v:=GetIt;',
  16314. ' v:=GetIt();',
  16315. ' GetIt()._AddRef;',
  16316. ' i:=GetIt()._AddRef;',
  16317. 'end;',
  16318. 'var v: IUnknown;',
  16319. ' i: longint;',
  16320. 'begin',
  16321. ' v:=GetIt;',
  16322. ' v:=GetIt();',
  16323. ' GetIt()._AddRef;',
  16324. ' i:=GetIt()._AddRef;',
  16325. '']);
  16326. ConvertProgram;
  16327. CheckSource('TestClassInterface_COM_FunctionInExpr',
  16328. LinesToStr([ // statements
  16329. 'rtl.createInterface($mod, "IUnknown", "{D7ADB0E1-758A-322B-BDDF-21CD521DDFA9}", ["_AddRef", "_Release"], null);',
  16330. 'rtl.createClass($mod, "TObject", null, function () {',
  16331. ' this.$init = function () {',
  16332. ' };',
  16333. ' this.$final = function () {',
  16334. ' };',
  16335. ' rtl.addIntf(this, $mod.IUnknown);',
  16336. '});',
  16337. 'this.GetIt = function () {',
  16338. ' var Result = null;',
  16339. ' return Result;',
  16340. '};',
  16341. 'this.DoSome = function () {',
  16342. ' var v = null;',
  16343. ' var i = 0;',
  16344. ' var $ir = rtl.createIntfRefs();',
  16345. ' try {',
  16346. ' v = rtl.setIntfL(v, $mod.GetIt(), true);',
  16347. ' v = rtl.setIntfL(v, $mod.GetIt(), true);',
  16348. ' $ir.ref(1, $mod.GetIt())._AddRef();',
  16349. ' i = $ir.ref(2, $mod.GetIt())._AddRef();',
  16350. ' } finally {',
  16351. ' $ir.free();',
  16352. ' rtl._Release(v);',
  16353. ' };',
  16354. '};',
  16355. 'this.v = null;',
  16356. 'this.i = 0;',
  16357. '']),
  16358. LinesToStr([ // $mod.$main
  16359. 'var $ir = rtl.createIntfRefs();',
  16360. 'try {',
  16361. ' rtl.setIntfP($mod, "v", $mod.GetIt(), true);',
  16362. ' rtl.setIntfP($mod, "v", $mod.GetIt(), true);',
  16363. ' $ir.ref(1, $mod.GetIt())._AddRef();',
  16364. ' $mod.i = $ir.ref(2, $mod.GetIt())._AddRef();',
  16365. '} finally {',
  16366. ' $ir.free();',
  16367. '};',
  16368. '']));
  16369. end;
  16370. procedure TTestModule.TestClassInterface_COM_Property;
  16371. begin
  16372. StartProgram(false);
  16373. Add([
  16374. '{$interfaces com}',
  16375. 'type',
  16376. ' IUnknown = interface',
  16377. ' function _AddRef: longint;',
  16378. ' function _Release: longint;',
  16379. ' end;',
  16380. ' TObject = class(IUnknown)',
  16381. ' FAnt: IUnknown;',
  16382. ' function _AddRef: longint; virtual; abstract;',
  16383. ' function _Release: longint; virtual; abstract;',
  16384. ' function GetBird: IUnknown; virtual; abstract;',
  16385. ' procedure SetBird(Value: IUnknown); virtual; abstract;',
  16386. ' function GetItems(Index: longint): IUnknown; virtual; abstract;',
  16387. ' procedure SetItems(Index: longint; Value: IUnknown); virtual; abstract;',
  16388. ' property Ant: IUnknown read FAnt write FAnt;',
  16389. ' property Bird: IUnknown read GetBird write SetBird;',
  16390. ' property Items[Index: longint]: IUnknown read GetItems write SetItems; default;',
  16391. ' end;',
  16392. 'procedure DoIt;',
  16393. 'var',
  16394. ' o: TObject;',
  16395. ' v: IUnknown;',
  16396. 'begin',
  16397. ' v:=o.Ant;',
  16398. ' o.Ant:=v;',
  16399. ' o.Ant:=o.Ant;',
  16400. ' v:=o.Bird;',
  16401. ' o.Bird:=v;',
  16402. ' o.Bird:=o.Bird;',
  16403. ' v:=o.Items[1];',
  16404. ' o.Items[2]:=v;',
  16405. ' o.Items[3]:=o.Items[4];',
  16406. ' v:=o[5];',
  16407. ' o[6]:=v;',
  16408. ' o[7]:=o[8];',
  16409. 'end;',
  16410. 'begin',
  16411. '']);
  16412. ConvertProgram;
  16413. CheckSource('TestClassInterface_COM_Property',
  16414. LinesToStr([ // statements
  16415. 'rtl.createInterface($mod, "IUnknown", "{D7ADB0E1-758A-322B-BDDF-21CD521DDFA9}", ["_AddRef", "_Release"], null);',
  16416. 'rtl.createClass($mod, "TObject", null, function () {',
  16417. ' this.$init = function () {',
  16418. ' this.FAnt = null;',
  16419. ' };',
  16420. ' this.$final = function () {',
  16421. ' this.FAnt = undefined;',
  16422. ' };',
  16423. ' rtl.addIntf(this, $mod.IUnknown);',
  16424. '});',
  16425. 'this.DoIt = function () {',
  16426. ' var o = null;',
  16427. ' var v = null;',
  16428. ' var $ir = rtl.createIntfRefs();',
  16429. ' try {',
  16430. ' v = rtl.setIntfL(v, o.FAnt);',
  16431. ' rtl.setIntfP(o, "FAnt", v);',
  16432. ' rtl.setIntfP(o, "FAnt", o.FAnt);',
  16433. ' v = rtl.setIntfL(v, o.GetBird(), true);',
  16434. ' o.SetBird(v);',
  16435. ' o.SetBird($ir.ref(1, o.GetBird()));',
  16436. ' v = rtl.setIntfL(v, o.GetItems(1), true);',
  16437. ' o.SetItems(2, v);',
  16438. ' o.SetItems(3, $ir.ref(2, o.GetItems(4)));',
  16439. ' v = rtl.setIntfL(v, o.GetItems(5), true);',
  16440. ' o.SetItems(6, v);',
  16441. ' o.SetItems(7, $ir.ref(3, o.GetItems(8)));',
  16442. ' } finally {',
  16443. ' $ir.free();',
  16444. ' rtl._Release(v);',
  16445. ' };',
  16446. '};',
  16447. '']),
  16448. LinesToStr([ // $mod.$main
  16449. '']));
  16450. end;
  16451. procedure TTestModule.TestClassInterface_COM_IntfProperty;
  16452. begin
  16453. StartProgram(false);
  16454. Add([
  16455. '{$interfaces com}',
  16456. 'type',
  16457. ' IUnknown = interface',
  16458. ' function _AddRef: longint;',
  16459. ' function _Release: longint;',
  16460. ' function GetBird: IUnknown;',
  16461. ' procedure SetBird(Value: IUnknown);',
  16462. ' function GetItems(Index: longint): IUnknown;',
  16463. ' procedure SetItems(Index: longint; Value: IUnknown);',
  16464. ' property Bird: IUnknown read GetBird write SetBird;',
  16465. ' property Items[Index: longint]: IUnknown read GetItems write SetItems; default;',
  16466. ' end;',
  16467. ' TObject = class(IUnknown)',
  16468. ' function _AddRef: longint; virtual; abstract;',
  16469. ' function _Release: longint; virtual; abstract;',
  16470. ' function GetBird: IUnknown; virtual; abstract;',
  16471. ' procedure SetBird(Value: IUnknown); virtual; abstract;',
  16472. ' function GetItems(Index: longint): IUnknown; virtual; abstract;',
  16473. ' procedure SetItems(Index: longint; Value: IUnknown); virtual; abstract;',
  16474. ' end;',
  16475. 'procedure DoIt;',
  16476. 'var',
  16477. ' o: TObject;',
  16478. ' v: IUnknown;',
  16479. 'begin',
  16480. ' v:=v.Items[1];',
  16481. ' v.Items[2]:=v;',
  16482. ' v.Items[3]:=v.Items[4];',
  16483. ' v:=v[5];',
  16484. ' v[6]:=v;',
  16485. ' v[7]:=v[8];',
  16486. ' v[9].Bird.Bird:=v;',
  16487. ' v:=v.Bird[10].Bird',
  16488. 'end;',
  16489. 'begin',
  16490. '']);
  16491. ConvertProgram;
  16492. CheckSource('TestClassInterface_COM_IntfProperty',
  16493. LinesToStr([ // statements
  16494. 'rtl.createInterface($mod, "IUnknown", "{385F5482-571B-338C-8130-4E97F330543B}", [',
  16495. ' "_AddRef",',
  16496. ' "_Release",',
  16497. ' "GetBird",',
  16498. ' "SetBird",',
  16499. ' "GetItems",',
  16500. ' "SetItems"',
  16501. '], null);',
  16502. 'rtl.createClass($mod, "TObject", null, function () {',
  16503. ' this.$init = function () {',
  16504. ' };',
  16505. ' this.$final = function () {',
  16506. ' };',
  16507. ' rtl.addIntf(this, $mod.IUnknown);',
  16508. '});',
  16509. 'this.DoIt = function () {',
  16510. ' var o = null;',
  16511. ' var v = null;',
  16512. ' var $ir = rtl.createIntfRefs();',
  16513. ' try {',
  16514. ' v = rtl.setIntfL(v, v.GetItems(1), true);',
  16515. ' v.SetItems(2, v);',
  16516. ' v.SetItems(3, $ir.ref(1, v.GetItems(4)));',
  16517. ' v = rtl.setIntfL(v, v.GetItems(5), true);',
  16518. ' v.SetItems(6, v);',
  16519. ' v.SetItems(7, $ir.ref(2, v.GetItems(8)));',
  16520. ' $ir.ref(4, $ir.ref(3, v.GetItems(9)).GetBird()).SetBird(v);',
  16521. ' v = rtl.setIntfL(v, $ir.ref(6, v.$ir.ref(5, GetBird()).GetItems(10)).GetBird(), true);',
  16522. ' } finally {',
  16523. ' $ir.free();',
  16524. ' rtl._Release(v);',
  16525. ' };',
  16526. '};',
  16527. '']),
  16528. LinesToStr([ // $mod.$main
  16529. '']));
  16530. end;
  16531. procedure TTestModule.TestClassInterface_COM_Delegation;
  16532. begin
  16533. StartProgram(false);
  16534. Add([
  16535. '{$interfaces com}',
  16536. 'type',
  16537. ' IUnknown = interface',
  16538. ' function _AddRef: longint;',
  16539. ' function _Release: longint;',
  16540. ' end;',
  16541. ' IBird = interface(IUnknown)',
  16542. ' procedure Fly(s: string);',
  16543. ' end;',
  16544. ' IEagle = interface(IBird) end;',
  16545. ' IDove = interface(IBird) end;',
  16546. ' ISwallow = interface(IBird) end;',
  16547. ' TObject = class',
  16548. ' end;',
  16549. ' TBird = class(TObject,IBird,IEagle,IDove,ISwallow)',
  16550. ' function _AddRef: longint; virtual; abstract;',
  16551. ' function _Release: longint; virtual; abstract;',
  16552. ' procedure Fly(s: string); virtual; abstract;',
  16553. ' end;',
  16554. ' TBat = class(IBird,IEagle,IDove,ISwallow)',
  16555. ' function _AddRef: longint; virtual; abstract;',
  16556. ' function _Release: longint; virtual; abstract;',
  16557. ' FBirdIntf: IBird;',
  16558. ' property BirdIntf: IBird read FBirdIntf implements IBird;',
  16559. ' function GetEagleIntf: IEagle; virtual; abstract;',
  16560. ' property EagleIntf: IEagle read GetEagleIntf implements IEagle;',
  16561. ' FDoveObj: TBird;',
  16562. ' property DoveObj: TBird read FDoveObj implements IDove;',
  16563. ' function GetSwallowObj: TBird; virtual; abstract;',
  16564. ' property SwallowObj: TBird read GetSwallowObj implements ISwallow;',
  16565. ' end;',
  16566. 'begin',
  16567. '']);
  16568. ConvertProgram;
  16569. CheckSource('TestClassInterface_COM_Delegation',
  16570. LinesToStr([ // statements
  16571. 'rtl.createInterface($mod, "IUnknown", "{D7ADB0E1-758A-322B-BDDF-21CD521DDFA9}", ["_AddRef", "_Release"], null);',
  16572. 'rtl.createInterface($mod, "IBird", "{CC440C7F-7623-3DEE-AE88-000B86AAF108}", ["Fly"], $mod.IUnknown);',
  16573. 'rtl.createInterface($mod, "IEagle", "{4B6A41C9-B020-3D7C-B688-96D19022B1B4}", [], $mod.IBird);',
  16574. 'rtl.createInterface($mod, "IDove", "{4B6A41C9-B020-3D7C-B688-96D18EF16074}", [], $mod.IBird);',
  16575. 'rtl.createInterface($mod, "ISwallow", "{BB6A41C9-B020-3D7C-B688-96D1CBDCB359}", [], $mod.IBird);',
  16576. 'rtl.createClass($mod, "TObject", null, function () {',
  16577. ' this.$init = function () {',
  16578. ' };',
  16579. ' this.$final = function () {',
  16580. ' };',
  16581. '});',
  16582. 'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
  16583. ' rtl.addIntf(this, $mod.IBird);',
  16584. ' rtl.addIntf(this, $mod.IEagle);',
  16585. ' rtl.addIntf(this, $mod.IDove);',
  16586. ' rtl.addIntf(this, $mod.ISwallow);',
  16587. '});',
  16588. 'rtl.createClass($mod, "TBat", $mod.TObject, function () {',
  16589. ' this.$init = function () {',
  16590. ' $mod.TObject.$init.call(this);',
  16591. ' this.FBirdIntf = null;',
  16592. ' this.FDoveObj = null;',
  16593. ' };',
  16594. ' this.$final = function () {',
  16595. ' this.FBirdIntf = undefined;',
  16596. ' this.FDoveObj = undefined;',
  16597. ' $mod.TObject.$final.call(this);',
  16598. ' };',
  16599. ' this.$intfmaps = {',
  16600. ' "{CC440C7F-7623-3DEE-AE88-000B86AAF108}": function () {',
  16601. ' return rtl._AddRef(this.FBirdIntf);',
  16602. ' },',
  16603. ' "{4B6A41C9-B020-3D7C-B688-96D19022B1B4}": function () {',
  16604. ' return this.GetEagleIntf();',
  16605. ' },',
  16606. ' "{4B6A41C9-B020-3D7C-B688-96D18EF16074}": function () {',
  16607. ' return rtl.queryIntfT(this.FDoveObj, $mod.IDove);',
  16608. ' },',
  16609. ' "{BB6A41C9-B020-3D7C-B688-96D1CBDCB359}": function () {',
  16610. ' return rtl.queryIntfT(this.GetSwallowObj(), $mod.ISwallow);',
  16611. ' }',
  16612. ' };',
  16613. '});',
  16614. '']),
  16615. LinesToStr([ // $mod.$main
  16616. '']));
  16617. end;
  16618. procedure TTestModule.TestClassInterface_COM_With;
  16619. begin
  16620. StartProgram(false);
  16621. Add([
  16622. '{$interfaces com}',
  16623. 'type',
  16624. ' IUnknown = interface',
  16625. ' function _AddRef: longint;',
  16626. ' function _Release: longint;',
  16627. ' function GetAnt: IUnknown;',
  16628. ' property Ant: IUnknown read GetAnt;',
  16629. ' end;',
  16630. ' TObject = class(IUnknown)',
  16631. ' function _AddRef: longint; virtual; abstract;',
  16632. ' function _Release: longint; virtual; abstract;',
  16633. ' function GetAnt: IUnknown; virtual; abstract;',
  16634. ' property Ant: IUnknown read GetAnt;',
  16635. ' end;',
  16636. 'procedure DoIt;',
  16637. 'var',
  16638. ' i: IUnknown;',
  16639. 'begin',
  16640. ' with i do ',
  16641. ' GetAnt;',
  16642. ' with i.Ant, Ant do ',
  16643. ' GetAnt;',
  16644. 'end;',
  16645. 'begin',
  16646. '']);
  16647. ConvertProgram;
  16648. CheckSource('TestClassInterface_COM_With',
  16649. LinesToStr([ // statements
  16650. 'rtl.createInterface($mod, "IUnknown", "{D7ADB00D-C6B6-39FB-BDDF-21CD521DDFA9}", ["_AddRef", "_Release", "GetAnt"], null);',
  16651. 'rtl.createClass($mod, "TObject", null, function () {',
  16652. ' this.$init = function () {',
  16653. ' };',
  16654. ' this.$final = function () {',
  16655. ' };',
  16656. ' rtl.addIntf(this, $mod.IUnknown);',
  16657. '});',
  16658. 'this.DoIt = function () {',
  16659. ' var i = null;',
  16660. ' var $ir = rtl.createIntfRefs();',
  16661. ' try {',
  16662. ' $ir.ref(1, i.GetAnt());',
  16663. ' var $with1 = $ir.ref(2, i.GetAnt());',
  16664. ' var $with2 = $ir.ref(3, $with1.GetAnt());',
  16665. ' $ir.ref(4, $with2.GetAnt());',
  16666. ' } finally {',
  16667. ' $ir.free();',
  16668. ' };',
  16669. '};',
  16670. '']),
  16671. LinesToStr([ // $mod.$main
  16672. '']));
  16673. end;
  16674. procedure TTestModule.TestClassInterface_COM_ForIn;
  16675. begin
  16676. StartProgram(false);
  16677. Add([
  16678. '{$interfaces com}',
  16679. 'type',
  16680. ' IUnknown = interface end;',
  16681. ' TObject = class',
  16682. ' Id: longint;',
  16683. ' end;',
  16684. ' IEnumerator = interface(IUnknown)',
  16685. ' function GetCurrent: TObject;',
  16686. ' function MoveNext: Boolean;',
  16687. ' property Current: TObject read GetCurrent;',
  16688. ' end;',
  16689. ' IEnumerable = interface(IUnknown)',
  16690. ' function GetEnumerator: IEnumerator;',
  16691. ' end;',
  16692. 'var',
  16693. ' o: TObject;',
  16694. ' i: IEnumerable;',
  16695. 'begin',
  16696. ' for o in i do o.Id:=3;',
  16697. '']);
  16698. ConvertProgram;
  16699. CheckSource('TestClassInterface_COM_ForIn',
  16700. LinesToStr([ // statements
  16701. 'rtl.createInterface($mod, "IUnknown", "{B92D5841-758A-322B-B800-000000000000}", [], null);',
  16702. 'rtl.createClass($mod, "TObject", null, function () {',
  16703. ' this.$init = function () {',
  16704. ' this.Id = 0;',
  16705. ' };',
  16706. ' this.$final = function () {',
  16707. ' };',
  16708. '});',
  16709. 'rtl.createInterface($mod, "IEnumerator", "{95D7745D-ED61-3F13-BBE4-07708161999E}", ["GetCurrent", "MoveNext"], $mod.IUnknown);',
  16710. 'rtl.createInterface($mod, "IEnumerable", "{8CC9D45D-ED7D-3B73-96B6-290B931BB19E}", ["GetEnumerator"], $mod.IUnknown);',
  16711. 'this.o = null;',
  16712. 'this.i = null;',
  16713. '']),
  16714. LinesToStr([ // $mod.$main
  16715. 'var $in1 = $mod.i.GetEnumerator();',
  16716. 'try {',
  16717. ' while ($in1.MoveNext()) {',
  16718. ' $mod.o = $in1.GetCurrent();',
  16719. ' $mod.o.Id = 3;',
  16720. ' }',
  16721. '} finally {',
  16722. ' rtl._Release($in1)',
  16723. '};',
  16724. '']));
  16725. end;
  16726. procedure TTestModule.TestClassInterface_COM_ArrayOfIntfFail;
  16727. begin
  16728. StartProgram(false);
  16729. Add([
  16730. '{$interfaces com}',
  16731. 'type',
  16732. ' IUnknown = interface',
  16733. ' function _AddRef: longint;',
  16734. ' function _Release: longint;',
  16735. ' end;',
  16736. ' TObject = class',
  16737. ' end;',
  16738. ' TArrOfIntf = array of IUnknown;',
  16739. 'begin',
  16740. '']);
  16741. SetExpectedPasResolverError('Not supported: array of COM-interface',nNotSupportedX);
  16742. ConvertProgram;
  16743. end;
  16744. procedure TTestModule.TestClassInterface_COM_RecordIntfFail;
  16745. begin
  16746. StartProgram(false);
  16747. Add([
  16748. '{$interfaces com}',
  16749. 'type',
  16750. ' IUnknown = interface',
  16751. ' function _AddRef: longint;',
  16752. ' function _Release: longint;',
  16753. ' end;',
  16754. ' TRec = record',
  16755. ' i: IUnknown;',
  16756. ' end;',
  16757. 'begin',
  16758. '']);
  16759. SetExpectedPasResolverError('Not supported: COM-interface as record member',nNotSupportedX);
  16760. ConvertProgram;
  16761. end;
  16762. procedure TTestModule.TestClassInterface_COM_UnitInitialization;
  16763. begin
  16764. StartUnit(false);
  16765. Add([
  16766. '{$interfaces com}',
  16767. 'interface',
  16768. 'implementation',
  16769. 'type',
  16770. ' IUnknown = interface',
  16771. ' function _AddRef: longint;',
  16772. ' end;',
  16773. ' TObject = class(IUnknown)',
  16774. ' function _AddRef: longint;',
  16775. ' end;',
  16776. 'function TObject._AddRef: longint; begin end;',
  16777. 'var i: IUnknown;',
  16778. ' o: TObject;',
  16779. 'initialization',
  16780. ' i:=nil;',
  16781. ' i:=i;',
  16782. ' i:=o;',
  16783. ' if (o as IUnknown)=nil then ;',
  16784. '']);
  16785. ConvertUnit;
  16786. CheckSource('TestClassInterface_COM_UnitInitialization',
  16787. LinesToStr([ // statements
  16788. 'var $impl = $mod.$impl;',
  16789. '']),
  16790. LinesToStr([ // this.$init
  16791. 'var $ir = rtl.createIntfRefs();',
  16792. 'try {',
  16793. ' rtl.setIntfP($impl, "i", null);',
  16794. ' rtl.setIntfP($impl, "i", $impl.i);',
  16795. ' rtl.setIntfP($impl, "i", rtl.queryIntfT($impl.o, $impl.IUnknown), true);',
  16796. ' if ($ir.ref(1, rtl.queryIntfT($impl.o, $impl.IUnknown)) === null) ;',
  16797. '} finally {',
  16798. ' $ir.free();',
  16799. '};',
  16800. '']),
  16801. LinesToStr([ // implementation
  16802. 'rtl.createInterface($impl, "IUnknown", "{B92D5841-758A-322B-BDDF-21CD52180000}", ["_AddRef"], null);',
  16803. 'rtl.createClass($impl, "TObject", null, function () {',
  16804. ' this.$init = function () {',
  16805. ' };',
  16806. ' this.$final = function () {',
  16807. ' };',
  16808. ' this._AddRef = function () {',
  16809. ' var Result = 0;',
  16810. ' return Result;',
  16811. ' };',
  16812. ' rtl.addIntf(this, $impl.IUnknown);',
  16813. '});',
  16814. '$impl.i = null;',
  16815. '$impl.o = null;',
  16816. ''])
  16817. );
  16818. end;
  16819. procedure TTestModule.TestClassInterface_GUID;
  16820. begin
  16821. StartProgram(false);
  16822. Add([
  16823. '{$interfaces corba}',
  16824. 'type',
  16825. ' IUnknown = interface',
  16826. ' [''{f31db68f-3010-D355-4EBA-CDD4EF4A737C}'']',
  16827. ' end;',
  16828. ' TObject = class end;',
  16829. ' TGUID = record D1, D2, D3, D4: word; end;',
  16830. ' TAliasGUID = TGUID;',
  16831. ' TGUIDString = type string;',
  16832. ' TAliasGUIDString = TGUIDString;',
  16833. 'procedure DoConstGUIDIt(const g: TAliasGUID); overload;',
  16834. 'begin end;',
  16835. 'procedure DoDefGUID(g: TAliasGUID); overload;',
  16836. 'begin end;',
  16837. 'procedure DoStr(const s: TAliasGUIDString); overload;',
  16838. 'begin end;',
  16839. 'var',
  16840. ' i: IUnknown;',
  16841. ' g: TAliasGUID = ''{d91c9af4-3C93-420F-A303-BF5BA82BFD23}'';',
  16842. ' s: TAliasGUIDString;',
  16843. 'begin',
  16844. ' DoConstGUIDIt(IUnknown);',
  16845. ' DoDefGUID(IUnknown);',
  16846. ' DoStr(IUnknown);',
  16847. ' DoConstGUIDIt(i);',
  16848. ' DoDefGUID(i);',
  16849. ' DoStr(i);',
  16850. ' DoConstGUIDIt(''{D91C9AF4-3c93-420f-A303-BF5BA82BFD23}'');',
  16851. ' DoDefGUID(''{D91C9AF4-3c93-420f-A303-BF5BA82BFD23}'');',
  16852. ' DoStr(g);',
  16853. ' g:=i;',
  16854. ' g:=IUnknown;',
  16855. ' g:=''{D91C9AF4-3C93-420F-A303-bf5ba82bfd23}'';',
  16856. ' s:=i;',
  16857. ' s:=IUnknown;',
  16858. ' s:=g;',
  16859. ' if g=i then ;',
  16860. ' if i=g then ;',
  16861. ' if g=IUnknown then ;',
  16862. ' if IUnknown=g then ;',
  16863. ' if s=i then ;',
  16864. ' if i=s then ;',
  16865. ' if s=IUnknown then ;',
  16866. ' if IUnknown=s then ;',
  16867. ' if s=g then ;',
  16868. ' if g=s then ;',
  16869. '']);
  16870. ConvertProgram;
  16871. CheckSource('TestClassInterface_GUID',
  16872. LinesToStr([ // statements
  16873. 'rtl.createInterface($mod, "IUnknown", "{F31DB68F-3010-D355-4EBA-CDD4EF4A737C}", [], null);',
  16874. 'rtl.createClass($mod, "TObject", null, function () {',
  16875. ' this.$init = function () {',
  16876. ' };',
  16877. ' this.$final = function () {',
  16878. ' };',
  16879. '});',
  16880. 'this.TGUID = function (s) {',
  16881. ' if (s) {',
  16882. ' this.D1 = s.D1;',
  16883. ' this.D2 = s.D2;',
  16884. ' this.D3 = s.D3;',
  16885. ' this.D4 = s.D4;',
  16886. ' } else {',
  16887. ' this.D1 = 0;',
  16888. ' this.D2 = 0;',
  16889. ' this.D3 = 0;',
  16890. ' this.D4 = 0;',
  16891. ' };',
  16892. ' this.$equal = function (b) {',
  16893. ' return (this.D1 === b.D1) && (this.D2 === b.D2) && (this.D3 === b.D3) && (this.D4 === b.D4);',
  16894. ' };',
  16895. '};',
  16896. 'this.DoConstGUIDIt = function (g) {',
  16897. '};',
  16898. 'this.DoDefGUID = function (g) {',
  16899. '};',
  16900. 'this.DoStr = function (s) {',
  16901. '};',
  16902. 'this.i = null;',
  16903. 'this.g = new $mod.TGUID({',
  16904. ' D1: 0xD91C9AF4,',
  16905. ' D2: 0x3C93,',
  16906. ' D3: 0x420F,',
  16907. ' D4: [',
  16908. ' 0xA3,',
  16909. ' 0x03,',
  16910. ' 0xBF,',
  16911. ' 0x5B,',
  16912. ' 0xA8,',
  16913. ' 0x2B,',
  16914. ' 0xFD,',
  16915. ' 0x23',
  16916. ' ]',
  16917. '});',
  16918. 'this.s = "";',
  16919. '']),
  16920. LinesToStr([ // $mod.$main
  16921. '$mod.DoConstGUIDIt(rtl.getIntfGUIDR($mod.IUnknown));',
  16922. '$mod.DoDefGUID(new $mod.TGUID(rtl.getIntfGUIDR($mod.IUnknown)));',
  16923. '$mod.DoStr($mod.IUnknown.$guid);',
  16924. '$mod.DoConstGUIDIt(rtl.getIntfGUIDR($mod.i));',
  16925. '$mod.DoDefGUID(new $mod.TGUID(rtl.getIntfGUIDR($mod.i)));',
  16926. '$mod.DoStr($mod.i.$guid);',
  16927. '$mod.DoConstGUIDIt(rtl.strToGUIDR("{D91C9AF4-3c93-420f-A303-BF5BA82BFD23}"));',
  16928. '$mod.DoDefGUID(rtl.strToGUIDR("{D91C9AF4-3c93-420f-A303-BF5BA82BFD23}"));',
  16929. '$mod.DoStr(rtl.guidrToStr($mod.g));',
  16930. '$mod.g = new $mod.TGUID(rtl.getIntfGUIDR($mod.i));',
  16931. '$mod.g = new $mod.TGUID(rtl.getIntfGUIDR($mod.IUnknown));',
  16932. '$mod.g = new $mod.TGUID({',
  16933. ' D1: 0xD91C9AF4,',
  16934. ' D2: 0x3C93,',
  16935. ' D3: 0x420F,',
  16936. ' D4: [',
  16937. ' 0xA3,',
  16938. ' 0x03,',
  16939. ' 0xBF,',
  16940. ' 0x5B,',
  16941. ' 0xA8,',
  16942. ' 0x2B,',
  16943. ' 0xFD,',
  16944. ' 0x23',
  16945. ' ]',
  16946. '});',
  16947. '$mod.s = $mod.i.$guid;',
  16948. '$mod.s = $mod.IUnknown.$guid;',
  16949. '$mod.s = rtl.guidrToStr($mod.g);',
  16950. 'if ($mod.g.$equal(rtl.getIntfGUIDR($mod.i))) ;',
  16951. 'if ($mod.g.$equal(rtl.getIntfGUIDR($mod.i))) ;',
  16952. 'if ($mod.g.$equal(rtl.getIntfGUIDR($mod.IUnknown))) ;',
  16953. 'if ($mod.g.$equal(rtl.getIntfGUIDR($mod.IUnknown))) ;',
  16954. 'if ($mod.s === $mod.i.$guid) ;',
  16955. 'if ($mod.i.$guid === $mod.s) ;',
  16956. 'if ($mod.s === $mod.IUnknown.$guid) ;',
  16957. 'if ($mod.IUnknown.$guid === $mod.s) ;',
  16958. 'if ($mod.g.$equal(rtl.createTGUID($mod.s))) ;',
  16959. 'if ($mod.g.$equal(rtl.createTGUID($mod.s))) ;',
  16960. '']));
  16961. end;
  16962. procedure TTestModule.TestClassInterface_GUIDProperty;
  16963. begin
  16964. StartProgram(false);
  16965. Add([
  16966. '{$interfaces corba}',
  16967. 'type',
  16968. ' IUnknown = interface',
  16969. ' [''{f31db68f-3010-D355-4EBA-CDD4EF4A737C}'']',
  16970. ' end;',
  16971. ' TGUID = record D1, D2, D3, D4: word; end;',
  16972. ' TAliasGUID = TGUID;',
  16973. ' TGUIDString = type string;',
  16974. ' TAliasGUIDString = TGUIDString;',
  16975. ' TObject = class',
  16976. ' function GetG: TAliasGUID; virtual; abstract;',
  16977. ' procedure SetG(const Value: TAliasGUID); virtual; abstract;',
  16978. ' function GetS: TAliasGUIDString; virtual; abstract;',
  16979. ' procedure SetS(const Value: TAliasGUIDString); virtual; abstract;',
  16980. ' property g: TAliasGUID read GetG write SetG;',
  16981. ' property s: TAliasGUIDString read GetS write SetS;',
  16982. ' end;',
  16983. 'var o: TObject;',
  16984. 'begin',
  16985. ' o.g:=IUnknown;',
  16986. ' o.g:=''{D91C9AF4-3C93-420F-A303-bf5ba82bfd23}'';',
  16987. ' o.s:=IUnknown;',
  16988. ' o.s:=o.g;',
  16989. '']);
  16990. ConvertProgram;
  16991. CheckSource('TestClassInterface_GUIDProperty',
  16992. LinesToStr([ // statements
  16993. 'rtl.createInterface($mod, "IUnknown", "{F31DB68F-3010-D355-4EBA-CDD4EF4A737C}", [], null);',
  16994. 'this.TGUID = function (s) {',
  16995. ' if (s) {',
  16996. ' this.D1 = s.D1;',
  16997. ' this.D2 = s.D2;',
  16998. ' this.D3 = s.D3;',
  16999. ' this.D4 = s.D4;',
  17000. ' } else {',
  17001. ' this.D1 = 0;',
  17002. ' this.D2 = 0;',
  17003. ' this.D3 = 0;',
  17004. ' this.D4 = 0;',
  17005. ' };',
  17006. ' this.$equal = function (b) {',
  17007. ' return (this.D1 === b.D1) && (this.D2 === b.D2) && (this.D3 === b.D3) && (this.D4 === b.D4);',
  17008. ' };',
  17009. '};',
  17010. 'rtl.createClass($mod, "TObject", null, function () {',
  17011. ' this.$init = function () {',
  17012. ' };',
  17013. ' this.$final = function () {',
  17014. ' };',
  17015. '});',
  17016. 'this.o = null;',
  17017. '']),
  17018. LinesToStr([ // $mod.$main
  17019. '$mod.o.SetG(new $mod.TGUID(rtl.getIntfGUIDR($mod.IUnknown)));',
  17020. '$mod.o.SetG(new $mod.TGUID({',
  17021. ' D1: 0xD91C9AF4,',
  17022. ' D2: 0x3C93,',
  17023. ' D3: 0x420F,',
  17024. ' D4: [',
  17025. ' 0xA3,',
  17026. ' 0x03,',
  17027. ' 0xBF,',
  17028. ' 0x5B,',
  17029. ' 0xA8,',
  17030. ' 0x2B,',
  17031. ' 0xFD,',
  17032. ' 0x23',
  17033. ' ]',
  17034. '}));',
  17035. '$mod.o.SetS($mod.IUnknown.$guid);',
  17036. '$mod.o.SetS(rtl.guidrToStr($mod.o.GetG()));',
  17037. '']));
  17038. end;
  17039. procedure TTestModule.TestProcType;
  17040. begin
  17041. StartProgram(false);
  17042. Add([
  17043. 'type',
  17044. ' TProcInt = procedure(vI: longint = 1);',
  17045. 'procedure DoIt(vJ: longint);',
  17046. 'begin end;',
  17047. 'var',
  17048. ' b: boolean;',
  17049. ' vP, vQ: tprocint;',
  17050. 'begin',
  17051. ' vp:=nil;',
  17052. ' vp:=vp;',
  17053. ' vp:=@doit;',
  17054. ' vp;',
  17055. ' vp();',
  17056. ' vp(2);',
  17057. ' b:=vp=nil;',
  17058. ' b:=nil=vp;',
  17059. ' b:=vp=vq;',
  17060. ' b:=vp=@doit;',
  17061. ' b:=@doit=vp;',
  17062. ' b:=vp<>nil;',
  17063. ' b:=nil<>vp;',
  17064. ' b:=vp<>vq;',
  17065. ' b:=vp<>@doit;',
  17066. ' b:=@doit<>vp;',
  17067. ' b:=Assigned(vp);',
  17068. ' if Assigned(vp) then ;']);
  17069. ConvertProgram;
  17070. CheckSource('TestProcType',
  17071. LinesToStr([ // statements
  17072. 'this.DoIt = function(vJ) {',
  17073. '};',
  17074. 'this.b = false;',
  17075. 'this.vP = null;',
  17076. 'this.vQ = null;'
  17077. ]),
  17078. LinesToStr([ // $mod.$main
  17079. '$mod.vP = null;',
  17080. '$mod.vP = $mod.vP;',
  17081. '$mod.vP = $mod.DoIt;',
  17082. '$mod.vP(1);',
  17083. '$mod.vP(1);',
  17084. '$mod.vP(2);',
  17085. '$mod.b = $mod.vP === null;',
  17086. '$mod.b = null === $mod.vP;',
  17087. '$mod.b = rtl.eqCallback($mod.vP,$mod.vQ);',
  17088. '$mod.b = rtl.eqCallback($mod.vP, $mod.DoIt);',
  17089. '$mod.b = rtl.eqCallback($mod.DoIt, $mod.vP);',
  17090. '$mod.b = $mod.vP !== null;',
  17091. '$mod.b = null !== $mod.vP;',
  17092. '$mod.b = !rtl.eqCallback($mod.vP,$mod.vQ);',
  17093. '$mod.b = !rtl.eqCallback($mod.vP, $mod.DoIt);',
  17094. '$mod.b = !rtl.eqCallback($mod.DoIt, $mod.vP);',
  17095. '$mod.b = $mod.vP != null;',
  17096. 'if ($mod.vP != null) ;',
  17097. '']));
  17098. end;
  17099. procedure TTestModule.TestProcType_Arg;
  17100. begin
  17101. StartProgram(false);
  17102. Add([
  17103. 'type',
  17104. ' TProcInt = procedure(vI: longint = 1);',
  17105. 'procedure DoIt(vJ: longint); begin end;',
  17106. 'procedure DoSome(vP, vQ: TProcInt);',
  17107. 'var',
  17108. ' b: boolean;',
  17109. 'begin',
  17110. ' vp:=nil;',
  17111. ' vp:=vp;',
  17112. ' vp:=@doit;',
  17113. ' vp;',
  17114. ' vp();',
  17115. ' vp(2);',
  17116. ' b:=vp=nil;',
  17117. ' b:=nil=vp;',
  17118. ' b:=vp=vq;',
  17119. ' b:=vp=@doit;',
  17120. ' b:=@doit=vp;',
  17121. ' b:=vp<>nil;',
  17122. ' b:=nil<>vp;',
  17123. ' b:=vp<>vq;',
  17124. ' b:=vp<>@doit;',
  17125. ' b:=@doit<>vp;',
  17126. ' b:=Assigned(vp);',
  17127. ' if Assigned(vp) then ;',
  17128. 'end;',
  17129. 'begin',
  17130. ' DoSome(@DoIt,nil);']);
  17131. ConvertProgram;
  17132. CheckSource('TestProcType_Arg',
  17133. LinesToStr([ // statements
  17134. 'this.DoIt = function(vJ) {',
  17135. '};',
  17136. 'this.DoSome = function(vP, vQ) {',
  17137. ' var b = false;',
  17138. ' vP = null;',
  17139. ' vP = vP;',
  17140. ' vP = $mod.DoIt;',
  17141. ' vP(1);',
  17142. ' vP(1);',
  17143. ' vP(2);',
  17144. ' b = vP === null;',
  17145. ' b = null === vP;',
  17146. ' b = rtl.eqCallback(vP,vQ);',
  17147. ' b = rtl.eqCallback(vP, $mod.DoIt);',
  17148. ' b = rtl.eqCallback($mod.DoIt, vP);',
  17149. ' b = vP !== null;',
  17150. ' b = null !== vP;',
  17151. ' b = !rtl.eqCallback(vP, vQ);',
  17152. ' b = !rtl.eqCallback(vP, $mod.DoIt);',
  17153. ' b = !rtl.eqCallback($mod.DoIt, vP);',
  17154. ' b = vP != null;',
  17155. ' if (vP != null) ;',
  17156. '};',
  17157. '']),
  17158. LinesToStr([ // $mod.$main
  17159. '$mod.DoSome($mod.DoIt,null);',
  17160. '']));
  17161. end;
  17162. procedure TTestModule.TestProcType_FunctionFPC;
  17163. begin
  17164. StartProgram(false);
  17165. Add('type');
  17166. Add(' TFuncInt = function(vA: longint = 1): longint;');
  17167. Add('function DoIt(vI: longint): longint;');
  17168. Add('begin end;');
  17169. Add('var');
  17170. Add(' b: boolean;');
  17171. Add(' vP, vQ: tfuncint;');
  17172. Add('begin');
  17173. Add(' vp:=nil;');
  17174. Add(' vp:=vp;');
  17175. Add(' vp:=@doit;'); // ok in fpc and delphi
  17176. //Add(' vp:=doit;'); // illegal in fpc, ok in delphi
  17177. Add(' vp;'); // ok in fpc and delphi
  17178. Add(' vp();');
  17179. Add(' vp(2);');
  17180. Add(' b:=vp=nil;'); // ok in fpc, illegal in delphi
  17181. Add(' b:=nil=vp;'); // ok in fpc, illegal in delphi
  17182. Add(' b:=vp=vq;'); // in fpc compare proctypes, in delphi compare results
  17183. Add(' b:=vp=@doit;'); // ok in fpc, illegal in delphi
  17184. Add(' b:=@doit=vp;'); // ok in fpc, illegal in delphi
  17185. //Add(' b:=vp=3;'); // illegal in fpc, ok in delphi
  17186. Add(' b:=4=vp;'); // illegal in fpc, ok in delphi
  17187. Add(' b:=vp<>nil;'); // ok in fpc, illegal in delphi
  17188. Add(' b:=nil<>vp;'); // ok in fpc, illegal in delphi
  17189. Add(' b:=vp<>vq;'); // in fpc compare proctypes, in delphi compare results
  17190. Add(' b:=vp<>@doit;'); // ok in fpc, illegal in delphi
  17191. Add(' b:=@doit<>vp;'); // ok in fpc, illegal in delphi
  17192. //Add(' b:=vp<>5;'); // illegal in fpc, ok in delphi
  17193. Add(' b:=6<>vp;'); // illegal in fpc, ok in delphi
  17194. Add(' b:=Assigned(vp);');
  17195. //Add(' doit(vp);'); // illegal in fpc, ok in delphi
  17196. Add(' doit(vp());'); // ok in fpc and delphi
  17197. Add(' doit(vp(2));'); // ok in fpc and delphi
  17198. ConvertProgram;
  17199. CheckSource('TestProcType_FunctionFPC',
  17200. LinesToStr([ // statements
  17201. 'this.DoIt = function(vI) {',
  17202. ' var Result = 0;',
  17203. ' return Result;',
  17204. '};',
  17205. 'this.b = false;',
  17206. 'this.vP = null;',
  17207. 'this.vQ = null;'
  17208. ]),
  17209. LinesToStr([ // $mod.$main
  17210. '$mod.vP = null;',
  17211. '$mod.vP = $mod.vP;',
  17212. '$mod.vP = $mod.DoIt;',
  17213. '$mod.vP(1);',
  17214. '$mod.vP(1);',
  17215. '$mod.vP(2);',
  17216. '$mod.b = $mod.vP === null;',
  17217. '$mod.b = null === $mod.vP;',
  17218. '$mod.b = rtl.eqCallback($mod.vP,$mod.vQ);',
  17219. '$mod.b = rtl.eqCallback($mod.vP, $mod.DoIt);',
  17220. '$mod.b = rtl.eqCallback($mod.DoIt, $mod.vP);',
  17221. '$mod.b = 4 === $mod.vP(1);',
  17222. '$mod.b = $mod.vP !== null;',
  17223. '$mod.b = null !== $mod.vP;',
  17224. '$mod.b = !rtl.eqCallback($mod.vP,$mod.vQ);',
  17225. '$mod.b = !rtl.eqCallback($mod.vP, $mod.DoIt);',
  17226. '$mod.b = !rtl.eqCallback($mod.DoIt, $mod.vP);',
  17227. '$mod.b = 6 !== $mod.vP(1);',
  17228. '$mod.b = $mod.vP != null;',
  17229. '$mod.DoIt($mod.vP(1));',
  17230. '$mod.DoIt($mod.vP(2));',
  17231. '']));
  17232. end;
  17233. procedure TTestModule.TestProcType_FunctionDelphi;
  17234. begin
  17235. StartProgram(false);
  17236. Add('{$mode Delphi}');
  17237. Add('type');
  17238. Add(' TFuncInt = function(vA: longint = 1): longint;');
  17239. Add('function DoIt(vI: longint): longint;');
  17240. Add('begin end;');
  17241. Add('var');
  17242. Add(' b: boolean;');
  17243. Add(' vP, vQ: tfuncint;');
  17244. Add('begin');
  17245. Add(' vp:=nil;');
  17246. Add(' vp:=vp;');
  17247. Add(' vp:=@doit;'); // ok in fpc and delphi
  17248. Add(' vp:=doit;'); // illegal in fpc, ok in delphi
  17249. Add(' vp;'); // ok in fpc and delphi
  17250. Add(' vp();');
  17251. Add(' vp(2);');
  17252. //Add(' b:=vp=nil;'); // ok in fpc, illegal in delphi
  17253. //Add(' b:=nil=vp;'); // ok in fpc, illegal in delphi
  17254. Add(' b:=vp=vq;'); // in fpc compare proctypes, in delphi compare results
  17255. //Add(' b:=vp=@doit;'); // ok in fpc, illegal in delphi
  17256. //Add(' b:=@doit=vp;'); // ok in fpc, illegal in delphi
  17257. Add(' b:=vp=3;'); // illegal in fpc, ok in delphi
  17258. Add(' b:=4=vp;'); // illegal in fpc, ok in delphi
  17259. //Add(' b:=vp<>nil;'); // ok in fpc, illegal in delphi
  17260. //Add(' b:=nil<>vp;'); // ok in fpc, illegal in delphi
  17261. Add(' b:=vp<>vq;'); // in fpc compare proctypes, in delphi compare results
  17262. //Add(' b:=vp<>@doit;'); // ok in fpc, illegal in delphi
  17263. //Add(' b:=@doit<>vp;'); // ok in fpc, illegal in delphi
  17264. Add(' b:=vp<>5;'); // illegal in fpc, ok in delphi
  17265. Add(' b:=6<>vp;'); // illegal in fpc, ok in delphi
  17266. Add(' b:=Assigned(vp);');
  17267. Add(' doit(vp);'); // illegal in fpc, ok in delphi
  17268. Add(' doit(vp());'); // ok in fpc and delphi
  17269. Add(' doit(vp(2));'); // ok in fpc and delphi *)
  17270. ConvertProgram;
  17271. CheckSource('TestProcType_FunctionDelphi',
  17272. LinesToStr([ // statements
  17273. 'this.DoIt = function(vI) {',
  17274. ' var Result = 0;',
  17275. ' return Result;',
  17276. '};',
  17277. 'this.b = false;',
  17278. 'this.vP = null;',
  17279. 'this.vQ = null;'
  17280. ]),
  17281. LinesToStr([ // $mod.$main
  17282. '$mod.vP = null;',
  17283. '$mod.vP = $mod.vP;',
  17284. '$mod.vP = $mod.DoIt;',
  17285. '$mod.vP = $mod.DoIt;',
  17286. '$mod.vP(1);',
  17287. '$mod.vP(1);',
  17288. '$mod.vP(2);',
  17289. '$mod.b = $mod.vP(1) === $mod.vQ(1);',
  17290. '$mod.b = $mod.vP(1) === 3;',
  17291. '$mod.b = 4 === $mod.vP(1);',
  17292. '$mod.b = $mod.vP(1) !== $mod.vQ(1);',
  17293. '$mod.b = $mod.vP(1) !== 5;',
  17294. '$mod.b = 6 !== $mod.vP(1);',
  17295. '$mod.b = $mod.vP != null;',
  17296. '$mod.DoIt($mod.vP(1));',
  17297. '$mod.DoIt($mod.vP(1));',
  17298. '$mod.DoIt($mod.vP(2));',
  17299. '']));
  17300. end;
  17301. procedure TTestModule.TestProcType_ProcedureDelphi;
  17302. begin
  17303. StartProgram(false);
  17304. Add('{$mode Delphi}');
  17305. Add('type');
  17306. Add(' TProc = procedure;');
  17307. Add('procedure DoIt;');
  17308. Add('begin end;');
  17309. Add('var');
  17310. Add(' b: boolean;');
  17311. Add(' vP, vQ: tproc;');
  17312. Add('begin');
  17313. Add(' vp:=nil;');
  17314. Add(' vp:=vp;');
  17315. Add(' vp:=vq;');
  17316. Add(' vp:=@doit;'); // ok in fpc and delphi, Note that in Delphi type of @F is Pointer, while in FPC it is the proc type
  17317. Add(' vp:=doit;'); // illegal in fpc, ok in delphi
  17318. //Add(' vp:=@doit;'); // illegal in fpc, ok in delphi (because Delphi treats @F as Pointer), not supported by resolver
  17319. Add(' vp;'); // ok in fpc and delphi
  17320. Add(' vp();');
  17321. // equal
  17322. //Add(' b:=vp=nil;'); // ok in fpc, illegal in delphi
  17323. Add(' b:=@@vp=nil;'); // ok in fpc delphi mode, ok in delphi
  17324. //Add(' b:=nil=vp;'); // ok in fpc, illegal in delphi
  17325. Add(' b:=nil=@@vp;'); // ok in fpc delphi mode, ok in delphi
  17326. Add(' b:=@@vp=@@vq;'); // ok in fpc delphi mode, ok in Delphi
  17327. //Add(' b:=vp=vq;'); // in fpc compare proctypes, in delphi compare results
  17328. //Add(' b:=vp=@doit;'); // ok in fpc, illegal in delphi
  17329. Add(' b:=@@vp=@doit;'); // ok in fpc delphi mode, ok in delphi
  17330. //Add(' b:=@doit=vp;'); // ok in fpc, illegal in delphi
  17331. Add(' b:=@doit=@@vp;'); // ok in fpc delphi mode, ok in delphi
  17332. // unequal
  17333. //Add(' b:=vp<>nil;'); // ok in fpc, illegal in delphi
  17334. Add(' b:=@@vp<>nil;'); // ok in fpc mode delphi, ok in delphi
  17335. //Add(' b:=nil<>vp;'); // ok in fpc, illegal in delphi
  17336. Add(' b:=nil<>@@vp;'); // ok in fpc mode delphi, ok in delphi
  17337. //Add(' b:=vp<>vq;'); // in fpc compare proctypes, in delphi compare results
  17338. Add(' b:=@@vp<>@@vq;'); // ok in fpc mode delphi, ok in delphi
  17339. //Add(' b:=vp<>@doit;'); // ok in fpc, illegal in delphi
  17340. Add(' b:=@@vp<>@doit;'); // ok in fpc mode delphi, illegal in delphi
  17341. //Add(' b:=@doit<>vp;'); // ok in fpc, illegal in delphi
  17342. Add(' b:=@doit<>@@vp;'); // ok in fpc mode delphi, illegal in delphi
  17343. Add(' b:=Assigned(vp);');
  17344. ConvertProgram;
  17345. CheckSource('TestProcType_ProcedureDelphi',
  17346. LinesToStr([ // statements
  17347. 'this.DoIt = function() {',
  17348. '};',
  17349. 'this.b = false;',
  17350. 'this.vP = null;',
  17351. 'this.vQ = null;'
  17352. ]),
  17353. LinesToStr([ // $mod.$main
  17354. '$mod.vP = null;',
  17355. '$mod.vP = $mod.vP;',
  17356. '$mod.vP = $mod.vQ;',
  17357. '$mod.vP = $mod.DoIt;',
  17358. '$mod.vP = $mod.DoIt;',
  17359. '$mod.vP();',
  17360. '$mod.vP();',
  17361. '$mod.b = $mod.vP === null;',
  17362. '$mod.b = null === $mod.vP;',
  17363. '$mod.b = rtl.eqCallback($mod.vP, $mod.vQ);',
  17364. '$mod.b = rtl.eqCallback($mod.vP, $mod.DoIt);',
  17365. '$mod.b = rtl.eqCallback($mod.DoIt, $mod.vP);',
  17366. '$mod.b = $mod.vP !== null;',
  17367. '$mod.b = null !== $mod.vP;',
  17368. '$mod.b = !rtl.eqCallback($mod.vP, $mod.vQ);',
  17369. '$mod.b = !rtl.eqCallback($mod.vP, $mod.DoIt);',
  17370. '$mod.b = !rtl.eqCallback($mod.DoIt, $mod.vP);',
  17371. '$mod.b = $mod.vP != null;',
  17372. '']));
  17373. end;
  17374. procedure TTestModule.TestProcType_AsParam;
  17375. begin
  17376. StartProgram(false);
  17377. Add('type');
  17378. Add(' TFuncInt = function(vA: longint = 1): longint;');
  17379. Add('procedure DoIt(vG: tfuncint; const vH: tfuncint; var vI: tfuncint);');
  17380. Add('var vJ: tfuncint;');
  17381. Add('begin');
  17382. Add(' vg:=vg;');
  17383. Add(' vj:=vh;');
  17384. Add(' vi:=vi;');
  17385. Add(' doit(vg,vg,vg);');
  17386. Add(' doit(vh,vh,vj);');
  17387. Add(' doit(vi,vi,vi);');
  17388. Add(' doit(vj,vj,vj);');
  17389. Add('end;');
  17390. Add('var i: tfuncint;');
  17391. Add('begin');
  17392. Add(' doit(i,i,i);');
  17393. ConvertProgram;
  17394. CheckSource('TestProcType_AsParam',
  17395. LinesToStr([ // statements
  17396. 'this.DoIt = function (vG,vH,vI) {',
  17397. ' var vJ = null;',
  17398. ' vG = vG;',
  17399. ' vJ = vH;',
  17400. ' vI.set(vI.get());',
  17401. ' $mod.DoIt(vG, vG, {',
  17402. ' get: function () {',
  17403. ' return vG;',
  17404. ' },',
  17405. ' set: function (v) {',
  17406. ' vG = v;',
  17407. ' }',
  17408. ' });',
  17409. ' $mod.DoIt(vH, vH, {',
  17410. ' get: function () {',
  17411. ' return vJ;',
  17412. ' },',
  17413. ' set: function (v) {',
  17414. ' vJ = v;',
  17415. ' }',
  17416. ' });',
  17417. ' $mod.DoIt(vI.get(), vI.get(), vI);',
  17418. ' $mod.DoIt(vJ, vJ, {',
  17419. ' get: function () {',
  17420. ' return vJ;',
  17421. ' },',
  17422. ' set: function (v) {',
  17423. ' vJ = v;',
  17424. ' }',
  17425. ' });',
  17426. '};',
  17427. 'this.i = null;'
  17428. ]),
  17429. LinesToStr([
  17430. '$mod.DoIt($mod.i,$mod.i,{',
  17431. ' p: $mod,',
  17432. ' get: function () {',
  17433. ' return this.p.i;',
  17434. ' },',
  17435. ' set: function (v) {',
  17436. ' this.p.i = v;',
  17437. ' }',
  17438. '});'
  17439. ]));
  17440. end;
  17441. procedure TTestModule.TestProcType_MethodFPC;
  17442. begin
  17443. StartProgram(false);
  17444. Add('type');
  17445. Add(' TFuncInt = function(vA: longint = 1): longint of object;');
  17446. Add(' TObject = class');
  17447. Add(' function DoIt(vA: longint = 1): longint;');
  17448. Add(' end;');
  17449. Add('function TObject.DoIt(vA: longint = 1): longint;');
  17450. Add('begin');
  17451. Add('end;');
  17452. Add('var');
  17453. Add(' Obj: TObject;');
  17454. Add(' vP: tfuncint;');
  17455. Add(' b: boolean;');
  17456. Add('begin');
  17457. Add(' vp:[email protected];'); // ok in fpc and delphi
  17458. //Add(' vp:=obj.doit;'); // illegal in fpc, ok in delphi
  17459. Add(' vp;'); // ok in fpc and delphi
  17460. Add(' vp();');
  17461. Add(' vp(2);');
  17462. Add(' b:[email protected];'); // ok in fpc, illegal in delphi
  17463. Add(' b:[email protected]=vp;'); // ok in fpc, illegal in delphi
  17464. Add(' b:=vp<>@obj.doit;'); // ok in fpc, illegal in delphi
  17465. Add(' b:[email protected]<>vp;'); // ok in fpc, illegal in delphi
  17466. ConvertProgram;
  17467. CheckSource('TestProcType_MethodFPC',
  17468. LinesToStr([ // statements
  17469. 'rtl.createClass($mod, "TObject", null, function () {',
  17470. ' this.$init = function () {',
  17471. ' };',
  17472. ' this.$final = function () {',
  17473. ' };',
  17474. ' this.DoIt = function (vA) {',
  17475. ' var Result = 0;',
  17476. ' return Result;',
  17477. ' };',
  17478. '});',
  17479. 'this.Obj = null;',
  17480. 'this.vP = null;',
  17481. 'this.b = false;'
  17482. ]),
  17483. LinesToStr([
  17484. '$mod.vP = rtl.createCallback($mod.Obj, "DoIt");',
  17485. '$mod.vP(1);',
  17486. '$mod.vP(1);',
  17487. '$mod.vP(2);',
  17488. '$mod.b = rtl.eqCallback($mod.vP, rtl.createCallback($mod.Obj, "DoIt"));',
  17489. '$mod.b = rtl.eqCallback(rtl.createCallback($mod.Obj, "DoIt"), $mod.vP);',
  17490. '$mod.b = !rtl.eqCallback($mod.vP, rtl.createCallback($mod.Obj, "DoIt"));',
  17491. '$mod.b = !rtl.eqCallback(rtl.createCallback($mod.Obj, "DoIt"), $mod.vP);',
  17492. '']));
  17493. end;
  17494. procedure TTestModule.TestProcType_MethodDelphi;
  17495. begin
  17496. StartProgram(false);
  17497. Add('{$mode delphi}');
  17498. Add('type');
  17499. Add(' TFuncInt = function(vA: longint = 1): longint of object;');
  17500. Add(' TObject = class');
  17501. Add(' function DoIt(vA: longint = 1): longint;');
  17502. Add(' end;');
  17503. Add('function TObject.DoIt(vA: longint = 1): longint;');
  17504. Add('begin');
  17505. Add('end;');
  17506. Add('var');
  17507. Add(' Obj: TObject;');
  17508. Add(' vP: tfuncint;');
  17509. Add(' b: boolean;');
  17510. Add('begin');
  17511. Add(' vp:[email protected];'); // ok in fpc and delphi
  17512. Add(' vp:=obj.doit;'); // illegal in fpc, ok in delphi
  17513. Add(' vp;'); // ok in fpc and delphi
  17514. Add(' vp();');
  17515. Add(' vp(2);');
  17516. //Add(' b:[email protected];'); // ok in fpc, illegal in delphi
  17517. //Add(' b:[email protected]=vp;'); // ok in fpc, illegal in delphi
  17518. //Add(' b:=vp<>@obj.doit;'); // ok in fpc, illegal in delphi
  17519. //Add(' b:[email protected]<>vp;'); // ok in fpc, illegal in delphi
  17520. ConvertProgram;
  17521. CheckSource('TestProcType_MethodDelphi',
  17522. LinesToStr([ // statements
  17523. 'rtl.createClass($mod, "TObject", null, function () {',
  17524. ' this.$init = function () {',
  17525. ' };',
  17526. ' this.$final = function () {',
  17527. ' };',
  17528. ' this.DoIt = function (vA) {',
  17529. ' var Result = 0;',
  17530. ' return Result;',
  17531. ' };',
  17532. '});',
  17533. 'this.Obj = null;',
  17534. 'this.vP = null;',
  17535. 'this.b = false;'
  17536. ]),
  17537. LinesToStr([
  17538. '$mod.vP = rtl.createCallback($mod.Obj, "DoIt");',
  17539. '$mod.vP = rtl.createCallback($mod.Obj, "DoIt");',
  17540. '$mod.vP(1);',
  17541. '$mod.vP(1);',
  17542. '$mod.vP(2);',
  17543. '']));
  17544. end;
  17545. procedure TTestModule.TestProcType_PropertyFPC;
  17546. begin
  17547. StartProgram(false);
  17548. Add('type');
  17549. Add(' TFuncInt = function(vA: longint = 1): longint of object;');
  17550. Add(' TObject = class');
  17551. Add(' FOnFoo: TFuncInt;');
  17552. Add(' function DoIt(vA: longint = 1): longint;');
  17553. Add(' function GetFoo: TFuncInt;');
  17554. Add(' procedure SetFoo(const Value: TFuncInt);');
  17555. Add(' function GetEvents(Index: longint): TFuncInt;');
  17556. Add(' procedure SetEvents(Index: longint; const Value: TFuncInt);');
  17557. Add(' property OnFoo: TFuncInt read FOnFoo write FOnFoo;');
  17558. Add(' property OnBar: TFuncInt read GetFoo write SetFoo;');
  17559. Add(' property Events[Index: longint]: TFuncInt read GetEvents write SetEvents; default;');
  17560. Add(' end;');
  17561. Add('function tobject.doit(va: longint = 1): longint; begin end;');
  17562. Add('function tobject.getfoo: tfuncint; begin end;');
  17563. Add('procedure tobject.setfoo(const value: tfuncint); begin end;');
  17564. Add('function tobject.getevents(index: longint): tfuncint; begin end;');
  17565. Add('procedure tobject.setevents(index: longint; const value: tfuncint); begin end;');
  17566. Add('var');
  17567. Add(' Obj: TObject;');
  17568. Add(' vP: tfuncint;');
  17569. Add(' b: boolean;');
  17570. Add('begin');
  17571. Add(' obj.onfoo:=nil;');
  17572. Add(' obj.onbar:=nil;');
  17573. Add(' obj.events[1]:=nil;');
  17574. Add(' obj.onfoo:=obj.onfoo;');
  17575. Add(' obj.onbar:=obj.onbar;');
  17576. Add(' obj.events[2]:=obj.events[3];');
  17577. Add(' obj.onfoo:[email protected];');
  17578. Add(' obj.onbar:[email protected];');
  17579. Add(' obj.events[4]:[email protected];');
  17580. //Add(' obj.onfoo:=obj.doit;'); // delphi
  17581. //Add(' obj.onbar:=obj.doit;'); // delphi
  17582. //Add(' obj.events[4]:=obj.doit;'); // delphi
  17583. Add(' obj.onfoo;');
  17584. Add(' obj.onbar;');
  17585. //Add(' obj.events[5];'); ToDo in pasresolver
  17586. Add(' obj.onfoo();');
  17587. Add(' obj.onbar();');
  17588. Add(' obj.events[6]();');
  17589. Add(' b:=obj.onfoo=nil;');
  17590. Add(' b:=obj.onbar=nil;');
  17591. Add(' b:=obj.events[7]=nil;');
  17592. Add(' b:=obj.onfoo<>nil;');
  17593. Add(' b:=obj.onbar<>nil;');
  17594. Add(' b:=obj.events[8]<>nil;');
  17595. Add(' b:=obj.onfoo=vp;');
  17596. Add(' b:=obj.onbar=vp;');
  17597. Add(' b:=obj.events[9]=vp;');
  17598. Add(' b:=obj.onfoo=obj.onfoo;');
  17599. Add(' b:=obj.onbar=obj.onfoo;');
  17600. Add(' b:=obj.events[10]=obj.onfoo;');
  17601. Add(' b:=obj.onfoo<>obj.onfoo;');
  17602. Add(' b:=obj.onbar<>obj.onfoo;');
  17603. Add(' b:=obj.events[11]<>obj.onfoo;');
  17604. Add(' b:[email protected];');
  17605. Add(' b:[email protected];');
  17606. Add(' b:=obj.events[12][email protected];');
  17607. Add(' b:=obj.onfoo<>@obj.doit;');
  17608. Add(' b:=obj.onbar<>@obj.doit;');
  17609. Add(' b:=obj.events[12]<>@obj.doit;');
  17610. Add(' b:=Assigned(obj.onfoo);');
  17611. Add(' b:=Assigned(obj.onbar);');
  17612. Add(' b:=Assigned(obj.events[13]);');
  17613. ConvertProgram;
  17614. CheckSource('TestProcType_PropertyFPC',
  17615. LinesToStr([ // statements
  17616. 'rtl.createClass($mod, "TObject", null, function () {',
  17617. ' this.$init = function () {',
  17618. ' this.FOnFoo = null;',
  17619. ' };',
  17620. ' this.$final = function () {',
  17621. ' this.FOnFoo = undefined;',
  17622. ' };',
  17623. ' this.DoIt = function (vA) {',
  17624. ' var Result = 0;',
  17625. ' return Result;',
  17626. ' };',
  17627. 'this.GetFoo = function () {',
  17628. ' var Result = null;',
  17629. ' return Result;',
  17630. '};',
  17631. 'this.SetFoo = function (Value) {',
  17632. '};',
  17633. 'this.GetEvents = function (Index) {',
  17634. ' var Result = null;',
  17635. ' return Result;',
  17636. '};',
  17637. 'this.SetEvents = function (Index, Value) {',
  17638. '};',
  17639. '});',
  17640. 'this.Obj = null;',
  17641. 'this.vP = null;',
  17642. 'this.b = false;'
  17643. ]),
  17644. LinesToStr([
  17645. '$mod.Obj.FOnFoo = null;',
  17646. '$mod.Obj.SetFoo(null);',
  17647. '$mod.Obj.SetEvents(1, null);',
  17648. '$mod.Obj.FOnFoo = $mod.Obj.FOnFoo;',
  17649. '$mod.Obj.SetFoo($mod.Obj.GetFoo());',
  17650. '$mod.Obj.SetEvents(2, $mod.Obj.GetEvents(3));',
  17651. '$mod.Obj.FOnFoo = rtl.createCallback($mod.Obj, "DoIt");',
  17652. '$mod.Obj.SetFoo(rtl.createCallback($mod.Obj, "DoIt"));',
  17653. '$mod.Obj.SetEvents(4, rtl.createCallback($mod.Obj, "DoIt"));',
  17654. '$mod.Obj.FOnFoo(1);',
  17655. '$mod.Obj.GetFoo();',
  17656. '$mod.Obj.FOnFoo(1);',
  17657. '$mod.Obj.GetFoo()(1);',
  17658. '$mod.Obj.GetEvents(6)(1);',
  17659. '$mod.b = $mod.Obj.FOnFoo === null;',
  17660. '$mod.b = $mod.Obj.GetFoo() === null;',
  17661. '$mod.b = $mod.Obj.GetEvents(7) === null;',
  17662. '$mod.b = $mod.Obj.FOnFoo !== null;',
  17663. '$mod.b = $mod.Obj.GetFoo() !== null;',
  17664. '$mod.b = $mod.Obj.GetEvents(8) !== null;',
  17665. '$mod.b = rtl.eqCallback($mod.Obj.FOnFoo, $mod.vP);',
  17666. '$mod.b = rtl.eqCallback($mod.Obj.GetFoo(), $mod.vP);',
  17667. '$mod.b = rtl.eqCallback($mod.Obj.GetEvents(9), $mod.vP);',
  17668. '$mod.b = rtl.eqCallback($mod.Obj.FOnFoo, $mod.Obj.FOnFoo);',
  17669. '$mod.b = rtl.eqCallback($mod.Obj.GetFoo(), $mod.Obj.FOnFoo);',
  17670. '$mod.b = rtl.eqCallback($mod.Obj.GetEvents(10), $mod.Obj.FOnFoo);',
  17671. '$mod.b = !rtl.eqCallback($mod.Obj.FOnFoo, $mod.Obj.FOnFoo);',
  17672. '$mod.b = !rtl.eqCallback($mod.Obj.GetFoo(), $mod.Obj.FOnFoo);',
  17673. '$mod.b = !rtl.eqCallback($mod.Obj.GetEvents(11), $mod.Obj.FOnFoo);',
  17674. '$mod.b = rtl.eqCallback($mod.Obj.FOnFoo, rtl.createCallback($mod.Obj, "DoIt"));',
  17675. '$mod.b = rtl.eqCallback($mod.Obj.GetFoo(), rtl.createCallback($mod.Obj, "DoIt"));',
  17676. '$mod.b = rtl.eqCallback($mod.Obj.GetEvents(12), rtl.createCallback($mod.Obj, "DoIt"));',
  17677. '$mod.b = !rtl.eqCallback($mod.Obj.FOnFoo, rtl.createCallback($mod.Obj, "DoIt"));',
  17678. '$mod.b = !rtl.eqCallback($mod.Obj.GetFoo(), rtl.createCallback($mod.Obj, "DoIt"));',
  17679. '$mod.b = !rtl.eqCallback($mod.Obj.GetEvents(12), rtl.createCallback($mod.Obj, "DoIt"));',
  17680. '$mod.b = $mod.Obj.FOnFoo != null;',
  17681. '$mod.b = $mod.Obj.GetFoo() != null;',
  17682. '$mod.b = $mod.Obj.GetEvents(13) != null;',
  17683. '']));
  17684. end;
  17685. procedure TTestModule.TestProcType_PropertyDelphi;
  17686. begin
  17687. StartProgram(false);
  17688. Add('{$mode delphi}');
  17689. Add('type');
  17690. Add(' TFuncInt = function(vA: longint = 1): longint of object;');
  17691. Add(' TObject = class');
  17692. Add(' FOnFoo: TFuncInt;');
  17693. Add(' function DoIt(vA: longint = 1): longint;');
  17694. Add(' function GetFoo: TFuncInt;');
  17695. Add(' procedure SetFoo(const Value: TFuncInt);');
  17696. Add(' function GetEvents(Index: longint): TFuncInt;');
  17697. Add(' procedure SetEvents(Index: longint; const Value: TFuncInt);');
  17698. Add(' property OnFoo: TFuncInt read FOnFoo write FOnFoo;');
  17699. Add(' property OnBar: TFuncInt read GetFoo write SetFoo;');
  17700. Add(' property Events[Index: longint]: TFuncInt read GetEvents write SetEvents; default;');
  17701. Add(' end;');
  17702. Add('function tobject.doit(va: longint = 1): longint; begin end;');
  17703. Add('function tobject.getfoo: tfuncint; begin end;');
  17704. Add('procedure tobject.setfoo(const value: tfuncint); begin end;');
  17705. Add('function tobject.getevents(index: longint): tfuncint; begin end;');
  17706. Add('procedure tobject.setevents(index: longint; const value: tfuncint); begin end;');
  17707. Add('var');
  17708. Add(' Obj: TObject;');
  17709. Add(' vP: tfuncint;');
  17710. Add(' b: boolean;');
  17711. Add('begin');
  17712. Add(' obj.onfoo:=nil;');
  17713. Add(' obj.onbar:=nil;');
  17714. Add(' obj.events[1]:=nil;');
  17715. Add(' obj.onfoo:=obj.onfoo;');
  17716. Add(' obj.onbar:=obj.onbar;');
  17717. Add(' obj.events[2]:=obj.events[3];');
  17718. Add(' obj.onfoo:[email protected];');
  17719. Add(' obj.onbar:[email protected];');
  17720. Add(' obj.events[4]:[email protected];');
  17721. Add(' obj.onfoo:=obj.doit;'); // delphi
  17722. Add(' obj.onbar:=obj.doit;'); // delphi
  17723. Add(' obj.events[4]:=obj.doit;'); // delphi
  17724. Add(' obj.onfoo;');
  17725. Add(' obj.onbar;');
  17726. //Add(' obj.events[5];'); ToDo in pasresolver
  17727. Add(' obj.onfoo();');
  17728. Add(' obj.onbar();');
  17729. Add(' obj.events[6]();');
  17730. //Add(' b:=obj.onfoo=nil;'); // fpc
  17731. //Add(' b:=obj.onbar=nil;'); // fpc
  17732. //Add(' b:=obj.events[7]=nil;'); // fpc
  17733. //Add(' b:=obj.onfoo<>nil;'); // fpc
  17734. //Add(' b:=obj.onbar<>nil;'); // fpc
  17735. //Add(' b:=obj.events[8]<>nil;'); // fpc
  17736. Add(' b:=obj.onfoo=vp;');
  17737. Add(' b:=obj.onbar=vp;');
  17738. //Add(' b:=obj.events[9]=vp;'); ToDo in pasresolver
  17739. Add(' b:=obj.onfoo=obj.onfoo;');
  17740. Add(' b:=obj.onbar=obj.onfoo;');
  17741. //Add(' b:=obj.events[10]=obj.onfoo;'); // ToDo in pasresolver
  17742. Add(' b:=obj.onfoo<>obj.onfoo;');
  17743. Add(' b:=obj.onbar<>obj.onfoo;');
  17744. //Add(' b:=obj.events[11]<>obj.onfoo;'); // ToDo in pasresolver
  17745. //Add(' b:[email protected];'); // fpc
  17746. //Add(' b:[email protected];'); // fpc
  17747. //Add(' b:=obj.events[12][email protected];'); // fpc
  17748. //Add(' b:=obj.onfoo<>@obj.doit;'); // fpc
  17749. //Add(' b:=obj.onbar<>@obj.doit;'); // fpc
  17750. //Add(' b:=obj.events[12]<>@obj.doit;'); // fpc
  17751. Add(' b:=Assigned(obj.onfoo);');
  17752. Add(' b:=Assigned(obj.onbar);');
  17753. Add(' b:=Assigned(obj.events[13]);');
  17754. ConvertProgram;
  17755. CheckSource('TestProcType_PropertyDelphi',
  17756. LinesToStr([ // statements
  17757. 'rtl.createClass($mod, "TObject", null, function () {',
  17758. ' this.$init = function () {',
  17759. ' this.FOnFoo = null;',
  17760. ' };',
  17761. ' this.$final = function () {',
  17762. ' this.FOnFoo = undefined;',
  17763. ' };',
  17764. ' this.DoIt = function (vA) {',
  17765. ' var Result = 0;',
  17766. ' return Result;',
  17767. ' };',
  17768. 'this.GetFoo = function () {',
  17769. ' var Result = null;',
  17770. ' return Result;',
  17771. '};',
  17772. 'this.SetFoo = function (Value) {',
  17773. '};',
  17774. 'this.GetEvents = function (Index) {',
  17775. ' var Result = null;',
  17776. ' return Result;',
  17777. '};',
  17778. 'this.SetEvents = function (Index, Value) {',
  17779. '};',
  17780. '});',
  17781. 'this.Obj = null;',
  17782. 'this.vP = null;',
  17783. 'this.b = false;'
  17784. ]),
  17785. LinesToStr([
  17786. '$mod.Obj.FOnFoo = null;',
  17787. '$mod.Obj.SetFoo(null);',
  17788. '$mod.Obj.SetEvents(1, null);',
  17789. '$mod.Obj.FOnFoo = $mod.Obj.FOnFoo;',
  17790. '$mod.Obj.SetFoo($mod.Obj.GetFoo());',
  17791. '$mod.Obj.SetEvents(2, $mod.Obj.GetEvents(3));',
  17792. '$mod.Obj.FOnFoo = rtl.createCallback($mod.Obj, "DoIt");',
  17793. '$mod.Obj.SetFoo(rtl.createCallback($mod.Obj, "DoIt"));',
  17794. '$mod.Obj.SetEvents(4, rtl.createCallback($mod.Obj, "DoIt"));',
  17795. '$mod.Obj.FOnFoo = rtl.createCallback($mod.Obj, "DoIt");',
  17796. '$mod.Obj.SetFoo(rtl.createCallback($mod.Obj, "DoIt"));',
  17797. '$mod.Obj.SetEvents(4, rtl.createCallback($mod.Obj, "DoIt"));',
  17798. '$mod.Obj.FOnFoo(1);',
  17799. '$mod.Obj.GetFoo();',
  17800. '$mod.Obj.FOnFoo(1);',
  17801. '$mod.Obj.GetFoo()(1);',
  17802. '$mod.Obj.GetEvents(6)(1);',
  17803. '$mod.b = $mod.Obj.FOnFoo(1) === $mod.vP(1);',
  17804. '$mod.b = $mod.Obj.GetFoo() === $mod.vP(1);',
  17805. '$mod.b = $mod.Obj.FOnFoo(1) === $mod.Obj.FOnFoo(1);',
  17806. '$mod.b = $mod.Obj.GetFoo() === $mod.Obj.FOnFoo(1);',
  17807. '$mod.b = $mod.Obj.FOnFoo(1) !== $mod.Obj.FOnFoo(1);',
  17808. '$mod.b = $mod.Obj.GetFoo() !== $mod.Obj.FOnFoo(1);',
  17809. '$mod.b = $mod.Obj.FOnFoo != null;',
  17810. '$mod.b = $mod.Obj.GetFoo() != null;',
  17811. '$mod.b = $mod.Obj.GetEvents(13) != null;',
  17812. '']));
  17813. end;
  17814. procedure TTestModule.TestProcType_WithClassInstDoPropertyFPC;
  17815. begin
  17816. StartProgram(false);
  17817. Add('type');
  17818. Add(' TFuncInt = function(vA: longint = 1): longint of object;');
  17819. Add(' TObject = class');
  17820. Add(' FOnFoo: TFuncInt;');
  17821. Add(' function DoIt(vA: longint = 1): longint;');
  17822. Add(' function GetFoo: TFuncInt;');
  17823. Add(' procedure SetFoo(const Value: TFuncInt);');
  17824. Add(' property OnFoo: TFuncInt read FOnFoo write FOnFoo;');
  17825. Add(' property OnBar: TFuncInt read GetFoo write SetFoo;');
  17826. Add(' end;');
  17827. Add('function tobject.doit(va: longint = 1): longint; begin end;');
  17828. Add('function tobject.getfoo: tfuncint; begin end;');
  17829. Add('procedure tobject.setfoo(const value: tfuncint); begin end;');
  17830. Add('var');
  17831. Add(' Obj: TObject;');
  17832. Add(' vP: tfuncint;');
  17833. Add(' b: boolean;');
  17834. Add('begin');
  17835. Add('with obj do begin');
  17836. Add(' fonfoo:=nil;');
  17837. Add(' onfoo:=nil;');
  17838. Add(' onbar:=nil;');
  17839. Add(' fonfoo:=fonfoo;');
  17840. Add(' onfoo:=onfoo;');
  17841. Add(' onbar:=onbar;');
  17842. Add(' fonfoo:=@doit;');
  17843. Add(' onfoo:=@doit;');
  17844. Add(' onbar:=@doit;');
  17845. //Add(' fonfoo:=doit;'); // delphi
  17846. //Add(' onfoo:=doit;'); // delphi
  17847. //Add(' onbar:=doit;'); // delphi
  17848. Add(' fonfoo;');
  17849. Add(' onfoo;');
  17850. Add(' onbar;');
  17851. Add(' fonfoo();');
  17852. Add(' onfoo();');
  17853. Add(' onbar();');
  17854. Add(' b:=fonfoo=nil;');
  17855. Add(' b:=onfoo=nil;');
  17856. Add(' b:=onbar=nil;');
  17857. Add(' b:=fonfoo<>nil;');
  17858. Add(' b:=onfoo<>nil;');
  17859. Add(' b:=onbar<>nil;');
  17860. Add(' b:=fonfoo=vp;');
  17861. Add(' b:=onfoo=vp;');
  17862. Add(' b:=onbar=vp;');
  17863. Add(' b:=fonfoo=fonfoo;');
  17864. Add(' b:=onfoo=onfoo;');
  17865. Add(' b:=onbar=onfoo;');
  17866. Add(' b:=fonfoo<>fonfoo;');
  17867. Add(' b:=onfoo<>onfoo;');
  17868. Add(' b:=onbar<>onfoo;');
  17869. Add(' b:=fonfoo=@doit;');
  17870. Add(' b:=onfoo=@doit;');
  17871. Add(' b:=onbar=@doit;');
  17872. Add(' b:=fonfoo<>@doit;');
  17873. Add(' b:=onfoo<>@doit;');
  17874. Add(' b:=onbar<>@doit;');
  17875. Add(' b:=Assigned(fonfoo);');
  17876. Add(' b:=Assigned(onfoo);');
  17877. Add(' b:=Assigned(onbar);');
  17878. Add('end;');
  17879. ConvertProgram;
  17880. CheckSource('TestProcType_WithClassInstDoPropertyFPC',
  17881. LinesToStr([ // statements
  17882. 'rtl.createClass($mod, "TObject", null, function () {',
  17883. ' this.$init = function () {',
  17884. ' this.FOnFoo = null;',
  17885. ' };',
  17886. ' this.$final = function () {',
  17887. ' this.FOnFoo = undefined;',
  17888. ' };',
  17889. ' this.DoIt = function (vA) {',
  17890. ' var Result = 0;',
  17891. ' return Result;',
  17892. ' };',
  17893. ' this.GetFoo = function () {',
  17894. ' var Result = null;',
  17895. ' return Result;',
  17896. ' };',
  17897. ' this.SetFoo = function (Value) {',
  17898. ' };',
  17899. '});',
  17900. 'this.Obj = null;',
  17901. 'this.vP = null;',
  17902. 'this.b = false;'
  17903. ]),
  17904. LinesToStr([
  17905. 'var $with1 = $mod.Obj;',
  17906. '$with1.FOnFoo = null;',
  17907. '$with1.FOnFoo = null;',
  17908. '$with1.SetFoo(null);',
  17909. '$with1.FOnFoo = $with1.FOnFoo;',
  17910. '$with1.FOnFoo = $with1.FOnFoo;',
  17911. '$with1.SetFoo($with1.GetFoo());',
  17912. '$with1.FOnFoo = rtl.createCallback($with1, "DoIt");',
  17913. '$with1.FOnFoo = rtl.createCallback($with1, "DoIt");',
  17914. '$with1.SetFoo(rtl.createCallback($with1, "DoIt"));',
  17915. '$with1.FOnFoo(1);',
  17916. '$with1.FOnFoo(1);',
  17917. '$with1.GetFoo();',
  17918. '$with1.FOnFoo(1);',
  17919. '$with1.FOnFoo(1);',
  17920. '$with1.GetFoo()(1);',
  17921. '$mod.b = $with1.FOnFoo === null;',
  17922. '$mod.b = $with1.FOnFoo === null;',
  17923. '$mod.b = $with1.GetFoo() === null;',
  17924. '$mod.b = $with1.FOnFoo !== null;',
  17925. '$mod.b = $with1.FOnFoo !== null;',
  17926. '$mod.b = $with1.GetFoo() !== null;',
  17927. '$mod.b = rtl.eqCallback($with1.FOnFoo, $mod.vP);',
  17928. '$mod.b = rtl.eqCallback($with1.FOnFoo, $mod.vP);',
  17929. '$mod.b = rtl.eqCallback($with1.GetFoo(), $mod.vP);',
  17930. '$mod.b = rtl.eqCallback($with1.FOnFoo, $with1.FOnFoo);',
  17931. '$mod.b = rtl.eqCallback($with1.FOnFoo, $with1.FOnFoo);',
  17932. '$mod.b = rtl.eqCallback($with1.GetFoo(), $with1.FOnFoo);',
  17933. '$mod.b = !rtl.eqCallback($with1.FOnFoo, $with1.FOnFoo);',
  17934. '$mod.b = !rtl.eqCallback($with1.FOnFoo, $with1.FOnFoo);',
  17935. '$mod.b = !rtl.eqCallback($with1.GetFoo(), $with1.FOnFoo);',
  17936. '$mod.b = rtl.eqCallback($with1.FOnFoo, rtl.createCallback($with1, "DoIt"));',
  17937. '$mod.b = rtl.eqCallback($with1.FOnFoo, rtl.createCallback($with1, "DoIt"));',
  17938. '$mod.b = rtl.eqCallback($with1.GetFoo(), rtl.createCallback($with1, "DoIt"));',
  17939. '$mod.b = !rtl.eqCallback($with1.FOnFoo, rtl.createCallback($with1, "DoIt"));',
  17940. '$mod.b = !rtl.eqCallback($with1.FOnFoo, rtl.createCallback($with1, "DoIt"));',
  17941. '$mod.b = !rtl.eqCallback($with1.GetFoo(), rtl.createCallback($with1, "DoIt"));',
  17942. '$mod.b = $with1.FOnFoo != null;',
  17943. '$mod.b = $with1.FOnFoo != null;',
  17944. '$mod.b = $with1.GetFoo() != null;',
  17945. '']));
  17946. end;
  17947. procedure TTestModule.TestProcType_Nested;
  17948. begin
  17949. StartProgram(false);
  17950. Add([
  17951. 'type',
  17952. ' TProcInt = procedure(vI: longint = 1);',
  17953. 'procedure DoIt(vJ: longint);',
  17954. 'var aProc: TProcInt;',
  17955. ' b: boolean;',
  17956. ' procedure Sub(vK: longint);',
  17957. ' var aSub: TProcInt;',
  17958. ' procedure SubSub(vK: longint);',
  17959. ' var aSubSub: TProcInt;',
  17960. ' begin;',
  17961. ' aProc:=@DoIt;',
  17962. ' aSub:=@DoIt;',
  17963. ' aSubSub:=@DoIt;',
  17964. ' aProc:=@Sub;',
  17965. ' aSub:=@Sub;',
  17966. ' aSubSub:=@Sub;',
  17967. ' aProc:=@SubSub;',
  17968. ' aSub:=@SubSub;',
  17969. ' aSubSub:=@SubSub;',
  17970. ' end;',
  17971. ' begin;',
  17972. ' end;',
  17973. 'begin;',
  17974. ' aProc:=@Sub;',
  17975. ' b:=aProc=@Sub;',
  17976. ' b:=@Sub=aProc;',
  17977. 'end;',
  17978. 'begin',
  17979. '']);
  17980. ConvertProgram;
  17981. CheckSource('TestProcType_Nested',
  17982. LinesToStr([ // statements
  17983. 'this.DoIt = function (vJ) {',
  17984. ' var aProc = null;',
  17985. ' var b = false;',
  17986. ' function Sub(vK) {',
  17987. ' var aSub = null;',
  17988. ' function SubSub(vK) {',
  17989. ' var aSubSub = null;',
  17990. ' aProc = $mod.DoIt;',
  17991. ' aSub = $mod.DoIt;',
  17992. ' aSubSub = $mod.DoIt;',
  17993. ' aProc = Sub;',
  17994. ' aSub = Sub;',
  17995. ' aSubSub = Sub;',
  17996. ' aProc = SubSub;',
  17997. ' aSub = SubSub;',
  17998. ' aSubSub = SubSub;',
  17999. ' };',
  18000. ' };',
  18001. ' aProc = Sub;',
  18002. ' b = rtl.eqCallback(aProc, Sub);',
  18003. ' b = rtl.eqCallback(Sub, aProc);',
  18004. '};',
  18005. '']),
  18006. LinesToStr([ // $mod.$main
  18007. '']));
  18008. end;
  18009. procedure TTestModule.TestProcType_NestedOfObject;
  18010. begin
  18011. StartProgram(false);
  18012. Add([
  18013. 'type',
  18014. ' TProcInt = procedure(vI: longint = 1) of object;',
  18015. ' TObject = class',
  18016. ' procedure DoIt(vJ: longint);',
  18017. ' end;',
  18018. 'procedure TObject.DoIt(vJ: longint);',
  18019. 'var aProc: TProcInt;',
  18020. ' b: boolean;',
  18021. ' procedure Sub(vK: longint);',
  18022. ' var aSub: TProcInt;',
  18023. ' procedure SubSub(vK: longint);',
  18024. ' var aSubSub: TProcInt;',
  18025. ' begin;',
  18026. ' aProc:=@DoIt;',
  18027. ' aSub:=@DoIt;',
  18028. ' aSubSub:=@DoIt;',
  18029. ' aProc:=@Sub;',
  18030. ' aSub:=@Sub;',
  18031. ' aSubSub:=@Sub;',
  18032. ' aProc:=@SubSub;',
  18033. ' aSub:=@SubSub;',
  18034. ' aSubSub:=@SubSub;',
  18035. ' end;',
  18036. ' begin;',
  18037. ' end;',
  18038. 'begin;',
  18039. ' aProc:=@Sub;',
  18040. ' b:=aProc=@Sub;',
  18041. ' b:=@Sub=aProc;',
  18042. 'end;',
  18043. 'begin',
  18044. '']);
  18045. ConvertProgram;
  18046. CheckSource('TestProcType_Nested',
  18047. LinesToStr([ // statements
  18048. 'rtl.createClass($mod, "TObject", null, function () {',
  18049. ' this.$init = function () {',
  18050. ' };',
  18051. ' this.$final = function () {',
  18052. ' };',
  18053. ' this.DoIt = function (vJ) {',
  18054. ' var Self = this;',
  18055. ' var aProc = null;',
  18056. ' var b = false;',
  18057. ' function Sub(vK) {',
  18058. ' var aSub = null;',
  18059. ' function SubSub(vK) {',
  18060. ' var aSubSub = null;',
  18061. ' aProc = rtl.createCallback(Self, "DoIt");',
  18062. ' aSub = rtl.createCallback(Self, "DoIt");',
  18063. ' aSubSub = rtl.createCallback(Self, "DoIt");',
  18064. ' aProc = Sub;',
  18065. ' aSub = Sub;',
  18066. ' aSubSub = Sub;',
  18067. ' aProc = SubSub;',
  18068. ' aSub = SubSub;',
  18069. ' aSubSub = SubSub;',
  18070. ' };',
  18071. ' };',
  18072. ' aProc = Sub;',
  18073. ' b = rtl.eqCallback(aProc, Sub);',
  18074. ' b = rtl.eqCallback(Sub, aProc);',
  18075. ' };',
  18076. '});',
  18077. '']),
  18078. LinesToStr([ // $mod.$main
  18079. '']));
  18080. end;
  18081. procedure TTestModule.TestProcType_ReferenceToProc;
  18082. begin
  18083. StartProgram(false);
  18084. Add([
  18085. 'type',
  18086. ' TProcRef = reference to procedure(i: longint = 0);',
  18087. ' TFuncRef = reference to function(i: longint = 0): longint;',
  18088. 'var',
  18089. ' p: TProcRef;',
  18090. ' f: TFuncRef;',
  18091. 'procedure DoIt(i: longint);',
  18092. 'begin',
  18093. 'end;',
  18094. 'function GetIt(i: longint): longint;',
  18095. 'begin',
  18096. ' p:=@DoIt;',
  18097. ' f:=@GetIt;',
  18098. ' f;',
  18099. ' f();',
  18100. ' f(1);',
  18101. 'end;',
  18102. 'begin',
  18103. ' p:=@DoIt;',
  18104. ' f:=@GetIt;',
  18105. ' f;',
  18106. ' f();',
  18107. ' f(1);',
  18108. ' p:=TProcRef(f);',
  18109. '']);
  18110. ConvertProgram;
  18111. CheckSource('TestProcType_ReferenceToProc',
  18112. LinesToStr([ // statements
  18113. 'this.p = null;',
  18114. 'this.f = null;',
  18115. 'this.DoIt = function (i) {',
  18116. '};',
  18117. 'this.GetIt = function (i) {',
  18118. ' var Result = 0;',
  18119. ' $mod.p = $mod.DoIt;',
  18120. ' $mod.f = $mod.GetIt;',
  18121. ' $mod.f(0);',
  18122. ' $mod.f(0);',
  18123. ' $mod.f(1);',
  18124. ' return Result;',
  18125. '};',
  18126. '']),
  18127. LinesToStr([ // $mod.$main
  18128. '$mod.p = $mod.DoIt;',
  18129. '$mod.f = $mod.GetIt;',
  18130. '$mod.f(0);',
  18131. '$mod.f(0);',
  18132. '$mod.f(1);',
  18133. '$mod.p = $mod.f;',
  18134. '']));
  18135. end;
  18136. procedure TTestModule.TestProcType_ReferenceToMethod;
  18137. begin
  18138. StartProgram(false);
  18139. Add([
  18140. 'type',
  18141. ' TFuncRef = reference to function(i: longint = 5): longint;',
  18142. ' TObject = class',
  18143. ' function Grow(s: longint): longint;',
  18144. ' end;',
  18145. 'var',
  18146. ' f: tfuncref;',
  18147. 'function tobject.grow(s: longint): longint;',
  18148. ' function GrowSub(i: longint): longint;',
  18149. ' begin',
  18150. ' f:=@grow;',
  18151. ' f:=@growsub;',
  18152. ' end;',
  18153. 'begin',
  18154. ' f:=@grow;',
  18155. ' f:=@growsub;',
  18156. 'end;',
  18157. 'begin',
  18158. '']);
  18159. ConvertProgram;
  18160. CheckSource('TestProcType_ReferenceToMethod',
  18161. LinesToStr([ // statements
  18162. 'rtl.createClass($mod, "TObject", null, function () {',
  18163. ' this.$init = function () {',
  18164. ' };',
  18165. ' this.$final = function () {',
  18166. ' };',
  18167. ' this.Grow = function (s) {',
  18168. ' var Self = this;',
  18169. ' var Result = 0;',
  18170. ' function GrowSub(i) {',
  18171. ' var Result = 0;',
  18172. ' $mod.f = rtl.createCallback(Self, "Grow");',
  18173. ' $mod.f = GrowSub;',
  18174. ' return Result;',
  18175. ' };',
  18176. ' $mod.f = rtl.createCallback(Self, "Grow");',
  18177. ' $mod.f = GrowSub;',
  18178. ' return Result;',
  18179. ' };',
  18180. '});',
  18181. 'this.f = null;',
  18182. '']),
  18183. LinesToStr([ // $mod.$main
  18184. '']));
  18185. end;
  18186. procedure TTestModule.TestProcType_Typecast;
  18187. begin
  18188. StartProgram(false);
  18189. Add([
  18190. 'type',
  18191. ' TNotifyEvent = procedure(Sender: Pointer) of object;',
  18192. ' TEvent = procedure of object;',
  18193. ' TGetter = function:longint of object;',
  18194. ' TProcA = procedure(i: longint);',
  18195. ' TFuncB = function(i, j: longint): longint;',
  18196. 'procedure DoIt(); varargs; begin end;',
  18197. 'var',
  18198. ' Notify: tnotifyevent;',
  18199. ' Event: tevent;',
  18200. ' Getter: tgetter;',
  18201. ' ProcA: tproca;',
  18202. ' FuncB: tfuncb;',
  18203. ' p: pointer;',
  18204. 'begin',
  18205. ' notify:=tnotifyevent(event);',
  18206. ' event:=tevent(event);',
  18207. ' event:=tevent(notify);',
  18208. ' event:=tevent(getter);',
  18209. ' event:=tevent(proca);',
  18210. ' proca:=tproca(funcb);',
  18211. ' funcb:=tfuncb(funcb);',
  18212. ' funcb:=tfuncb(proca);',
  18213. ' funcb:=tfuncb(getter);',
  18214. ' proca:=tproca(p);',
  18215. ' funcb:=tfuncb(p);',
  18216. ' getter:=tgetter(p);',
  18217. ' p:=pointer(notify);',
  18218. ' p:=notify;',
  18219. ' p:=pointer(proca);',
  18220. ' p:=proca;',
  18221. ' p:=pointer(funcb);',
  18222. ' p:=funcb;',
  18223. ' doit(Pointer(notify),pointer(event),pointer(proca));',
  18224. '']);
  18225. ConvertProgram;
  18226. CheckSource('TestProcType_Typecast',
  18227. LinesToStr([ // statements
  18228. 'this.DoIt = function () {',
  18229. '};',
  18230. 'this.Notify = null;',
  18231. 'this.Event = null;',
  18232. 'this.Getter = null;',
  18233. 'this.ProcA = null;',
  18234. 'this.FuncB = null;',
  18235. 'this.p = null;',
  18236. '']),
  18237. LinesToStr([ // $mod.$main
  18238. '$mod.Notify = $mod.Event;',
  18239. '$mod.Event = $mod.Event;',
  18240. '$mod.Event = $mod.Notify;',
  18241. '$mod.Event = $mod.Getter;',
  18242. '$mod.Event = $mod.ProcA;',
  18243. '$mod.ProcA = $mod.FuncB;',
  18244. '$mod.FuncB = $mod.FuncB;',
  18245. '$mod.FuncB = $mod.ProcA;',
  18246. '$mod.FuncB = $mod.Getter;',
  18247. '$mod.ProcA = $mod.p;',
  18248. '$mod.FuncB = $mod.p;',
  18249. '$mod.Getter = $mod.p;',
  18250. '$mod.p = $mod.Notify;',
  18251. '$mod.p = $mod.Notify;',
  18252. '$mod.p = $mod.ProcA;',
  18253. '$mod.p = $mod.ProcA;',
  18254. '$mod.p = $mod.FuncB;',
  18255. '$mod.p = $mod.FuncB;',
  18256. '$mod.DoIt($mod.Notify, $mod.Event, $mod.ProcA);',
  18257. '']));
  18258. end;
  18259. procedure TTestModule.TestProcType_PassProcToUntyped;
  18260. begin
  18261. StartProgram(false);
  18262. Add([
  18263. 'type',
  18264. ' TEvent = procedure of object;',
  18265. ' TFunc = function: longint;',
  18266. 'procedure DoIt(); varargs; begin end;',
  18267. 'procedure DoSome(const a; var b; p: pointer); begin end;',
  18268. 'var',
  18269. ' Event: tevent;',
  18270. ' Func: TFunc;',
  18271. 'begin',
  18272. ' doit(event,func);',
  18273. ' dosome(event,event,event);',
  18274. ' dosome(func,func,func);',
  18275. '']);
  18276. ConvertProgram;
  18277. CheckSource('TestProcType_PassProcToUntyped',
  18278. LinesToStr([ // statements
  18279. 'this.DoIt = function () {',
  18280. '};',
  18281. 'this.DoSome = function (a, b, p) {',
  18282. '};',
  18283. 'this.Event = null;',
  18284. 'this.Func = null;',
  18285. '']),
  18286. LinesToStr([ // $mod.$main
  18287. '$mod.DoIt($mod.Event, $mod.Func);',
  18288. '$mod.DoSome($mod.Event, {',
  18289. ' p: $mod,',
  18290. ' get: function () {',
  18291. ' return this.p.Event;',
  18292. ' },',
  18293. ' set: function (v) {',
  18294. ' this.p.Event = v;',
  18295. ' }',
  18296. '}, $mod.Event);',
  18297. '$mod.DoSome($mod.Func, {',
  18298. ' p: $mod,',
  18299. ' get: function () {',
  18300. ' return this.p.Func;',
  18301. ' },',
  18302. ' set: function (v) {',
  18303. ' this.p.Func = v;',
  18304. ' }',
  18305. '}, $mod.Func);',
  18306. '']));
  18307. end;
  18308. procedure TTestModule.TestProcType_PassProcToArray;
  18309. begin
  18310. StartProgram(false);
  18311. Add([
  18312. 'type',
  18313. ' TFunc = function: longint;',
  18314. ' TArrFunc = array of TFunc;',
  18315. 'procedure DoIt(Arr: TArrFunc); begin end;',
  18316. 'function GetIt: longint; begin end;',
  18317. 'var',
  18318. ' Func: tfunc;',
  18319. 'begin',
  18320. ' doit([]);',
  18321. ' doit([@GetIt]);',
  18322. ' doit([Func]);',
  18323. '']);
  18324. ConvertProgram;
  18325. CheckSource('TestProcType_PassProcToArray',
  18326. LinesToStr([ // statements
  18327. 'this.DoIt = function (Arr) {',
  18328. '};',
  18329. 'this.GetIt = function () {',
  18330. ' var Result = 0;',
  18331. ' return Result;',
  18332. '};',
  18333. 'this.Func = null;',
  18334. '']),
  18335. LinesToStr([ // $mod.$main
  18336. '$mod.DoIt([]);',
  18337. '$mod.DoIt([$mod.GetIt]);',
  18338. '$mod.DoIt([$mod.Func]);',
  18339. '']));
  18340. end;
  18341. procedure TTestModule.TestPointer;
  18342. begin
  18343. StartProgram(false);
  18344. Add(['type',
  18345. ' TObject = class end;',
  18346. ' TClass = class of TObject;',
  18347. ' TArrInt = array of longint;',
  18348. 'const',
  18349. ' n = nil;',
  18350. 'var',
  18351. ' v: jsvalue;',
  18352. ' Obj: tobject;',
  18353. ' C: tclass;',
  18354. ' a: tarrint;',
  18355. ' p: Pointer = nil;',
  18356. ' s: string;',
  18357. 'begin',
  18358. ' p:=p;',
  18359. ' p:=nil;',
  18360. ' if p=nil then;',
  18361. ' if nil=p then;',
  18362. ' if Assigned(p) then;',
  18363. ' p:=Pointer(v);',
  18364. ' p:=obj;',
  18365. ' p:=c;',
  18366. ' p:=a;',
  18367. ' p:=tobject;',
  18368. ' obj:=TObject(p);',
  18369. ' c:=TClass(p);',
  18370. ' a:=TArrInt(p);',
  18371. ' p:=n;',
  18372. ' p:=Pointer(a);',
  18373. ' p:=pointer(s);',
  18374. ' s:=string(p);',
  18375. '']);
  18376. ConvertProgram;
  18377. CheckSource('TestPointer',
  18378. LinesToStr([ // statements
  18379. 'rtl.createClass($mod, "TObject", null, function () {',
  18380. ' this.$init = function () {',
  18381. ' };',
  18382. ' this.$final = function () {',
  18383. ' };',
  18384. '});',
  18385. 'this.n = null;',
  18386. 'this.v = undefined;',
  18387. 'this.Obj = null;',
  18388. 'this.C = null;',
  18389. 'this.a = [];',
  18390. 'this.p = null;',
  18391. 'this.s = "";',
  18392. '']),
  18393. LinesToStr([ // $mod.$main
  18394. '$mod.p = $mod.p;',
  18395. '$mod.p = null;',
  18396. 'if ($mod.p === null) ;',
  18397. 'if (null === $mod.p) ;',
  18398. 'if ($mod.p != null) ;',
  18399. '$mod.p = $mod.v;',
  18400. '$mod.p = $mod.Obj;',
  18401. '$mod.p = $mod.C;',
  18402. '$mod.p = $mod.a;',
  18403. '$mod.p = $mod.TObject;',
  18404. '$mod.Obj = $mod.p;',
  18405. '$mod.C = $mod.p;',
  18406. '$mod.a = $mod.p;',
  18407. '$mod.p = null;',
  18408. '$mod.p = $mod.a;',
  18409. '$mod.p = $mod.s;',
  18410. '$mod.s = $mod.p;',
  18411. '']));
  18412. end;
  18413. procedure TTestModule.TestPointer_Proc;
  18414. begin
  18415. StartProgram(false);
  18416. Add('type');
  18417. Add(' TObject = class');
  18418. Add(' procedure DoIt; virtual; abstract;');
  18419. Add(' end;');
  18420. Add('procedure DoSome; begin end;');
  18421. Add('var');
  18422. Add(' o: TObject;');
  18423. Add(' p: Pointer;');
  18424. Add('begin');
  18425. Add(' p:=@DoSome;');
  18426. Add(' p:[email protected];');
  18427. ConvertProgram;
  18428. CheckSource('TestPointer_Proc',
  18429. LinesToStr([ // statements
  18430. 'rtl.createClass($mod, "TObject", null, function () {',
  18431. ' this.$init = function () {',
  18432. ' };',
  18433. ' this.$final = function () {',
  18434. ' };',
  18435. '});',
  18436. 'this.DoSome = function () {',
  18437. '};',
  18438. 'this.o = null;',
  18439. 'this.p = null;',
  18440. '']),
  18441. LinesToStr([ // $mod.$main
  18442. '$mod.p = $mod.DoSome;',
  18443. '$mod.p = rtl.createCallback($mod.o, "DoIt");',
  18444. '']));
  18445. end;
  18446. procedure TTestModule.TestPointer_AssignRecordFail;
  18447. begin
  18448. StartProgram(false);
  18449. Add('type');
  18450. Add(' TRec = record end;');
  18451. Add('var');
  18452. Add(' p: Pointer;');
  18453. Add(' r: TRec;');
  18454. Add('begin');
  18455. Add(' p:=r;');
  18456. SetExpectedPasResolverError('Incompatible types: got "TRec" expected "Pointer"',
  18457. nIncompatibleTypesGotExpected);
  18458. ConvertProgram;
  18459. end;
  18460. procedure TTestModule.TestPointer_AssignStaticArrayFail;
  18461. begin
  18462. StartProgram(false);
  18463. Add('type');
  18464. Add(' TArr = array[boolean] of longint;');
  18465. Add('var');
  18466. Add(' p: Pointer;');
  18467. Add(' a: TArr;');
  18468. Add('begin');
  18469. Add(' p:=a;');
  18470. SetExpectedPasResolverError('Incompatible types: got "TArr" expected "Pointer"',
  18471. nIncompatibleTypesGotExpected);
  18472. ConvertProgram;
  18473. end;
  18474. procedure TTestModule.TestPointer_TypeCastJSValueToPointer;
  18475. begin
  18476. StartProgram(false);
  18477. Add([
  18478. 'procedure DoIt(args: array of jsvalue); begin end;',
  18479. 'procedure DoAll; varargs; begin end;',
  18480. 'var',
  18481. ' v: jsvalue;',
  18482. 'begin',
  18483. ' DoIt([pointer(v)]);',
  18484. ' DoAll(pointer(v));',
  18485. '']);
  18486. ConvertProgram;
  18487. CheckSource('TestPointer_TypeCastJSValueToPointer',
  18488. LinesToStr([ // statements
  18489. 'this.DoIt = function (args) {',
  18490. '};',
  18491. 'this.DoAll = function () {',
  18492. '};',
  18493. 'this.v = undefined;',
  18494. '']),
  18495. LinesToStr([ // $mod.$main
  18496. '$mod.DoIt([$mod.v]);',
  18497. '$mod.DoAll($mod.v);',
  18498. '']));
  18499. end;
  18500. procedure TTestModule.TestPointer_NonRecordFail;
  18501. begin
  18502. StartProgram(false);
  18503. Add([
  18504. 'type',
  18505. ' p = ^longint;',
  18506. 'begin',
  18507. '']);
  18508. SetExpectedPasResolverError('Not supported: pointer of Longint',nNotSupportedX);
  18509. ConvertProgram;
  18510. end;
  18511. procedure TTestModule.TestPointer_AnonymousArgTypeFail;
  18512. begin
  18513. StartProgram(false);
  18514. Add([
  18515. 'procedure DoIt(p: ^longint); begin end;',
  18516. 'begin',
  18517. '']);
  18518. SetExpectedPasResolverError('Not supported: pointer',nNotSupportedX);
  18519. ConvertProgram;
  18520. end;
  18521. procedure TTestModule.TestPointer_AnonymousVarTypeFail;
  18522. begin
  18523. StartProgram(false);
  18524. Add([
  18525. 'var p: ^longint;',
  18526. 'begin',
  18527. '']);
  18528. SetExpectedPasResolverError('Not supported: pointer',nNotSupportedX);
  18529. ConvertProgram;
  18530. end;
  18531. procedure TTestModule.TestPointer_AnonymousResultTypeFail;
  18532. begin
  18533. StartProgram(false);
  18534. Add([
  18535. 'function DoIt: ^longint; begin end;',
  18536. 'begin',
  18537. '']);
  18538. SetExpectedPasResolverError('Not supported: pointer',nNotSupportedX);
  18539. ConvertProgram;
  18540. end;
  18541. procedure TTestModule.TestPointer_AddrOperatorFail;
  18542. begin
  18543. StartProgram(false);
  18544. Add([
  18545. 'var i: longint;',
  18546. 'begin',
  18547. ' if @i=nil then ;',
  18548. '']);
  18549. SetExpectedConverterError('illegal qualifier "@" in front of "i:Longint"',nIllegalQualifierInFrontOf);
  18550. ConvertProgram;
  18551. end;
  18552. procedure TTestModule.TestPointer_ArrayParamsFail;
  18553. begin
  18554. StartProgram(false);
  18555. Add([
  18556. 'var',
  18557. ' p: Pointer;',
  18558. 'begin',
  18559. ' p:=p[1];',
  18560. '']);
  18561. SetExpectedPasResolverError('illegal qualifier "[" after "Pointer"',nIllegalQualifierAfter);
  18562. ConvertProgram;
  18563. end;
  18564. procedure TTestModule.TestPointer_PointerAddFail;
  18565. begin
  18566. StartProgram(false);
  18567. Add([
  18568. 'var',
  18569. ' p: Pointer;',
  18570. 'begin',
  18571. ' p:=p+1;',
  18572. '']);
  18573. SetExpectedPasResolverError('Operator is not overloaded: "Pointer" + "Longint"',nOperatorIsNotOverloadedAOpB);
  18574. ConvertProgram;
  18575. end;
  18576. procedure TTestModule.TestPointer_IncPointerFail;
  18577. begin
  18578. StartProgram(false);
  18579. Add([
  18580. 'var',
  18581. ' p: Pointer;',
  18582. 'begin',
  18583. ' inc(p,1);',
  18584. '']);
  18585. SetExpectedPasResolverError('Incompatible type arg no. 1: Got "Pointer", expected "integer"',
  18586. nIncompatibleTypeArgNo);
  18587. ConvertProgram;
  18588. end;
  18589. procedure TTestModule.TestPointer_Record;
  18590. begin
  18591. StartProgram(false);
  18592. Add([
  18593. 'type',
  18594. ' TRec = record x: longint; end;',
  18595. ' PRec = ^TRec;',
  18596. 'var',
  18597. ' r: TRec;',
  18598. ' p: PRec;',
  18599. ' q: ^TRec;',
  18600. ' Ptr: pointer;',
  18601. 'begin',
  18602. ' new(p);',
  18603. ' p:=@r;',
  18604. ' r:=p^;',
  18605. ' r.x:=p^.x;',
  18606. ' p^.x:=r.x;',
  18607. ' if p^.x=3 then ;',
  18608. ' if 4=p^.x then ;',
  18609. ' dispose(p);',
  18610. ' new(q);',
  18611. ' dispose(q);',
  18612. ' Ptr:=p;',
  18613. ' p:=PRec(ptr);',
  18614. '']);
  18615. ConvertProgram;
  18616. CheckSource('TestPointer_Record',
  18617. LinesToStr([ // statements
  18618. 'this.TRec = function (s) {',
  18619. ' if (s) {',
  18620. ' this.x = s.x;',
  18621. ' } else {',
  18622. ' this.x = 0;',
  18623. ' };',
  18624. ' this.$equal = function (b) {',
  18625. ' return this.x === b.x;',
  18626. ' };',
  18627. '};',
  18628. 'this.r = new $mod.TRec();',
  18629. 'this.p = null;',
  18630. 'this.q = null;',
  18631. 'this.Ptr = null;',
  18632. '']),
  18633. LinesToStr([ // $mod.$main
  18634. '$mod.p = new $mod.TRec();',
  18635. '$mod.p = $mod.r;',
  18636. '$mod.r = new $mod.TRec($mod.p);',
  18637. '$mod.r.x = $mod.p.x;',
  18638. '$mod.p.x = $mod.r.x;',
  18639. 'if ($mod.p.x === 3) ;',
  18640. 'if (4 === $mod.p.x) ;',
  18641. '$mod.p = null;',
  18642. '$mod.q = new $mod.TRec();',
  18643. '$mod.q = null;',
  18644. '$mod.Ptr = $mod.p;',
  18645. '$mod.p = $mod.Ptr;',
  18646. '']));
  18647. end;
  18648. procedure TTestModule.TestPointer_RecordArg;
  18649. begin
  18650. StartProgram(false);
  18651. Add([
  18652. '{$modeswitch autoderef}',
  18653. 'type',
  18654. ' TRec = record x: longint; end;',
  18655. ' PRec = ^TRec;',
  18656. 'function DoIt(const a: PRec; var b: PRec; out c: PRec): TRec;',
  18657. 'begin',
  18658. ' a.x:=a.x;',
  18659. ' a^.x:=a^.x;',
  18660. ' with a^ do',
  18661. ' x:=x;',
  18662. 'end;',
  18663. 'function GetIt(p: PRec): PRec;',
  18664. 'begin',
  18665. ' p.x:=p.x;',
  18666. ' p^.x:=p^.x;',
  18667. ' with p^ do',
  18668. ' x:=x;',
  18669. 'end;',
  18670. 'var',
  18671. ' r: TRec;',
  18672. ' p: PRec;',
  18673. 'begin',
  18674. ' p:=GetIt(p);',
  18675. ' p^:=GetIt(@r)^;',
  18676. ' DoIt(p,p,p);',
  18677. ' DoIt(@r,p,p);',
  18678. '']);
  18679. ConvertProgram;
  18680. CheckSource('TestPointer_Record',
  18681. LinesToStr([ // statements
  18682. 'this.TRec = function (s) {',
  18683. ' if (s) {',
  18684. ' this.x = s.x;',
  18685. ' } else {',
  18686. ' this.x = 0;',
  18687. ' };',
  18688. ' this.$equal = function (b) {',
  18689. ' return this.x === b.x;',
  18690. ' };',
  18691. '};',
  18692. 'this.DoIt = function (a, b, c) {',
  18693. ' var Result = new $mod.TRec();',
  18694. ' a.x = a.x;',
  18695. ' a.x = a.x;',
  18696. ' a.x = a.x;',
  18697. ' return Result;',
  18698. '};',
  18699. 'this.GetIt = function (p) {',
  18700. ' var Result = null;',
  18701. ' p.x = p.x;',
  18702. ' p.x = p.x;',
  18703. ' p.x = p.x;',
  18704. ' return Result;',
  18705. '};',
  18706. 'this.r = new $mod.TRec();',
  18707. 'this.p = null;',
  18708. '']),
  18709. LinesToStr([ // $mod.$main
  18710. '$mod.p = $mod.GetIt($mod.p);',
  18711. '$mod.p = new $mod.TRec($mod.GetIt($mod.r));',
  18712. '$mod.DoIt($mod.p, {',
  18713. ' p: $mod,',
  18714. ' get: function () {',
  18715. ' return this.p.p;',
  18716. ' },',
  18717. ' set: function (v) {',
  18718. ' this.p.p = v;',
  18719. ' }',
  18720. '}, {',
  18721. ' p: $mod,',
  18722. ' get: function () {',
  18723. ' return this.p.p;',
  18724. ' },',
  18725. ' set: function (v) {',
  18726. ' this.p.p = v;',
  18727. ' }',
  18728. '});',
  18729. '$mod.DoIt($mod.r, {',
  18730. ' p: $mod,',
  18731. ' get: function () {',
  18732. ' return this.p.p;',
  18733. ' },',
  18734. ' set: function (v) {',
  18735. ' this.p.p = v;',
  18736. ' }',
  18737. '}, {',
  18738. ' p: $mod,',
  18739. ' get: function () {',
  18740. ' return this.p.p;',
  18741. ' },',
  18742. ' set: function (v) {',
  18743. ' this.p.p = v;',
  18744. ' }',
  18745. '});',
  18746. '']));
  18747. end;
  18748. procedure TTestModule.TestJSValue_AssignToJSValue;
  18749. begin
  18750. StartProgram(false);
  18751. Add('var');
  18752. Add(' v: jsvalue;');
  18753. Add(' i: longint;');
  18754. Add(' s: string;');
  18755. Add(' b: boolean;');
  18756. Add(' d: double;');
  18757. Add(' p: pointer;');
  18758. Add('begin');
  18759. Add(' v:=v;');
  18760. Add(' v:=1;');
  18761. Add(' v:=i;');
  18762. Add(' v:='''';');
  18763. Add(' v:=''c'';');
  18764. Add(' v:=''foo'';');
  18765. Add(' v:=s;');
  18766. Add(' v:=false;');
  18767. Add(' v:=true;');
  18768. Add(' v:=b;');
  18769. Add(' v:=0.1;');
  18770. Add(' v:=d;');
  18771. Add(' v:=nil;');
  18772. Add(' v:=p;');
  18773. ConvertProgram;
  18774. CheckSource('TestJSValue_AssignToJSValue',
  18775. LinesToStr([ // statements
  18776. 'this.v = undefined;',
  18777. 'this.i = 0;',
  18778. 'this.s = "";',
  18779. 'this.b = false;',
  18780. 'this.d = 0.0;',
  18781. 'this.p = null;',
  18782. '']),
  18783. LinesToStr([ // $mod.$main
  18784. '$mod.v = $mod.v;',
  18785. '$mod.v = 1;',
  18786. '$mod.v = $mod.i;',
  18787. '$mod.v = "";',
  18788. '$mod.v = "c";',
  18789. '$mod.v = "foo";',
  18790. '$mod.v = $mod.s;',
  18791. '$mod.v = false;',
  18792. '$mod.v = true;',
  18793. '$mod.v = $mod.b;',
  18794. '$mod.v = 0.1;',
  18795. '$mod.v = $mod.d;',
  18796. '$mod.v = null;',
  18797. '$mod.v = $mod.p;',
  18798. '']));
  18799. end;
  18800. procedure TTestModule.TestJSValue_TypeCastToBaseType;
  18801. begin
  18802. StartProgram(false);
  18803. Add('type');
  18804. Add(' integer = longint;');
  18805. Add(' TYesNo = boolean;');
  18806. Add(' TFloat = double;');
  18807. Add(' TCaption = string;');
  18808. Add(' TChar = char;');
  18809. Add('var');
  18810. Add(' v: jsvalue;');
  18811. Add(' i: integer;');
  18812. Add(' s: TCaption;');
  18813. Add(' b: TYesNo;');
  18814. Add(' d: TFloat;');
  18815. Add(' c: char;');
  18816. Add('begin');
  18817. Add(' i:=longint(v);');
  18818. Add(' i:=integer(v);');
  18819. Add(' s:=string(v);');
  18820. Add(' s:=TCaption(v);');
  18821. Add(' b:=boolean(v);');
  18822. Add(' b:=TYesNo(v);');
  18823. Add(' d:=double(v);');
  18824. Add(' d:=TFloat(v);');
  18825. Add(' c:=char(v);');
  18826. Add(' c:=TChar(v);');
  18827. ConvertProgram;
  18828. CheckSource('TestJSValue_TypeCastToBaseType',
  18829. LinesToStr([ // statements
  18830. 'this.v = undefined;',
  18831. 'this.i = 0;',
  18832. 'this.s = "";',
  18833. 'this.b = false;',
  18834. 'this.d = 0.0;',
  18835. 'this.c = "";',
  18836. '']),
  18837. LinesToStr([ // $mod.$main
  18838. '$mod.i = Math.floor($mod.v);',
  18839. '$mod.i = Math.floor($mod.v);',
  18840. '$mod.s = "" + $mod.v;',
  18841. '$mod.s = "" + $mod.v;',
  18842. '$mod.b = !($mod.v == false);',
  18843. '$mod.b = !($mod.v == false);',
  18844. '$mod.d = rtl.getNumber($mod.v);',
  18845. '$mod.d = rtl.getNumber($mod.v);',
  18846. '$mod.c = rtl.getChar($mod.v);',
  18847. '$mod.c = rtl.getChar($mod.v);',
  18848. '']));
  18849. end;
  18850. procedure TTestModule.TestJSValue_Equal;
  18851. begin
  18852. StartProgram(false);
  18853. Add('type');
  18854. Add(' integer = longint;');
  18855. Add(' TYesNo = boolean;');
  18856. Add(' TFloat = double;');
  18857. Add(' TCaption = string;');
  18858. Add(' TChar = char;');
  18859. Add(' TMulti = JSValue;');
  18860. Add('var');
  18861. Add(' v: jsvalue;');
  18862. Add(' i: integer;');
  18863. Add(' s: TCaption;');
  18864. Add(' b: TYesNo;');
  18865. Add(' d: TFloat;');
  18866. Add(' c: char;');
  18867. Add(' m: TMulti;');
  18868. Add('begin');
  18869. Add(' b:=v=v;');
  18870. Add(' b:=v<>v;');
  18871. Add(' b:=v=1;');
  18872. Add(' b:=v<>1;');
  18873. Add(' b:=2=v;');
  18874. Add(' b:=2<>v;');
  18875. Add(' b:=v=i;');
  18876. Add(' b:=i=v;');
  18877. Add(' b:=v=nil;');
  18878. Add(' b:=nil=v;');
  18879. Add(' b:=v=false;');
  18880. Add(' b:=true=v;');
  18881. Add(' b:=v=b;');
  18882. Add(' b:=b=v;');
  18883. Add(' b:=v=s;');
  18884. Add(' b:=s=v;');
  18885. Add(' b:=v=''foo'';');
  18886. Add(' b:=''''=v;');
  18887. Add(' b:=v=d;');
  18888. Add(' b:=d=v;');
  18889. Add(' b:=v=3.4;');
  18890. Add(' b:=5.6=v;');
  18891. Add(' b:=v=c;');
  18892. Add(' b:=c=v;');
  18893. Add(' b:=m=m;');
  18894. Add(' b:=v=m;');
  18895. Add(' b:=m=v;');
  18896. ConvertProgram;
  18897. CheckSource('TestJSValue_Equal',
  18898. LinesToStr([ // statements
  18899. 'this.v = undefined;',
  18900. 'this.i = 0;',
  18901. 'this.s = "";',
  18902. 'this.b = false;',
  18903. 'this.d = 0.0;',
  18904. 'this.c = "";',
  18905. 'this.m = undefined;',
  18906. '']),
  18907. LinesToStr([ // $mod.$main
  18908. '$mod.b = $mod.v == $mod.v;',
  18909. '$mod.b = $mod.v != $mod.v;',
  18910. '$mod.b = $mod.v == 1;',
  18911. '$mod.b = $mod.v != 1;',
  18912. '$mod.b = 2 == $mod.v;',
  18913. '$mod.b = 2 != $mod.v;',
  18914. '$mod.b = $mod.v == $mod.i;',
  18915. '$mod.b = $mod.i == $mod.v;',
  18916. '$mod.b = $mod.v == null;',
  18917. '$mod.b = null == $mod.v;',
  18918. '$mod.b = $mod.v == false;',
  18919. '$mod.b = true == $mod.v;',
  18920. '$mod.b = $mod.v == $mod.b;',
  18921. '$mod.b = $mod.b == $mod.v;',
  18922. '$mod.b = $mod.v == $mod.s;',
  18923. '$mod.b = $mod.s == $mod.v;',
  18924. '$mod.b = $mod.v == "foo";',
  18925. '$mod.b = "" == $mod.v;',
  18926. '$mod.b = $mod.v == $mod.d;',
  18927. '$mod.b = $mod.d == $mod.v;',
  18928. '$mod.b = $mod.v == 3.4;',
  18929. '$mod.b = 5.6 == $mod.v;',
  18930. '$mod.b = $mod.v == $mod.c;',
  18931. '$mod.b = $mod.c == $mod.v;',
  18932. '$mod.b = $mod.m == $mod.m;',
  18933. '$mod.b = $mod.v == $mod.m;',
  18934. '$mod.b = $mod.m == $mod.v;',
  18935. '']));
  18936. end;
  18937. procedure TTestModule.TestJSValue_If;
  18938. begin
  18939. StartProgram(false);
  18940. Add([
  18941. 'var',
  18942. ' v: jsvalue;',
  18943. 'begin',
  18944. ' if v then ;',
  18945. ' while v do ;',
  18946. ' repeat until v;',
  18947. '']);
  18948. ConvertProgram;
  18949. CheckSource('TestJSValue_If',
  18950. LinesToStr([ // statements
  18951. 'this.v = undefined;',
  18952. '']),
  18953. LinesToStr([ // $mod.$main
  18954. 'if ($mod.v) ;',
  18955. 'while($mod.v){',
  18956. '};',
  18957. 'do{',
  18958. '} while(!$mod.v);',
  18959. '']));
  18960. end;
  18961. procedure TTestModule.TestJSValue_Not;
  18962. begin
  18963. StartProgram(false);
  18964. Add([
  18965. 'var',
  18966. ' v: jsvalue;',
  18967. ' b: boolean;',
  18968. 'begin',
  18969. ' b:=not v;',
  18970. ' if not v then ;',
  18971. ' while not v do ;',
  18972. ' repeat until not v;',
  18973. '']);
  18974. ConvertProgram;
  18975. CheckSource('TestJSValue_If',
  18976. LinesToStr([ // statements
  18977. 'this.v = undefined;',
  18978. 'this.b = false;',
  18979. '']),
  18980. LinesToStr([ // $mod.$main
  18981. '$mod.b=!$mod.v;',
  18982. 'if (!$mod.v) ;',
  18983. 'while(!$mod.v){',
  18984. '};',
  18985. 'do{',
  18986. '} while($mod.v);',
  18987. '']));
  18988. end;
  18989. procedure TTestModule.TestJSValue_Enum;
  18990. begin
  18991. StartProgram(false);
  18992. Add('type');
  18993. Add(' TColor = (red, blue);');
  18994. Add(' TRedBlue = TColor;');
  18995. Add('var');
  18996. Add(' v: jsvalue;');
  18997. Add(' e: TColor;');
  18998. Add('begin');
  18999. Add(' v:=e;');
  19000. Add(' v:=TColor(e);');
  19001. Add(' v:=TRedBlue(e);');
  19002. Add(' e:=TColor(v);');
  19003. Add(' e:=TRedBlue(v);');
  19004. ConvertProgram;
  19005. CheckSource('TestJSValue_Enum',
  19006. LinesToStr([ // statements
  19007. 'this.TColor = {',
  19008. ' "0": "red",',
  19009. ' red: 0,',
  19010. ' "1": "blue",',
  19011. ' blue: 1',
  19012. '};',
  19013. 'this.v = undefined;',
  19014. 'this.e = 0;',
  19015. '']),
  19016. LinesToStr([ // $mod.$main
  19017. '$mod.v = $mod.e;',
  19018. '$mod.v = $mod.e;',
  19019. '$mod.v = $mod.e;',
  19020. '$mod.e = $mod.v;',
  19021. '$mod.e = $mod.v;',
  19022. '']));
  19023. end;
  19024. procedure TTestModule.TestJSValue_ClassInstance;
  19025. begin
  19026. StartProgram(false);
  19027. Add([
  19028. 'type',
  19029. ' TObject = class',
  19030. ' end;',
  19031. ' TBirdObject = TObject;',
  19032. 'var',
  19033. ' v: jsvalue;',
  19034. ' o: TObject;',
  19035. 'begin',
  19036. ' v:=o;',
  19037. ' v:=TObject(o);',
  19038. ' v:=TBirdObject(o);',
  19039. ' o:=TObject(v);',
  19040. ' o:=TBirdObject(v);',
  19041. ' if v is TObject then ;',
  19042. '']);
  19043. ConvertProgram;
  19044. CheckSource('TestJSValue_ClassInstance',
  19045. LinesToStr([ // statements
  19046. 'rtl.createClass($mod, "TObject", null, function () {',
  19047. ' this.$init = function () {',
  19048. ' };',
  19049. ' this.$final = function () {',
  19050. ' };',
  19051. '});',
  19052. 'this.v = undefined;',
  19053. 'this.o = null;',
  19054. '']),
  19055. LinesToStr([ // $mod.$main
  19056. '$mod.v = $mod.o;',
  19057. '$mod.v = $mod.o;',
  19058. '$mod.v = $mod.o;',
  19059. '$mod.o = rtl.getObject($mod.v);',
  19060. '$mod.o = rtl.getObject($mod.v);',
  19061. 'if (rtl.isExt($mod.v, $mod.TObject, 1)) ;',
  19062. '']));
  19063. end;
  19064. procedure TTestModule.TestJSValue_ClassOf;
  19065. begin
  19066. StartProgram(false);
  19067. Add([
  19068. 'type',
  19069. ' TClass = class of TObject;',
  19070. ' TObject = class',
  19071. ' end;',
  19072. ' TBirds = class of TBird;',
  19073. ' TBird = class(TObject) end;',
  19074. 'var',
  19075. ' v: jsvalue;',
  19076. ' c: TClass;',
  19077. 'begin',
  19078. ' v:=c;',
  19079. ' v:=TObject;',
  19080. ' v:=TClass(c);',
  19081. ' v:=TBirds(c);',
  19082. ' c:=TClass(v);',
  19083. ' c:=TBirds(v);',
  19084. ' if v is TClass then ;',
  19085. '']);
  19086. ConvertProgram;
  19087. CheckSource('TestJSValue_ClassOf',
  19088. LinesToStr([ // statements
  19089. 'rtl.createClass($mod, "TObject", null, function () {',
  19090. ' this.$init = function () {',
  19091. ' };',
  19092. ' this.$final = function () {',
  19093. ' };',
  19094. '});',
  19095. 'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
  19096. '});',
  19097. 'this.v = undefined;',
  19098. 'this.c = null;',
  19099. '']),
  19100. LinesToStr([ // $mod.$main
  19101. '$mod.v = $mod.c;',
  19102. '$mod.v = $mod.TObject;',
  19103. '$mod.v = $mod.c;',
  19104. '$mod.v = $mod.c;',
  19105. '$mod.c = rtl.getObject($mod.v);',
  19106. '$mod.c = rtl.getObject($mod.v);',
  19107. 'if (rtl.isExt($mod.v, $mod.TObject, 2)) ;',
  19108. '']));
  19109. end;
  19110. procedure TTestModule.TestJSValue_ArrayOfJSValue;
  19111. begin
  19112. StartProgram(false);
  19113. Add([
  19114. 'type',
  19115. ' integer = longint;',
  19116. ' TArray = array of JSValue;',
  19117. ' TArrgh = tarray;',
  19118. ' TArrInt = array of integer;',
  19119. 'var',
  19120. ' v: jsvalue;',
  19121. ' TheArray: tarray = (1,''2'');',
  19122. ' Arr: tarrgh;',
  19123. ' i: integer;',
  19124. ' ArrInt: tarrint;',
  19125. 'begin',
  19126. ' arr:=thearray;',
  19127. ' thearray:=arr;',
  19128. ' setlength(arr,2);',
  19129. ' setlength(thearray,3);',
  19130. ' arr[4]:=v;',
  19131. ' arr[5]:=length(thearray);',
  19132. ' arr[6]:=nil;',
  19133. ' arr[7]:=thearray[8];',
  19134. ' arr[low(arr)]:=high(thearray);',
  19135. ' arr:=arrint;',
  19136. ' arrInt:=tarrint(arr);',
  19137. ' if TheArray = nil then ;',
  19138. ' if nil = TheArray then ;',
  19139. ' if TheArray <> nil then ;',
  19140. ' if nil <> TheArray then ;',
  19141. '']);
  19142. ConvertProgram;
  19143. CheckSource('TestJSValue_ArrayOfJSValue',
  19144. LinesToStr([ // statements
  19145. 'this.v = undefined;',
  19146. 'this.TheArray = [1, "2"];',
  19147. 'this.Arr = [];',
  19148. 'this.i = 0;',
  19149. 'this.ArrInt = [];',
  19150. '']),
  19151. LinesToStr([ // $mod.$main
  19152. '$mod.Arr = $mod.TheArray;',
  19153. '$mod.TheArray = $mod.Arr;',
  19154. '$mod.Arr = rtl.arraySetLength($mod.Arr,undefined,2);',
  19155. '$mod.TheArray = rtl.arraySetLength($mod.TheArray,undefined,3);',
  19156. '$mod.Arr[4] = $mod.v;',
  19157. '$mod.Arr[5] = rtl.length($mod.TheArray);',
  19158. '$mod.Arr[6] = null;',
  19159. '$mod.Arr[7] = $mod.TheArray[8];',
  19160. '$mod.Arr[0] = rtl.length($mod.TheArray) - 1;',
  19161. '$mod.Arr = $mod.ArrInt;',
  19162. '$mod.ArrInt = $mod.Arr;',
  19163. 'if (rtl.length($mod.TheArray) === 0) ;',
  19164. 'if (rtl.length($mod.TheArray) === 0) ;',
  19165. 'if (rtl.length($mod.TheArray) > 0) ;',
  19166. 'if (rtl.length($mod.TheArray) > 0) ;',
  19167. '']));
  19168. end;
  19169. procedure TTestModule.TestJSValue_ArrayLit;
  19170. begin
  19171. StartProgram(false);
  19172. Add([
  19173. 'type',
  19174. ' TFlag = (big,small);',
  19175. ' TArray = array of JSValue;',
  19176. ' TObject = class end;',
  19177. ' TClass = class of TObject;',
  19178. 'var',
  19179. ' v: jsvalue;',
  19180. ' a: TArray;',
  19181. ' o: TObject;',
  19182. 'begin',
  19183. ' a:=[];',
  19184. ' a:=[1];',
  19185. ' a:=[1,2];',
  19186. ' a:=[big];',
  19187. ' a:=[1,big];',
  19188. ' a:=[o,nil];',
  19189. '']);
  19190. ConvertProgram;
  19191. CheckSource('TestJSValue_ArrayLit',
  19192. LinesToStr([ // statements
  19193. 'this.TFlag = {',
  19194. ' "0": "big",',
  19195. ' big: 0,',
  19196. ' "1": "small",',
  19197. ' small: 1',
  19198. '};',
  19199. 'rtl.createClass($mod, "TObject", null, function () {',
  19200. ' this.$init = function () {',
  19201. ' };',
  19202. ' this.$final = function () {',
  19203. ' };',
  19204. '});',
  19205. 'this.v = undefined;',
  19206. 'this.a = [];',
  19207. 'this.o = null;',
  19208. '']),
  19209. LinesToStr([ // $mod.$main
  19210. '$mod.a = [];',
  19211. '$mod.a = [1];',
  19212. '$mod.a = [1, 2];',
  19213. '$mod.a = [$mod.TFlag.big];',
  19214. '$mod.a = [1, $mod.TFlag.big];',
  19215. '$mod.a = [$mod.o, null];',
  19216. '']));
  19217. end;
  19218. procedure TTestModule.TestJSValue_Params;
  19219. begin
  19220. StartProgram(false);
  19221. Add('type');
  19222. Add(' integer = longint;');
  19223. Add(' TYesNo = boolean;');
  19224. Add(' TFloat = double;');
  19225. Add(' TCaption = string;');
  19226. Add(' TChar = char;');
  19227. Add('function DoIt(a: jsvalue; const b: jsvalue; var c: jsvalue; out d: jsvalue): jsvalue;');
  19228. Add('var');
  19229. Add(' l: jsvalue;');
  19230. Add('begin');
  19231. Add(' a:=a;');
  19232. Add(' l:=b;');
  19233. Add(' c:=c;');
  19234. Add(' d:=d;');
  19235. Add(' Result:=l;');
  19236. Add('end;');
  19237. Add('function DoSome(a: jsvalue; const b: jsvalue): jsvalue; begin end;');
  19238. Add('var');
  19239. Add(' v: jsvalue;');
  19240. Add(' i: integer;');
  19241. Add(' b: TYesNo;');
  19242. Add(' d: TFloat;');
  19243. Add(' s: TCaption;');
  19244. Add(' c: TChar;');
  19245. Add('begin');
  19246. Add(' v:=doit(v,v,v,v);');
  19247. Add(' i:=integer(dosome(i,i));');
  19248. Add(' b:=TYesNo(dosome(b,b));');
  19249. Add(' d:=TFloat(dosome(d,d));');
  19250. Add(' s:=TCaption(dosome(s,s));');
  19251. Add(' c:=TChar(dosome(c,c));');
  19252. ConvertProgram;
  19253. CheckSource('TestJSValue_Params',
  19254. LinesToStr([ // statements
  19255. 'this.DoIt = function (a, b, c, d) {',
  19256. ' var Result = undefined;',
  19257. ' var l = undefined;',
  19258. ' a = a;',
  19259. ' l = b;',
  19260. ' c.set(c.get());',
  19261. ' d.set(d.get());',
  19262. ' Result = l;',
  19263. ' return Result;',
  19264. '};',
  19265. 'this.DoSome = function (a, b) {',
  19266. ' var Result = undefined;',
  19267. ' return Result;',
  19268. '};',
  19269. 'this.v = undefined;',
  19270. 'this.i = 0;',
  19271. 'this.b = false;',
  19272. 'this.d = 0.0;',
  19273. 'this.s = "";',
  19274. 'this.c = "";',
  19275. '']),
  19276. LinesToStr([ // $mod.$main
  19277. '$mod.v = $mod.DoIt($mod.v, $mod.v, {',
  19278. ' p: $mod,',
  19279. ' get: function () {',
  19280. ' return this.p.v;',
  19281. ' },',
  19282. ' set: function (v) {',
  19283. ' this.p.v = v;',
  19284. ' }',
  19285. '}, {',
  19286. ' p: $mod,',
  19287. ' get: function () {',
  19288. ' return this.p.v;',
  19289. ' },',
  19290. ' set: function (v) {',
  19291. ' this.p.v = v;',
  19292. ' }',
  19293. '});',
  19294. '$mod.i = Math.floor($mod.DoSome($mod.i, $mod.i));',
  19295. '$mod.b = !($mod.DoSome($mod.b, $mod.b) == false);',
  19296. '$mod.d = rtl.getNumber($mod.DoSome($mod.d, $mod.d));',
  19297. '$mod.s = "" + $mod.DoSome($mod.s, $mod.s);',
  19298. '$mod.c = rtl.getChar($mod.DoSome($mod.c, $mod.c));',
  19299. '']));
  19300. end;
  19301. procedure TTestModule.TestJSValue_UntypedParam;
  19302. begin
  19303. StartProgram(false);
  19304. Add('function DoIt(const a; var b; out c): jsvalue;');
  19305. Add('begin');
  19306. Add(' Result:=a;');
  19307. Add(' Result:=b;');
  19308. Add(' Result:=c;');
  19309. Add(' b:=Result;');
  19310. Add(' c:=Result;');
  19311. Add('end;');
  19312. Add('var i: longint;');
  19313. Add('begin');
  19314. Add(' doit(i,i,i);');
  19315. ConvertProgram;
  19316. CheckSource('TestJSValue_UntypedParam',
  19317. LinesToStr([ // statements
  19318. 'this.DoIt = function (a, b, c) {',
  19319. ' var Result = undefined;',
  19320. ' Result = a;',
  19321. ' Result = b.get();',
  19322. ' Result = c.get();',
  19323. ' b.set(Result);',
  19324. ' c.set(Result);',
  19325. ' return Result;',
  19326. '};',
  19327. 'this.i = 0;',
  19328. '']),
  19329. LinesToStr([ // $mod.$main
  19330. '$mod.DoIt($mod.i, {',
  19331. ' p: $mod,',
  19332. ' get: function () {',
  19333. ' return this.p.i;',
  19334. ' },',
  19335. ' set: function (v) {',
  19336. ' this.p.i = v;',
  19337. ' }',
  19338. '}, {',
  19339. ' p: $mod,',
  19340. ' get: function () {',
  19341. ' return this.p.i;',
  19342. ' },',
  19343. ' set: function (v) {',
  19344. ' this.p.i = v;',
  19345. ' }',
  19346. '});',
  19347. '']));
  19348. end;
  19349. procedure TTestModule.TestJSValue_FuncResultType;
  19350. begin
  19351. StartProgram(false);
  19352. Add('type');
  19353. Add(' integer = longint;');
  19354. Add(' TJSValueArray = array of JSValue;');
  19355. Add(' TListSortCompare = function(Item1, Item2: JSValue): Integer;');
  19356. Add('procedure Sort(P: JSValue; aList: TJSValueArray; const Compare: TListSortCompare);');
  19357. Add('begin');
  19358. Add(' while Compare(P,aList[0])>0 do ;');
  19359. Add('end;');
  19360. Add('var');
  19361. Add(' Compare: TListSortCompare;');
  19362. Add(' V: JSValue;');
  19363. Add(' i: integer;');
  19364. Add('begin');
  19365. Add(' if Compare(V,V)>0 then ;');
  19366. Add(' if Compare(i,i)>1 then ;');
  19367. Add(' if Compare(nil,false)>2 then ;');
  19368. Add(' if Compare(1,true)>3 then ;');
  19369. ConvertProgram;
  19370. CheckSource('TestJSValue_UntypedParam',
  19371. LinesToStr([ // statements
  19372. 'this.Sort = function (P, aList, Compare) {',
  19373. ' while (Compare(P, aList[0]) > 0) {',
  19374. ' };',
  19375. '};',
  19376. 'this.Compare = null;',
  19377. 'this.V = undefined;',
  19378. 'this.i = 0;',
  19379. '']),
  19380. LinesToStr([ // $mod.$main
  19381. 'if ($mod.Compare($mod.V, $mod.V) > 0) ;',
  19382. 'if ($mod.Compare($mod.i, $mod.i) > 1) ;',
  19383. 'if ($mod.Compare(null, false) > 2) ;',
  19384. 'if ($mod.Compare(1, true) > 3) ;',
  19385. '']));
  19386. end;
  19387. procedure TTestModule.TestJSValue_ProcType_Assign;
  19388. begin
  19389. StartProgram(false);
  19390. Add('type');
  19391. Add(' integer = longint;');
  19392. Add(' TObject = class');
  19393. Add(' class function GetGlob: integer;');
  19394. Add(' function Getter: integer;');
  19395. Add(' end;');
  19396. Add('class function TObject.GetGlob: integer;');
  19397. Add('var v1: jsvalue;');
  19398. Add('begin');
  19399. Add(' v1:=@GetGlob;');
  19400. Add(' v1:[email protected];');
  19401. Add('end;');
  19402. Add('function TObject.Getter: integer;');
  19403. Add('var v2: jsvalue;');
  19404. Add('begin');
  19405. Add(' v2:=@Getter;');
  19406. Add(' v2:[email protected];');
  19407. Add(' v2:=@GetGlob;');
  19408. Add(' v2:[email protected];');
  19409. Add('end;');
  19410. Add('function GetIt(i: integer): integer;');
  19411. Add('var v3: jsvalue;');
  19412. Add('begin');
  19413. Add(' v3:=@GetIt;');
  19414. Add('end;');
  19415. Add('var');
  19416. Add(' V: JSValue;');
  19417. Add(' o: TObject;');
  19418. Add('begin');
  19419. Add(' v:=@GetIt;');
  19420. Add(' v:[email protected];');
  19421. Add(' v:[email protected];');
  19422. ConvertProgram;
  19423. CheckSource('TestJSValue_ProcType_Assign',
  19424. LinesToStr([ // statements
  19425. 'rtl.createClass($mod, "TObject", null, function () {',
  19426. ' this.$init = function () {',
  19427. ' };',
  19428. ' this.$final = function () {',
  19429. ' };',
  19430. ' this.GetGlob = function () {',
  19431. ' var Result = 0;',
  19432. ' var v1 = undefined;',
  19433. ' v1 = rtl.createCallback(this, "GetGlob");',
  19434. ' v1 = rtl.createCallback(this, "GetGlob");',
  19435. ' return Result;',
  19436. ' };',
  19437. ' this.Getter = function () {',
  19438. ' var Result = 0;',
  19439. ' var v2 = undefined;',
  19440. ' v2 = rtl.createCallback(this, "Getter");',
  19441. ' v2 = rtl.createCallback(this, "Getter");',
  19442. ' v2 = rtl.createCallback(this.$class, "GetGlob");',
  19443. ' v2 = rtl.createCallback(this.$class, "GetGlob");',
  19444. ' return Result;',
  19445. ' };',
  19446. '});',
  19447. 'this.GetIt = function (i) {',
  19448. ' var Result = 0;',
  19449. ' var v3 = undefined;',
  19450. ' v3 = $mod.GetIt;',
  19451. ' return Result;',
  19452. '};',
  19453. 'this.V = undefined;',
  19454. 'this.o = null;',
  19455. '']),
  19456. LinesToStr([ // $mod.$main
  19457. '$mod.V = $mod.GetIt;',
  19458. '$mod.V = rtl.createCallback($mod.o, "Getter");',
  19459. '$mod.V = rtl.createCallback($mod.o.$class, "GetGlob");',
  19460. '']));
  19461. end;
  19462. procedure TTestModule.TestJSValue_ProcType_Equal;
  19463. begin
  19464. StartProgram(false);
  19465. Add('type');
  19466. Add(' integer = longint;');
  19467. Add(' TObject = class');
  19468. Add(' class function GetGlob: integer;');
  19469. Add(' function Getter: integer;');
  19470. Add(' end;');
  19471. Add('class function TObject.GetGlob: integer;');
  19472. Add('var v1: jsvalue;');
  19473. Add('begin');
  19474. Add(' if v1=@GetGlob then;');
  19475. Add(' if [email protected] then ;');
  19476. Add('end;');
  19477. Add('function TObject.Getter: integer;');
  19478. Add('var v2: jsvalue;');
  19479. Add('begin');
  19480. Add(' if v2=@Getter then;');
  19481. Add(' if [email protected] then ;');
  19482. Add(' if v2=@GetGlob then;');
  19483. Add(' if [email protected] then;');
  19484. Add('end;');
  19485. Add('function GetIt(i: integer): integer;');
  19486. Add('var v3: jsvalue;');
  19487. Add('begin');
  19488. Add(' if v3=@GetIt then;');
  19489. Add('end;');
  19490. Add('var');
  19491. Add(' V: JSValue;');
  19492. Add(' o: TObject;');
  19493. Add('begin');
  19494. Add(' if v=@GetIt then;');
  19495. Add(' if [email protected] then;');
  19496. Add(' if [email protected] then;');
  19497. Add(' if @GetIt=v then;');
  19498. Add(' if @o.Getter=v then;');
  19499. Add(' if @o.GetGlob=v then;');
  19500. ConvertProgram;
  19501. CheckSource('TestJSValue_ProcType_Equal',
  19502. LinesToStr([ // statements
  19503. 'rtl.createClass($mod, "TObject", null, function () {',
  19504. ' this.$init = function () {',
  19505. ' };',
  19506. ' this.$final = function () {',
  19507. ' };',
  19508. ' this.GetGlob = function () {',
  19509. ' var Result = 0;',
  19510. ' var v1 = undefined;',
  19511. ' if (rtl.eqCallback(v1, rtl.createCallback(this, "GetGlob"))) ;',
  19512. ' if (rtl.eqCallback(v1, rtl.createCallback(this, "GetGlob"))) ;',
  19513. ' return Result;',
  19514. ' };',
  19515. ' this.Getter = function () {',
  19516. ' var Result = 0;',
  19517. ' var v2 = undefined;',
  19518. ' if (rtl.eqCallback(v2, rtl.createCallback(this, "Getter"))) ;',
  19519. ' if (rtl.eqCallback(v2, rtl.createCallback(this, "Getter"))) ;',
  19520. ' if (rtl.eqCallback(v2, rtl.createCallback(this.$class, "GetGlob"))) ;',
  19521. ' if (rtl.eqCallback(v2, rtl.createCallback(this.$class, "GetGlob"))) ;',
  19522. ' return Result;',
  19523. ' };',
  19524. '});',
  19525. 'this.GetIt = function (i) {',
  19526. ' var Result = 0;',
  19527. ' var v3 = undefined;',
  19528. ' if (rtl.eqCallback(v3, $mod.GetIt)) ;',
  19529. ' return Result;',
  19530. '};',
  19531. 'this.V = undefined;',
  19532. 'this.o = null;',
  19533. '']),
  19534. LinesToStr([ // $mod.$main
  19535. 'if (rtl.eqCallback($mod.V, $mod.GetIt)) ;',
  19536. 'if (rtl.eqCallback($mod.V, rtl.createCallback($mod.o, "Getter"))) ;',
  19537. 'if (rtl.eqCallback($mod.V, rtl.createCallback($mod.o.$class, "GetGlob"))) ;',
  19538. 'if (rtl.eqCallback($mod.GetIt, $mod.V)) ;',
  19539. 'if (rtl.eqCallback(rtl.createCallback($mod.o, "Getter"), $mod.V)) ;',
  19540. 'if (rtl.eqCallback(rtl.createCallback($mod.o.$class, "GetGlob"), $mod.V)) ;',
  19541. '']));
  19542. end;
  19543. procedure TTestModule.TestJSValue_ProcType_Param;
  19544. begin
  19545. StartProgram(false);
  19546. Add([
  19547. 'type',
  19548. ' variant = jsvalue;',
  19549. ' TArrVariant = array of variant;',
  19550. ' TArrVar2 = TArrVariant;',
  19551. ' TFuncInt = function: longint;',
  19552. 'function GetIt: longint;',
  19553. 'begin',
  19554. 'end;',
  19555. 'procedure DoIt(p: jsvalue; Arr: TArrVar2);',
  19556. 'var v: variant;',
  19557. 'begin',
  19558. ' v:=arr[1];',
  19559. 'end;',
  19560. 'var s: string;',
  19561. 'begin',
  19562. ' DoIt(GetIt,[]);',
  19563. ' DoIt(@GetIt,[]);',
  19564. ' DoIt(1,[s,GetIt]);',
  19565. ' DoIt(1,[s,@GetIt]);',
  19566. '']);
  19567. ConvertProgram;
  19568. CheckSource('TestJSValue_ProcType_Param',
  19569. LinesToStr([ // statements
  19570. 'this.GetIt = function () {',
  19571. ' var Result = 0;',
  19572. ' return Result;',
  19573. '};',
  19574. 'this.DoIt = function (p, Arr) {',
  19575. ' var v = undefined;',
  19576. ' v = Arr[1];',
  19577. '};',
  19578. 'this.s = "";',
  19579. '']),
  19580. LinesToStr([ // $mod.$main
  19581. '$mod.DoIt($mod.GetIt(), []);',
  19582. '$mod.DoIt($mod.GetIt, []);',
  19583. '$mod.DoIt(1, [$mod.s, $mod.GetIt()]);',
  19584. '$mod.DoIt(1, [$mod.s, $mod.GetIt]);',
  19585. '']));
  19586. end;
  19587. procedure TTestModule.TestJSValue_AssignToPointerFail;
  19588. begin
  19589. StartProgram(false);
  19590. Add([
  19591. 'var',
  19592. ' v: JSValue;',
  19593. ' p: Pointer;',
  19594. 'begin',
  19595. ' p:=v;',
  19596. '']);
  19597. SetExpectedPasResolverError('Incompatible types: got "JSValue" expected "Pointer"',
  19598. nIncompatibleTypesGotExpected);
  19599. ConvertProgram;
  19600. end;
  19601. procedure TTestModule.TestJSValue_OverloadDouble;
  19602. begin
  19603. StartProgram(false);
  19604. Add([
  19605. 'type',
  19606. ' integer = longint;',
  19607. ' tdatetime = double;',
  19608. 'procedure DoIt(d: double); begin end;',
  19609. 'procedure DoIt(v: jsvalue); begin end;',
  19610. 'var',
  19611. ' d: double;',
  19612. ' dt: tdatetime;',
  19613. ' i: integer;',
  19614. ' b: byte;',
  19615. ' shi: shortint;',
  19616. ' w: word;',
  19617. ' smi: smallint;',
  19618. ' lw: longword;',
  19619. ' li: longint;',
  19620. ' ni: nativeint;',
  19621. ' nu: nativeuint;',
  19622. 'begin',
  19623. ' DoIt(d);',
  19624. ' DoIt(dt);',
  19625. ' DoIt(i);',
  19626. ' DoIt(b);',
  19627. ' DoIt(shi);',
  19628. ' DoIt(w);',
  19629. ' DoIt(smi);',
  19630. ' DoIt(lw);',
  19631. ' DoIt(li);',
  19632. ' DoIt(ni);',
  19633. ' DoIt(nu);',
  19634. '']);
  19635. ConvertProgram;
  19636. CheckSource('TestJSValue_OverloadDouble',
  19637. LinesToStr([ // statements
  19638. 'this.DoIt = function (d) {',
  19639. '};',
  19640. 'this.DoIt$1 = function (v) {',
  19641. '};',
  19642. 'this.d = 0.0;',
  19643. 'this.dt = 0.0;',
  19644. 'this.i = 0;',
  19645. 'this.b = 0;',
  19646. 'this.shi = 0;',
  19647. 'this.w = 0;',
  19648. 'this.smi = 0;',
  19649. 'this.lw = 0;',
  19650. 'this.li = 0;',
  19651. 'this.ni = 0;',
  19652. 'this.nu = 0;',
  19653. '']),
  19654. LinesToStr([ // $mod.$main
  19655. '$mod.DoIt($mod.d);',
  19656. '$mod.DoIt($mod.dt);',
  19657. '$mod.DoIt$1($mod.i);',
  19658. '$mod.DoIt$1($mod.b);',
  19659. '$mod.DoIt$1($mod.shi);',
  19660. '$mod.DoIt$1($mod.w);',
  19661. '$mod.DoIt$1($mod.smi);',
  19662. '$mod.DoIt$1($mod.lw);',
  19663. '$mod.DoIt$1($mod.li);',
  19664. '$mod.DoIt$1($mod.ni);',
  19665. '$mod.DoIt$1($mod.nu);',
  19666. '']));
  19667. end;
  19668. procedure TTestModule.TestJSValue_OverloadNativeInt;
  19669. begin
  19670. StartProgram(false);
  19671. Add([
  19672. 'type',
  19673. ' integer = longint;',
  19674. ' int53 = nativeint;',
  19675. ' tdatetime = double;',
  19676. 'procedure DoIt(n: nativeint); begin end;',
  19677. 'procedure DoIt(v: jsvalue); begin end;',
  19678. 'var',
  19679. ' d: double;',
  19680. ' dt: tdatetime;',
  19681. ' i: integer;',
  19682. ' b: byte;',
  19683. ' shi: shortint;',
  19684. ' w: word;',
  19685. ' smi: smallint;',
  19686. ' lw: longword;',
  19687. ' li: longint;',
  19688. ' ni: nativeint;',
  19689. ' nu: nativeuint;',
  19690. 'begin',
  19691. ' DoIt(d);',
  19692. ' DoIt(dt);',
  19693. ' DoIt(i);',
  19694. ' DoIt(b);',
  19695. ' DoIt(shi);',
  19696. ' DoIt(w);',
  19697. ' DoIt(smi);',
  19698. ' DoIt(lw);',
  19699. ' DoIt(li);',
  19700. ' DoIt(ni);',
  19701. ' DoIt(nu);',
  19702. '']);
  19703. ConvertProgram;
  19704. CheckSource('TestJSValue_OverloadNativeInt',
  19705. LinesToStr([ // statements
  19706. 'this.DoIt = function (n) {',
  19707. '};',
  19708. 'this.DoIt$1 = function (v) {',
  19709. '};',
  19710. 'this.d = 0.0;',
  19711. 'this.dt = 0.0;',
  19712. 'this.i = 0;',
  19713. 'this.b = 0;',
  19714. 'this.shi = 0;',
  19715. 'this.w = 0;',
  19716. 'this.smi = 0;',
  19717. 'this.lw = 0;',
  19718. 'this.li = 0;',
  19719. 'this.ni = 0;',
  19720. 'this.nu = 0;',
  19721. '']),
  19722. LinesToStr([ // $mod.$main
  19723. '$mod.DoIt$1($mod.d);',
  19724. '$mod.DoIt$1($mod.dt);',
  19725. '$mod.DoIt($mod.i);',
  19726. '$mod.DoIt($mod.b);',
  19727. '$mod.DoIt($mod.shi);',
  19728. '$mod.DoIt($mod.w);',
  19729. '$mod.DoIt($mod.smi);',
  19730. '$mod.DoIt($mod.lw);',
  19731. '$mod.DoIt($mod.li);',
  19732. '$mod.DoIt($mod.ni);',
  19733. '$mod.DoIt($mod.nu);',
  19734. '']));
  19735. end;
  19736. procedure TTestModule.TestJSValue_OverloadWord;
  19737. begin
  19738. StartProgram(false);
  19739. Add([
  19740. 'type',
  19741. ' integer = longint;',
  19742. ' int53 = nativeint;',
  19743. ' tdatetime = double;',
  19744. 'procedure DoIt(w: word); begin end;',
  19745. 'procedure DoIt(v: jsvalue); begin end;',
  19746. 'var',
  19747. ' d: double;',
  19748. ' dt: tdatetime;',
  19749. ' i: integer;',
  19750. ' b: byte;',
  19751. ' shi: shortint;',
  19752. ' w: word;',
  19753. ' smi: smallint;',
  19754. ' lw: longword;',
  19755. ' li: longint;',
  19756. ' ni: nativeint;',
  19757. ' nu: nativeuint;',
  19758. 'begin',
  19759. ' DoIt(d);',
  19760. ' DoIt(dt);',
  19761. ' DoIt(i);',
  19762. ' DoIt(b);',
  19763. ' DoIt(shi);',
  19764. ' DoIt(w);',
  19765. ' DoIt(smi);',
  19766. ' DoIt(lw);',
  19767. ' DoIt(li);',
  19768. ' DoIt(ni);',
  19769. ' DoIt(nu);',
  19770. '']);
  19771. ConvertProgram;
  19772. CheckSource('TestJSValue_OverloadWord',
  19773. LinesToStr([ // statements
  19774. 'this.DoIt = function (w) {',
  19775. '};',
  19776. 'this.DoIt$1 = function (v) {',
  19777. '};',
  19778. 'this.d = 0.0;',
  19779. 'this.dt = 0.0;',
  19780. 'this.i = 0;',
  19781. 'this.b = 0;',
  19782. 'this.shi = 0;',
  19783. 'this.w = 0;',
  19784. 'this.smi = 0;',
  19785. 'this.lw = 0;',
  19786. 'this.li = 0;',
  19787. 'this.ni = 0;',
  19788. 'this.nu = 0;',
  19789. '']),
  19790. LinesToStr([ // $mod.$main
  19791. '$mod.DoIt$1($mod.d);',
  19792. '$mod.DoIt$1($mod.dt);',
  19793. '$mod.DoIt$1($mod.i);',
  19794. '$mod.DoIt($mod.b);',
  19795. '$mod.DoIt($mod.shi);',
  19796. '$mod.DoIt($mod.w);',
  19797. '$mod.DoIt$1($mod.smi);',
  19798. '$mod.DoIt$1($mod.lw);',
  19799. '$mod.DoIt$1($mod.li);',
  19800. '$mod.DoIt$1($mod.ni);',
  19801. '$mod.DoIt$1($mod.nu);',
  19802. '']));
  19803. end;
  19804. procedure TTestModule.TestJSValue_OverloadString;
  19805. begin
  19806. StartProgram(false);
  19807. Add([
  19808. 'type',
  19809. ' uni = string;',
  19810. ' WChar = char;',
  19811. 'procedure DoIt(s: string); begin end;',
  19812. 'procedure DoIt(v: jsvalue); begin end;',
  19813. 'var',
  19814. ' s: string;',
  19815. ' c: char;',
  19816. ' u: uni;',
  19817. 'begin',
  19818. ' DoIt(s);',
  19819. ' DoIt(c);',
  19820. ' DoIt(u);',
  19821. '']);
  19822. ConvertProgram;
  19823. CheckSource('TestJSValue_OverloadString',
  19824. LinesToStr([ // statements
  19825. 'this.DoIt = function (s) {',
  19826. '};',
  19827. 'this.DoIt$1 = function (v) {',
  19828. '};',
  19829. 'this.s = "";',
  19830. 'this.c = "";',
  19831. 'this.u = "";',
  19832. '']),
  19833. LinesToStr([ // $mod.$main
  19834. '$mod.DoIt($mod.s);',
  19835. '$mod.DoIt($mod.c);',
  19836. '$mod.DoIt($mod.u);',
  19837. '']));
  19838. end;
  19839. procedure TTestModule.TestJSValue_OverloadChar;
  19840. begin
  19841. StartProgram(false);
  19842. Add([
  19843. 'type',
  19844. ' uni = string;',
  19845. ' WChar = char;',
  19846. 'procedure DoIt(c: char); begin end;',
  19847. 'procedure DoIt(v: jsvalue); begin end;',
  19848. 'var',
  19849. ' s: string;',
  19850. ' c: char;',
  19851. ' u: uni;',
  19852. 'begin',
  19853. ' DoIt(s);',
  19854. ' DoIt(c);',
  19855. ' DoIt(u);',
  19856. '']);
  19857. ConvertProgram;
  19858. CheckSource('TestJSValue_OverloadChar',
  19859. LinesToStr([ // statements
  19860. 'this.DoIt = function (c) {',
  19861. '};',
  19862. 'this.DoIt$1 = function (v) {',
  19863. '};',
  19864. 'this.s = "";',
  19865. 'this.c = "";',
  19866. 'this.u = "";',
  19867. '']),
  19868. LinesToStr([ // $mod.$main
  19869. '$mod.DoIt$1($mod.s);',
  19870. '$mod.DoIt($mod.c);',
  19871. '$mod.DoIt$1($mod.u);',
  19872. '']));
  19873. end;
  19874. procedure TTestModule.TestJSValue_OverloadPointer;
  19875. begin
  19876. StartProgram(false);
  19877. Add([
  19878. 'type',
  19879. ' TObject = class end;',
  19880. 'procedure DoIt(p: pointer); begin end;',
  19881. 'procedure DoIt(v: jsvalue); begin end;',
  19882. 'var',
  19883. ' o: TObject;',
  19884. 'begin',
  19885. ' DoIt(o);',
  19886. '']);
  19887. ConvertProgram;
  19888. CheckSource('TestJSValue_OverloadPointer',
  19889. LinesToStr([ // statements
  19890. 'rtl.createClass($mod, "TObject", null, function () {',
  19891. ' this.$init = function () {',
  19892. ' };',
  19893. ' this.$final = function () {',
  19894. ' };',
  19895. '});',
  19896. 'this.DoIt = function (p) {',
  19897. '};',
  19898. 'this.DoIt$1 = function (v) {',
  19899. '};',
  19900. 'this.o = null;',
  19901. '']),
  19902. LinesToStr([ // $mod.$main
  19903. '$mod.DoIt($mod.o);',
  19904. '']));
  19905. end;
  19906. procedure TTestModule.TestJSValue_ForIn;
  19907. begin
  19908. StartProgram(false);
  19909. Add([
  19910. 'var',
  19911. ' v: JSValue;',
  19912. ' key: string;',
  19913. 'begin',
  19914. ' for key in v do begin',
  19915. ' if key=''abc'' then ;',
  19916. ' end;',
  19917. '']);
  19918. ConvertProgram;
  19919. CheckSource('TestJSValue_ForIn',
  19920. LinesToStr([ // statements
  19921. 'this.v = undefined;',
  19922. 'this.key = "";',
  19923. '']),
  19924. LinesToStr([ // $mod.$main
  19925. 'for ($mod.key in $mod.v) {',
  19926. ' if ($mod.key === "abc") ;',
  19927. '};',
  19928. '']));
  19929. end;
  19930. procedure TTestModule.TestRTTI_IntRange;
  19931. begin
  19932. Converter.Options:=Converter.Options-[coNoTypeInfo];
  19933. StartProgram(false);
  19934. Add([
  19935. '{$modeswitch externalclass}',
  19936. 'type',
  19937. ' TTypeInfo = class external name ''rtl.tTypeInfo''',
  19938. ' end;',
  19939. ' TTypeInfoInteger = class external name ''rtl.tTypeInfoInteger''(TTypeInfo)',
  19940. ' end;',
  19941. ' TGraphicsColor = -$7FFFFFFF-1..$7FFFFFFF;',
  19942. ' TColor = type TGraphicsColor;',
  19943. 'var',
  19944. ' p: TTypeInfo;',
  19945. 'begin',
  19946. ' p:=typeinfo(TGraphicsColor);',
  19947. ' p:=typeinfo(TColor);',
  19948. '']);
  19949. ConvertProgram;
  19950. CheckSource('TestRTTI_IntRange',
  19951. LinesToStr([ // statements
  19952. '$mod.$rtti.$Int("TGraphicsColor", {',
  19953. ' minvalue: -2147483648,',
  19954. ' maxvalue: 2147483647,',
  19955. ' ordtype: 4',
  19956. '});',
  19957. '$mod.$rtti.$inherited("TColor", $mod.$rtti["TGraphicsColor"], {});',
  19958. 'this.p = null;',
  19959. '']),
  19960. LinesToStr([ // $mod.$main
  19961. '$mod.p = $mod.$rtti["TGraphicsColor"];',
  19962. '$mod.p = $mod.$rtti["TColor"];',
  19963. '']));
  19964. end;
  19965. procedure TTestModule.TestRTTI_Double;
  19966. begin
  19967. Converter.Options:=Converter.Options-[coNoTypeInfo];
  19968. StartProgram(false);
  19969. Add([
  19970. '{$modeswitch externalclass}',
  19971. 'type',
  19972. ' TTypeInfo = class external name ''rtl.tTypeInfo''',
  19973. ' end;',
  19974. ' TFloat = type double;',
  19975. 'var',
  19976. ' p: TTypeInfo;',
  19977. 'begin',
  19978. ' p:=typeinfo(double);',
  19979. ' p:=typeinfo(TFloat);',
  19980. '']);
  19981. ConvertProgram;
  19982. CheckSource('TestRTTI_Double',
  19983. LinesToStr([ // statements
  19984. '$mod.$rtti.$inherited("TFloat", rtl.double, {});',
  19985. 'this.p = null;',
  19986. '']),
  19987. LinesToStr([ // $mod.$main
  19988. '$mod.p = rtl.double;',
  19989. '$mod.p = $mod.$rtti["TFloat"];',
  19990. '']));
  19991. end;
  19992. procedure TTestModule.TestRTTI_ProcType;
  19993. begin
  19994. Converter.Options:=Converter.Options-[coNoTypeInfo];
  19995. StartProgram(false);
  19996. Add('type');
  19997. Add(' TProcA = procedure;');
  19998. Add(' TMethodB = procedure of object;');
  19999. Add(' TProcC = procedure; varargs;');
  20000. Add(' TProcD = procedure(i: longint; const j: string; var c: char; out d: double);');
  20001. Add(' TProcE = function: nativeint;');
  20002. Add(' TProcF = function(const p: TProcA): nativeuint;');
  20003. Add('var p: pointer;');
  20004. Add('begin');
  20005. Add(' p:=typeinfo(tproca);');
  20006. ConvertProgram;
  20007. CheckSource('TestRTTI_ProcType',
  20008. LinesToStr([ // statements
  20009. '$mod.$rtti.$ProcVar("TProcA", {',
  20010. ' procsig: rtl.newTIProcSig(null)',
  20011. '});',
  20012. '$mod.$rtti.$MethodVar("TMethodB", {',
  20013. ' procsig: rtl.newTIProcSig(null),',
  20014. ' methodkind: 0',
  20015. '});',
  20016. '$mod.$rtti.$ProcVar("TProcC", {',
  20017. ' procsig: rtl.newTIProcSig(null, 2)',
  20018. '});',
  20019. '$mod.$rtti.$ProcVar("TProcD", {',
  20020. ' procsig: rtl.newTIProcSig([["i", rtl.longint], ["j", rtl.string, 2], ["c", rtl.char, 1], ["d", rtl.double, 4]])',
  20021. '});',
  20022. '$mod.$rtti.$ProcVar("TProcE", {',
  20023. ' procsig: rtl.newTIProcSig(null, rtl.nativeint)',
  20024. '});',
  20025. '$mod.$rtti.$ProcVar("TProcF", {',
  20026. ' procsig: rtl.newTIProcSig([["p", $mod.$rtti["TProcA"], 2]], rtl.nativeuint)',
  20027. '});',
  20028. 'this.p = null;',
  20029. '']),
  20030. LinesToStr([ // $mod.$main
  20031. '$mod.p = $mod.$rtti["TProcA"];',
  20032. '']));
  20033. end;
  20034. procedure TTestModule.TestRTTI_ProcType_ArgFromOtherUnit;
  20035. begin
  20036. Converter.Options:=Converter.Options-[coNoTypeInfo];
  20037. AddModuleWithIntfImplSrc('unit2.pas',
  20038. LinesToStr([
  20039. 'type',
  20040. ' TObject = class end;'
  20041. ]),
  20042. '');
  20043. StartUnit(true);
  20044. Add('interface');
  20045. Add('uses unit2;');
  20046. Add('type');
  20047. Add(' TProcA = function(o: tobject): tobject;');
  20048. Add('implementation');
  20049. Add('type');
  20050. Add(' TProcB = function(o: tobject): tobject;');
  20051. Add('var p: Pointer;');
  20052. Add('initialization');
  20053. Add(' p:=typeinfo(tproca);');
  20054. Add(' p:=typeinfo(tprocb);');
  20055. ConvertUnit;
  20056. CheckSource('TestRTTI_ProcType_ArgFromOtherUnit',
  20057. LinesToStr([ // statements
  20058. 'var $impl = $mod.$impl;',
  20059. '$mod.$rtti.$ProcVar("TProcA", {',
  20060. ' procsig: rtl.newTIProcSig([["o", pas.unit2.$rtti["TObject"]]], pas.unit2.$rtti["TObject"])',
  20061. '});',
  20062. '']),
  20063. LinesToStr([ // this.$init
  20064. '$impl.p = $mod.$rtti["TProcA"];',
  20065. '$impl.p = $mod.$rtti["TProcB"];',
  20066. '']),
  20067. LinesToStr([ // implementation
  20068. '$mod.$rtti.$ProcVar("TProcB", {',
  20069. ' procsig: rtl.newTIProcSig([["o", pas.unit2.$rtti["TObject"]]], pas.unit2.$rtti["TObject"])',
  20070. '});',
  20071. '$impl.p = null;',
  20072. '']) );
  20073. end;
  20074. procedure TTestModule.TestRTTI_EnumAndSetType;
  20075. begin
  20076. Converter.Options:=Converter.Options-[coNoTypeInfo];
  20077. StartProgram(false);
  20078. Add('type');
  20079. Add(' TFlag = (light,dark);');
  20080. Add(' TFlags = set of TFlag;');
  20081. Add(' TProc = function(f: TFlags): TFlag;');
  20082. Add('var p: pointer;');
  20083. Add('begin');
  20084. Add(' p:=typeinfo(tflag);');
  20085. Add(' p:=typeinfo(tflags);');
  20086. ConvertProgram;
  20087. CheckSource('TestRTTI_EnumAndType',
  20088. LinesToStr([ // statements
  20089. 'this.TFlag = {',
  20090. ' "0": "light",',
  20091. ' light: 0,',
  20092. ' "1": "dark",',
  20093. ' dark: 1',
  20094. '};',
  20095. '$mod.$rtti.$Enum("TFlag", {',
  20096. ' minvalue: 0,',
  20097. ' maxvalue: 1,',
  20098. ' ordtype: 1,',
  20099. ' enumtype: this.TFlag',
  20100. '});',
  20101. '$mod.$rtti.$Set("TFlags", {',
  20102. ' comptype: $mod.$rtti["TFlag"]',
  20103. '});',
  20104. '$mod.$rtti.$ProcVar("TProc", {',
  20105. ' procsig: rtl.newTIProcSig([["f", $mod.$rtti["TFlags"]]], $mod.$rtti["TFlag"])',
  20106. '});',
  20107. 'this.p = null;',
  20108. '']),
  20109. LinesToStr([ // $mod.$main
  20110. '$mod.p = $mod.$rtti["TFlag"];',
  20111. '$mod.p = $mod.$rtti["TFlags"];',
  20112. '']));
  20113. end;
  20114. procedure TTestModule.TestRTTI_EnumRange;
  20115. begin
  20116. Converter.Options:=Converter.Options-[coNoTypeInfo];
  20117. StartProgram(false);
  20118. Add([
  20119. 'type',
  20120. ' TCol = (red,green,blue);',
  20121. ' TColRg = green..blue;',
  20122. ' TSetOfColRg = set of TColRg;',
  20123. 'var p: pointer;',
  20124. 'begin',
  20125. ' p:=typeinfo(tcolrg);',
  20126. ' p:=typeinfo(tsetofcolrg);',
  20127. '']);
  20128. ConvertProgram;
  20129. end;
  20130. procedure TTestModule.TestRTTI_AnonymousEnumType;
  20131. begin
  20132. Converter.Options:=Converter.Options-[coNoTypeInfo];
  20133. StartProgram(false);
  20134. Add('type');
  20135. Add(' TFlags = set of (red, green);');
  20136. Add('var');
  20137. Add(' f: TFlags;');
  20138. Add('begin');
  20139. Add(' Include(f,red);');
  20140. ConvertProgram;
  20141. CheckSource('TestRTTI_AnonymousEnumType',
  20142. LinesToStr([ // statements
  20143. 'this.TFlags$a = {',
  20144. ' "0": "red",',
  20145. ' red: 0,',
  20146. ' "1": "green",',
  20147. ' green: 1',
  20148. '};',
  20149. '$mod.$rtti.$Enum("TFlags$a", {',
  20150. ' minvalue: 0,',
  20151. ' maxvalue: 1,',
  20152. ' ordtype: 1,',
  20153. ' enumtype: this.TFlags$a',
  20154. '});',
  20155. '$mod.$rtti.$Set("TFlags", {',
  20156. ' comptype: $mod.$rtti["TFlags$a"]',
  20157. '});',
  20158. 'this.f = {};',
  20159. '']),
  20160. LinesToStr([
  20161. '$mod.f = rtl.includeSet($mod.f, $mod.TFlags$a.red);',
  20162. '']));
  20163. end;
  20164. procedure TTestModule.TestRTTI_StaticArray;
  20165. begin
  20166. Converter.Options:=Converter.Options-[coNoTypeInfo];
  20167. StartProgram(false);
  20168. Add('type');
  20169. Add(' TFlag = (light,dark);');
  20170. Add(' TFlagNames = array[TFlag] of string;');
  20171. Add(' TBoolNames = array[boolean] of string;');
  20172. Add(' TByteArray = array[1..32768] of byte;');
  20173. Add(' TProc = function(f: TBoolNames): TFlagNames;');
  20174. Add('var p: pointer;');
  20175. Add('begin');
  20176. Add(' p:=typeinfo(TFlagNames);');
  20177. Add(' p:=typeinfo(TBoolNames);');
  20178. ConvertProgram;
  20179. CheckSource('TestRTTI_StaticArray',
  20180. LinesToStr([ // statements
  20181. 'this.TFlag = {',
  20182. ' "0": "light",',
  20183. ' light: 0,',
  20184. ' "1": "dark",',
  20185. ' dark: 1',
  20186. '};',
  20187. '$mod.$rtti.$Enum("TFlag", {',
  20188. ' minvalue: 0,',
  20189. ' maxvalue: 1,',
  20190. ' ordtype: 1,',
  20191. ' enumtype: this.TFlag',
  20192. '});',
  20193. '$mod.$rtti.$StaticArray("TFlagNames", {',
  20194. ' dims: [2],',
  20195. ' eltype: rtl.string',
  20196. '});',
  20197. '$mod.$rtti.$StaticArray("TBoolNames", {',
  20198. ' dims: [2],',
  20199. ' eltype: rtl.string',
  20200. '});',
  20201. '$mod.$rtti.$StaticArray("TByteArray", {',
  20202. ' dims: [32768],',
  20203. ' eltype: rtl.byte',
  20204. '});',
  20205. '$mod.$rtti.$ProcVar("TProc", {',
  20206. ' procsig: rtl.newTIProcSig([["f", $mod.$rtti["TBoolNames"]]], $mod.$rtti["TFlagNames"])',
  20207. '});',
  20208. 'this.p = null;',
  20209. '']),
  20210. LinesToStr([ // $mod.$main
  20211. '$mod.p = $mod.$rtti["TFlagNames"];',
  20212. '$mod.p = $mod.$rtti["TBoolNames"];',
  20213. '']));
  20214. end;
  20215. procedure TTestModule.TestRTTI_DynArray;
  20216. begin
  20217. Converter.Options:=Converter.Options-[coNoTypeInfo];
  20218. StartProgram(false);
  20219. Add('type');
  20220. Add(' TArrStr = array of string;');
  20221. Add(' TArr2Dim = array of tarrstr;');
  20222. Add(' TProc = function(f: TArrStr): TArr2Dim;');
  20223. Add('var p: pointer;');
  20224. Add('begin');
  20225. Add(' p:=typeinfo(tarrstr);');
  20226. Add(' p:=typeinfo(tarr2dim);');
  20227. ConvertProgram;
  20228. CheckSource('TestRTTI_DynArray',
  20229. LinesToStr([ // statements
  20230. '$mod.$rtti.$DynArray("TArrStr", {',
  20231. ' eltype: rtl.string',
  20232. '});',
  20233. '$mod.$rtti.$DynArray("TArr2Dim", {',
  20234. ' eltype: $mod.$rtti["TArrStr"]',
  20235. '});',
  20236. '$mod.$rtti.$ProcVar("TProc", {',
  20237. ' procsig: rtl.newTIProcSig([["f", $mod.$rtti["TArrStr"]]], $mod.$rtti["TArr2Dim"])',
  20238. '});',
  20239. 'this.p = null;',
  20240. '']),
  20241. LinesToStr([ // $mod.$main
  20242. '$mod.p = $mod.$rtti["TArrStr"];',
  20243. '$mod.p = $mod.$rtti["TArr2Dim"];',
  20244. '']));
  20245. end;
  20246. procedure TTestModule.TestRTTI_ArrayNestedAnonymous;
  20247. begin
  20248. Converter.Options:=Converter.Options-[coNoTypeInfo];
  20249. StartProgram(false);
  20250. Add('type');
  20251. Add(' TArr = array of array of longint;');
  20252. Add('var a: TArr;');
  20253. Add('begin');
  20254. ConvertProgram;
  20255. CheckSource('TestRTTI_ArrayNestedAnonymous',
  20256. LinesToStr([ // statements
  20257. '$mod.$rtti.$DynArray("TArr$a", {',
  20258. ' eltype: rtl.longint',
  20259. '});',
  20260. '$mod.$rtti.$DynArray("TArr", {',
  20261. ' eltype: $mod.$rtti["TArr$a"]',
  20262. '});',
  20263. 'this.a = [];',
  20264. '']),
  20265. LinesToStr([ // $mod.$main
  20266. ]));
  20267. end;
  20268. procedure TTestModule.TestRTTI_PublishedMethodOverloadFail;
  20269. begin
  20270. Converter.Options:=Converter.Options-[coNoTypeInfo];
  20271. StartProgram(false);
  20272. Add('type');
  20273. Add(' TObject = class');
  20274. Add(' published');
  20275. Add(' procedure Proc; virtual; abstract;');
  20276. Add(' procedure Proc(Sender: tobject); virtual; abstract;');
  20277. Add(' end;');
  20278. Add('begin');
  20279. SetExpectedPasResolverError('Duplicate identifier "Proc" at test1.pp(6,19)',
  20280. nDuplicateIdentifier);
  20281. ConvertProgram;
  20282. end;
  20283. procedure TTestModule.TestRTTI_PublishedMethodExternalFail;
  20284. begin
  20285. Converter.Options:=Converter.Options-[coNoTypeInfo];
  20286. StartProgram(false);
  20287. Add('type');
  20288. Add(' TObject = class');
  20289. Add(' published');
  20290. Add(' procedure Proc; external name ''foo'';');
  20291. Add(' end;');
  20292. Add('begin');
  20293. SetExpectedPasResolverError(sPublishedNameMustMatchExternal,
  20294. nPublishedNameMustMatchExternal);
  20295. ConvertProgram;
  20296. end;
  20297. procedure TTestModule.TestRTTI_PublishedClassPropertyFail;
  20298. begin
  20299. Converter.Options:=Converter.Options-[coNoTypeInfo];
  20300. StartProgram(false);
  20301. Add('type');
  20302. Add(' TObject = class');
  20303. Add(' class var FA: longint;');
  20304. Add(' published');
  20305. Add(' class property A: longint read FA;');
  20306. Add(' end;');
  20307. Add('begin');
  20308. SetExpectedPasResolverError('Invalid published property modifier "class"',
  20309. nInvalidXModifierY);
  20310. ConvertProgram;
  20311. end;
  20312. procedure TTestModule.TestRTTI_PublishedClassFieldFail;
  20313. begin
  20314. Converter.Options:=Converter.Options-[coNoTypeInfo];
  20315. StartProgram(false);
  20316. Add('type');
  20317. Add(' TObject = class');
  20318. Add(' published');
  20319. Add(' class var FA: longint;');
  20320. Add(' end;');
  20321. Add('begin');
  20322. SetExpectedPasResolverError(sSymbolCannotBePublished,
  20323. nSymbolCannotBePublished);
  20324. ConvertProgram;
  20325. end;
  20326. procedure TTestModule.TestRTTI_PublishedFieldExternalFail;
  20327. begin
  20328. Converter.Options:=Converter.Options-[coNoTypeInfo];
  20329. StartProgram(false);
  20330. Add('{$modeswitch externalclass}');
  20331. Add('type');
  20332. Add(' TObject = class');
  20333. Add(' published');
  20334. Add(' V: longint; external name ''foo'';');
  20335. Add(' end;');
  20336. Add('begin');
  20337. SetExpectedPasResolverError(sPublishedNameMustMatchExternal,
  20338. nPublishedNameMustMatchExternal);
  20339. ConvertProgram;
  20340. end;
  20341. procedure TTestModule.TestRTTI_Class_Field;
  20342. begin
  20343. Converter.Options:=Converter.Options-[coNoTypeInfo];
  20344. StartProgram(false);
  20345. Add('{$modeswitch externalclass}');
  20346. Add('type');
  20347. Add(' TObject = class');
  20348. Add(' private');
  20349. Add(' FPropA: string;');
  20350. Add(' published');
  20351. Add(' VarLI: longint;');
  20352. Add(' VarC: char;');
  20353. Add(' VarS: string;');
  20354. Add(' VarD: double;');
  20355. Add(' VarB: boolean;');
  20356. Add(' VarLW: longword;');
  20357. Add(' VarSmI: smallint;');
  20358. Add(' VarW: word;');
  20359. Add(' VarShI: shortint;');
  20360. Add(' VarBy: byte;');
  20361. Add(' VarExt: longint external name ''VarExt'';');
  20362. Add(' end;');
  20363. Add('var p: pointer;');
  20364. Add(' Obj: tobject;');
  20365. Add('begin');
  20366. Add(' p:=typeinfo(tobject);');
  20367. Add(' p:=typeinfo(p);');
  20368. Add(' p:=typeinfo(obj);');
  20369. ConvertProgram;
  20370. CheckSource('TestRTTI_Class_Field',
  20371. LinesToStr([ // statements
  20372. 'rtl.createClass($mod, "TObject", null, function () {',
  20373. ' this.$init = function () {',
  20374. ' this.FPropA = "";',
  20375. ' this.VarLI = 0;',
  20376. ' this.VarC = "";',
  20377. ' this.VarS = "";',
  20378. ' this.VarD = 0.0;',
  20379. ' this.VarB = false;',
  20380. ' this.VarLW = 0;',
  20381. ' this.VarSmI = 0;',
  20382. ' this.VarW = 0;',
  20383. ' this.VarShI = 0;',
  20384. ' this.VarBy = 0;',
  20385. ' };',
  20386. ' this.$final = function () {',
  20387. ' };',
  20388. ' var $r = this.$rtti;',
  20389. ' $r.addField("VarLI", rtl.longint);',
  20390. ' $r.addField("VarC", rtl.char);',
  20391. ' $r.addField("VarS", rtl.string);',
  20392. ' $r.addField("VarD", rtl.double);',
  20393. ' $r.addField("VarB", rtl.boolean);',
  20394. ' $r.addField("VarLW", rtl.longword);',
  20395. ' $r.addField("VarSmI", rtl.smallint);',
  20396. ' $r.addField("VarW", rtl.word);',
  20397. ' $r.addField("VarShI", rtl.shortint);',
  20398. ' $r.addField("VarBy", rtl.byte);',
  20399. ' $r.addField("VarExt", rtl.longint);',
  20400. '});',
  20401. 'this.p = null;',
  20402. 'this.Obj = null;',
  20403. '']),
  20404. LinesToStr([ // $mod.$main
  20405. '$mod.p = $mod.$rtti["TObject"];',
  20406. '$mod.p = rtl.pointer;',
  20407. '$mod.p = $mod.Obj.$rtti;',
  20408. '']));
  20409. end;
  20410. procedure TTestModule.TestRTTI_Class_Method;
  20411. begin
  20412. Converter.Options:=Converter.Options-[coNoTypeInfo];
  20413. StartProgram(false);
  20414. Add('type');
  20415. Add(' TObject = class');
  20416. Add(' private');
  20417. Add(' procedure Internal; external name ''$intern'';');
  20418. Add(' published');
  20419. Add(' procedure Click; virtual; abstract;');
  20420. Add(' procedure Notify(Sender: TObject); virtual; abstract;');
  20421. Add(' function GetNotify: boolean; external name ''GetNotify'';');
  20422. Add(' procedure Println(a,b: longint); varargs; virtual; abstract;');
  20423. Add(' end;');
  20424. Add('begin');
  20425. ConvertProgram;
  20426. CheckSource('TestRTTI_Class_Method',
  20427. LinesToStr([ // statements
  20428. 'rtl.createClass($mod, "TObject", null, function () {',
  20429. ' this.$init = function () {',
  20430. ' };',
  20431. ' this.$final = function () {',
  20432. ' };',
  20433. ' var $r = this.$rtti;',
  20434. ' $r.addMethod("Click", 0, null);',
  20435. ' $r.addMethod("Notify", 0, [["Sender", $r]]);',
  20436. ' $r.addMethod("GetNotify", 1, null, rtl.boolean,{flags: 4});',
  20437. ' $r.addMethod("Println", 0, [["a", rtl.longint], ["b", rtl.longint]], null, {',
  20438. ' flags: 2',
  20439. ' });',
  20440. '});',
  20441. '']),
  20442. LinesToStr([ // $mod.$main
  20443. '']));
  20444. end;
  20445. procedure TTestModule.TestRTTI_Class_MethodArgFlags;
  20446. begin
  20447. Converter.Options:=Converter.Options-[coNoTypeInfo];
  20448. StartProgram(false);
  20449. Add('type');
  20450. Add(' TObject = class');
  20451. Add(' published');
  20452. Add(' procedure OpenArray(const Args: array of string); virtual; abstract;');
  20453. Add(' procedure ByRef(var Value: longint; out Item: longint); virtual; abstract;');
  20454. Add(' procedure Untyped(var Value; out Item); virtual; abstract;');
  20455. Add(' end;');
  20456. Add('begin');
  20457. ConvertProgram;
  20458. CheckSource('TestRTTI_Class_MethodOpenArray',
  20459. LinesToStr([ // statements
  20460. 'rtl.createClass($mod, "TObject", null, function () {',
  20461. ' this.$init = function () {',
  20462. ' };',
  20463. ' this.$final = function () {',
  20464. ' };',
  20465. ' var $r = this.$rtti;',
  20466. '$r.addMethod("OpenArray", 0, [["Args", rtl.string, 10]]);',
  20467. '$r.addMethod("ByRef", 0, [["Value", rtl.longint, 1], ["Item", rtl.longint, 4]]);',
  20468. '$r.addMethod("Untyped", 0, [["Value", null, 1], ["Item", null, 4]]);',
  20469. '});',
  20470. '']),
  20471. LinesToStr([ // $mod.$main
  20472. '']));
  20473. end;
  20474. procedure TTestModule.TestRTTI_Class_Property;
  20475. begin
  20476. Converter.Options:=Converter.Options-[coNoTypeInfo];
  20477. StartProgram(false);
  20478. Add('{$modeswitch externalclass}');
  20479. Add('type');
  20480. Add(' TObject = class');
  20481. Add(' private');
  20482. Add(' FColor: longint;');
  20483. Add(' FColorStored: boolean;');
  20484. Add(' procedure SetColor(Value: longint); virtual; abstract;');
  20485. Add(' function GetColor: longint; virtual; abstract;');
  20486. Add(' function GetColorStored: boolean; virtual; abstract;');
  20487. Add(' FExtSize: longint external name ''$extSize'';');
  20488. Add(' FExtSizeStored: boolean external name ''$extSizeStored'';');
  20489. Add(' procedure SetExtSize(Value: longint); external name ''$setSize'';');
  20490. Add(' function GetExtSize: longint; external name ''$getSize'';');
  20491. Add(' function GetExtSizeStored: boolean; external name ''$getExtSizeStored'';');
  20492. Add(' published');
  20493. Add(' property ColorA: longint read FColor;');
  20494. Add(' property ColorB: longint write FColor;');
  20495. Add(' property ColorC: longint read GetColor write SetColor;');
  20496. Add(' property ColorD: longint read FColor write FColor stored FColorStored;');
  20497. Add(' property ExtSizeA: longint read FExtSize write FExtSize;');
  20498. Add(' property ExtSizeB: longint read GetExtSize write SetExtSize stored FExtSizeStored;');
  20499. Add(' property ExtSizeC: longint read FExtSize write FExtSize stored GetExtSizeStored;');
  20500. Add(' end;');
  20501. Add('begin');
  20502. ConvertProgram;
  20503. CheckSource('TestRTTI_Class_Property',
  20504. LinesToStr([ // statements
  20505. 'rtl.createClass($mod, "TObject", null, function () {',
  20506. ' this.$init = function () {',
  20507. ' this.FColor = 0;',
  20508. ' this.FColorStored = false;',
  20509. ' };',
  20510. ' this.$final = function () {',
  20511. ' };',
  20512. ' var $r = this.$rtti;',
  20513. ' $r.addProperty("ColorA", 0, rtl.longint, "FColor", "");',
  20514. ' $r.addProperty("ColorB", 0, rtl.longint, "", "FColor");',
  20515. ' $r.addProperty("ColorC", 3, rtl.longint, "GetColor", "SetColor");',
  20516. ' $r.addProperty(',
  20517. ' "ColorD",',
  20518. ' 8,',
  20519. ' rtl.longint,',
  20520. ' "FColor",',
  20521. ' "FColor",',
  20522. ' {',
  20523. ' stored: "FColorStored"',
  20524. ' }',
  20525. ' );',
  20526. ' $r.addProperty("ExtSizeA", 0, rtl.longint, "$extSize", "$extSize");',
  20527. ' $r.addProperty(',
  20528. ' "ExtSizeB",',
  20529. ' 11,',
  20530. ' rtl.longint,',
  20531. ' "$getSize",',
  20532. ' "$setSize",',
  20533. ' {',
  20534. ' stored: "$extSizeStored"',
  20535. ' }',
  20536. ' );',
  20537. ' $r.addProperty(',
  20538. ' "ExtSizeC",',
  20539. ' 12,',
  20540. ' rtl.longint,',
  20541. ' "$extSize",',
  20542. ' "$extSize",',
  20543. ' {',
  20544. ' stored: "$getExtSizeStored"',
  20545. ' }',
  20546. ' );',
  20547. '});',
  20548. '']),
  20549. LinesToStr([ // $mod.$main
  20550. '']));
  20551. end;
  20552. procedure TTestModule.TestRTTI_Class_PropertyParams;
  20553. begin
  20554. Converter.Options:=Converter.Options-[coNoTypeInfo];
  20555. StartProgram(false);
  20556. Add('{$modeswitch externalclass}');
  20557. Add('type');
  20558. Add(' integer = longint;');
  20559. Add(' TObject = class');
  20560. Add(' private');
  20561. Add(' function GetItems(i: integer): tobject; virtual; abstract;');
  20562. Add(' procedure SetItems(i: integer; value: tobject); virtual; abstract;');
  20563. Add(' function GetValues(const i: integer; var b: boolean): char; virtual; abstract;');
  20564. Add(' procedure SetValues(const i: integer; var b: boolean; value: char); virtual; abstract;');
  20565. Add(' published');
  20566. Add(' property Items[Index: integer]: tobject read getitems write setitems;');
  20567. Add(' property Values[const keya: integer; var keyb: boolean]: char read getvalues write setvalues;');
  20568. Add(' end;');
  20569. Add('begin');
  20570. ConvertProgram;
  20571. CheckSource('TestRTTI_Class_PropertyParams',
  20572. LinesToStr([ // statements
  20573. 'rtl.createClass($mod, "TObject", null, function () {',
  20574. ' this.$init = function () {',
  20575. ' };',
  20576. ' this.$final = function () {',
  20577. ' };',
  20578. ' var $r = this.$rtti;',
  20579. ' $r.addProperty("Items", 3, $r, "GetItems", "SetItems");',
  20580. ' $r.addProperty("Values", 3, rtl.char, "GetValues", "SetValues");',
  20581. '});',
  20582. '']),
  20583. LinesToStr([ // $mod.$main
  20584. '']));
  20585. end;
  20586. procedure TTestModule.TestRTTI_Class_OtherUnit_TypeAlias;
  20587. begin
  20588. Converter.Options:=Converter.Options-[coNoTypeInfo];
  20589. AddModuleWithIntfImplSrc('unit1.pas',
  20590. 'type TColor = -5..5;',
  20591. '');
  20592. StartProgram(true);
  20593. Add([
  20594. 'uses unit1;',
  20595. 'type',
  20596. ' TColorAlias = TColor;',
  20597. ' TColorTypeAlias = type TColor;',
  20598. ' TObject = class',
  20599. ' private',
  20600. ' fColor: TColor;',
  20601. ' fAlias: TColorAlias;',
  20602. ' fTypeAlias: TColorTypeAlias;',
  20603. ' published',
  20604. ' property Color: TColor read fcolor;',
  20605. ' property Alias: TColorAlias read falias;',
  20606. ' property TypeAlias: TColorTypeAlias read ftypealias;',
  20607. ' end;',
  20608. 'begin',
  20609. '']);
  20610. ConvertProgram;
  20611. CheckSource('TestRTTI_Class_OtherUnit_TypeAlias',
  20612. LinesToStr([ // statements
  20613. '$mod.$rtti.$inherited("TColorTypeAlias", pas.unit1.$rtti["TColor"], {});',
  20614. 'rtl.createClass($mod, "TObject", null, function () {',
  20615. ' this.$init = function () {',
  20616. ' this.fColor = 0;',
  20617. ' this.fAlias = 0;',
  20618. ' this.fTypeAlias = 0;',
  20619. ' };',
  20620. ' this.$final = function () {',
  20621. ' };',
  20622. ' var $r = this.$rtti;',
  20623. ' $r.addProperty("Color", 0, pas.unit1.$rtti["TColor"], "fColor", "");',
  20624. ' $r.addProperty("Alias", 0, pas.unit1.$rtti["TColor"], "fAlias", "");',
  20625. ' $r.addProperty("TypeAlias", 0, $mod.$rtti["TColorTypeAlias"], "fTypeAlias", "");',
  20626. '});',
  20627. '']),
  20628. LinesToStr([ // $mod.$main
  20629. '']));
  20630. end;
  20631. procedure TTestModule.TestRTTI_Class_OmitRTTI;
  20632. begin
  20633. Converter.Options:=Converter.Options-[coNoTypeInfo];
  20634. StartProgram(false);
  20635. Add([
  20636. '{$modeswitch omitrtti}',
  20637. 'type',
  20638. ' TObject = class',
  20639. ' private',
  20640. ' FA: byte;',
  20641. ' published',
  20642. ' property A: byte read FA write FA;',
  20643. ' end;',
  20644. 'begin']);
  20645. ConvertProgram;
  20646. CheckSource('TestRTTI_Class_OmitRTTI',
  20647. LinesToStr([ // statements
  20648. 'rtl.createClass($mod, "TObject", null, function () {',
  20649. ' this.$init = function () {',
  20650. ' this.FA = 0;',
  20651. ' };',
  20652. ' this.$final = function () {',
  20653. ' };',
  20654. '});',
  20655. '']),
  20656. LinesToStr([ // $mod.$main
  20657. '']));
  20658. end;
  20659. procedure TTestModule.TestRTTI_IndexModifier;
  20660. begin
  20661. Converter.Options:=Converter.Options-[coNoTypeInfo];
  20662. StartProgram(false);
  20663. Add([
  20664. 'type',
  20665. ' TEnum = (red, blue);',
  20666. ' TObject = class',
  20667. ' FB: boolean;',
  20668. ' procedure SetIntBool(Index: longint; b: boolean); virtual; abstract;',
  20669. ' function GetBoolBool(Index: boolean): boolean; virtual; abstract;',
  20670. ' procedure SetBoolBool(Index: boolean; b: boolean); virtual; abstract;',
  20671. ' function GetEnumBool(Index: TEnum): boolean; virtual; abstract;',
  20672. ' function GetStrIntBool(A: String; I: longint): boolean; virtual; abstract;',
  20673. ' procedure SetStrIntBool(A: String; I: longint; b: boolean); virtual; abstract;',
  20674. ' published',
  20675. ' property B1: boolean index 1 read FB write SetIntBool;',
  20676. ' property B2: boolean index TEnum.blue read GetEnumBool write FB;',
  20677. ' property I1[A: String]: boolean index 2 read GetStrIntBool write SetStrIntBool;',
  20678. ' end;',
  20679. 'begin']);
  20680. ConvertProgram;
  20681. CheckSource('TestRTTI_IndexModifier',
  20682. LinesToStr([ // statements
  20683. 'this.TEnum = {',
  20684. ' "0": "red",',
  20685. ' red: 0,',
  20686. ' "1": "blue",',
  20687. ' blue: 1',
  20688. '};',
  20689. '$mod.$rtti.$Enum("TEnum", {',
  20690. ' minvalue: 0,',
  20691. ' maxvalue: 1,',
  20692. ' ordtype: 1,',
  20693. ' enumtype: this.TEnum',
  20694. '});',
  20695. 'rtl.createClass($mod, "TObject", null, function () {',
  20696. ' this.$init = function () {',
  20697. ' this.FB = false;',
  20698. ' };',
  20699. ' this.$final = function () {',
  20700. ' };',
  20701. ' var $r = this.$rtti;',
  20702. ' $r.addProperty(',
  20703. ' "B1",',
  20704. ' 18,',
  20705. ' rtl.boolean,',
  20706. ' "FB",',
  20707. ' "SetIntBool",',
  20708. ' {',
  20709. ' index: 1',
  20710. ' }',
  20711. ' );',
  20712. ' $r.addProperty(',
  20713. ' "B2",',
  20714. ' 17,',
  20715. ' rtl.boolean,',
  20716. ' "GetEnumBool",',
  20717. ' "FB",',
  20718. ' {',
  20719. ' index: $mod.TEnum.blue',
  20720. ' }',
  20721. ' );',
  20722. ' $r.addProperty(',
  20723. ' "I1",',
  20724. ' 19,',
  20725. ' rtl.boolean,',
  20726. ' "GetStrIntBool",',
  20727. ' "SetStrIntBool",',
  20728. ' {',
  20729. ' index: 2',
  20730. ' }',
  20731. ' );',
  20732. '});',
  20733. '']),
  20734. LinesToStr([ // $mod.$main
  20735. '']));
  20736. end;
  20737. procedure TTestModule.TestRTTI_StoredModifier;
  20738. begin
  20739. Converter.Options:=Converter.Options-[coNoTypeInfo];
  20740. StartProgram(false);
  20741. Add([
  20742. 'const',
  20743. ' ConstB = true;',
  20744. 'type',
  20745. ' TObject = class',
  20746. ' private',
  20747. ' FB: boolean;',
  20748. ' function IsBStored: boolean; virtual; abstract;',
  20749. ' published',
  20750. ' property BoolA: boolean read FB stored true;',
  20751. ' property BoolB: boolean read FB stored false;',
  20752. ' property BoolC: boolean read FB stored FB;',
  20753. ' property BoolD: boolean read FB stored ConstB;',
  20754. ' property BoolE: boolean read FB stored IsBStored;',
  20755. ' end;',
  20756. 'begin']);
  20757. ConvertProgram;
  20758. CheckSource('TestRTTI_StoredModifier',
  20759. LinesToStr([ // statements
  20760. 'this.ConstB = true;',
  20761. 'rtl.createClass($mod, "TObject", null, function () {',
  20762. ' this.$init = function () {',
  20763. ' this.FB = false;',
  20764. ' };',
  20765. ' this.$final = function () {',
  20766. ' };',
  20767. ' var $r = this.$rtti;',
  20768. ' $r.addProperty("BoolA", 0, rtl.boolean, "FB", "");',
  20769. ' $r.addProperty("BoolB", 4, rtl.boolean, "FB", "");',
  20770. ' $r.addProperty(',
  20771. ' "BoolC",',
  20772. ' 8,',
  20773. ' rtl.boolean,',
  20774. ' "FB",',
  20775. ' "",',
  20776. ' {',
  20777. ' stored: "FB"',
  20778. ' }',
  20779. ' );',
  20780. ' $r.addProperty("BoolD", 0, rtl.boolean, "FB", "");',
  20781. ' $r.addProperty(',
  20782. ' "BoolE",',
  20783. ' 12,',
  20784. ' rtl.boolean,',
  20785. ' "FB",',
  20786. ' "",',
  20787. ' {',
  20788. ' stored: "IsBStored"',
  20789. ' }',
  20790. ' );',
  20791. '});',
  20792. '']),
  20793. LinesToStr([ // $mod.$main
  20794. '']));
  20795. end;
  20796. procedure TTestModule.TestRTTI_DefaultValue;
  20797. begin
  20798. Converter.Options:=Converter.Options-[coNoTypeInfo];
  20799. StartProgram(false);
  20800. Add([
  20801. 'type',
  20802. ' TEnum = (red, blue);',
  20803. 'const',
  20804. ' CB = true or false;',
  20805. ' CI = 1+2;',
  20806. 'type',
  20807. ' TObject = class',
  20808. ' FB: boolean;',
  20809. ' FI: longint;',
  20810. ' FE: TEnum;',
  20811. ' published',
  20812. ' property B1: boolean read FB default true;',
  20813. ' property B2: boolean read FB default CB;',
  20814. ' property B3: boolean read FB default test1.cb;',
  20815. ' property I1: longint read FI default 2;',
  20816. ' property I2: longint read FI default CI;',
  20817. ' property E1: TEnum read FE default red;',
  20818. ' property E2: TEnum read FE default TEnum.blue;',
  20819. ' end;',
  20820. 'begin']);
  20821. ConvertProgram;
  20822. CheckSource('TestRTTI_DefaultValue',
  20823. LinesToStr([ // statements
  20824. 'this.TEnum = {',
  20825. ' "0": "red",',
  20826. ' red: 0,',
  20827. ' "1": "blue",',
  20828. ' blue: 1',
  20829. '};',
  20830. '$mod.$rtti.$Enum("TEnum", {',
  20831. ' minvalue: 0,',
  20832. ' maxvalue: 1,',
  20833. ' ordtype: 1,',
  20834. ' enumtype: this.TEnum',
  20835. '});',
  20836. 'this.CB = true || false;',
  20837. 'this.CI = 1 + 2;',
  20838. 'rtl.createClass($mod, "TObject", null, function () {',
  20839. ' this.$init = function () {',
  20840. ' this.FB = false;',
  20841. ' this.FI = 0;',
  20842. ' this.FE = 0;',
  20843. ' };',
  20844. ' this.$final = function () {',
  20845. ' };',
  20846. ' var $r = this.$rtti;',
  20847. ' $r.addProperty(',
  20848. ' "B1",',
  20849. ' 0,',
  20850. ' rtl.boolean,',
  20851. ' "FB",',
  20852. ' "",',
  20853. ' {',
  20854. ' Default: true',
  20855. ' }',
  20856. ' );',
  20857. ' $r.addProperty(',
  20858. ' "B2",',
  20859. ' 0,',
  20860. ' rtl.boolean,',
  20861. ' "FB",',
  20862. ' "",',
  20863. ' {',
  20864. ' Default: true',
  20865. ' }',
  20866. ' );',
  20867. ' $r.addProperty(',
  20868. ' "B3",',
  20869. ' 0,',
  20870. ' rtl.boolean,',
  20871. ' "FB",',
  20872. ' "",',
  20873. ' {',
  20874. ' Default: true',
  20875. ' }',
  20876. ' );',
  20877. ' $r.addProperty(',
  20878. ' "I1",',
  20879. ' 0,',
  20880. ' rtl.longint,',
  20881. ' "FI",',
  20882. ' "",',
  20883. ' {',
  20884. ' Default: 2',
  20885. ' }',
  20886. ' );',
  20887. ' $r.addProperty(',
  20888. ' "I2",',
  20889. ' 0,',
  20890. ' rtl.longint,',
  20891. ' "FI",',
  20892. ' "",',
  20893. ' {',
  20894. ' Default: 3',
  20895. ' }',
  20896. ' );',
  20897. ' $r.addProperty(',
  20898. ' "E1",',
  20899. ' 0,',
  20900. ' $mod.$rtti["TEnum"],',
  20901. ' "FE",',
  20902. ' "",',
  20903. ' {',
  20904. ' Default: $mod.TEnum.red',
  20905. ' }',
  20906. ' );',
  20907. ' $r.addProperty(',
  20908. ' "E2",',
  20909. ' 0,',
  20910. ' $mod.$rtti["TEnum"],',
  20911. ' "FE",',
  20912. ' "",',
  20913. ' {',
  20914. ' Default: $mod.TEnum.blue',
  20915. ' }',
  20916. ' );',
  20917. '});',
  20918. '']),
  20919. LinesToStr([ // $mod.$main
  20920. '']));
  20921. end;
  20922. procedure TTestModule.TestRTTI_DefaultValueSet;
  20923. begin
  20924. Converter.Options:=Converter.Options-[coNoTypeInfo];
  20925. StartProgram(false);
  20926. Add([
  20927. 'type',
  20928. ' TEnum = (red, blue);',
  20929. ' TSet = set of TEnum;',
  20930. 'const',
  20931. ' CSet = [red,blue];',
  20932. 'type',
  20933. ' TObject = class',
  20934. ' FSet: TSet;',
  20935. ' published',
  20936. ' property Set1: TSet read FSet default [];',
  20937. ' property Set2: TSet read FSet default [red];',
  20938. ' property Set3: TSet read FSet default [red,blue];',
  20939. ' property Set4: TSet read FSet default CSet;',
  20940. ' end;',
  20941. 'begin']);
  20942. ConvertProgram;
  20943. CheckSource('TestRTTI_DefaultValueSet',
  20944. LinesToStr([ // statements
  20945. 'this.TEnum = {',
  20946. ' "0": "red",',
  20947. ' red: 0,',
  20948. ' "1": "blue",',
  20949. ' blue: 1',
  20950. '};',
  20951. '$mod.$rtti.$Enum("TEnum", {',
  20952. ' minvalue: 0,',
  20953. ' maxvalue: 1,',
  20954. ' ordtype: 1,',
  20955. ' enumtype: this.TEnum',
  20956. '});',
  20957. '$mod.$rtti.$Set("TSet", {',
  20958. ' comptype: $mod.$rtti["TEnum"]',
  20959. '});',
  20960. 'this.CSet = rtl.createSet($mod.TEnum.red, $mod.TEnum.blue);',
  20961. 'rtl.createClass($mod, "TObject", null, function () {',
  20962. ' this.$init = function () {',
  20963. ' this.FSet = {};',
  20964. ' };',
  20965. ' this.$final = function () {',
  20966. ' this.FSet = undefined;',
  20967. ' };',
  20968. ' var $r = this.$rtti;',
  20969. ' $r.addProperty(',
  20970. ' "Set1",',
  20971. ' 0,',
  20972. ' $mod.$rtti["TSet"],',
  20973. ' "FSet",',
  20974. ' "",',
  20975. ' {',
  20976. ' Default: {}',
  20977. ' }',
  20978. ' );',
  20979. ' $r.addProperty(',
  20980. ' "Set2",',
  20981. ' 0,',
  20982. ' $mod.$rtti["TSet"],',
  20983. ' "FSet",',
  20984. ' "",',
  20985. ' {',
  20986. ' Default: rtl.createSet($mod.TEnum.red)',
  20987. ' }',
  20988. ' );',
  20989. ' $r.addProperty(',
  20990. ' "Set3",',
  20991. ' 0,',
  20992. ' $mod.$rtti["TSet"],',
  20993. ' "FSet",',
  20994. ' "",',
  20995. ' {',
  20996. ' Default: rtl.createSet($mod.TEnum.red, $mod.TEnum.blue)',
  20997. ' }',
  20998. ' );',
  20999. ' $r.addProperty(',
  21000. ' "Set4",',
  21001. ' 0,',
  21002. ' $mod.$rtti["TSet"],',
  21003. ' "FSet",',
  21004. ' "",',
  21005. ' {',
  21006. ' Default: $mod.CSet',
  21007. ' }',
  21008. ' );',
  21009. '});',
  21010. '']),
  21011. LinesToStr([ // $mod.$main
  21012. '']));
  21013. end;
  21014. procedure TTestModule.TestRTTI_DefaultValueRangeType;
  21015. begin
  21016. Converter.Options:=Converter.Options-[coNoTypeInfo];
  21017. StartProgram(false);
  21018. Add([
  21019. 'type',
  21020. ' TRg = -1..1;',
  21021. 'const',
  21022. ' l = low(TRg);',
  21023. ' h = high(TRg);',
  21024. 'type',
  21025. ' TObject = class',
  21026. ' FV: TRg;',
  21027. ' published',
  21028. ' property V1: TRg read FV default -1;',
  21029. ' end;',
  21030. 'begin']);
  21031. ConvertProgram;
  21032. CheckSource('TestRTTI_DefaultValueRangeType',
  21033. LinesToStr([ // statements
  21034. '$mod.$rtti.$Int("TRg", {',
  21035. ' minvalue: -1,',
  21036. ' maxvalue: 1,',
  21037. ' ordtype: 0',
  21038. '});',
  21039. 'this.l = -1;',
  21040. 'this.h = 1;',
  21041. 'rtl.createClass($mod, "TObject", null, function () {',
  21042. ' this.$init = function () {',
  21043. ' this.FV = 0;',
  21044. ' };',
  21045. ' this.$final = function () {',
  21046. ' };',
  21047. ' var $r = this.$rtti;',
  21048. ' $r.addProperty(',
  21049. ' "V1",',
  21050. ' 0,',
  21051. ' $mod.$rtti["TRg"],',
  21052. ' "FV",',
  21053. ' "",',
  21054. ' {',
  21055. ' Default: -1',
  21056. ' }',
  21057. ' );',
  21058. '});',
  21059. '']),
  21060. LinesToStr([ // $mod.$main
  21061. '']));
  21062. end;
  21063. procedure TTestModule.TestRTTI_DefaultValueInherit;
  21064. begin
  21065. Converter.Options:=Converter.Options-[coNoTypeInfo];
  21066. StartProgram(false);
  21067. Add([
  21068. 'type',
  21069. ' TObject = class',
  21070. ' FA, FB: byte;',
  21071. ' property A: byte read FA default 1;',
  21072. ' property B: byte read FB default 2;',
  21073. ' end;',
  21074. ' TBird = class',
  21075. ' published',
  21076. ' property A;',
  21077. ' property B nodefault;',
  21078. ' end;',
  21079. 'begin']);
  21080. ConvertProgram;
  21081. CheckSource('TestRTTI_DefaultValueInherit',
  21082. LinesToStr([ // statements
  21083. 'rtl.createClass($mod, "TObject", null, function () {',
  21084. ' this.$init = function () {',
  21085. ' this.FA = 0;',
  21086. ' this.FB = 0;',
  21087. ' };',
  21088. ' this.$final = function () {',
  21089. ' };',
  21090. '});',
  21091. 'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
  21092. ' var $r = this.$rtti;',
  21093. ' $r.addProperty(',
  21094. ' "A",',
  21095. ' 0,',
  21096. ' rtl.byte,',
  21097. ' "FA",',
  21098. ' "",',
  21099. ' {',
  21100. ' Default: 1',
  21101. ' }',
  21102. ' );',
  21103. ' $r.addProperty("B", 0, rtl.byte, "FB", "");',
  21104. '});',
  21105. '']),
  21106. LinesToStr([ // $mod.$main
  21107. '']));
  21108. end;
  21109. procedure TTestModule.TestRTTI_OverrideMethod;
  21110. begin
  21111. Converter.Options:=Converter.Options-[coNoTypeInfo];
  21112. StartProgram(false);
  21113. Add('type');
  21114. Add(' TObject = class');
  21115. Add(' published');
  21116. Add(' procedure DoIt; virtual; abstract;');
  21117. Add(' end;');
  21118. Add(' TSky = class');
  21119. Add(' published');
  21120. Add(' procedure DoIt; override;');
  21121. Add(' end;');
  21122. Add('procedure TSky.DoIt; begin end;');
  21123. Add('begin');
  21124. ConvertProgram;
  21125. CheckSource('TestRTTI_OverrideMethod',
  21126. LinesToStr([ // statements
  21127. 'rtl.createClass($mod, "TObject", null, function () {',
  21128. ' this.$init = function () {',
  21129. ' };',
  21130. ' this.$final = function () {',
  21131. ' };',
  21132. ' var $r = this.$rtti;',
  21133. ' $r.addMethod("DoIt", 0, null);',
  21134. '});',
  21135. 'rtl.createClass($mod, "TSky", $mod.TObject, function () {',
  21136. ' this.DoIt = function () {',
  21137. ' };',
  21138. '});',
  21139. '']),
  21140. LinesToStr([ // $mod.$main
  21141. '']));
  21142. end;
  21143. procedure TTestModule.TestRTTI_OverloadProperty;
  21144. begin
  21145. Converter.Options:=Converter.Options-[coNoTypeInfo];
  21146. StartProgram(false);
  21147. Add('type');
  21148. Add(' TObject = class');
  21149. Add(' protected');
  21150. Add(' FFlag: longint;');
  21151. Add(' published');
  21152. Add(' property Flag: longint read fflag;');
  21153. Add(' end;');
  21154. Add(' TSky = class');
  21155. Add(' published');
  21156. Add(' property FLAG: longint write fflag;');
  21157. Add(' end;');
  21158. Add('begin');
  21159. ConvertProgram;
  21160. CheckSource('TestRTTI_OverrideMethod',
  21161. LinesToStr([ // statements
  21162. 'rtl.createClass($mod, "TObject", null, function () {',
  21163. ' this.$init = function () {',
  21164. ' this.FFlag = 0;',
  21165. ' };',
  21166. ' this.$final = function () {',
  21167. ' };',
  21168. ' var $r = this.$rtti;',
  21169. ' $r.addProperty("Flag", 0, rtl.longint, "FFlag", "");',
  21170. '});',
  21171. 'rtl.createClass($mod, "TSky", $mod.TObject, function () {',
  21172. ' var $r = this.$rtti;',
  21173. ' $r.addProperty("Flag", 0, rtl.longint, "", "FFlag");',
  21174. '});',
  21175. '']),
  21176. LinesToStr([ // $mod.$main
  21177. '']));
  21178. end;
  21179. procedure TTestModule.TestRTTI_ClassForward;
  21180. begin
  21181. Converter.Options:=Converter.Options-[coNoTypeInfo];
  21182. StartProgram(false);
  21183. Add('type');
  21184. Add(' TObject = class end;');
  21185. Add(' tbridge = class;');
  21186. Add(' TProc = function: tbridge;');
  21187. Add(' TOger = class');
  21188. Add(' published');
  21189. Add(' FBridge: tbridge;');
  21190. Add(' procedure SetBridge(Value: tbridge); virtual; abstract;');
  21191. Add(' property Bridge: tbridge read fbridge write setbridge;');
  21192. Add(' end;');
  21193. Add(' TBridge = class');
  21194. Add(' FOger: toger;');
  21195. Add(' end;');
  21196. Add('var p: Pointer;');
  21197. Add(' b: tbridge;');
  21198. Add('begin');
  21199. Add(' p:=typeinfo(tbridge);');
  21200. Add(' p:=typeinfo(b);');
  21201. ConvertProgram;
  21202. CheckSource('TestRTTI_ClassForward',
  21203. LinesToStr([ // statements
  21204. 'rtl.createClass($mod, "TObject", null, function () {',
  21205. ' this.$init = function () {',
  21206. ' };',
  21207. ' this.$final = function () {',
  21208. ' };',
  21209. '});',
  21210. '$mod.$rtti.$Class("TBridge");',
  21211. '$mod.$rtti.$ProcVar("TProc", {',
  21212. ' procsig: rtl.newTIProcSig(null, $mod.$rtti["TBridge"])',
  21213. '});',
  21214. 'rtl.createClass($mod, "TOger", $mod.TObject, function () {',
  21215. ' this.$init = function () {',
  21216. ' $mod.TObject.$init.call(this);',
  21217. ' this.FBridge = null;',
  21218. ' };',
  21219. ' this.$final = function () {',
  21220. ' this.FBridge = undefined;',
  21221. ' $mod.TObject.$final.call(this);',
  21222. ' };',
  21223. ' var $r = this.$rtti;',
  21224. ' $r.addField("FBridge", $mod.$rtti["TBridge"]);',
  21225. ' $r.addMethod("SetBridge", 0, [["Value", $mod.$rtti["TBridge"]]]);',
  21226. ' $r.addProperty("Bridge", 2, $mod.$rtti["TBridge"], "FBridge", "SetBridge");',
  21227. '});',
  21228. 'rtl.createClass($mod, "TBridge", $mod.TObject, function () {',
  21229. ' this.$init = function () {',
  21230. ' $mod.TObject.$init.call(this);',
  21231. ' this.FOger = null;',
  21232. ' };',
  21233. ' this.$final = function () {',
  21234. ' this.FOger = undefined;',
  21235. ' $mod.TObject.$final.call(this);',
  21236. ' };',
  21237. '});',
  21238. 'this.p = null;',
  21239. 'this.b = null;',
  21240. '']),
  21241. LinesToStr([ // $mod.$main
  21242. '$mod.p = $mod.$rtti["TBridge"];',
  21243. '$mod.p = $mod.b.$rtti;',
  21244. '']));
  21245. end;
  21246. procedure TTestModule.TestRTTI_ClassOf;
  21247. begin
  21248. Converter.Options:=Converter.Options-[coNoTypeInfo];
  21249. StartProgram(false);
  21250. Add('type');
  21251. Add(' TClass = class of tobject;');
  21252. Add(' TProcA = function: TClass;');
  21253. Add(' TObject = class');
  21254. Add(' published');
  21255. Add(' C: tclass;');
  21256. Add(' end;');
  21257. Add(' tfox = class;');
  21258. Add(' TBird = class end;');
  21259. Add(' TBirds = class of tbird;');
  21260. Add(' TFox = class end;');
  21261. Add(' TFoxes = class of tfox;');
  21262. Add(' TCows = class of TCow;');
  21263. Add(' TCow = class;');
  21264. Add(' TCow = class end;');
  21265. Add('begin');
  21266. ConvertProgram;
  21267. CheckSource('TestRTTI_ClassOf',
  21268. LinesToStr([ // statements
  21269. '$mod.$rtti.$Class("TObject");',
  21270. '$mod.$rtti.$ClassRef("TClass", {',
  21271. ' instancetype: $mod.$rtti["TObject"]',
  21272. '});',
  21273. '$mod.$rtti.$ProcVar("TProcA", {',
  21274. ' procsig: rtl.newTIProcSig(null, $mod.$rtti["TClass"])',
  21275. '});',
  21276. 'rtl.createClass($mod, "TObject", null, function () {',
  21277. ' this.$init = function () {',
  21278. ' this.C = null;',
  21279. ' };',
  21280. ' this.$final = function () {',
  21281. ' this.C = undefined;',
  21282. ' };',
  21283. ' var $r = this.$rtti;',
  21284. ' $r.addField("C", $mod.$rtti["TClass"]);',
  21285. '});',
  21286. '$mod.$rtti.$Class("TFox");',
  21287. 'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
  21288. '});',
  21289. '$mod.$rtti.$ClassRef("TBirds", {',
  21290. ' instancetype: $mod.$rtti["TBird"]',
  21291. '});',
  21292. 'rtl.createClass($mod, "TFox", $mod.TObject, function () {',
  21293. '});',
  21294. '$mod.$rtti.$ClassRef("TFoxes", {',
  21295. ' instancetype: $mod.$rtti["TFox"]',
  21296. '});',
  21297. '$mod.$rtti.$Class("TCow");',
  21298. '$mod.$rtti.$ClassRef("TCows", {',
  21299. ' instancetype: $mod.$rtti["TCow"]',
  21300. '});',
  21301. 'rtl.createClass($mod, "TCow", $mod.TObject, function () {',
  21302. '});',
  21303. '']),
  21304. LinesToStr([ // $mod.$main
  21305. '']));
  21306. end;
  21307. procedure TTestModule.TestRTTI_Record;
  21308. begin
  21309. Converter.Options:=Converter.Options-[coNoTypeInfo];
  21310. StartProgram(false);
  21311. Add('type');
  21312. Add(' integer = longint;');
  21313. Add(' TPoint = record');
  21314. Add(' x,y: integer;');
  21315. Add(' end;');
  21316. Add('var p: pointer;');
  21317. Add(' r: tpoint;');
  21318. Add('begin');
  21319. Add(' p:=typeinfo(tpoint);');
  21320. Add(' p:=typeinfo(r);');
  21321. Add(' p:=typeinfo(r.x);');
  21322. ConvertProgram;
  21323. CheckSource('TestRTTI_Record',
  21324. LinesToStr([ // statements
  21325. 'this.TPoint = function (s) {',
  21326. ' if (s) {',
  21327. ' this.x = s.x;',
  21328. ' this.y = s.y;',
  21329. ' } else {',
  21330. ' this.x = 0;',
  21331. ' this.y = 0;',
  21332. ' };',
  21333. ' this.$equal = function (b) {',
  21334. ' return (this.x === b.x) && (this.y === b.y);',
  21335. ' };',
  21336. '};',
  21337. '$mod.$rtti.$Record("TPoint", {}).addFields("x", rtl.longint, "y", rtl.longint);',
  21338. 'this.p = null;',
  21339. 'this.r = new $mod.TPoint();',
  21340. '']),
  21341. LinesToStr([ // $mod.$main
  21342. '$mod.p = $mod.$rtti["TPoint"];',
  21343. '$mod.p = $mod.$rtti["TPoint"];',
  21344. '$mod.p = rtl.longint;',
  21345. '']));
  21346. end;
  21347. procedure TTestModule.TestRTTI_RecordAnonymousArray;
  21348. begin
  21349. Converter.Options:=Converter.Options-[coNoTypeInfo];
  21350. StartProgram(false);
  21351. Add('type');
  21352. Add(' TFloatRec = record');
  21353. Add(' d: array of char;');
  21354. // Add(' i: array of array of longint;');
  21355. Add(' end;');
  21356. Add('var p: pointer;');
  21357. Add(' r: tfloatrec;');
  21358. Add('begin');
  21359. Add(' p:=typeinfo(tfloatrec);');
  21360. Add(' p:=typeinfo(r);');
  21361. Add(' p:=typeinfo(r.d);');
  21362. ConvertProgram;
  21363. CheckSource('TestRTTI_Record',
  21364. LinesToStr([ // statements
  21365. '$mod.$rtti.$DynArray("TFloatRec.d$a", {',
  21366. ' eltype: rtl.char',
  21367. '});',
  21368. 'this.TFloatRec = function (s) {',
  21369. ' if (s) {',
  21370. ' this.d = s.d;',
  21371. ' } else {',
  21372. ' this.d = [];',
  21373. ' };',
  21374. ' this.$equal = function (b) {',
  21375. ' return this.d === b.d;',
  21376. ' };',
  21377. '};',
  21378. '$mod.$rtti.$Record("TFloatRec", {}).addFields("d", $mod.$rtti["TFloatRec.d$a"]);',
  21379. 'this.p = null;',
  21380. 'this.r = new $mod.TFloatRec();',
  21381. '']),
  21382. LinesToStr([ // $mod.$main
  21383. '$mod.p = $mod.$rtti["TFloatRec"];',
  21384. '$mod.p = $mod.$rtti["TFloatRec"];',
  21385. '$mod.p = $mod.$rtti["TFloatRec.d$a"];',
  21386. '']));
  21387. end;
  21388. procedure TTestModule.TestRTTI_LocalTypes;
  21389. begin
  21390. Converter.Options:=Converter.Options-[coNoTypeInfo];
  21391. StartProgram(false);
  21392. Add([
  21393. 'procedure DoIt;',
  21394. 'type',
  21395. ' integer = longint;',
  21396. ' TPoint = record',
  21397. ' x,y: integer;',
  21398. ' end;',
  21399. 'var p: TPoint;',
  21400. 'begin',
  21401. 'end;',
  21402. 'begin']);
  21403. ConvertProgram;
  21404. CheckSource('TestRTTI_LocalTypes',
  21405. LinesToStr([ // statements
  21406. 'var TPoint = function(s) {',
  21407. ' if (s) {',
  21408. ' this.x = s.x;',
  21409. ' this.y = s.y;',
  21410. ' } else {',
  21411. ' this.x = 0;',
  21412. ' this.y = 0;',
  21413. ' };',
  21414. ' this.$equal = function (b) {',
  21415. ' return (this.x === b.x) && (this.y === b.y);',
  21416. ' };',
  21417. '};',
  21418. 'this.DoIt = function () {',
  21419. ' var p = new TPoint();',
  21420. '};',
  21421. '']),
  21422. LinesToStr([ // $mod.$main
  21423. '']));
  21424. end;
  21425. procedure TTestModule.TestRTTI_TypeInfo_BaseTypes;
  21426. begin
  21427. Converter.Options:=Converter.Options-[coNoTypeInfo];
  21428. StartProgram(false);
  21429. Add([
  21430. 'type',
  21431. ' TCaption = string;',
  21432. ' TYesNo = boolean;',
  21433. ' TLetter = char;',
  21434. ' TFloat = double;',
  21435. ' TPtr = pointer;',
  21436. ' TShortInt = shortint;',
  21437. ' TByte = byte;',
  21438. ' TSmallInt = smallint;',
  21439. ' TWord = word;',
  21440. ' TInt32 = longint;',
  21441. ' TDWord = longword;',
  21442. ' TValue = jsvalue;',
  21443. 'var p: TPtr;',
  21444. 'begin',
  21445. ' p:=typeinfo(string);',
  21446. ' p:=typeinfo(tcaption);',
  21447. ' p:=typeinfo(boolean);',
  21448. ' p:=typeinfo(tyesno);',
  21449. ' p:=typeinfo(char);',
  21450. ' p:=typeinfo(tletter);',
  21451. ' p:=typeinfo(double);',
  21452. ' p:=typeinfo(tfloat);',
  21453. ' p:=typeinfo(pointer);',
  21454. ' p:=typeinfo(tptr);',
  21455. ' p:=typeinfo(shortint);',
  21456. ' p:=typeinfo(tshortint);',
  21457. ' p:=typeinfo(byte);',
  21458. ' p:=typeinfo(tbyte);',
  21459. ' p:=typeinfo(smallint);',
  21460. ' p:=typeinfo(tsmallint);',
  21461. ' p:=typeinfo(word);',
  21462. ' p:=typeinfo(tword);',
  21463. ' p:=typeinfo(longword);',
  21464. ' p:=typeinfo(tdword);',
  21465. ' p:=typeinfo(jsvalue);',
  21466. ' p:=typeinfo(tvalue);',
  21467. '']);
  21468. ConvertProgram;
  21469. CheckSource('TestRTTI_TypeInfo_BaseTypes',
  21470. LinesToStr([ // statements
  21471. 'this.p = null;',
  21472. '']),
  21473. LinesToStr([ // $mod.$main
  21474. '$mod.p = rtl.string;',
  21475. '$mod.p = rtl.string;',
  21476. '$mod.p = rtl.boolean;',
  21477. '$mod.p = rtl.boolean;',
  21478. '$mod.p = rtl.char;',
  21479. '$mod.p = rtl.char;',
  21480. '$mod.p = rtl.double;',
  21481. '$mod.p = rtl.double;',
  21482. '$mod.p = rtl.pointer;',
  21483. '$mod.p = rtl.pointer;',
  21484. '$mod.p = rtl.shortint;',
  21485. '$mod.p = rtl.shortint;',
  21486. '$mod.p = rtl.byte;',
  21487. '$mod.p = rtl.byte;',
  21488. '$mod.p = rtl.smallint;',
  21489. '$mod.p = rtl.smallint;',
  21490. '$mod.p = rtl.word;',
  21491. '$mod.p = rtl.word;',
  21492. '$mod.p = rtl.longword;',
  21493. '$mod.p = rtl.longword;',
  21494. '$mod.p = rtl.jsvalue;',
  21495. '$mod.p = rtl.jsvalue;',
  21496. '']));
  21497. end;
  21498. procedure TTestModule.TestRTTI_TypeInfo_Type_BaseTypes;
  21499. begin
  21500. Converter.Options:=Converter.Options-[coNoTypeInfo];
  21501. StartProgram(false);
  21502. Add([
  21503. 'type',
  21504. ' TCaption = type string;',
  21505. ' TYesNo = type boolean;',
  21506. ' TLetter = type char;',
  21507. ' TFloat = type double;',
  21508. ' TPtr = type pointer;',
  21509. ' TShortInt = type shortint;',
  21510. ' TByte = type byte;',
  21511. ' TSmallInt = type smallint;',
  21512. ' TWord = type word;',
  21513. ' TInt32 = type longint;',
  21514. ' TDWord = type longword;',
  21515. ' TValue = type jsvalue;',
  21516. ' TAliasValue = type TValue;',
  21517. 'var',
  21518. ' p: TPtr;',
  21519. ' a: TAliasValue;',
  21520. 'begin',
  21521. ' p:=typeinfo(tcaption);',
  21522. ' p:=typeinfo(tyesno);',
  21523. ' p:=typeinfo(tletter);',
  21524. ' p:=typeinfo(tfloat);',
  21525. ' p:=typeinfo(tptr);',
  21526. ' p:=typeinfo(tshortint);',
  21527. ' p:=typeinfo(tbyte);',
  21528. ' p:=typeinfo(tsmallint);',
  21529. ' p:=typeinfo(tword);',
  21530. ' p:=typeinfo(tdword);',
  21531. ' p:=typeinfo(tvalue);',
  21532. ' p:=typeinfo(taliasvalue);',
  21533. ' p:=typeinfo(a);',
  21534. '']);
  21535. ConvertProgram;
  21536. CheckSource('TestRTTI_TypeInfo_Type_BaseTypes',
  21537. LinesToStr([ // statements
  21538. '$mod.$rtti.$inherited("TCaption", rtl.string, {});',
  21539. '$mod.$rtti.$inherited("TYesNo", rtl.boolean, {});',
  21540. '$mod.$rtti.$inherited("TLetter", rtl.char, {});',
  21541. '$mod.$rtti.$inherited("TFloat", rtl.double, {});',
  21542. '$mod.$rtti.$inherited("TPtr", rtl.pointer, {});',
  21543. '$mod.$rtti.$inherited("TShortInt", rtl.shortint, {});',
  21544. '$mod.$rtti.$inherited("TByte", rtl.byte, {});',
  21545. '$mod.$rtti.$inherited("TSmallInt", rtl.smallint, {});',
  21546. '$mod.$rtti.$inherited("TWord", rtl.word, {});',
  21547. '$mod.$rtti.$inherited("TInt32", rtl.longint, {});',
  21548. '$mod.$rtti.$inherited("TDWord", rtl.longword, {});',
  21549. '$mod.$rtti.$inherited("TValue", rtl.jsvalue, {});',
  21550. '$mod.$rtti.$inherited("TAliasValue", $mod.$rtti["TValue"], {});',
  21551. 'this.p = null;',
  21552. 'this.a = undefined;',
  21553. '']),
  21554. LinesToStr([ // $mod.$main
  21555. '$mod.p = $mod.$rtti["TCaption"];',
  21556. '$mod.p = $mod.$rtti["TYesNo"];',
  21557. '$mod.p = $mod.$rtti["TLetter"];',
  21558. '$mod.p = $mod.$rtti["TFloat"];',
  21559. '$mod.p = $mod.$rtti["TPtr"];',
  21560. '$mod.p = $mod.$rtti["TShortInt"];',
  21561. '$mod.p = $mod.$rtti["TByte"];',
  21562. '$mod.p = $mod.$rtti["TSmallInt"];',
  21563. '$mod.p = $mod.$rtti["TWord"];',
  21564. '$mod.p = $mod.$rtti["TDWord"];',
  21565. '$mod.p = $mod.$rtti["TValue"];',
  21566. '$mod.p = $mod.$rtti["TAliasValue"];',
  21567. '$mod.p = $mod.$rtti["TAliasValue"];',
  21568. '']));
  21569. end;
  21570. procedure TTestModule.TestRTTI_TypeInfo_LocalFail;
  21571. begin
  21572. Converter.Options:=Converter.Options-[coNoTypeInfo];
  21573. StartProgram(false);
  21574. Add('procedure DoIt;');
  21575. Add('type');
  21576. Add(' integer = longint;');
  21577. Add(' TPoint = record');
  21578. Add(' x,y: integer;');
  21579. Add(' end;');
  21580. Add('var p: pointer;');
  21581. Add('begin');
  21582. Add(' p:=typeinfo(tpoint);');
  21583. Add('end;');
  21584. Add('begin');
  21585. SetExpectedPasResolverError(sSymbolCannotBePublished,nSymbolCannotBePublished);
  21586. ConvertProgram;
  21587. end;
  21588. procedure TTestModule.TestRTTI_TypeInfo_ExtTypeInfoClasses1;
  21589. begin
  21590. Converter.Options:=Converter.Options-[coNoTypeInfo];
  21591. StartProgram(false);
  21592. Add([
  21593. '{$modeswitch externalclass}',
  21594. 'type',
  21595. ' TTypeInfo = class external name ''rtl.tTypeInfo'' end;',
  21596. ' TTypeInfoInteger = class external name ''rtl.tTypeInfoInteger''(TTypeInfo) end;',
  21597. ' TFlag = (up,down);',
  21598. ' TTypeInfoEnum = class external name ''rtl.tTypeInfoEnum''(TTypeInfoInteger) end;',
  21599. ' TFlags = set of TFlag;',
  21600. ' TTypeInfoSet = class external name ''rtl.tTypeInfoSet''(TTypeInfo) end;',
  21601. 'var',
  21602. ' ti: TTypeInfo;',
  21603. ' tiInt: TTypeInfoInteger;',
  21604. ' tiEnum: TTypeInfoEnum;',
  21605. ' tiSet: TTypeInfoSet;',
  21606. 'begin',
  21607. ' ti:=typeinfo(string);',
  21608. ' ti:=typeinfo(boolean);',
  21609. ' ti:=typeinfo(char);',
  21610. ' ti:=typeinfo(double);',
  21611. ' tiInt:=typeinfo(shortint);',
  21612. ' tiInt:=typeinfo(byte);',
  21613. ' tiInt:=typeinfo(smallint);',
  21614. ' tiInt:=typeinfo(word);',
  21615. ' tiInt:=typeinfo(longint);',
  21616. ' tiInt:=typeinfo(longword);',
  21617. ' ti:=typeinfo(jsvalue);',
  21618. ' tiEnum:=typeinfo(tflag);',
  21619. ' tiSet:=typeinfo(tflags);']);
  21620. ConvertProgram;
  21621. CheckSource('TestRTTI_TypeInfo_ExtTypeInfoClasses1',
  21622. LinesToStr([ // statements
  21623. 'this.TFlag = {',
  21624. ' "0": "up",',
  21625. ' up: 0,',
  21626. ' "1": "down",',
  21627. ' down: 1',
  21628. '};',
  21629. '$mod.$rtti.$Enum("TFlag", {',
  21630. ' minvalue: 0,',
  21631. ' maxvalue: 1,',
  21632. ' ordtype: 1,',
  21633. ' enumtype: this.TFlag',
  21634. '});',
  21635. '$mod.$rtti.$Set("TFlags", {',
  21636. ' comptype: $mod.$rtti["TFlag"]',
  21637. '});',
  21638. 'this.ti = null;',
  21639. 'this.tiInt = null;',
  21640. 'this.tiEnum = null;',
  21641. 'this.tiSet = null;',
  21642. '']),
  21643. LinesToStr([ // $mod.$main
  21644. '$mod.ti = rtl.string;',
  21645. '$mod.ti = rtl.boolean;',
  21646. '$mod.ti = rtl.char;',
  21647. '$mod.ti = rtl.double;',
  21648. '$mod.tiInt = rtl.shortint;',
  21649. '$mod.tiInt = rtl.byte;',
  21650. '$mod.tiInt = rtl.smallint;',
  21651. '$mod.tiInt = rtl.word;',
  21652. '$mod.tiInt = rtl.longint;',
  21653. '$mod.tiInt = rtl.longword;',
  21654. '$mod.ti = rtl.jsvalue;',
  21655. '$mod.tiEnum = $mod.$rtti["TFlag"];',
  21656. '$mod.tiSet = $mod.$rtti["TFlags"];',
  21657. '']));
  21658. end;
  21659. procedure TTestModule.TestRTTI_TypeInfo_ExtTypeInfoClasses2;
  21660. begin
  21661. Converter.Options:=Converter.Options-[coNoTypeInfo];
  21662. StartProgram(false);
  21663. Add('{$modeswitch externalclass}');
  21664. Add('type');
  21665. Add(' TTypeInfo = class external name ''rtl.tTypeInfo'' end;');
  21666. Add(' TStaticArr = array[boolean] of string;');
  21667. Add(' TTypeInfoStaticArray = class external name ''rtl.tTypeInfoStaticArray''(TTypeInfo) end;');
  21668. Add(' TDynArr = array of string;');
  21669. Add(' TTypeInfoDynArray = class external name ''rtl.tTypeInfoDynArray''(TTypeInfo) end;');
  21670. Add(' TProc = procedure;');
  21671. Add(' TTypeInfoProcVar = class external name ''rtl.tTypeInfoProcVar''(TTypeInfo) end;');
  21672. Add(' TMethod = procedure of object;');
  21673. Add(' TTypeInfoMethodVar = class external name ''rtl.tTypeInfoMethodVar''(TTypeInfoProcVar) end;');
  21674. Add('var');
  21675. Add(' StaticArray: TStaticArr;');
  21676. Add(' tiStaticArray: TTypeInfoStaticArray;');
  21677. Add(' DynArray: TDynArr;');
  21678. Add(' tiDynArray: TTypeInfoDynArray;');
  21679. Add(' ProcVar: TProc;');
  21680. Add(' tiProcVar: TTypeInfoProcVar;');
  21681. Add(' MethodVar: TMethod;');
  21682. Add(' tiMethodVar: TTypeInfoMethodVar;');
  21683. Add('begin');
  21684. Add(' tiStaticArray:=typeinfo(StaticArray);');
  21685. Add(' tiStaticArray:=typeinfo(TStaticArr);');
  21686. Add(' tiDynArray:=typeinfo(DynArray);');
  21687. Add(' tiDynArray:=typeinfo(TDynArr);');
  21688. Add(' tiProcVar:=typeinfo(ProcVar);');
  21689. Add(' tiProcVar:=typeinfo(TProc);');
  21690. Add(' tiMethodVar:=typeinfo(MethodVar);');
  21691. Add(' tiMethodVar:=typeinfo(TMethod);');
  21692. ConvertProgram;
  21693. CheckSource('TestRTTI_TypeInfo_ExtTypeInfoClasses2',
  21694. LinesToStr([ // statements
  21695. ' $mod.$rtti.$StaticArray("TStaticArr", {',
  21696. ' dims: [2],',
  21697. ' eltype: rtl.string',
  21698. '});',
  21699. '$mod.$rtti.$DynArray("TDynArr", {',
  21700. ' eltype: rtl.string',
  21701. '});',
  21702. '$mod.$rtti.$ProcVar("TProc", {',
  21703. ' procsig: rtl.newTIProcSig(null)',
  21704. '});',
  21705. '$mod.$rtti.$MethodVar("TMethod", {',
  21706. ' procsig: rtl.newTIProcSig(null),',
  21707. ' methodkind: 0',
  21708. '});',
  21709. 'this.StaticArray = rtl.arraySetLength(null,"",2);',
  21710. 'this.tiStaticArray = null;',
  21711. 'this.DynArray = [];',
  21712. 'this.tiDynArray = null;',
  21713. 'this.ProcVar = null;',
  21714. 'this.tiProcVar = null;',
  21715. 'this.MethodVar = null;',
  21716. 'this.tiMethodVar = null;',
  21717. '']),
  21718. LinesToStr([ // $mod.$main
  21719. '$mod.tiStaticArray = $mod.$rtti["TStaticArr"];',
  21720. '$mod.tiStaticArray = $mod.$rtti["TStaticArr"];',
  21721. '$mod.tiDynArray = $mod.$rtti["TDynArr"];',
  21722. '$mod.tiDynArray = $mod.$rtti["TDynArr"];',
  21723. '$mod.tiProcVar = $mod.$rtti["TProc"];',
  21724. '$mod.tiProcVar = $mod.$rtti["TProc"];',
  21725. '$mod.tiMethodVar = $mod.$rtti["TMethod"];',
  21726. '$mod.tiMethodVar = $mod.$rtti["TMethod"];',
  21727. '']));
  21728. end;
  21729. procedure TTestModule.TestRTTI_TypeInfo_ExtTypeInfoClasses3;
  21730. begin
  21731. Converter.Options:=Converter.Options-[coNoTypeInfo];
  21732. StartProgram(false);
  21733. Add('{$modeswitch externalclass}');
  21734. Add('type');
  21735. Add(' TTypeInfo = class external name ''rtl.tTypeInfo'' end;');
  21736. Add(' TRec = record end;');
  21737. Add(' TTypeInfoRecord = class external name ''rtl.tTypeInfoRecord''(TTypeInfo) end;');
  21738. // ToDo: ^PRec
  21739. Add(' TObject = class end;');
  21740. Add(' TTypeInfoClass = class external name ''rtl.tTypeInfoClass''(TTypeInfo) end;');
  21741. Add(' TClass = class of tobject;');
  21742. Add(' TTypeInfoClassRef = class external name ''rtl.tTypeInfoClassRef''(TTypeInfo) end;');
  21743. Add(' TTypeInfoPointer = class external name ''rtl.tTypeInfoPointer''(TTypeInfo) end;');
  21744. Add('var');
  21745. Add(' Rec: trec;');
  21746. Add(' tiRecord: ttypeinforecord;');
  21747. Add(' Obj: tobject;');
  21748. Add(' tiClass: ttypeinfoclass;');
  21749. Add(' aClass: tclass;');
  21750. Add(' tiClassRef: ttypeinfoclassref;');
  21751. // ToDo: ^PRec
  21752. Add(' tiPointer: ttypeinfopointer;');
  21753. Add('begin');
  21754. Add(' tirecord:=typeinfo(trec);');
  21755. Add(' tirecord:=typeinfo(trec);');
  21756. Add(' ticlass:=typeinfo(obj);');
  21757. Add(' ticlass:=typeinfo(tobject);');
  21758. Add(' ticlass:=typeinfo(aclass);');
  21759. Add(' ticlassref:=typeinfo(tclass);');
  21760. ConvertProgram;
  21761. CheckSource('TestRTTI_TypeInfo_ExtTypeInfoClasses3',
  21762. LinesToStr([ // statements
  21763. 'this.TRec = function (s) {',
  21764. ' this.$equal = function (b) {',
  21765. ' return true;',
  21766. ' };',
  21767. '};',
  21768. '$mod.$rtti.$Record("TRec", {});',
  21769. 'rtl.createClass($mod, "TObject", null, function () {',
  21770. ' this.$init = function () {',
  21771. ' };',
  21772. ' this.$final = function () {',
  21773. ' };',
  21774. '});',
  21775. '$mod.$rtti.$ClassRef("TClass", {',
  21776. ' instancetype: $mod.$rtti["TObject"]',
  21777. '});',
  21778. 'this.Rec = new $mod.TRec();',
  21779. 'this.tiRecord = null;',
  21780. 'this.Obj = null;',
  21781. 'this.tiClass = null;',
  21782. 'this.aClass = null;',
  21783. 'this.tiClassRef = null;',
  21784. 'this.tiPointer = null;',
  21785. '']),
  21786. LinesToStr([ // $mod.$main
  21787. '$mod.tiRecord = $mod.$rtti["TRec"];',
  21788. '$mod.tiRecord = $mod.$rtti["TRec"];',
  21789. '$mod.tiClass = $mod.Obj.$rtti;',
  21790. '$mod.tiClass = $mod.$rtti["TObject"];',
  21791. '$mod.tiClass = $mod.aClass.$rtti;',
  21792. '$mod.tiClassRef = $mod.$rtti["TClass"];',
  21793. '']));
  21794. end;
  21795. procedure TTestModule.TestRTTI_TypeInfo_FunctionClassType;
  21796. begin
  21797. Converter.Options:=Converter.Options-[coNoTypeInfo];
  21798. StartProgram(false);
  21799. Add([
  21800. '{$modeswitch externalclass}',
  21801. 'type',
  21802. ' TClass = class of tobject;',
  21803. ' TObject = class',
  21804. ' function MyClass: TClass;',
  21805. ' class function ClassType: TClass;',
  21806. ' end;',
  21807. ' TTypeInfo = class external name ''rtl.tTypeInfo'' end;',
  21808. ' TTypeInfoClass = class external name ''rtl.tTypeInfoClass''(TTypeInfo) end;',
  21809. 'function TObject.MyClass: TClass;',
  21810. 'var t: TTypeInfoClass;',
  21811. 'begin',
  21812. ' t:=TypeInfo(Self);',
  21813. ' t:=TypeInfo(Result);',
  21814. ' t:=TypeInfo(TObject);',
  21815. 'end;',
  21816. 'class function TObject.ClassType: TClass;',
  21817. 'var t: TTypeInfoClass;',
  21818. 'begin',
  21819. ' t:=TypeInfo(Self);',
  21820. ' t:=TypeInfo(Result);',
  21821. 'end;',
  21822. 'var',
  21823. ' Obj: TObject;',
  21824. ' t: TTypeInfoClass;',
  21825. 'begin',
  21826. ' t:=TypeInfo(TObject.ClassType);',
  21827. ' t:=TypeInfo(Obj.ClassType);',
  21828. ' t:=TypeInfo(Obj.MyClass);',
  21829. '']);
  21830. ConvertProgram;
  21831. CheckSource('TestRTTI_TypeInfo_FunctionClassType',
  21832. LinesToStr([ // statements
  21833. '$mod.$rtti.$Class("TObject");',
  21834. '$mod.$rtti.$ClassRef("TClass", {',
  21835. ' instancetype: $mod.$rtti["TObject"]',
  21836. '});',
  21837. 'rtl.createClass($mod, "TObject", null, function () {',
  21838. ' this.$init = function () {',
  21839. ' };',
  21840. ' this.$final = function () {',
  21841. ' };',
  21842. ' this.MyClass = function () {',
  21843. ' var Result = null;',
  21844. ' var t = null;',
  21845. ' t = this.$rtti;',
  21846. ' t = Result.$rtti;',
  21847. ' t = $mod.$rtti["TObject"];',
  21848. ' return Result;',
  21849. ' };',
  21850. ' this.ClassType = function () {',
  21851. ' var Result = null;',
  21852. ' var t = null;',
  21853. ' t = this.$rtti;',
  21854. ' t = Result.$rtti;',
  21855. ' return Result;',
  21856. ' };',
  21857. '});',
  21858. 'this.Obj = null;',
  21859. 'this.t = null;',
  21860. '']),
  21861. LinesToStr([ // $mod.$main
  21862. '$mod.t = $mod.TObject.ClassType().$rtti;',
  21863. '$mod.t = $mod.Obj.$class.ClassType().$rtti;',
  21864. '$mod.t = $mod.Obj.MyClass().$rtti;',
  21865. '']));
  21866. end;
  21867. procedure TTestModule.TestRTTI_TypeInfo_MixedUnits_PointerAndClass;
  21868. begin
  21869. Converter.Options:=Converter.Options-[coNoTypeInfo];
  21870. AddModuleWithIntfImplSrc('typinfo.pas',
  21871. LinesToStr([
  21872. '{$modeswitch externalclass}',
  21873. 'type',
  21874. ' TTypeInfo = class external name ''rtl.tTypeInfo'' end;',
  21875. ' TTypeInfoInteger = class external name ''rtl.tTypeInfoInteger''(TTypeInfo) end;',
  21876. '']),
  21877. '');
  21878. AddModuleWithIntfImplSrc('unit2.pas',
  21879. LinesToStr([
  21880. 'uses typinfo;',
  21881. 'type PTypeInfo = TTypeInfo;', // delphi compatibility code
  21882. 'procedure DoPtr(p: PTypeInfo);',
  21883. 'procedure DoInfo(t: TTypeInfo);',
  21884. 'procedure DoInt(t: TTypeInfoInteger);',
  21885. '']),
  21886. LinesToStr([
  21887. 'procedure DoPtr(p: PTypeInfo);',
  21888. 'begin end;',
  21889. 'procedure DoInfo(t: TTypeInfo);',
  21890. 'begin end;',
  21891. 'procedure DoInt(t: TTypeInfoInteger);',
  21892. 'begin end;',
  21893. '']));
  21894. StartUnit(true);
  21895. Add([
  21896. 'interface',
  21897. 'uses unit2;', // does not use unit typinfo
  21898. 'implementation',
  21899. 'var',
  21900. ' i: byte;',
  21901. ' p: pointer;',
  21902. ' t: PTypeInfo;',
  21903. 'initialization',
  21904. ' p:=typeinfo(i);',
  21905. ' t:=typeinfo(i);',
  21906. ' if p=t then ;',
  21907. ' if p=typeinfo(i) then ;',
  21908. ' if typeinfo(i)=p then ;',
  21909. ' if t=typeinfo(i) then ;',
  21910. ' if typeinfo(i)=t then ;',
  21911. ' DoPtr(p);',
  21912. ' DoPtr(t);',
  21913. ' DoPtr(typeinfo(i));',
  21914. ' DoInfo(p);',
  21915. ' DoInfo(t);',
  21916. ' DoInfo(typeinfo(i));',
  21917. ' DoInt(typeinfo(i));',
  21918. '']);
  21919. ConvertUnit;
  21920. CheckSource('TestRTTI_TypeInfo_MixedUnits_PointerAndClass',
  21921. LinesToStr([ // statements
  21922. 'var $impl = $mod.$impl;',
  21923. '']),
  21924. LinesToStr([ // this.$init
  21925. '$impl.p = rtl.byte;',
  21926. '$impl.t = rtl.byte;',
  21927. 'if ($impl.p === $impl.t) ;',
  21928. 'if ($impl.p === rtl.byte) ;',
  21929. 'if (rtl.byte === $impl.p) ;',
  21930. 'if ($impl.t === rtl.byte) ;',
  21931. 'if (rtl.byte === $impl.t) ;',
  21932. 'pas.unit2.DoPtr($impl.p);',
  21933. 'pas.unit2.DoPtr($impl.t);',
  21934. 'pas.unit2.DoPtr(rtl.byte);',
  21935. 'pas.unit2.DoInfo($impl.p);',
  21936. 'pas.unit2.DoInfo($impl.t);',
  21937. 'pas.unit2.DoInfo(rtl.byte);',
  21938. 'pas.unit2.DoInt(rtl.byte);',
  21939. '']),
  21940. LinesToStr([ // implementation
  21941. '$impl.i = 0;',
  21942. '$impl.p = null;',
  21943. '$impl.t = null;',
  21944. '']) );
  21945. end;
  21946. procedure TTestModule.TestRTTI_Interface_Corba;
  21947. begin
  21948. Converter.Options:=Converter.Options-[coNoTypeInfo];
  21949. StartProgram(false);
  21950. Add([
  21951. '{$interfaces corba}',
  21952. '{$modeswitch externalclass}',
  21953. 'type',
  21954. ' IUnknown = interface',
  21955. ' end;',
  21956. ' IBird = interface',
  21957. ' function GetItem: longint;',
  21958. ' procedure SetItem(Value: longint);',
  21959. ' property Item: longint read GetItem write SetItem;',
  21960. ' end;',
  21961. ' TTypeInfo = class external name ''rtl.tTypeInfo'' end;',
  21962. ' TTypeInfoInterface = class external name ''rtl.tTypeInfoInterface''(TTypeInfo) end;',
  21963. 'procedure DoIt(t: TTypeInfoInterface); begin end;',
  21964. 'var',
  21965. ' i: IBird;',
  21966. ' t: TTypeInfoInterface;',
  21967. 'begin',
  21968. ' t:=TypeInfo(IBird);',
  21969. ' t:=TypeInfo(i);',
  21970. ' DoIt(t);',
  21971. ' DoIt(TypeInfo(IBird));',
  21972. '']);
  21973. ConvertProgram;
  21974. CheckSource('TestRTTI_Interface_Corba',
  21975. LinesToStr([ // statements
  21976. 'rtl.createInterface(',
  21977. ' $mod,',
  21978. ' "IUnknown",',
  21979. ' "{B92D5841-758A-322B-B800-000000000000}",',
  21980. ' [],',
  21981. ' null,',
  21982. ' function () {',
  21983. ' }',
  21984. ');',
  21985. 'rtl.createInterface(',
  21986. ' $mod,',
  21987. ' "IBird",',
  21988. ' "{D32D5841-6264-3AE3-A2C9-B91CE922C9B9}",',
  21989. ' ["GetItem", "SetItem"],',
  21990. ' null,',
  21991. ' function () {',
  21992. ' var $r = this.$rtti;',
  21993. ' $r.addMethod("GetItem", 1, null, rtl.longint);',
  21994. ' $r.addMethod("SetItem", 0, [["Value", rtl.longint]]);',
  21995. ' $r.addProperty("Item", 3, rtl.longint, "GetItem", "SetItem");',
  21996. ' }',
  21997. ');',
  21998. 'this.DoIt = function (t) {',
  21999. '}; ',
  22000. 'this.i = null;',
  22001. 'this.t = null;',
  22002. '']),
  22003. LinesToStr([ // $mod.$main
  22004. '$mod.t = $mod.$rtti["IBird"];',
  22005. '$mod.t = $mod.i.$rtti;',
  22006. '$mod.DoIt($mod.t);',
  22007. '$mod.DoIt($mod.$rtti["IBird"]);',
  22008. '']));
  22009. end;
  22010. procedure TTestModule.TestRTTI_Interface_COM;
  22011. begin
  22012. Converter.Options:=Converter.Options-[coNoTypeInfo];
  22013. StartProgram(false);
  22014. Add([
  22015. '{$interfaces com}',
  22016. '{$modeswitch externalclass}',
  22017. 'type',
  22018. ' TGuid = record end;',
  22019. ' integer = longint;',
  22020. ' IUnknown = interface',
  22021. ' function QueryInterface(const iid: TGuid; out obj): Integer;',
  22022. ' function _AddRef: Integer;',
  22023. ' function _Release: Integer;',
  22024. ' end;',
  22025. ' IBird = interface',
  22026. ' function GetItem: longint;',
  22027. ' procedure SetItem(Value: longint);',
  22028. ' property Item: longint read GetItem write SetItem;',
  22029. ' end;',
  22030. ' TTypeInfo = class external name ''rtl.tTypeInfo'' end;',
  22031. ' TTypeInfoInterface = class external name ''rtl.tTypeInfoInterface''(TTypeInfo) end;',
  22032. 'var',
  22033. ' i: IBird;',
  22034. ' t: TTypeInfoInterface;',
  22035. 'begin',
  22036. ' t:=TypeInfo(IBird);',
  22037. ' t:=TypeInfo(i);',
  22038. '']);
  22039. ConvertProgram;
  22040. CheckSource('TestRTTI_Interface_COM',
  22041. LinesToStr([ // statements
  22042. 'this.TGuid = function (s) {',
  22043. ' this.$equal = function (b) {',
  22044. ' return true;',
  22045. ' };',
  22046. '};',
  22047. '$mod.$rtti.$Record("TGuid", {});',
  22048. 'rtl.createInterface(',
  22049. ' $mod,',
  22050. ' "IUnknown",',
  22051. ' "{D7ADB00D-1A9B-3EDC-B123-730E661DDFA9}",',
  22052. ' ["QueryInterface", "_AddRef", "_Release"],',
  22053. ' null,',
  22054. ' function () {',
  22055. ' this.$kind = "com";',
  22056. ' var $r = this.$rtti;',
  22057. ' $r.addMethod("QueryInterface", 1, [["iid", $mod.$rtti["TGuid"], 2], ["obj", null, 4]], rtl.longint);',
  22058. ' $r.addMethod("_AddRef", 1, null, rtl.longint);',
  22059. ' $r.addMethod("_Release", 1, null, rtl.longint);',
  22060. ' }',
  22061. ');',
  22062. 'rtl.createInterface(',
  22063. ' $mod,',
  22064. ' "IBird",',
  22065. ' "{9CC77572-0E45-3594-9A88-9E8D865C9E0A}",',
  22066. ' ["GetItem", "SetItem"],',
  22067. ' $mod.IUnknown,',
  22068. ' function () {',
  22069. ' var $r = this.$rtti;',
  22070. ' $r.addMethod("GetItem", 1, null, rtl.longint);',
  22071. ' $r.addMethod("SetItem", 0, [["Value", rtl.longint]]);',
  22072. ' $r.addProperty("Item", 3, rtl.longint, "GetItem", "SetItem");',
  22073. ' }',
  22074. ');',
  22075. 'this.i = null;',
  22076. 'this.t = null;',
  22077. '']),
  22078. LinesToStr([ // $mod.$main
  22079. '$mod.t = $mod.$rtti["IBird"];',
  22080. '$mod.t = $mod.i.$rtti;',
  22081. '']));
  22082. end;
  22083. procedure TTestModule.TestResourcestringProgram;
  22084. begin
  22085. StartProgram(false);
  22086. Add([
  22087. 'const Bar = ''bar'';',
  22088. 'resourcestring',
  22089. ' Red = ''red'';',
  22090. ' Foobar = ''fOo''+bar;',
  22091. 'var s: string;',
  22092. ' c: char;',
  22093. 'begin',
  22094. ' s:=red;',
  22095. ' s:=test1.red;',
  22096. ' c:=red[1];',
  22097. ' c:=test1.red[2];',
  22098. ' if red=foobar then ;',
  22099. ' if red[3]=red[4] then ;']);
  22100. ConvertProgram;
  22101. CheckSource('TestResourcestringProgram',
  22102. LinesToStr([ // statements
  22103. 'this.Bar = "bar";',
  22104. 'this.s = "";',
  22105. 'this.c = "";',
  22106. '$mod.$resourcestrings = {',
  22107. ' Red: {',
  22108. ' org: "red"',
  22109. ' },',
  22110. ' Foobar: {',
  22111. ' org: "fOobar"',
  22112. ' }',
  22113. '};',
  22114. '']),
  22115. LinesToStr([ // $mod.$main
  22116. '$mod.s = rtl.getResStr(pas.program, "Red");',
  22117. '$mod.s = rtl.getResStr(pas.program, "Red");',
  22118. '$mod.c = rtl.getResStr(pas.program, "Red").charAt(0);',
  22119. '$mod.c = rtl.getResStr(pas.program, "Red").charAt(1);',
  22120. 'if (rtl.getResStr(pas.program, "Red") === rtl.getResStr(pas.program, "Foobar")) ;',
  22121. 'if (rtl.getResStr(pas.program, "Red").charAt(2) === rtl.getResStr(pas.program, "Red").charAt(3)) ;',
  22122. '']));
  22123. end;
  22124. procedure TTestModule.TestResourcestringUnit;
  22125. begin
  22126. StartUnit(false);
  22127. Add([
  22128. 'interface',
  22129. 'const Red = ''rEd'';',
  22130. 'resourcestring',
  22131. ' Blue = ''blue'';',
  22132. ' NotRed = ''not''+Red;',
  22133. 'var s: string;',
  22134. 'implementation',
  22135. 'resourcestring',
  22136. ' ImplGreen = ''green'';',
  22137. 'initialization',
  22138. ' s:=blue+ImplGreen;',
  22139. ' s:=test1.blue+test1.implgreen;',
  22140. ' s:=blue[1]+implgreen[2];']);
  22141. ConvertUnit;
  22142. CheckSource('TestResourcestringUnit',
  22143. LinesToStr([ // statements
  22144. 'this.Red = "rEd";',
  22145. 'this.s = "";',
  22146. '$mod.$resourcestrings = {',
  22147. ' Blue: {',
  22148. ' org: "blue"',
  22149. ' },',
  22150. ' NotRed: {',
  22151. ' org: "notrEd"',
  22152. ' },',
  22153. ' ImplGreen: {',
  22154. ' org: "green"',
  22155. ' }',
  22156. '};',
  22157. '']),
  22158. LinesToStr([ // $mod.$main
  22159. '$mod.s = rtl.getResStr(pas.Test1, "Blue") + rtl.getResStr(pas.Test1, "ImplGreen");',
  22160. '$mod.s = rtl.getResStr(pas.Test1, "Blue") + rtl.getResStr(pas.Test1, "ImplGreen");',
  22161. '$mod.s = rtl.getResStr(pas.Test1, "Blue").charAt(0) + rtl.getResStr(pas.Test1, "ImplGreen").charAt(1);',
  22162. '']));
  22163. end;
  22164. procedure TTestModule.TestResourcestringImplementation;
  22165. begin
  22166. StartUnit(false);
  22167. Add([
  22168. 'interface',
  22169. 'implementation',
  22170. 'resourcestring',
  22171. ' ImplRed = ''red'';']);
  22172. ConvertUnit;
  22173. CheckSource('TestResourcestringImplementation',
  22174. LinesToStr([ // intf statements
  22175. 'var $impl = $mod.$impl;']),
  22176. LinesToStr([ // $mod.$init
  22177. '']),
  22178. LinesToStr([ // impl statements
  22179. '$mod.$resourcestrings = {',
  22180. ' ImplRed: {',
  22181. ' org: "red"',
  22182. ' }',
  22183. '};',
  22184. '']));
  22185. end;
  22186. procedure TTestModule.TestAtributes_Ignore;
  22187. begin
  22188. StartProgram(false);
  22189. Add([
  22190. '{$modeswitch ignoreattributes}',
  22191. 'type',
  22192. ' [custom1, custom2(1+3,''foo'')] [mod1.custom3]',
  22193. ' TObject = class',
  22194. ' [custom5()] FS: string;',
  22195. ' [customProp] property S: string read FS;',
  22196. ' end;',
  22197. 'var',
  22198. ' [custom6]',
  22199. ' o: TObject;',
  22200. 'begin',
  22201. '']);
  22202. ConvertProgram;
  22203. CheckSource('TestAtributes_Ignore',
  22204. LinesToStr([ // statements
  22205. 'rtl.createClass($mod, "TObject", null, function () {',
  22206. ' this.$init = function () {',
  22207. ' this.FS = "";',
  22208. ' };',
  22209. ' this.$final = function () {',
  22210. ' };',
  22211. '});',
  22212. 'this.o = null;',
  22213. '']),
  22214. LinesToStr([ // $mod.$main
  22215. '']));
  22216. end;
  22217. procedure TTestModule.TestAssert;
  22218. begin
  22219. StartProgram(false);
  22220. Add([
  22221. 'procedure DoIt;',
  22222. 'var',
  22223. ' b: boolean;',
  22224. ' s: string;',
  22225. 'begin',
  22226. ' {$Assertions on}',
  22227. ' Assert(b);',
  22228. 'end;',
  22229. 'begin',
  22230. ' DoIt;',
  22231. '']);
  22232. ConvertProgram;
  22233. CheckSource('TestAssert',
  22234. LinesToStr([ // statements
  22235. 'this.DoIt = function () {',
  22236. ' var b = false;',
  22237. ' var s = "";',
  22238. ' if (!b) throw "assert failed";',
  22239. '};',
  22240. '']),
  22241. LinesToStr([ // $mod.$main
  22242. '$mod.DoIt();',
  22243. '']));
  22244. end;
  22245. procedure TTestModule.TestAssert_SysUtils;
  22246. begin
  22247. AddModuleWithIntfImplSrc('SysUtils.pas',
  22248. LinesToStr([
  22249. 'type',
  22250. ' TObject = class',
  22251. ' constructor Create;',
  22252. ' end;',
  22253. ' EAssertionFailed = class',
  22254. ' constructor Create(s: string);',
  22255. ' end;',
  22256. '']),
  22257. LinesToStr([
  22258. 'constructor TObject.Create;',
  22259. 'begin end;',
  22260. 'constructor EAssertionFailed.Create(s: string);',
  22261. 'begin end;',
  22262. '']) );
  22263. StartProgram(true);
  22264. Add([
  22265. 'uses sysutils;',
  22266. 'procedure DoIt;',
  22267. 'var',
  22268. ' b: boolean;',
  22269. ' s: string;',
  22270. 'begin',
  22271. ' {$Assertions on}',
  22272. ' Assert(b);',
  22273. ' Assert(b,''msg'');',
  22274. 'end;',
  22275. 'begin',
  22276. ' DoIt;',
  22277. '']);
  22278. ConvertProgram;
  22279. CheckSource('TestAssert_SysUtils',
  22280. LinesToStr([ // statements
  22281. 'this.DoIt = function () {',
  22282. ' var b = false;',
  22283. ' var s = "";',
  22284. ' if (!b) throw pas.SysUtils.EAssertionFailed.$create("Create");',
  22285. ' if (!b) throw pas.SysUtils.EAssertionFailed.$create("Create$1", ["msg"]);',
  22286. '};',
  22287. '']),
  22288. LinesToStr([ // $mod.$main
  22289. '$mod.DoIt();',
  22290. '']));
  22291. end;
  22292. procedure TTestModule.TestObjectChecks;
  22293. begin
  22294. Scanner.CurrentBoolSwitches:=Scanner.CurrentBoolSwitches+[bsObjectChecks];
  22295. StartProgram(false);
  22296. Add([
  22297. 'type',
  22298. ' TObject = class',
  22299. ' procedure DoIt;',
  22300. ' end;',
  22301. ' TClass = class of tobject;',
  22302. ' TBird = class',
  22303. ' end;',
  22304. ' TBirdClass = class of TBird;',
  22305. 'var',
  22306. ' o : TObject;',
  22307. ' c: TClass;',
  22308. ' b: TBird;',
  22309. ' bc: TBirdClass;',
  22310. 'procedure TObject.DoIt;',
  22311. 'begin',
  22312. ' b:=TBird(o);',
  22313. 'end;',
  22314. 'begin',
  22315. ' o.DoIt;',
  22316. ' b:=TBird(o);',
  22317. ' bc:=TBirdClass(c);',
  22318. '']);
  22319. ConvertProgram;
  22320. CheckSource('TestCheckMethodCall',
  22321. LinesToStr([ // statements
  22322. 'rtl.createClass($mod, "TObject", null, function () {',
  22323. ' this.$init = function () {',
  22324. ' };',
  22325. ' this.$final = function () {',
  22326. ' };',
  22327. ' this.DoIt = function () {',
  22328. ' rtl.checkMethodCall(this,$mod.TObject);',
  22329. ' $mod.b = rtl.asExt($mod.o, $mod.TBird, 1);',
  22330. ' };',
  22331. '});',
  22332. 'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
  22333. '});',
  22334. 'this.o = null;',
  22335. 'this.c = null;',
  22336. 'this.b = null;',
  22337. 'this.bc = null;',
  22338. '']),
  22339. LinesToStr([ // $mod.$main
  22340. '$mod.o.DoIt();',
  22341. '$mod.b = rtl.asExt($mod.o,$mod.TBird, 1);',
  22342. '$mod.bc = rtl.asExt($mod.c, $mod.TBird, 2);',
  22343. '']));
  22344. end;
  22345. procedure TTestModule.TestRangeChecks_AssignInt;
  22346. begin
  22347. Scanner.Options:=Scanner.Options+[po_CAssignments];
  22348. StartProgram(false);
  22349. Add([
  22350. '{$R+}',
  22351. 'var',
  22352. ' b: byte = 2;',
  22353. ' w: word = 3;',
  22354. 'procedure DoIt(p: byte);',
  22355. 'begin',
  22356. ' b:=w;',
  22357. ' b+=w;',
  22358. ' b:=1;',
  22359. 'end;',
  22360. '{$R-}',
  22361. 'procedure DoSome;',
  22362. 'begin',
  22363. ' DoIt(w);',
  22364. ' b:=w;',
  22365. ' b:=2;',
  22366. 'end;',
  22367. 'begin',
  22368. '{$R+}',
  22369. '']);
  22370. ConvertProgram;
  22371. CheckSource('TestRangeChecks_AssignInt',
  22372. LinesToStr([ // statements
  22373. 'this.b = 2;',
  22374. 'this.w = 3;',
  22375. 'this.DoIt = function (p) {',
  22376. ' rtl.rc(p, 0, 255);',
  22377. ' $mod.b = rtl.rc($mod.w,0,255);',
  22378. ' rtl.rc($mod.b += $mod.w, 0, 255);',
  22379. ' $mod.b = 1;',
  22380. '};',
  22381. 'this.DoSome = function () {',
  22382. ' $mod.DoIt($mod.w);',
  22383. ' $mod.b = $mod.w;',
  22384. ' $mod.b = 2;',
  22385. '};',
  22386. '']),
  22387. LinesToStr([ // $mod.$main
  22388. '']));
  22389. end;
  22390. procedure TTestModule.TestRangeChecks_AssignIntRange;
  22391. begin
  22392. Scanner.Options:=Scanner.Options+[po_CAssignments];
  22393. StartProgram(false);
  22394. Add([
  22395. '{$R+}',
  22396. 'type Ten = 1..10;',
  22397. 'var',
  22398. ' b: Ten = 2;',
  22399. ' w: Ten = 3;',
  22400. 'procedure DoIt(p: Ten);',
  22401. 'begin',
  22402. ' b:=w;',
  22403. ' b+=w;',
  22404. ' b:=1;',
  22405. 'end;',
  22406. '{$R-}',
  22407. 'procedure DoSome;',
  22408. 'begin',
  22409. ' DoIt(w);',
  22410. ' b:=w;',
  22411. ' b:=2;',
  22412. 'end;',
  22413. 'begin',
  22414. '{$R+}',
  22415. '']);
  22416. ConvertProgram;
  22417. CheckSource('TestRangeChecks_AssignIntRange',
  22418. LinesToStr([ // statements
  22419. 'this.b = 2;',
  22420. 'this.w = 3;',
  22421. 'this.DoIt = function (p) {',
  22422. ' rtl.rc(p, 1, 10);',
  22423. ' $mod.b = rtl.rc($mod.w, 1, 10);',
  22424. ' rtl.rc($mod.b += $mod.w, 1, 10);',
  22425. ' $mod.b = 1;',
  22426. '};',
  22427. 'this.DoSome = function () {',
  22428. ' $mod.DoIt($mod.w);',
  22429. ' $mod.b = $mod.w;',
  22430. ' $mod.b = 2;',
  22431. '};',
  22432. '']),
  22433. LinesToStr([ // $mod.$main
  22434. '']));
  22435. end;
  22436. procedure TTestModule.TestRangeChecks_AssignEnum;
  22437. begin
  22438. StartProgram(false);
  22439. Add([
  22440. '{$R+}',
  22441. 'type TEnum = (red,green);',
  22442. 'var',
  22443. ' e: TEnum = red;',
  22444. 'procedure DoIt(p: TEnum);',
  22445. 'begin',
  22446. ' e:=p;',
  22447. ' p:=TEnum(0);',
  22448. ' p:=succ(e);',
  22449. 'end;',
  22450. '{$R-}',
  22451. 'procedure DoSome;',
  22452. 'begin',
  22453. ' DoIt(e);',
  22454. ' e:=TEnum(1);',
  22455. ' e:=pred(e);',
  22456. 'end;',
  22457. 'begin',
  22458. '{$R+}',
  22459. '']);
  22460. ConvertProgram;
  22461. CheckSource('TestRangeChecks_AssignEnum',
  22462. LinesToStr([ // statements
  22463. 'this.TEnum = {',
  22464. ' "0": "red",',
  22465. ' red: 0,',
  22466. ' "1": "green",',
  22467. ' green: 1',
  22468. '};',
  22469. 'this.e = $mod.TEnum.red;',
  22470. 'this.DoIt = function (p) {',
  22471. ' rtl.rc(p, 0, 1);',
  22472. ' $mod.e = rtl.rc(p, 0, 1);',
  22473. ' p = 0;',
  22474. ' p = rtl.rc($mod.e + 1, 0, 1);',
  22475. '};',
  22476. 'this.DoSome = function () {',
  22477. ' $mod.DoIt($mod.e);',
  22478. ' $mod.e = 1;',
  22479. ' $mod.e = $mod.e - 1;',
  22480. '};',
  22481. '']),
  22482. LinesToStr([ // $mod.$main
  22483. '']));
  22484. end;
  22485. procedure TTestModule.TestRangeChecks_AssignEnumRange;
  22486. begin
  22487. StartProgram(false);
  22488. Add([
  22489. '{$R+}',
  22490. 'type',
  22491. ' TEnum = (red,green);',
  22492. ' TEnumRg = red..green;',
  22493. 'var',
  22494. ' e: TEnumRg = red;',
  22495. 'procedure DoIt(p: TEnumRg);',
  22496. 'begin',
  22497. ' e:=p;',
  22498. ' p:=TEnumRg(0);',
  22499. ' p:=succ(e);',
  22500. 'end;',
  22501. '{$R-}',
  22502. 'procedure DoSome;',
  22503. 'begin',
  22504. ' DoIt(e);',
  22505. ' e:=TEnum(1);',
  22506. ' e:=pred(e);',
  22507. 'end;',
  22508. 'begin',
  22509. '{$R+}',
  22510. '']);
  22511. ConvertProgram;
  22512. CheckSource('TestRangeChecks_AssignEnumRange',
  22513. LinesToStr([ // statements
  22514. 'this.TEnum = {',
  22515. ' "0": "red",',
  22516. ' red: 0,',
  22517. ' "1": "green",',
  22518. ' green: 1',
  22519. '};',
  22520. 'this.e = $mod.TEnum.red;',
  22521. 'this.DoIt = function (p) {',
  22522. ' rtl.rc(p, 0, 1);',
  22523. ' $mod.e = rtl.rc(p, 0, 1);',
  22524. ' p = 0;',
  22525. ' p = rtl.rc($mod.e + 1, 0, 1);',
  22526. '};',
  22527. 'this.DoSome = function () {',
  22528. ' $mod.DoIt($mod.e);',
  22529. ' $mod.e = 1;',
  22530. ' $mod.e = $mod.e - 1;',
  22531. '};',
  22532. '']),
  22533. LinesToStr([ // $mod.$main
  22534. '']));
  22535. end;
  22536. procedure TTestModule.TestRangeChecks_AssignChar;
  22537. begin
  22538. StartProgram(false);
  22539. Add([
  22540. '{$R+}',
  22541. 'type',
  22542. ' TLetter = char;',
  22543. 'var',
  22544. ' b: TLetter = ''2'';',
  22545. ' w: TLetter = ''3'';',
  22546. 'procedure DoIt(p: TLetter);',
  22547. 'begin',
  22548. ' b:=w;',
  22549. ' b:=''1'';',
  22550. 'end;',
  22551. '{$R-}',
  22552. 'procedure DoSome;',
  22553. 'begin',
  22554. ' DoIt(w);',
  22555. ' b:=w;',
  22556. ' b:=''2'';',
  22557. 'end;',
  22558. 'begin',
  22559. '{$R+}',
  22560. '']);
  22561. ConvertProgram;
  22562. CheckSource('TestRangeChecks_AssignChar',
  22563. LinesToStr([ // statements
  22564. 'this.b = "2";',
  22565. 'this.w = "3";',
  22566. 'this.DoIt = function (p) {',
  22567. ' rtl.rcc(p, 0, 65535);',
  22568. ' $mod.b = rtl.rcc($mod.w, 0, 65535);',
  22569. ' $mod.b = "1";',
  22570. '};',
  22571. 'this.DoSome = function () {',
  22572. ' $mod.DoIt($mod.w);',
  22573. ' $mod.b = $mod.w;',
  22574. ' $mod.b = "2";',
  22575. '};',
  22576. '']),
  22577. LinesToStr([ // $mod.$main
  22578. '']));
  22579. end;
  22580. procedure TTestModule.TestRangeChecks_AssignCharRange;
  22581. begin
  22582. StartProgram(false);
  22583. Add([
  22584. '{$R+}',
  22585. 'type TDigit = ''0''..''9'';',
  22586. 'var',
  22587. ' b: TDigit = ''2'';',
  22588. ' w: TDigit = ''3'';',
  22589. 'procedure DoIt(p: TDigit);',
  22590. 'begin',
  22591. ' b:=w;',
  22592. ' b:=''1'';',
  22593. 'end;',
  22594. '{$R-}',
  22595. 'procedure DoSome;',
  22596. 'begin',
  22597. ' DoIt(w);',
  22598. ' b:=w;',
  22599. ' b:=''2'';',
  22600. 'end;',
  22601. 'begin',
  22602. '{$R+}',
  22603. '']);
  22604. ConvertProgram;
  22605. CheckSource('TestRangeChecks_AssignCharRange',
  22606. LinesToStr([ // statements
  22607. 'this.b = "2";',
  22608. 'this.w = "3";',
  22609. 'this.DoIt = function (p) {',
  22610. ' rtl.rcc(p, 48, 57);',
  22611. ' $mod.b = rtl.rcc($mod.w, 48, 57);',
  22612. ' $mod.b = "1";',
  22613. '};',
  22614. 'this.DoSome = function () {',
  22615. ' $mod.DoIt($mod.w);',
  22616. ' $mod.b = $mod.w;',
  22617. ' $mod.b = "2";',
  22618. '};',
  22619. '']),
  22620. LinesToStr([ // $mod.$main
  22621. '']));
  22622. end;
  22623. procedure TTestModule.TestRangeChecks_ArrayIndex;
  22624. begin
  22625. StartProgram(false);
  22626. Add([
  22627. '{$R+}',
  22628. 'type',
  22629. ' Ten = 1..10;',
  22630. ' TArr = array of Ten;',
  22631. ' TArrArr = array of TArr;',
  22632. ' TArrByte = array[byte] of Ten;',
  22633. ' TArrChar = array[''0''..''9''] of Ten;',
  22634. ' TArrByteChar = array[byte,''0''..''9''] of Ten;',
  22635. ' TObject = class',
  22636. ' A: TArr;',
  22637. ' end;',
  22638. 'procedure DoIt;',
  22639. 'var',
  22640. ' Arr: TArr;',
  22641. ' ArrArr: TArrArr;',
  22642. ' ArrByte: TArrByte;',
  22643. ' ArrChar: TArrChar;',
  22644. ' ArrByteChar: TArrByteChar;',
  22645. ' i: Ten;',
  22646. ' c: char;',
  22647. ' o: tobject;',
  22648. 'begin',
  22649. ' i:=Arr[1];',
  22650. ' i:=ArrByteChar[1,''2''];',
  22651. ' Arr[1]:=Arr[1];',
  22652. ' Arr[i]:=Arr[i];',
  22653. ' ArrByte[3]:=ArrByte[3];',
  22654. ' ArrByte[i]:=ArrByte[i];',
  22655. ' ArrChar[''5'']:=ArrChar[''5''];',
  22656. ' ArrChar[c]:=ArrChar[c];',
  22657. ' ArrByteChar[7,''7'']:=ArrByteChar[7,''7''];',
  22658. ' ArrByteChar[i,c]:=ArrByteChar[i,c];',
  22659. ' o.a[i]:=o.a[i];',
  22660. 'end;',
  22661. 'begin',
  22662. '']);
  22663. ConvertProgram;
  22664. CheckSource('TestRangeChecks_ArrayIndex',
  22665. LinesToStr([ // statements
  22666. 'rtl.createClass($mod, "TObject", null, function () {',
  22667. ' this.$init = function () {',
  22668. ' this.A = [];',
  22669. ' };',
  22670. ' this.$final = function () {',
  22671. ' this.A = undefined;',
  22672. ' };',
  22673. '});',
  22674. 'this.DoIt = function () {',
  22675. ' var Arr = [];',
  22676. ' var ArrArr = [];',
  22677. ' var ArrByte = rtl.arraySetLength(null, 0, 256);',
  22678. ' var ArrChar = rtl.arraySetLength(null, 0, 10);',
  22679. ' var ArrByteChar = rtl.arraySetLength(null, 0, 256, 10);',
  22680. ' var i = 0;',
  22681. ' var c = "";',
  22682. ' var o = null;',
  22683. ' i = rtl.rc(Arr[1], 1, 10);',
  22684. ' i = rtl.rc(ArrByteChar[1][2], 1, 10);',
  22685. ' Arr[1] = rtl.rc(Arr[1], 1, 10);',
  22686. ' rtl.rcArrW(Arr, i, rtl.rcArrR(Arr, i));',
  22687. ' ArrByte[3] = rtl.rc(ArrByte[3], 1, 10);',
  22688. ' rtl.rcArrW(ArrByte, i, rtl.rcArrR(ArrByte, i));',
  22689. ' ArrChar[5] = rtl.rc(ArrChar[5], 1, 10);',
  22690. ' rtl.rcArrW(ArrChar, c.charCodeAt() - 48, rtl.rcArrR(ArrChar, c.charCodeAt() - 48));',
  22691. ' ArrByteChar[7][7] = rtl.rc(ArrByteChar[7][7], 1, 10);',
  22692. ' rtl.rcArrW(ArrByteChar, i, c.charCodeAt() - 48, rtl.rcArrR(ArrByteChar, i, c.charCodeAt() - 48));',
  22693. ' o.A[i] = rtl.rc(o.A[i], 1, 10);',
  22694. '};',
  22695. '']),
  22696. LinesToStr([ // $mod.$main
  22697. '']));
  22698. end;
  22699. procedure TTestModule.TestRangeChecks_StringIndex;
  22700. begin
  22701. StartProgram(false);
  22702. Add([
  22703. 'type',
  22704. ' TObject = class',
  22705. ' S: string;',
  22706. ' end;',
  22707. '{$R+}',
  22708. 'procedure DoIt(var h: string);',
  22709. 'var',
  22710. ' s: string;',
  22711. ' i: longint;',
  22712. ' c: char;',
  22713. ' o: tobject;',
  22714. 'begin',
  22715. ' c:=s[1];',
  22716. ' s[i]:=s[i];',
  22717. ' h[i]:=h[i];',
  22718. ' c:=o.s[i];',
  22719. 'end;',
  22720. 'begin',
  22721. '']);
  22722. ConvertProgram;
  22723. CheckSource('TestRangeChecks_StringIndex',
  22724. LinesToStr([ // statements
  22725. 'rtl.createClass($mod, "TObject", null, function () {',
  22726. ' this.$init = function () {',
  22727. ' this.S = "";',
  22728. ' };',
  22729. ' this.$final = function () {',
  22730. ' };',
  22731. '});',
  22732. 'this.DoIt = function (h) {',
  22733. ' var s = "";',
  22734. ' var i = 0;',
  22735. ' var c = "";',
  22736. ' var o = null;',
  22737. ' c = rtl.rcc(rtl.rcCharAt(s, 0), 0, 65535);',
  22738. ' s = rtl.rcSetCharAt(s, i - 1, rtl.rcCharAt(s, i - 1));',
  22739. ' h.set(rtl.rcSetCharAt(h.get(), i - 1, rtl.rcCharAt(h.get(), i - 1)));',
  22740. ' c = rtl.rcc(o.S.charAt(i - 1), 0, 65535);',
  22741. '};',
  22742. '']),
  22743. LinesToStr([ // $mod.$main
  22744. '']));
  22745. end;
  22746. procedure TTestModule.TestRangeChecks_TypecastInt;
  22747. begin
  22748. StartProgram(false);
  22749. Add([
  22750. '{$R+}',
  22751. 'var',
  22752. ' i: nativeint;',
  22753. ' b: byte;',
  22754. ' sh: shortint;',
  22755. ' w: word;',
  22756. ' sm: smallint;',
  22757. ' lw: longword;',
  22758. ' li: longint;',
  22759. 'begin',
  22760. ' b:=12+byte(i);',
  22761. ' sh:=12+shortint(i);',
  22762. ' w:=12+word(i);',
  22763. ' sm:=12+smallint(i);',
  22764. ' lw:=12+longword(i);',
  22765. ' li:=12+longint(i);',
  22766. '']);
  22767. ConvertProgram;
  22768. CheckSource('TestRangeChecks_TypecastInt',
  22769. LinesToStr([
  22770. 'this.i = 0;',
  22771. 'this.b = 0;',
  22772. 'this.sh = 0;',
  22773. 'this.w = 0;',
  22774. 'this.sm = 0;',
  22775. 'this.lw = 0;',
  22776. 'this.li = 0;',
  22777. '']),
  22778. LinesToStr([
  22779. '$mod.b = rtl.rc(12 + rtl.rc($mod.i, 0, 255), 0, 255);',
  22780. '$mod.sh = rtl.rc(12 + rtl.rc($mod.i, -128, 127), -128, 127);',
  22781. '$mod.w = rtl.rc(12 + rtl.rc($mod.i, 0, 65535), 0, 65535);',
  22782. '$mod.sm = rtl.rc(12 + rtl.rc($mod.i, -32768, 32767), -32768, 32767);',
  22783. '$mod.lw = rtl.rc(12 + rtl.rc($mod.i, 0, 4294967295), 0, 4294967295);',
  22784. '$mod.li = rtl.rc(12 + rtl.rc($mod.i, -2147483648, 2147483647), -2147483648, 2147483647);',
  22785. '']));
  22786. end;
  22787. Initialization
  22788. RegisterTests([TTestModule]);
  22789. end.