tcmodules.pas 537 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760376137623763376437653766376737683769377037713772377337743775377637773778377937803781378237833784378537863787378837893790379137923793379437953796379737983799380038013802380338043805380638073808380938103811381238133814381538163817381838193820382138223823382438253826382738283829383038313832383338343835383638373838383938403841384238433844384538463847384838493850385138523853385438553856385738583859386038613862386338643865386638673868386938703871387238733874387538763877387838793880388138823883388438853886388738883889389038913892389338943895389638973898389939003901390239033904390539063907390839093910391139123913391439153916391739183919392039213922392339243925392639273928392939303931393239333934393539363937393839393940394139423943394439453946394739483949395039513952395339543955395639573958395939603961396239633964396539663967396839693970397139723973397439753976397739783979398039813982398339843985398639873988398939903991399239933994399539963997399839994000400140024003400440054006400740084009401040114012401340144015401640174018401940204021402240234024402540264027402840294030403140324033403440354036403740384039404040414042404340444045404640474048404940504051405240534054405540564057405840594060406140624063406440654066406740684069407040714072407340744075407640774078407940804081408240834084408540864087408840894090409140924093409440954096409740984099410041014102410341044105410641074108410941104111411241134114411541164117411841194120412141224123412441254126412741284129413041314132413341344135413641374138413941404141414241434144414541464147414841494150415141524153415441554156415741584159416041614162416341644165416641674168416941704171417241734174417541764177417841794180418141824183418441854186418741884189419041914192419341944195419641974198419942004201420242034204420542064207420842094210421142124213421442154216421742184219422042214222422342244225422642274228422942304231423242334234423542364237423842394240424142424243424442454246424742484249425042514252425342544255425642574258425942604261426242634264426542664267426842694270427142724273427442754276427742784279428042814282428342844285428642874288428942904291429242934294429542964297429842994300430143024303430443054306430743084309431043114312431343144315431643174318431943204321432243234324432543264327432843294330433143324333433443354336433743384339434043414342434343444345434643474348434943504351435243534354435543564357435843594360436143624363436443654366436743684369437043714372437343744375437643774378437943804381438243834384438543864387438843894390439143924393439443954396439743984399440044014402440344044405440644074408440944104411441244134414441544164417441844194420442144224423442444254426442744284429443044314432443344344435443644374438443944404441444244434444444544464447444844494450445144524453445444554456445744584459446044614462446344644465446644674468446944704471447244734474447544764477447844794480448144824483448444854486448744884489449044914492449344944495449644974498449945004501450245034504450545064507450845094510451145124513451445154516451745184519452045214522452345244525452645274528452945304531453245334534453545364537453845394540454145424543454445454546454745484549455045514552455345544555455645574558455945604561456245634564456545664567456845694570457145724573457445754576457745784579458045814582458345844585458645874588458945904591459245934594459545964597459845994600460146024603460446054606460746084609461046114612461346144615461646174618461946204621462246234624462546264627462846294630463146324633463446354636463746384639464046414642464346444645464646474648464946504651465246534654465546564657465846594660466146624663466446654666466746684669467046714672467346744675467646774678467946804681468246834684468546864687468846894690469146924693469446954696469746984699470047014702470347044705470647074708470947104711471247134714471547164717471847194720472147224723472447254726472747284729473047314732473347344735473647374738473947404741474247434744474547464747474847494750475147524753475447554756475747584759476047614762476347644765476647674768476947704771477247734774477547764777477847794780478147824783478447854786478747884789479047914792479347944795479647974798479948004801480248034804480548064807480848094810481148124813481448154816481748184819482048214822482348244825482648274828482948304831483248334834483548364837483848394840484148424843484448454846484748484849485048514852485348544855485648574858485948604861486248634864486548664867486848694870487148724873487448754876487748784879488048814882488348844885488648874888488948904891489248934894489548964897489848994900490149024903490449054906490749084909491049114912491349144915491649174918491949204921492249234924492549264927492849294930493149324933493449354936493749384939494049414942494349444945494649474948494949504951495249534954495549564957495849594960496149624963496449654966496749684969497049714972497349744975497649774978497949804981498249834984498549864987498849894990499149924993499449954996499749984999500050015002500350045005500650075008500950105011501250135014501550165017501850195020502150225023502450255026502750285029503050315032503350345035503650375038503950405041504250435044504550465047504850495050505150525053505450555056505750585059506050615062506350645065506650675068506950705071507250735074507550765077507850795080508150825083508450855086508750885089509050915092509350945095509650975098509951005101510251035104510551065107510851095110511151125113511451155116511751185119512051215122512351245125512651275128512951305131513251335134513551365137513851395140514151425143514451455146514751485149515051515152515351545155515651575158515951605161516251635164516551665167516851695170517151725173517451755176517751785179518051815182518351845185518651875188518951905191519251935194519551965197519851995200520152025203520452055206520752085209521052115212521352145215521652175218521952205221522252235224522552265227522852295230523152325233523452355236523752385239524052415242524352445245524652475248524952505251525252535254525552565257525852595260526152625263526452655266526752685269527052715272527352745275527652775278527952805281528252835284528552865287528852895290529152925293529452955296529752985299530053015302530353045305530653075308530953105311531253135314531553165317531853195320532153225323532453255326532753285329533053315332533353345335533653375338533953405341534253435344534553465347534853495350535153525353535453555356535753585359536053615362536353645365536653675368536953705371537253735374537553765377537853795380538153825383538453855386538753885389539053915392539353945395539653975398539954005401540254035404540554065407540854095410541154125413541454155416541754185419542054215422542354245425542654275428542954305431543254335434543554365437543854395440544154425443544454455446544754485449545054515452545354545455545654575458545954605461546254635464546554665467546854695470547154725473547454755476547754785479548054815482548354845485548654875488548954905491549254935494549554965497549854995500550155025503550455055506550755085509551055115512551355145515551655175518551955205521552255235524552555265527552855295530553155325533553455355536553755385539554055415542554355445545554655475548554955505551555255535554555555565557555855595560556155625563556455655566556755685569557055715572557355745575557655775578557955805581558255835584558555865587558855895590559155925593559455955596559755985599560056015602560356045605560656075608560956105611561256135614561556165617561856195620562156225623562456255626562756285629563056315632563356345635563656375638563956405641564256435644564556465647564856495650565156525653565456555656565756585659566056615662566356645665566656675668566956705671567256735674567556765677567856795680568156825683568456855686568756885689569056915692569356945695569656975698569957005701570257035704570557065707570857095710571157125713571457155716571757185719572057215722572357245725572657275728572957305731573257335734573557365737573857395740574157425743574457455746574757485749575057515752575357545755575657575758575957605761576257635764576557665767576857695770577157725773577457755776577757785779578057815782578357845785578657875788578957905791579257935794579557965797579857995800580158025803580458055806580758085809581058115812581358145815581658175818581958205821582258235824582558265827582858295830583158325833583458355836583758385839584058415842584358445845584658475848584958505851585258535854585558565857585858595860586158625863586458655866586758685869587058715872587358745875587658775878587958805881588258835884588558865887588858895890589158925893589458955896589758985899590059015902590359045905590659075908590959105911591259135914591559165917591859195920592159225923592459255926592759285929593059315932593359345935593659375938593959405941594259435944594559465947594859495950595159525953595459555956595759585959596059615962596359645965596659675968596959705971597259735974597559765977597859795980598159825983598459855986598759885989599059915992599359945995599659975998599960006001600260036004600560066007600860096010601160126013601460156016601760186019602060216022602360246025602660276028602960306031603260336034603560366037603860396040604160426043604460456046604760486049605060516052605360546055605660576058605960606061606260636064606560666067606860696070607160726073607460756076607760786079608060816082608360846085608660876088608960906091609260936094609560966097609860996100610161026103610461056106610761086109611061116112611361146115611661176118611961206121612261236124612561266127612861296130613161326133613461356136613761386139614061416142614361446145614661476148614961506151615261536154615561566157615861596160616161626163616461656166616761686169617061716172617361746175617661776178617961806181618261836184618561866187618861896190619161926193619461956196619761986199620062016202620362046205620662076208620962106211621262136214621562166217621862196220622162226223622462256226622762286229623062316232623362346235623662376238623962406241624262436244624562466247624862496250625162526253625462556256625762586259626062616262626362646265626662676268626962706271627262736274627562766277627862796280628162826283628462856286628762886289629062916292629362946295629662976298629963006301630263036304630563066307630863096310631163126313631463156316631763186319632063216322632363246325632663276328632963306331633263336334633563366337633863396340634163426343634463456346634763486349635063516352635363546355635663576358635963606361636263636364636563666367636863696370637163726373637463756376637763786379638063816382638363846385638663876388638963906391639263936394639563966397639863996400640164026403640464056406640764086409641064116412641364146415641664176418641964206421642264236424642564266427642864296430643164326433643464356436643764386439644064416442644364446445644664476448644964506451645264536454645564566457645864596460646164626463646464656466646764686469647064716472647364746475647664776478647964806481648264836484648564866487648864896490649164926493649464956496649764986499650065016502650365046505650665076508650965106511651265136514651565166517651865196520652165226523652465256526652765286529653065316532653365346535653665376538653965406541654265436544654565466547654865496550655165526553655465556556655765586559656065616562656365646565656665676568656965706571657265736574657565766577657865796580658165826583658465856586658765886589659065916592659365946595659665976598659966006601660266036604660566066607660866096610661166126613661466156616661766186619662066216622662366246625662666276628662966306631663266336634663566366637663866396640664166426643664466456646664766486649665066516652665366546655665666576658665966606661666266636664666566666667666866696670667166726673667466756676667766786679668066816682668366846685668666876688668966906691669266936694669566966697669866996700670167026703670467056706670767086709671067116712671367146715671667176718671967206721672267236724672567266727672867296730673167326733673467356736673767386739674067416742674367446745674667476748674967506751675267536754675567566757675867596760676167626763676467656766676767686769677067716772677367746775677667776778677967806781678267836784678567866787678867896790679167926793679467956796679767986799680068016802680368046805680668076808680968106811681268136814681568166817681868196820682168226823682468256826682768286829683068316832683368346835683668376838683968406841684268436844684568466847684868496850685168526853685468556856685768586859686068616862686368646865686668676868686968706871687268736874687568766877687868796880688168826883688468856886688768886889689068916892689368946895689668976898689969006901690269036904690569066907690869096910691169126913691469156916691769186919692069216922692369246925692669276928692969306931693269336934693569366937693869396940694169426943694469456946694769486949695069516952695369546955695669576958695969606961696269636964696569666967696869696970697169726973697469756976697769786979698069816982698369846985698669876988698969906991699269936994699569966997699869997000700170027003700470057006700770087009701070117012701370147015701670177018701970207021702270237024702570267027702870297030703170327033703470357036703770387039704070417042704370447045704670477048704970507051705270537054705570567057705870597060706170627063706470657066706770687069707070717072707370747075707670777078707970807081708270837084708570867087708870897090709170927093709470957096709770987099710071017102710371047105710671077108710971107111711271137114711571167117711871197120712171227123712471257126712771287129713071317132713371347135713671377138713971407141714271437144714571467147714871497150715171527153715471557156715771587159716071617162716371647165716671677168716971707171717271737174717571767177717871797180718171827183718471857186718771887189719071917192719371947195719671977198719972007201720272037204720572067207720872097210721172127213721472157216721772187219722072217222722372247225722672277228722972307231723272337234723572367237723872397240724172427243724472457246724772487249725072517252725372547255725672577258725972607261726272637264726572667267726872697270727172727273727472757276727772787279728072817282728372847285728672877288728972907291729272937294729572967297729872997300730173027303730473057306730773087309731073117312731373147315731673177318731973207321732273237324732573267327732873297330733173327333733473357336733773387339734073417342734373447345734673477348734973507351735273537354735573567357735873597360736173627363736473657366736773687369737073717372737373747375737673777378737973807381738273837384738573867387738873897390739173927393739473957396739773987399740074017402740374047405740674077408740974107411741274137414741574167417741874197420742174227423742474257426742774287429743074317432743374347435743674377438743974407441744274437444744574467447744874497450745174527453745474557456745774587459746074617462746374647465746674677468746974707471747274737474747574767477747874797480748174827483748474857486748774887489749074917492749374947495749674977498749975007501750275037504750575067507750875097510751175127513751475157516751775187519752075217522752375247525752675277528752975307531753275337534753575367537753875397540754175427543754475457546754775487549755075517552755375547555755675577558755975607561756275637564756575667567756875697570757175727573757475757576757775787579758075817582758375847585758675877588758975907591759275937594759575967597759875997600760176027603760476057606760776087609761076117612761376147615761676177618761976207621762276237624762576267627762876297630763176327633763476357636763776387639764076417642764376447645764676477648764976507651765276537654765576567657765876597660766176627663766476657666766776687669767076717672767376747675767676777678767976807681768276837684768576867687768876897690769176927693769476957696769776987699770077017702770377047705770677077708770977107711771277137714771577167717771877197720772177227723772477257726772777287729773077317732773377347735773677377738773977407741774277437744774577467747774877497750775177527753775477557756775777587759776077617762776377647765776677677768776977707771777277737774777577767777777877797780778177827783778477857786778777887789779077917792779377947795779677977798779978007801780278037804780578067807780878097810781178127813781478157816781778187819782078217822782378247825782678277828782978307831783278337834783578367837783878397840784178427843784478457846784778487849785078517852785378547855785678577858785978607861786278637864786578667867786878697870787178727873787478757876787778787879788078817882788378847885788678877888788978907891789278937894789578967897789878997900790179027903790479057906790779087909791079117912791379147915791679177918791979207921792279237924792579267927792879297930793179327933793479357936793779387939794079417942794379447945794679477948794979507951795279537954795579567957795879597960796179627963796479657966796779687969797079717972797379747975797679777978797979807981798279837984798579867987798879897990799179927993799479957996799779987999800080018002800380048005800680078008800980108011801280138014801580168017801880198020802180228023802480258026802780288029803080318032803380348035803680378038803980408041804280438044804580468047804880498050805180528053805480558056805780588059806080618062806380648065806680678068806980708071807280738074807580768077807880798080808180828083808480858086808780888089809080918092809380948095809680978098809981008101810281038104810581068107810881098110811181128113811481158116811781188119812081218122812381248125812681278128812981308131813281338134813581368137813881398140814181428143814481458146814781488149815081518152815381548155815681578158815981608161816281638164816581668167816881698170817181728173817481758176817781788179818081818182818381848185818681878188818981908191819281938194819581968197819881998200820182028203820482058206820782088209821082118212821382148215821682178218821982208221822282238224822582268227822882298230823182328233823482358236823782388239824082418242824382448245824682478248824982508251825282538254825582568257825882598260826182628263826482658266826782688269827082718272827382748275827682778278827982808281828282838284828582868287828882898290829182928293829482958296829782988299830083018302830383048305830683078308830983108311831283138314831583168317831883198320832183228323832483258326832783288329833083318332833383348335833683378338833983408341834283438344834583468347834883498350835183528353835483558356835783588359836083618362836383648365836683678368836983708371837283738374837583768377837883798380838183828383838483858386838783888389839083918392839383948395839683978398839984008401840284038404840584068407840884098410841184128413841484158416841784188419842084218422842384248425842684278428842984308431843284338434843584368437843884398440844184428443844484458446844784488449845084518452845384548455845684578458845984608461846284638464846584668467846884698470847184728473847484758476847784788479848084818482848384848485848684878488848984908491849284938494849584968497849884998500850185028503850485058506850785088509851085118512851385148515851685178518851985208521852285238524852585268527852885298530853185328533853485358536853785388539854085418542854385448545854685478548854985508551855285538554855585568557855885598560856185628563856485658566856785688569857085718572857385748575857685778578857985808581858285838584858585868587858885898590859185928593859485958596859785988599860086018602860386048605860686078608860986108611861286138614861586168617861886198620862186228623862486258626862786288629863086318632863386348635863686378638863986408641864286438644864586468647864886498650865186528653865486558656865786588659866086618662866386648665866686678668866986708671867286738674867586768677867886798680868186828683868486858686868786888689869086918692869386948695869686978698869987008701870287038704870587068707870887098710871187128713871487158716871787188719872087218722872387248725872687278728872987308731873287338734873587368737873887398740874187428743874487458746874787488749875087518752875387548755875687578758875987608761876287638764876587668767876887698770877187728773877487758776877787788779878087818782878387848785878687878788878987908791879287938794879587968797879887998800880188028803880488058806880788088809881088118812881388148815881688178818881988208821882288238824882588268827882888298830883188328833883488358836883788388839884088418842884388448845884688478848884988508851885288538854885588568857885888598860886188628863886488658866886788688869887088718872887388748875887688778878887988808881888288838884888588868887888888898890889188928893889488958896889788988899890089018902890389048905890689078908890989108911891289138914891589168917891889198920892189228923892489258926892789288929893089318932893389348935893689378938893989408941894289438944894589468947894889498950895189528953895489558956895789588959896089618962896389648965896689678968896989708971897289738974897589768977897889798980898189828983898489858986898789888989899089918992899389948995899689978998899990009001900290039004900590069007900890099010901190129013901490159016901790189019902090219022902390249025902690279028902990309031903290339034903590369037903890399040904190429043904490459046904790489049905090519052905390549055905690579058905990609061906290639064906590669067906890699070907190729073907490759076907790789079908090819082908390849085908690879088908990909091909290939094909590969097909890999100910191029103910491059106910791089109911091119112911391149115911691179118911991209121912291239124912591269127912891299130913191329133913491359136913791389139914091419142914391449145914691479148914991509151915291539154915591569157915891599160916191629163916491659166916791689169917091719172917391749175917691779178917991809181918291839184918591869187918891899190919191929193919491959196919791989199920092019202920392049205920692079208920992109211921292139214921592169217921892199220922192229223922492259226922792289229923092319232923392349235923692379238923992409241924292439244924592469247924892499250925192529253925492559256925792589259926092619262926392649265926692679268926992709271927292739274927592769277927892799280928192829283928492859286928792889289929092919292929392949295929692979298929993009301930293039304930593069307930893099310931193129313931493159316931793189319932093219322932393249325932693279328932993309331933293339334933593369337933893399340934193429343934493459346934793489349935093519352935393549355935693579358935993609361936293639364936593669367936893699370937193729373937493759376937793789379938093819382938393849385938693879388938993909391939293939394939593969397939893999400940194029403940494059406940794089409941094119412941394149415941694179418941994209421942294239424942594269427942894299430943194329433943494359436943794389439944094419442944394449445944694479448944994509451945294539454945594569457945894599460946194629463946494659466946794689469947094719472947394749475947694779478947994809481948294839484948594869487948894899490949194929493949494959496949794989499950095019502950395049505950695079508950995109511951295139514951595169517951895199520952195229523952495259526952795289529953095319532953395349535953695379538953995409541954295439544954595469547954895499550955195529553955495559556955795589559956095619562956395649565956695679568956995709571957295739574957595769577957895799580958195829583958495859586958795889589959095919592959395949595959695979598959996009601960296039604960596069607960896099610961196129613961496159616961796189619962096219622962396249625962696279628962996309631963296339634963596369637963896399640964196429643964496459646964796489649965096519652965396549655965696579658965996609661966296639664966596669667966896699670967196729673967496759676967796789679968096819682968396849685968696879688968996909691969296939694969596969697969896999700970197029703970497059706970797089709971097119712971397149715971697179718971997209721972297239724972597269727972897299730973197329733973497359736973797389739974097419742974397449745974697479748974997509751975297539754975597569757975897599760976197629763976497659766976797689769977097719772977397749775977697779778977997809781978297839784978597869787978897899790979197929793979497959796979797989799980098019802980398049805980698079808980998109811981298139814981598169817981898199820982198229823982498259826982798289829983098319832983398349835983698379838983998409841984298439844984598469847984898499850985198529853985498559856985798589859986098619862986398649865986698679868986998709871987298739874987598769877987898799880988198829883988498859886988798889889989098919892989398949895989698979898989999009901990299039904990599069907990899099910991199129913991499159916991799189919992099219922992399249925992699279928992999309931993299339934993599369937993899399940994199429943994499459946994799489949995099519952995399549955995699579958995999609961996299639964996599669967996899699970997199729973997499759976997799789979998099819982998399849985998699879988998999909991999299939994999599969997999899991000010001100021000310004100051000610007100081000910010100111001210013100141001510016100171001810019100201002110022100231002410025100261002710028100291003010031100321003310034100351003610037100381003910040100411004210043100441004510046100471004810049100501005110052100531005410055100561005710058100591006010061100621006310064100651006610067100681006910070100711007210073100741007510076100771007810079100801008110082100831008410085100861008710088100891009010091100921009310094100951009610097100981009910100101011010210103101041010510106101071010810109101101011110112101131011410115101161011710118101191012010121101221012310124101251012610127101281012910130101311013210133101341013510136101371013810139101401014110142101431014410145101461014710148101491015010151101521015310154101551015610157101581015910160101611016210163101641016510166101671016810169101701017110172101731017410175101761017710178101791018010181101821018310184101851018610187101881018910190101911019210193101941019510196101971019810199102001020110202102031020410205102061020710208102091021010211102121021310214102151021610217102181021910220102211022210223102241022510226102271022810229102301023110232102331023410235102361023710238102391024010241102421024310244102451024610247102481024910250102511025210253102541025510256102571025810259102601026110262102631026410265102661026710268102691027010271102721027310274102751027610277102781027910280102811028210283102841028510286102871028810289102901029110292102931029410295102961029710298102991030010301103021030310304103051030610307103081030910310103111031210313103141031510316103171031810319103201032110322103231032410325103261032710328103291033010331103321033310334103351033610337103381033910340103411034210343103441034510346103471034810349103501035110352103531035410355103561035710358103591036010361103621036310364103651036610367103681036910370103711037210373103741037510376103771037810379103801038110382103831038410385103861038710388103891039010391103921039310394103951039610397103981039910400104011040210403104041040510406104071040810409104101041110412104131041410415104161041710418104191042010421104221042310424104251042610427104281042910430104311043210433104341043510436104371043810439104401044110442104431044410445104461044710448104491045010451104521045310454104551045610457104581045910460104611046210463104641046510466104671046810469104701047110472104731047410475104761047710478104791048010481104821048310484104851048610487104881048910490104911049210493104941049510496104971049810499105001050110502105031050410505105061050710508105091051010511105121051310514105151051610517105181051910520105211052210523105241052510526105271052810529105301053110532105331053410535105361053710538105391054010541105421054310544105451054610547105481054910550105511055210553105541055510556105571055810559105601056110562105631056410565105661056710568105691057010571105721057310574105751057610577105781057910580105811058210583105841058510586105871058810589105901059110592105931059410595105961059710598105991060010601106021060310604106051060610607106081060910610106111061210613106141061510616106171061810619106201062110622106231062410625106261062710628106291063010631106321063310634106351063610637106381063910640106411064210643106441064510646106471064810649106501065110652106531065410655106561065710658106591066010661106621066310664106651066610667106681066910670106711067210673106741067510676106771067810679106801068110682106831068410685106861068710688106891069010691106921069310694106951069610697106981069910700107011070210703107041070510706107071070810709107101071110712107131071410715107161071710718107191072010721107221072310724107251072610727107281072910730107311073210733107341073510736107371073810739107401074110742107431074410745107461074710748107491075010751107521075310754107551075610757107581075910760107611076210763107641076510766107671076810769107701077110772107731077410775107761077710778107791078010781107821078310784107851078610787107881078910790107911079210793107941079510796107971079810799108001080110802108031080410805108061080710808108091081010811108121081310814108151081610817108181081910820108211082210823108241082510826108271082810829108301083110832108331083410835108361083710838108391084010841108421084310844108451084610847108481084910850108511085210853108541085510856108571085810859108601086110862108631086410865108661086710868108691087010871108721087310874108751087610877108781087910880108811088210883108841088510886108871088810889108901089110892108931089410895108961089710898108991090010901109021090310904109051090610907109081090910910109111091210913109141091510916109171091810919109201092110922109231092410925109261092710928109291093010931109321093310934109351093610937109381093910940109411094210943109441094510946109471094810949109501095110952109531095410955109561095710958109591096010961109621096310964109651096610967109681096910970109711097210973109741097510976109771097810979109801098110982109831098410985109861098710988109891099010991109921099310994109951099610997109981099911000110011100211003110041100511006110071100811009110101101111012110131101411015110161101711018110191102011021110221102311024110251102611027110281102911030110311103211033110341103511036110371103811039110401104111042110431104411045110461104711048110491105011051110521105311054110551105611057110581105911060110611106211063110641106511066110671106811069110701107111072110731107411075110761107711078110791108011081110821108311084110851108611087110881108911090110911109211093110941109511096110971109811099111001110111102111031110411105111061110711108111091111011111111121111311114111151111611117111181111911120111211112211123111241112511126111271112811129111301113111132111331113411135111361113711138111391114011141111421114311144111451114611147111481114911150111511115211153111541115511156111571115811159111601116111162111631116411165111661116711168111691117011171111721117311174111751117611177111781117911180111811118211183111841118511186111871118811189111901119111192111931119411195111961119711198111991120011201112021120311204112051120611207112081120911210112111121211213112141121511216112171121811219112201122111222112231122411225112261122711228112291123011231112321123311234112351123611237112381123911240112411124211243112441124511246112471124811249112501125111252112531125411255112561125711258112591126011261112621126311264112651126611267112681126911270112711127211273112741127511276112771127811279112801128111282112831128411285112861128711288112891129011291112921129311294112951129611297112981129911300113011130211303113041130511306113071130811309113101131111312113131131411315113161131711318113191132011321113221132311324113251132611327113281132911330113311133211333113341133511336113371133811339113401134111342113431134411345113461134711348113491135011351113521135311354113551135611357113581135911360113611136211363113641136511366113671136811369113701137111372113731137411375113761137711378113791138011381113821138311384113851138611387113881138911390113911139211393113941139511396113971139811399114001140111402114031140411405114061140711408114091141011411114121141311414114151141611417114181141911420114211142211423114241142511426114271142811429114301143111432114331143411435114361143711438114391144011441114421144311444114451144611447114481144911450114511145211453114541145511456114571145811459114601146111462114631146411465114661146711468114691147011471114721147311474114751147611477114781147911480114811148211483114841148511486114871148811489114901149111492114931149411495114961149711498114991150011501115021150311504115051150611507115081150911510115111151211513115141151511516115171151811519115201152111522115231152411525115261152711528115291153011531115321153311534115351153611537115381153911540115411154211543115441154511546115471154811549115501155111552115531155411555115561155711558115591156011561115621156311564115651156611567115681156911570115711157211573115741157511576115771157811579115801158111582115831158411585115861158711588115891159011591115921159311594115951159611597115981159911600116011160211603116041160511606116071160811609116101161111612116131161411615116161161711618116191162011621116221162311624116251162611627116281162911630116311163211633116341163511636116371163811639116401164111642116431164411645116461164711648116491165011651116521165311654116551165611657116581165911660116611166211663116641166511666116671166811669116701167111672116731167411675116761167711678116791168011681116821168311684116851168611687116881168911690116911169211693116941169511696116971169811699117001170111702117031170411705117061170711708117091171011711117121171311714117151171611717117181171911720117211172211723117241172511726117271172811729117301173111732117331173411735117361173711738117391174011741117421174311744117451174611747117481174911750117511175211753117541175511756117571175811759117601176111762117631176411765117661176711768117691177011771117721177311774117751177611777117781177911780117811178211783117841178511786117871178811789117901179111792117931179411795117961179711798117991180011801118021180311804118051180611807118081180911810118111181211813118141181511816118171181811819118201182111822118231182411825118261182711828118291183011831118321183311834118351183611837118381183911840118411184211843118441184511846118471184811849118501185111852118531185411855118561185711858118591186011861118621186311864118651186611867118681186911870118711187211873118741187511876118771187811879118801188111882118831188411885118861188711888118891189011891118921189311894118951189611897118981189911900119011190211903119041190511906119071190811909119101191111912119131191411915119161191711918119191192011921119221192311924119251192611927119281192911930119311193211933119341193511936119371193811939119401194111942119431194411945119461194711948119491195011951119521195311954119551195611957119581195911960119611196211963119641196511966119671196811969119701197111972119731197411975119761197711978119791198011981119821198311984119851198611987119881198911990119911199211993119941199511996119971199811999120001200112002120031200412005120061200712008120091201012011120121201312014120151201612017120181201912020120211202212023120241202512026120271202812029120301203112032120331203412035120361203712038120391204012041120421204312044120451204612047120481204912050120511205212053120541205512056120571205812059120601206112062120631206412065120661206712068120691207012071120721207312074120751207612077120781207912080120811208212083120841208512086120871208812089120901209112092120931209412095120961209712098120991210012101121021210312104121051210612107121081210912110121111211212113121141211512116121171211812119121201212112122121231212412125121261212712128121291213012131121321213312134121351213612137121381213912140121411214212143121441214512146121471214812149121501215112152121531215412155121561215712158121591216012161121621216312164121651216612167121681216912170121711217212173121741217512176121771217812179121801218112182121831218412185121861218712188121891219012191121921219312194121951219612197121981219912200122011220212203122041220512206122071220812209122101221112212122131221412215122161221712218122191222012221122221222312224122251222612227122281222912230122311223212233122341223512236122371223812239122401224112242122431224412245122461224712248122491225012251122521225312254122551225612257122581225912260122611226212263122641226512266122671226812269122701227112272122731227412275122761227712278122791228012281122821228312284122851228612287122881228912290122911229212293122941229512296122971229812299123001230112302123031230412305123061230712308123091231012311123121231312314123151231612317123181231912320123211232212323123241232512326123271232812329123301233112332123331233412335123361233712338123391234012341123421234312344123451234612347123481234912350123511235212353123541235512356123571235812359123601236112362123631236412365123661236712368123691237012371123721237312374123751237612377123781237912380123811238212383123841238512386123871238812389123901239112392123931239412395123961239712398123991240012401124021240312404124051240612407124081240912410124111241212413124141241512416124171241812419124201242112422124231242412425124261242712428124291243012431124321243312434124351243612437124381243912440124411244212443124441244512446124471244812449124501245112452124531245412455124561245712458124591246012461124621246312464124651246612467124681246912470124711247212473124741247512476124771247812479124801248112482124831248412485124861248712488124891249012491124921249312494124951249612497124981249912500125011250212503125041250512506125071250812509125101251112512125131251412515125161251712518125191252012521125221252312524125251252612527125281252912530125311253212533125341253512536125371253812539125401254112542125431254412545125461254712548125491255012551125521255312554125551255612557125581255912560125611256212563125641256512566125671256812569125701257112572125731257412575125761257712578125791258012581125821258312584125851258612587125881258912590125911259212593125941259512596125971259812599126001260112602126031260412605126061260712608126091261012611126121261312614126151261612617126181261912620126211262212623126241262512626126271262812629126301263112632126331263412635126361263712638126391264012641126421264312644126451264612647126481264912650126511265212653126541265512656126571265812659126601266112662126631266412665126661266712668126691267012671126721267312674126751267612677126781267912680126811268212683126841268512686126871268812689126901269112692126931269412695126961269712698126991270012701127021270312704127051270612707127081270912710127111271212713127141271512716127171271812719127201272112722127231272412725127261272712728127291273012731127321273312734127351273612737127381273912740127411274212743127441274512746127471274812749127501275112752127531275412755127561275712758127591276012761127621276312764127651276612767127681276912770127711277212773127741277512776127771277812779127801278112782127831278412785127861278712788127891279012791127921279312794127951279612797127981279912800128011280212803128041280512806128071280812809128101281112812128131281412815128161281712818128191282012821128221282312824128251282612827128281282912830128311283212833128341283512836128371283812839128401284112842128431284412845128461284712848128491285012851128521285312854128551285612857128581285912860128611286212863128641286512866128671286812869128701287112872128731287412875128761287712878128791288012881128821288312884128851288612887128881288912890128911289212893128941289512896128971289812899129001290112902129031290412905129061290712908129091291012911129121291312914129151291612917129181291912920129211292212923129241292512926129271292812929129301293112932129331293412935129361293712938129391294012941129421294312944129451294612947129481294912950129511295212953129541295512956129571295812959129601296112962129631296412965129661296712968129691297012971129721297312974129751297612977129781297912980129811298212983129841298512986129871298812989129901299112992129931299412995129961299712998129991300013001130021300313004130051300613007130081300913010130111301213013130141301513016130171301813019130201302113022130231302413025130261302713028130291303013031130321303313034130351303613037130381303913040130411304213043130441304513046130471304813049130501305113052130531305413055130561305713058130591306013061130621306313064130651306613067130681306913070130711307213073130741307513076130771307813079130801308113082130831308413085130861308713088130891309013091130921309313094130951309613097130981309913100131011310213103131041310513106131071310813109131101311113112131131311413115131161311713118131191312013121131221312313124131251312613127131281312913130131311313213133131341313513136131371313813139131401314113142131431314413145131461314713148131491315013151131521315313154131551315613157131581315913160131611316213163131641316513166131671316813169131701317113172131731317413175131761317713178131791318013181131821318313184131851318613187131881318913190131911319213193131941319513196131971319813199132001320113202132031320413205132061320713208132091321013211132121321313214132151321613217132181321913220132211322213223132241322513226132271322813229132301323113232132331323413235132361323713238132391324013241132421324313244132451324613247132481324913250132511325213253132541325513256132571325813259132601326113262132631326413265132661326713268132691327013271132721327313274132751327613277132781327913280132811328213283132841328513286132871328813289132901329113292132931329413295132961329713298132991330013301133021330313304133051330613307133081330913310133111331213313133141331513316133171331813319133201332113322133231332413325133261332713328133291333013331133321333313334133351333613337133381333913340133411334213343133441334513346133471334813349133501335113352133531335413355133561335713358133591336013361133621336313364133651336613367133681336913370133711337213373133741337513376133771337813379133801338113382133831338413385133861338713388133891339013391133921339313394133951339613397133981339913400134011340213403134041340513406134071340813409134101341113412134131341413415134161341713418134191342013421134221342313424134251342613427134281342913430134311343213433134341343513436134371343813439134401344113442134431344413445134461344713448134491345013451134521345313454134551345613457134581345913460134611346213463134641346513466134671346813469134701347113472134731347413475134761347713478134791348013481134821348313484134851348613487134881348913490134911349213493134941349513496134971349813499135001350113502135031350413505135061350713508135091351013511135121351313514135151351613517135181351913520135211352213523135241352513526135271352813529135301353113532135331353413535135361353713538135391354013541135421354313544135451354613547135481354913550135511355213553135541355513556135571355813559135601356113562135631356413565135661356713568135691357013571135721357313574135751357613577135781357913580135811358213583135841358513586135871358813589135901359113592135931359413595135961359713598135991360013601136021360313604136051360613607136081360913610136111361213613136141361513616136171361813619136201362113622136231362413625136261362713628136291363013631136321363313634136351363613637136381363913640136411364213643136441364513646136471364813649136501365113652136531365413655136561365713658136591366013661136621366313664136651366613667136681366913670136711367213673136741367513676136771367813679136801368113682136831368413685136861368713688136891369013691136921369313694136951369613697136981369913700137011370213703137041370513706137071370813709137101371113712137131371413715137161371713718137191372013721137221372313724137251372613727137281372913730137311373213733137341373513736137371373813739137401374113742137431374413745137461374713748137491375013751137521375313754137551375613757137581375913760137611376213763137641376513766137671376813769137701377113772137731377413775137761377713778137791378013781137821378313784137851378613787137881378913790137911379213793137941379513796137971379813799138001380113802138031380413805138061380713808138091381013811138121381313814138151381613817138181381913820138211382213823138241382513826138271382813829138301383113832138331383413835138361383713838138391384013841138421384313844138451384613847138481384913850138511385213853138541385513856138571385813859138601386113862138631386413865138661386713868138691387013871138721387313874138751387613877138781387913880138811388213883138841388513886138871388813889138901389113892138931389413895138961389713898138991390013901139021390313904139051390613907139081390913910139111391213913139141391513916139171391813919139201392113922139231392413925139261392713928139291393013931139321393313934139351393613937139381393913940139411394213943139441394513946139471394813949139501395113952139531395413955139561395713958139591396013961139621396313964139651396613967139681396913970139711397213973139741397513976139771397813979139801398113982139831398413985139861398713988139891399013991139921399313994139951399613997139981399914000140011400214003140041400514006140071400814009140101401114012140131401414015140161401714018140191402014021140221402314024140251402614027140281402914030140311403214033140341403514036140371403814039140401404114042140431404414045140461404714048140491405014051140521405314054140551405614057140581405914060140611406214063140641406514066140671406814069140701407114072140731407414075140761407714078140791408014081140821408314084140851408614087140881408914090140911409214093140941409514096140971409814099141001410114102141031410414105141061410714108141091411014111141121411314114141151411614117141181411914120141211412214123141241412514126141271412814129141301413114132141331413414135141361413714138141391414014141141421414314144141451414614147141481414914150141511415214153141541415514156141571415814159141601416114162141631416414165141661416714168141691417014171141721417314174141751417614177141781417914180141811418214183141841418514186141871418814189141901419114192141931419414195141961419714198141991420014201142021420314204142051420614207142081420914210142111421214213142141421514216142171421814219142201422114222142231422414225142261422714228142291423014231142321423314234142351423614237142381423914240142411424214243142441424514246142471424814249142501425114252142531425414255142561425714258142591426014261142621426314264142651426614267142681426914270142711427214273142741427514276142771427814279142801428114282142831428414285142861428714288142891429014291142921429314294142951429614297142981429914300143011430214303143041430514306143071430814309143101431114312143131431414315143161431714318143191432014321143221432314324143251432614327143281432914330143311433214333143341433514336143371433814339143401434114342143431434414345143461434714348143491435014351143521435314354143551435614357143581435914360143611436214363143641436514366143671436814369143701437114372143731437414375143761437714378143791438014381143821438314384143851438614387143881438914390143911439214393143941439514396143971439814399144001440114402144031440414405144061440714408144091441014411144121441314414144151441614417144181441914420144211442214423144241442514426144271442814429144301443114432144331443414435144361443714438144391444014441144421444314444144451444614447144481444914450144511445214453144541445514456144571445814459144601446114462144631446414465144661446714468144691447014471144721447314474144751447614477144781447914480144811448214483144841448514486144871448814489144901449114492144931449414495144961449714498144991450014501145021450314504145051450614507145081450914510145111451214513145141451514516145171451814519145201452114522145231452414525145261452714528145291453014531145321453314534145351453614537145381453914540145411454214543145441454514546145471454814549145501455114552145531455414555145561455714558145591456014561145621456314564145651456614567145681456914570145711457214573145741457514576145771457814579145801458114582145831458414585145861458714588145891459014591145921459314594145951459614597145981459914600146011460214603146041460514606146071460814609146101461114612146131461414615146161461714618146191462014621146221462314624146251462614627146281462914630146311463214633146341463514636146371463814639146401464114642146431464414645146461464714648146491465014651146521465314654146551465614657146581465914660146611466214663146641466514666146671466814669146701467114672146731467414675146761467714678146791468014681146821468314684146851468614687146881468914690146911469214693146941469514696146971469814699147001470114702147031470414705147061470714708147091471014711147121471314714147151471614717147181471914720147211472214723147241472514726147271472814729147301473114732147331473414735147361473714738147391474014741147421474314744147451474614747147481474914750147511475214753147541475514756147571475814759147601476114762147631476414765147661476714768147691477014771147721477314774147751477614777147781477914780147811478214783147841478514786147871478814789147901479114792147931479414795147961479714798147991480014801148021480314804148051480614807148081480914810148111481214813148141481514816148171481814819148201482114822148231482414825148261482714828148291483014831148321483314834148351483614837148381483914840148411484214843148441484514846148471484814849148501485114852148531485414855148561485714858148591486014861148621486314864148651486614867148681486914870148711487214873148741487514876148771487814879148801488114882148831488414885148861488714888148891489014891148921489314894148951489614897148981489914900149011490214903149041490514906149071490814909149101491114912149131491414915149161491714918149191492014921149221492314924149251492614927149281492914930149311493214933149341493514936149371493814939149401494114942149431494414945149461494714948149491495014951149521495314954149551495614957149581495914960149611496214963149641496514966149671496814969149701497114972149731497414975149761497714978149791498014981149821498314984149851498614987149881498914990149911499214993149941499514996149971499814999150001500115002150031500415005150061500715008150091501015011150121501315014150151501615017150181501915020150211502215023150241502515026150271502815029150301503115032150331503415035150361503715038150391504015041150421504315044150451504615047150481504915050150511505215053150541505515056150571505815059150601506115062150631506415065150661506715068150691507015071150721507315074150751507615077150781507915080150811508215083150841508515086150871508815089150901509115092150931509415095150961509715098150991510015101151021510315104151051510615107151081510915110151111511215113151141511515116151171511815119151201512115122151231512415125151261512715128151291513015131151321513315134151351513615137151381513915140151411514215143151441514515146151471514815149151501515115152151531515415155151561515715158151591516015161151621516315164151651516615167151681516915170151711517215173151741517515176151771517815179151801518115182151831518415185151861518715188151891519015191151921519315194151951519615197151981519915200152011520215203152041520515206152071520815209152101521115212152131521415215152161521715218152191522015221152221522315224152251522615227152281522915230152311523215233152341523515236152371523815239152401524115242152431524415245152461524715248152491525015251152521525315254152551525615257152581525915260152611526215263152641526515266152671526815269152701527115272152731527415275152761527715278152791528015281152821528315284152851528615287152881528915290152911529215293152941529515296152971529815299153001530115302153031530415305153061530715308153091531015311153121531315314153151531615317153181531915320153211532215323153241532515326153271532815329153301533115332153331533415335153361533715338153391534015341153421534315344153451534615347153481534915350153511535215353153541535515356153571535815359153601536115362153631536415365153661536715368153691537015371153721537315374153751537615377153781537915380153811538215383153841538515386153871538815389153901539115392153931539415395153961539715398153991540015401154021540315404154051540615407154081540915410154111541215413154141541515416154171541815419154201542115422154231542415425154261542715428154291543015431154321543315434154351543615437154381543915440154411544215443154441544515446154471544815449154501545115452154531545415455154561545715458154591546015461154621546315464154651546615467154681546915470154711547215473154741547515476154771547815479154801548115482154831548415485154861548715488154891549015491154921549315494154951549615497154981549915500155011550215503155041550515506155071550815509155101551115512155131551415515155161551715518155191552015521155221552315524155251552615527155281552915530155311553215533155341553515536155371553815539155401554115542155431554415545155461554715548155491555015551155521555315554155551555615557155581555915560155611556215563155641556515566155671556815569155701557115572155731557415575155761557715578155791558015581155821558315584155851558615587155881558915590155911559215593155941559515596155971559815599156001560115602156031560415605156061560715608156091561015611156121561315614156151561615617156181561915620156211562215623156241562515626156271562815629156301563115632156331563415635156361563715638156391564015641156421564315644156451564615647156481564915650156511565215653156541565515656156571565815659156601566115662156631566415665156661566715668156691567015671156721567315674156751567615677156781567915680156811568215683156841568515686156871568815689156901569115692156931569415695156961569715698156991570015701157021570315704157051570615707157081570915710157111571215713157141571515716157171571815719157201572115722157231572415725157261572715728157291573015731157321573315734157351573615737157381573915740157411574215743157441574515746157471574815749157501575115752157531575415755157561575715758157591576015761157621576315764157651576615767157681576915770157711577215773157741577515776157771577815779157801578115782157831578415785157861578715788157891579015791157921579315794157951579615797157981579915800158011580215803158041580515806158071580815809158101581115812158131581415815158161581715818158191582015821158221582315824158251582615827158281582915830158311583215833158341583515836158371583815839158401584115842158431584415845158461584715848158491585015851158521585315854158551585615857158581585915860158611586215863158641586515866158671586815869158701587115872158731587415875158761587715878158791588015881158821588315884158851588615887158881588915890158911589215893158941589515896158971589815899159001590115902159031590415905159061590715908159091591015911159121591315914159151591615917159181591915920159211592215923159241592515926159271592815929159301593115932159331593415935159361593715938159391594015941159421594315944159451594615947159481594915950159511595215953159541595515956159571595815959159601596115962159631596415965159661596715968159691597015971159721597315974159751597615977159781597915980159811598215983159841598515986159871598815989159901599115992159931599415995159961599715998159991600016001160021600316004160051600616007160081600916010160111601216013160141601516016160171601816019160201602116022160231602416025160261602716028160291603016031160321603316034160351603616037160381603916040160411604216043160441604516046160471604816049160501605116052160531605416055160561605716058160591606016061160621606316064160651606616067160681606916070160711607216073160741607516076160771607816079160801608116082160831608416085160861608716088160891609016091160921609316094160951609616097160981609916100161011610216103161041610516106161071610816109161101611116112161131611416115161161611716118161191612016121161221612316124161251612616127161281612916130161311613216133161341613516136161371613816139161401614116142161431614416145161461614716148161491615016151161521615316154161551615616157161581615916160161611616216163161641616516166161671616816169161701617116172161731617416175161761617716178161791618016181161821618316184161851618616187161881618916190161911619216193161941619516196161971619816199162001620116202162031620416205162061620716208162091621016211162121621316214162151621616217162181621916220162211622216223162241622516226162271622816229162301623116232162331623416235162361623716238162391624016241162421624316244162451624616247162481624916250162511625216253162541625516256162571625816259162601626116262162631626416265162661626716268162691627016271162721627316274162751627616277162781627916280162811628216283162841628516286162871628816289162901629116292162931629416295162961629716298162991630016301163021630316304163051630616307163081630916310163111631216313163141631516316163171631816319163201632116322163231632416325163261632716328163291633016331163321633316334163351633616337163381633916340163411634216343163441634516346163471634816349163501635116352163531635416355163561635716358163591636016361163621636316364163651636616367163681636916370163711637216373163741637516376163771637816379163801638116382163831638416385163861638716388163891639016391163921639316394163951639616397163981639916400164011640216403164041640516406164071640816409164101641116412164131641416415164161641716418164191642016421164221642316424164251642616427164281642916430164311643216433164341643516436164371643816439164401644116442164431644416445164461644716448164491645016451164521645316454164551645616457164581645916460164611646216463164641646516466164671646816469164701647116472164731647416475164761647716478164791648016481164821648316484164851648616487164881648916490164911649216493164941649516496164971649816499165001650116502165031650416505165061650716508165091651016511165121651316514165151651616517165181651916520165211652216523165241652516526165271652816529165301653116532165331653416535165361653716538165391654016541165421654316544165451654616547165481654916550165511655216553165541655516556165571655816559165601656116562165631656416565165661656716568165691657016571165721657316574165751657616577165781657916580165811658216583165841658516586165871658816589165901659116592165931659416595165961659716598165991660016601166021660316604166051660616607166081660916610166111661216613166141661516616166171661816619166201662116622166231662416625166261662716628166291663016631166321663316634166351663616637166381663916640166411664216643166441664516646166471664816649166501665116652166531665416655166561665716658166591666016661166621666316664166651666616667166681666916670166711667216673166741667516676166771667816679166801668116682166831668416685166861668716688166891669016691166921669316694166951669616697166981669916700167011670216703167041670516706167071670816709167101671116712167131671416715167161671716718167191672016721167221672316724167251672616727167281672916730167311673216733167341673516736167371673816739167401674116742167431674416745167461674716748167491675016751167521675316754167551675616757167581675916760167611676216763167641676516766167671676816769167701677116772167731677416775167761677716778167791678016781167821678316784167851678616787167881678916790167911679216793167941679516796167971679816799168001680116802168031680416805168061680716808168091681016811168121681316814168151681616817168181681916820168211682216823168241682516826168271682816829168301683116832168331683416835168361683716838168391684016841168421684316844168451684616847168481684916850168511685216853168541685516856168571685816859168601686116862168631686416865168661686716868168691687016871168721687316874168751687616877168781687916880168811688216883168841688516886168871688816889168901689116892168931689416895168961689716898168991690016901169021690316904169051690616907169081690916910169111691216913169141691516916169171691816919169201692116922169231692416925169261692716928169291693016931169321693316934169351693616937169381693916940169411694216943169441694516946169471694816949169501695116952169531695416955169561695716958169591696016961169621696316964169651696616967169681696916970169711697216973169741697516976169771697816979169801698116982169831698416985169861698716988169891699016991169921699316994169951699616997169981699917000170011700217003170041700517006170071700817009170101701117012170131701417015170161701717018170191702017021170221702317024170251702617027170281702917030170311703217033170341703517036170371703817039170401704117042170431704417045170461704717048170491705017051170521705317054170551705617057170581705917060170611706217063170641706517066170671706817069170701707117072170731707417075170761707717078170791708017081170821708317084170851708617087170881708917090170911709217093170941709517096170971709817099171001710117102171031710417105171061710717108171091711017111171121711317114171151711617117171181711917120171211712217123171241712517126171271712817129171301713117132171331713417135171361713717138171391714017141171421714317144171451714617147171481714917150171511715217153171541715517156171571715817159171601716117162171631716417165171661716717168171691717017171171721717317174171751717617177171781717917180171811718217183171841718517186171871718817189171901719117192171931719417195171961719717198171991720017201172021720317204172051720617207172081720917210172111721217213172141721517216172171721817219172201722117222172231722417225172261722717228172291723017231172321723317234172351723617237172381723917240172411724217243172441724517246172471724817249172501725117252172531725417255172561725717258172591726017261172621726317264172651726617267172681726917270172711727217273172741727517276172771727817279172801728117282172831728417285172861728717288172891729017291172921729317294172951729617297172981729917300173011730217303173041730517306173071730817309173101731117312173131731417315173161731717318173191732017321173221732317324173251732617327173281732917330173311733217333173341733517336173371733817339173401734117342173431734417345173461734717348173491735017351173521735317354173551735617357173581735917360173611736217363173641736517366173671736817369173701737117372173731737417375173761737717378173791738017381173821738317384173851738617387173881738917390173911739217393173941739517396173971739817399174001740117402174031740417405174061740717408174091741017411174121741317414174151741617417174181741917420174211742217423174241742517426174271742817429174301743117432174331743417435174361743717438174391744017441174421744317444174451744617447174481744917450174511745217453174541745517456174571745817459174601746117462174631746417465174661746717468174691747017471174721747317474174751747617477174781747917480174811748217483174841748517486174871748817489174901749117492174931749417495174961749717498174991750017501175021750317504175051750617507175081750917510175111751217513175141751517516175171751817519175201752117522175231752417525175261752717528175291753017531175321753317534175351753617537175381753917540175411754217543175441754517546175471754817549175501755117552175531755417555175561755717558175591756017561175621756317564175651756617567175681756917570175711757217573175741757517576175771757817579175801758117582175831758417585175861758717588175891759017591175921759317594175951759617597175981759917600176011760217603176041760517606176071760817609176101761117612176131761417615176161761717618176191762017621176221762317624176251762617627176281762917630176311763217633176341763517636176371763817639176401764117642176431764417645176461764717648176491765017651176521765317654176551765617657176581765917660176611766217663176641766517666176671766817669176701767117672176731767417675176761767717678176791768017681176821768317684176851768617687176881768917690176911769217693176941769517696176971769817699177001770117702177031770417705177061770717708177091771017711177121771317714177151771617717177181771917720177211772217723177241772517726177271772817729177301773117732177331773417735177361773717738177391774017741177421774317744177451774617747177481774917750177511775217753177541775517756177571775817759177601776117762177631776417765177661776717768177691777017771177721777317774177751777617777177781777917780177811778217783177841778517786177871778817789177901779117792177931779417795177961779717798177991780017801178021780317804178051780617807178081780917810178111781217813178141781517816178171781817819178201782117822178231782417825178261782717828178291783017831178321783317834178351783617837178381783917840178411784217843178441784517846178471784817849178501785117852178531785417855178561785717858178591786017861178621786317864178651786617867178681786917870178711787217873178741787517876178771787817879178801788117882178831788417885178861788717888178891789017891178921789317894178951789617897178981789917900179011790217903179041790517906179071790817909179101791117912179131791417915179161791717918179191792017921179221792317924179251792617927179281792917930179311793217933179341793517936179371793817939179401794117942179431794417945179461794717948179491795017951179521795317954179551795617957179581795917960179611796217963179641796517966179671796817969179701797117972179731797417975179761797717978179791798017981179821798317984179851798617987179881798917990179911799217993179941799517996179971799817999180001800118002180031800418005180061800718008180091801018011180121801318014180151801618017180181801918020180211802218023180241802518026180271802818029180301803118032180331803418035180361803718038180391804018041180421804318044180451804618047180481804918050180511805218053180541805518056180571805818059180601806118062180631806418065180661806718068180691807018071180721807318074180751807618077180781807918080180811808218083180841808518086180871808818089180901809118092180931809418095180961809718098180991810018101181021810318104181051810618107181081810918110181111811218113181141811518116181171811818119181201812118122181231812418125181261812718128181291813018131181321813318134181351813618137181381813918140181411814218143181441814518146181471814818149181501815118152181531815418155181561815718158181591816018161181621816318164181651816618167181681816918170181711817218173181741817518176181771817818179181801818118182181831818418185181861818718188181891819018191181921819318194181951819618197181981819918200182011820218203182041820518206182071820818209182101821118212182131821418215182161821718218182191822018221182221822318224182251822618227182281822918230182311823218233182341823518236182371823818239182401824118242182431824418245182461824718248182491825018251182521825318254182551825618257182581825918260182611826218263182641826518266182671826818269182701827118272182731827418275182761827718278182791828018281182821828318284182851828618287182881828918290182911829218293182941829518296182971829818299183001830118302183031830418305183061830718308183091831018311183121831318314183151831618317183181831918320183211832218323183241832518326183271832818329183301833118332183331833418335183361833718338183391834018341183421834318344183451834618347183481834918350183511835218353183541835518356183571835818359183601836118362183631836418365183661836718368183691837018371183721837318374183751837618377183781837918380183811838218383183841838518386183871838818389183901839118392183931839418395183961839718398183991840018401184021840318404184051840618407184081840918410184111841218413184141841518416184171841818419184201842118422184231842418425184261842718428184291843018431184321843318434184351843618437184381843918440184411844218443184441844518446184471844818449184501845118452184531845418455184561845718458184591846018461184621846318464184651846618467184681846918470184711847218473184741847518476184771847818479184801848118482184831848418485184861848718488184891849018491184921849318494184951849618497184981849918500185011850218503185041850518506185071850818509185101851118512185131851418515185161851718518185191852018521185221852318524185251852618527185281852918530185311853218533185341853518536185371853818539185401854118542185431854418545185461854718548185491855018551185521855318554185551855618557185581855918560185611856218563185641856518566185671856818569185701857118572185731857418575185761857718578185791858018581185821858318584185851858618587185881858918590185911859218593185941859518596185971859818599186001860118602186031860418605186061860718608186091861018611186121861318614186151861618617186181861918620186211862218623186241862518626186271862818629186301863118632186331863418635186361863718638186391864018641186421864318644186451864618647186481864918650186511865218653186541865518656186571865818659186601866118662186631866418665186661866718668186691867018671186721867318674186751867618677186781867918680186811868218683186841868518686186871868818689186901869118692186931869418695186961869718698186991870018701187021870318704187051870618707187081870918710187111871218713187141871518716187171871818719187201872118722187231872418725187261872718728187291873018731187321873318734187351873618737187381873918740187411874218743187441874518746187471874818749187501875118752187531875418755187561875718758187591876018761187621876318764187651876618767187681876918770187711877218773187741877518776187771877818779187801878118782187831878418785187861878718788187891879018791187921879318794187951879618797187981879918800188011880218803188041880518806188071880818809188101881118812188131881418815188161881718818188191882018821188221882318824188251882618827188281882918830188311883218833188341883518836188371883818839188401884118842188431884418845188461884718848188491885018851188521885318854188551885618857188581885918860188611886218863188641886518866188671886818869188701887118872188731887418875188761887718878188791888018881188821888318884188851888618887188881888918890188911889218893188941889518896188971889818899189001890118902189031890418905189061890718908189091891018911189121891318914189151891618917189181891918920189211892218923189241892518926189271892818929189301893118932189331893418935189361893718938189391894018941189421894318944189451894618947189481894918950189511895218953189541895518956189571895818959189601896118962189631896418965189661896718968189691897018971189721897318974189751897618977189781897918980189811898218983189841898518986189871898818989189901899118992189931899418995189961899718998189991900019001190021900319004190051900619007190081900919010190111901219013190141901519016190171901819019190201902119022190231902419025190261902719028190291903019031190321903319034190351903619037190381903919040190411904219043190441904519046190471904819049190501905119052190531905419055190561905719058190591906019061190621906319064190651906619067190681906919070190711907219073190741907519076190771907819079190801908119082190831908419085190861908719088190891909019091190921909319094190951909619097190981909919100191011910219103191041910519106191071910819109191101911119112191131911419115191161911719118191191912019121191221912319124191251912619127191281912919130191311913219133191341913519136191371913819139191401914119142191431914419145191461914719148191491915019151191521915319154191551915619157191581915919160191611916219163191641916519166191671916819169191701917119172191731917419175191761917719178191791918019181191821918319184191851918619187191881918919190191911919219193191941919519196191971919819199192001920119202192031920419205192061920719208192091921019211192121921319214192151921619217192181921919220192211922219223192241922519226192271922819229192301923119232192331923419235192361923719238192391924019241192421924319244192451924619247192481924919250192511925219253192541925519256192571925819259192601926119262192631926419265192661926719268192691927019271192721927319274192751927619277192781927919280192811928219283192841928519286192871928819289192901929119292192931929419295192961929719298192991930019301193021930319304193051930619307193081930919310193111931219313193141931519316193171931819319193201932119322193231932419325193261932719328193291933019331193321933319334193351933619337193381933919340193411934219343193441934519346193471934819349193501935119352193531935419355193561935719358193591936019361193621936319364193651936619367193681936919370193711937219373193741937519376193771937819379193801938119382193831938419385193861938719388193891939019391193921939319394193951939619397193981939919400194011940219403194041940519406194071940819409194101941119412194131941419415194161941719418194191942019421194221942319424194251942619427194281942919430194311943219433194341943519436194371943819439194401944119442194431944419445194461944719448194491945019451194521945319454194551945619457194581945919460194611946219463194641946519466194671946819469194701947119472194731947419475194761947719478194791948019481194821948319484194851948619487194881948919490194911949219493194941949519496194971949819499195001950119502195031950419505195061950719508195091951019511195121951319514195151951619517195181951919520195211952219523195241952519526195271952819529195301953119532195331953419535195361953719538195391954019541195421954319544195451954619547195481954919550195511955219553195541955519556195571955819559195601956119562195631956419565195661956719568195691957019571195721957319574195751957619577195781957919580195811958219583195841958519586195871958819589195901959119592195931959419595195961959719598195991960019601196021960319604196051960619607196081960919610196111961219613196141961519616196171961819619196201962119622196231962419625196261962719628196291963019631196321963319634196351963619637196381963919640196411964219643196441964519646196471964819649196501965119652196531965419655196561965719658196591966019661196621966319664196651966619667196681966919670196711967219673196741967519676196771967819679196801968119682196831968419685196861968719688196891969019691196921969319694196951969619697196981969919700197011970219703197041970519706197071970819709197101971119712197131971419715197161971719718197191972019721197221972319724197251972619727197281972919730197311973219733197341973519736197371973819739197401974119742197431974419745197461974719748197491975019751197521975319754197551975619757197581975919760197611976219763197641976519766197671976819769197701977119772197731977419775197761977719778197791978019781197821978319784197851978619787197881978919790197911979219793197941979519796197971979819799198001980119802198031980419805198061980719808198091981019811198121981319814198151981619817198181981919820198211982219823198241982519826198271982819829198301983119832198331983419835198361983719838198391984019841198421984319844198451984619847198481984919850198511985219853198541985519856198571985819859198601986119862198631986419865198661986719868198691987019871198721987319874198751987619877198781987919880198811988219883198841988519886198871988819889198901989119892198931989419895198961989719898198991990019901199021990319904199051990619907199081990919910199111991219913199141991519916199171991819919199201992119922199231992419925199261992719928199291993019931199321993319934199351993619937199381993919940199411994219943199441994519946199471994819949199501995119952199531995419955199561995719958199591996019961199621996319964199651996619967199681996919970199711997219973199741997519976199771997819979199801998119982199831998419985199861998719988199891999019991199921999319994199951999619997199981999920000200012000220003200042000520006200072000820009200102001120012200132001420015200162001720018200192002020021200222002320024200252002620027200282002920030200312003220033200342003520036200372003820039200402004120042200432004420045200462004720048200492005020051200522005320054200552005620057200582005920060200612006220063200642006520066200672006820069200702007120072200732007420075200762007720078200792008020081200822008320084200852008620087200882008920090200912009220093200942009520096200972009820099201002010120102201032010420105201062010720108
  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. { TTestPasParser }
  29. TTestPasParser = Class(TPasParser)
  30. end;
  31. TOnFindUnit = function(const aUnitName: String): TPasModule of object;
  32. { TTestEnginePasResolver }
  33. TTestEnginePasResolver = class(TPas2JsResolver)
  34. private
  35. FFilename: string;
  36. FModule: TPasModule;
  37. FOnFindUnit: TOnFindUnit;
  38. FParser: TTestPasParser;
  39. FStreamResolver: TStreamResolver;
  40. FScanner: TPascalScanner;
  41. FSource: string;
  42. procedure SetModule(AValue: TPasModule);
  43. public
  44. destructor Destroy; override;
  45. function FindUnit(const AName, InFilename: String; NameExpr,
  46. InFileExpr: TPasExpr): TPasModule; override;
  47. procedure UsedInterfacesFinished(Section: TPasSection); override;
  48. property OnFindUnit: TOnFindUnit read FOnFindUnit write FOnFindUnit;
  49. property Filename: string read FFilename write FFilename;
  50. property StreamResolver: TStreamResolver read FStreamResolver write FStreamResolver;
  51. property Scanner: TPascalScanner read FScanner write FScanner;
  52. property Parser: TTestPasParser read FParser write FParser;
  53. property Source: string read FSource write FSource;
  54. property Module: TPasModule read FModule write SetModule;
  55. end;
  56. { TCustomTestModule }
  57. TCustomTestModule = Class(TTestCase)
  58. private
  59. FConverter: TPasToJSConverter;
  60. FEngine: TTestEnginePasResolver;
  61. FExpectedErrorClass: ExceptClass;
  62. FExpectedErrorMsg: string;
  63. FExpectedErrorNumber: integer;
  64. FFilename: string;
  65. FFileResolver: TStreamResolver;
  66. FJSImplementationSrc: TJSSourceElements;
  67. FJSImplementationUses: TJSArrayLiteral;
  68. FJSInitBody: TJSFunctionBody;
  69. FJSImplentationUses: TJSArrayLiteral;
  70. FJSInterfaceUses: TJSArrayLiteral;
  71. FJSModule: TJSSourceElements;
  72. FJSModuleSrc: TJSSourceElements;
  73. FJSSource: TStringList;
  74. FModule: TPasModule;
  75. FJSModuleCallArgs: TJSArguments;
  76. FModules: TObjectList;// list of TTestEnginePasResolver
  77. FParser: TTestPasParser;
  78. FPasProgram: TPasProgram;
  79. FJSRegModuleCall: TJSCallExpression;
  80. FScanner: TPascalScanner;
  81. FSkipTests: boolean;
  82. FSource: TStringList;
  83. FFirstPasStatement: TPasImplBlock;
  84. function GetResolverCount: integer;
  85. function GetResolvers(Index: integer): TTestEnginePasResolver;
  86. function OnPasResolverFindUnit(const aUnitName: String): TPasModule;
  87. protected
  88. procedure SetUp; override;
  89. function CreateConverter: TPasToJSConverter; virtual;
  90. function LoadUnit(const aUnitName: String): TPasModule;
  91. procedure InitScanner(aScanner: TPascalScanner); virtual;
  92. procedure TearDown; override;
  93. Procedure Add(Line: string); virtual;
  94. Procedure Add(const Lines: array of string);
  95. Procedure StartParsing; virtual;
  96. procedure ParseModuleQueue; virtual;
  97. procedure ParseModule; virtual;
  98. procedure ParseProgram; virtual;
  99. procedure ParseUnit; virtual;
  100. protected
  101. function FindModuleWithFilename(aFilename: string): TTestEnginePasResolver; virtual;
  102. function AddModule(aFilename: string): TTestEnginePasResolver; virtual;
  103. function AddModuleWithSrc(aFilename, Src: string): TTestEnginePasResolver; virtual;
  104. function AddModuleWithIntfImplSrc(aFilename, InterfaceSrc,
  105. ImplementationSrc: string): TTestEnginePasResolver; virtual;
  106. procedure AddSystemUnit; virtual;
  107. procedure StartProgram(NeedSystemUnit: boolean); virtual;
  108. procedure StartUnit(NeedSystemUnit: boolean); virtual;
  109. procedure ConvertModule; virtual;
  110. procedure ConvertProgram; virtual;
  111. procedure ConvertUnit; virtual;
  112. function ConvertJSModuleToString(El: TJSElement): string; virtual;
  113. procedure CheckDottedIdentifier(Msg: string; El: TJSElement; DottedName: string);
  114. function GetDottedIdentifier(El: TJSElement): string;
  115. procedure CheckSource(Msg,Statements: String; InitStatements: string = '';
  116. ImplStatements: string = ''); virtual;
  117. procedure CheckDiff(Msg, Expected, Actual: string); virtual;
  118. procedure CheckUnit(Filename, ExpectedSrc: string); virtual;
  119. procedure SetExpectedScannerError(Msg: string; MsgNumber: integer);
  120. procedure SetExpectedParserError(Msg: string; MsgNumber: integer);
  121. procedure SetExpectedPasResolverError(Msg: string; MsgNumber: integer);
  122. procedure SetExpectedConverterError(Msg: string; MsgNumber: integer);
  123. function IsErrorExpected(E: Exception): boolean;
  124. procedure HandleScannerError(E: EScannerError);
  125. procedure HandleParserError(E: EParserError);
  126. procedure HandlePasResolveError(E: EPasResolve);
  127. procedure HandlePas2JSError(E: EPas2JS);
  128. procedure HandleException(E: Exception);
  129. procedure FailException(E: Exception);
  130. procedure WriteSources(const aFilename: string; aRow, aCol: integer);
  131. function IndexOfResolver(const Filename: string): integer;
  132. function GetResolver(const Filename: string): TTestEnginePasResolver;
  133. function GetDefaultNamespace: string;
  134. property PasProgram: TPasProgram Read FPasProgram;
  135. property Resolvers[Index: integer]: TTestEnginePasResolver read GetResolvers;
  136. property ResolverCount: integer read GetResolverCount;
  137. property Engine: TTestEnginePasResolver read FEngine;
  138. property Filename: string read FFilename;
  139. Property Module: TPasModule Read FModule;
  140. property FirstPasStatement: TPasImplBlock read FFirstPasStatement;
  141. property Converter: TPasToJSConverter read FConverter;
  142. property JSSource: TStringList read FJSSource;
  143. property JSModule: TJSSourceElements read FJSModule;
  144. property JSRegModuleCall: TJSCallExpression read FJSRegModuleCall;
  145. property JSModuleCallArgs: TJSArguments read FJSModuleCallArgs;
  146. property JSImplementationUses: TJSArrayLiteral read FJSImplementationUses;
  147. property JSInterfaceUses: TJSArrayLiteral read FJSInterfaceUses;
  148. property JSModuleSrc: TJSSourceElements read FJSModuleSrc;
  149. property JSInitBody: TJSFunctionBody read FJSInitBody;
  150. property JSImplementationSrc: TJSSourceElements read FJSImplementationSrc;
  151. property ExpectedErrorClass: ExceptClass read FExpectedErrorClass write FExpectedErrorClass;
  152. property ExpectedErrorMsg: string read FExpectedErrorMsg write FExpectedErrorMsg;
  153. property ExpectedErrorNumber: integer read FExpectedErrorNumber write FExpectedErrorNumber;
  154. property SkipTests: boolean read FSkipTests write FSkipTests;
  155. public
  156. property Source: TStringList read FSource;
  157. property FileResolver: TStreamResolver read FFileResolver;
  158. property Scanner: TPascalScanner read FScanner;
  159. property Parser: TTestPasParser read FParser;
  160. end;
  161. { TTestModule }
  162. TTestModule = class(TCustomTestModule)
  163. Published
  164. // program/units
  165. Procedure TestEmptyProgram;
  166. Procedure TestEmptyProgramUseStrict;
  167. Procedure TestEmptyUnit;
  168. Procedure TestEmptyUnitUseStrict;
  169. Procedure TestDottedUnitNames;
  170. Procedure TestDottedUnitNameImpl;
  171. Procedure TestDottedUnitExpr;
  172. Procedure Test_ModeFPCFail;
  173. Procedure Test_ModeSwitchCBlocksFail;
  174. Procedure TestUnit_Intf1Impl2Intf1;
  175. // vars/const
  176. Procedure TestVarInt;
  177. Procedure TestVarBaseTypes;
  178. Procedure TestBaseTypeSingleFail;
  179. Procedure TestBaseTypeExtendedFail;
  180. Procedure TestConstBaseTypes;
  181. Procedure TestUnitImplVars;
  182. Procedure TestUnitImplConsts;
  183. Procedure TestUnitImplRecord;
  184. Procedure TestRenameJSNameConflict;
  185. Procedure TestLocalConst;
  186. Procedure TestVarExternal;
  187. Procedure TestVarExternalOtherUnit;
  188. Procedure TestVarAbsoluteFail;
  189. // numbers
  190. Procedure TestDouble;
  191. Procedure TestInteger;
  192. Procedure TestIntegerRange;
  193. Procedure TestCurrency;
  194. Procedure TestForBoolDo;
  195. Procedure TestForIntDo;
  196. Procedure TestForIntInDo;
  197. // strings
  198. Procedure TestCharConst;
  199. Procedure TestChar_Compare;
  200. Procedure TestChar_Ord;
  201. Procedure TestChar_Chr;
  202. Procedure TestStringConst;
  203. Procedure TestStringConstSurrogate;
  204. Procedure TestString_Length;
  205. Procedure TestString_Compare;
  206. Procedure TestString_SetLength;
  207. Procedure TestString_CharAt;
  208. Procedure TestStr;
  209. Procedure TestBaseType_AnsiStringFail;
  210. Procedure TestBaseType_WideStringFail;
  211. Procedure TestBaseType_ShortStringFail;
  212. Procedure TestBaseType_RawByteStringFail;
  213. Procedure TestTypeShortstring_Fail;
  214. Procedure TestCharSet_Custom;
  215. Procedure TestForCharDo;
  216. Procedure TestForCharInDo;
  217. // alias types
  218. Procedure TestAliasTypeRef;
  219. Procedure TestTypeCast_BaseTypes;
  220. Procedure TestTypeCast_AliasBaseTypes;
  221. // functions
  222. Procedure TestEmptyProc;
  223. Procedure TestProcOneParam;
  224. Procedure TestFunctionWithoutParams;
  225. Procedure TestProcedureWithoutParams;
  226. Procedure TestPrgProcVar;
  227. Procedure TestProcTwoArgs;
  228. Procedure TestProc_DefaultValue;
  229. Procedure TestUnitProcVar;
  230. Procedure TestImplProc;
  231. Procedure TestFunctionResult;
  232. Procedure TestNestedProc;
  233. Procedure TestNestedProc_ResultString;
  234. Procedure TestForwardProc;
  235. Procedure TestNestedForwardProc;
  236. Procedure TestAssignFunctionResult;
  237. Procedure TestFunctionResultInCondition;
  238. Procedure TestFunctionResultInForLoop;
  239. Procedure TestExit;
  240. Procedure TestBreak;
  241. Procedure TestBreakAsVar;
  242. Procedure TestContinue;
  243. Procedure TestProc_External;
  244. Procedure TestProc_ExternalOtherUnit;
  245. Procedure TestProc_Asm;
  246. Procedure TestProc_Assembler;
  247. Procedure TestProc_VarParam;
  248. Procedure TestProc_VarParamString;
  249. Procedure TestProc_VarParamV;
  250. Procedure TestProc_Overload;
  251. Procedure TestProc_OverloadForward;
  252. Procedure TestProc_OverloadIntfImpl;
  253. Procedure TestProc_OverloadNested;
  254. Procedure TestProc_OverloadUnitCycle;
  255. Procedure TestProc_Varargs;
  256. Procedure TestProc_ConstOrder;
  257. Procedure TestProc_DuplicateConst;
  258. Procedure TestProc_LocalVarAbsolute;
  259. // enums, sets
  260. Procedure TestEnum_Name;
  261. Procedure TestEnum_Number;
  262. Procedure TestEnum_ConstFail;
  263. Procedure TestEnum_Functions;
  264. Procedure TestEnum_AsParams;
  265. Procedure TestEnumRange_Array;
  266. Procedure TestEnum_ForIn;
  267. Procedure TestEnum_ScopedNumber;
  268. Procedure TestSet;
  269. Procedure TestSet_Operators;
  270. Procedure TestSet_Operator_In;
  271. Procedure TestSet_Functions;
  272. Procedure TestSet_PassAsArgClone;
  273. Procedure TestSet_AsParams;
  274. Procedure TestSet_Property;
  275. Procedure TestSet_EnumConst;
  276. Procedure TestSet_AnonymousEnumType;
  277. Procedure TestSet_AnonymousEnumTypeChar; // ToDo
  278. Procedure TestSet_ConstEnum;
  279. Procedure TestSet_ConstChar;
  280. Procedure TestSet_ConstInt;
  281. Procedure TestSet_ForIn;
  282. // statements
  283. Procedure TestNestBegin;
  284. Procedure TestIncDec;
  285. Procedure TestAssignments;
  286. Procedure TestArithmeticOperators1;
  287. Procedure TestLogicalOperators;
  288. Procedure TestBitwiseOperators;
  289. Procedure TestFunctionInt;
  290. Procedure TestFunctionString;
  291. Procedure TestForLoop;
  292. Procedure TestForLoopInsideFunction;
  293. Procedure TestForLoop_ReadVarAfter;
  294. Procedure TestForLoop_Nested;
  295. Procedure TestRepeatUntil;
  296. Procedure TestAsmBlock;
  297. Procedure TestAsmPas_Impl; // ToDo
  298. Procedure TestTryFinally;
  299. Procedure TestTryExcept;
  300. Procedure TestCaseOf;
  301. Procedure TestCaseOf_UseSwitch;
  302. Procedure TestCaseOfNoElse;
  303. Procedure TestCaseOfNoElse_UseSwitch;
  304. Procedure TestCaseOfRange;
  305. // arrays
  306. Procedure TestArray_Dynamic;
  307. Procedure TestArray_Dynamic_Nil;
  308. Procedure TestArray_DynMultiDimensional;
  309. Procedure TestArray_StaticInt;
  310. Procedure TestArray_StaticBool;
  311. Procedure TestArray_StaticChar;
  312. Procedure TestArray_StaticMultiDim; // ToDo
  313. Procedure TestArrayOfRecord;
  314. // ToDo: Procedure TestArrayOfSet;
  315. Procedure TestArray_DynAsParam;
  316. Procedure TestArray_StaticAsParam;
  317. Procedure TestArrayElement_AsParams;
  318. Procedure TestArrayElementFromFuncResult_AsParams;
  319. Procedure TestArrayEnumTypeRange;
  320. Procedure TestArray_SetLengthOutArg;
  321. Procedure TestArray_SetLengthProperty;
  322. Procedure TestArray_SetLengthMultiDim;
  323. Procedure TestArray_OpenArrayOfString;
  324. Procedure TestArray_Concat;
  325. Procedure TestArray_Copy;
  326. Procedure TestArray_InsertDelete;
  327. Procedure TestArray_DynArrayConst;
  328. Procedure TestArray_ForInArrOfString;
  329. Procedure TestExternalClass_TypeCastArrayToExternalArray;
  330. Procedure TestExternalClass_TypeCastArrayFromExternalArray;
  331. // record
  332. Procedure TestRecord_Empty;
  333. Procedure TestRecord_Var;
  334. Procedure TestWithRecordDo;
  335. Procedure TestRecord_Assign;
  336. Procedure TestRecord_PassAsArgClone;
  337. Procedure TestRecord_AsParams;
  338. Procedure TestRecordElement_AsParams;
  339. Procedure TestRecordElementFromFuncResult_AsParams;
  340. Procedure TestRecordElementFromWith_AsParams;
  341. Procedure TestRecord_Equal;
  342. Procedure TestRecord_TypeCastJSValueToRecord;
  343. Procedure TestRecord_VariantFail;
  344. Procedure TestRecord_FieldArray;
  345. // ToDo: const record
  346. // classes
  347. Procedure TestClass_TObjectDefaultConstructor;
  348. Procedure TestClass_TObjectConstructorWithParams;
  349. Procedure TestClass_TObjectConstructorWithDefaultParam;
  350. Procedure TestClass_Var;
  351. Procedure TestClass_Method;
  352. Procedure TestClass_Implementation;
  353. Procedure TestClass_Inheritance;
  354. Procedure TestClass_AbstractMethod;
  355. Procedure TestClass_CallInherited_NoParams;
  356. Procedure TestClass_CallInherited_WithParams;
  357. Procedure TestClasS_CallInheritedConstructor;
  358. Procedure TestClass_ClassVar;
  359. Procedure TestClass_CallClassMethod;
  360. Procedure TestClass_Property;
  361. Procedure TestClass_Property_ClassMethod;
  362. Procedure TestClass_Property_Indexed;
  363. Procedure TestClass_Property_IndexSpec;
  364. Procedure TestClass_PropertyOfTypeArray;
  365. Procedure TestClass_PropertyDefault;
  366. Procedure TestClass_PropertyOverride;
  367. Procedure TestClass_PropertyIncVisibility;
  368. Procedure TestClass_Assigned;
  369. Procedure TestClass_WithClassDoCreate;
  370. Procedure TestClass_WithClassInstDoProperty;
  371. Procedure TestClass_WithClassInstDoPropertyWithParams;
  372. Procedure TestClass_WithClassInstDoFunc;
  373. Procedure TestClass_TypeCast;
  374. Procedure TestClass_TypeCastUntypedParam;
  375. Procedure TestClass_Overloads;
  376. Procedure TestClass_OverloadsAncestor;
  377. Procedure TestClass_OverloadConstructor;
  378. Procedure TestClass_OverloadDelphiOverride;
  379. Procedure TestClass_ReintroducedVar;
  380. Procedure TestClass_RaiseDescendant;
  381. Procedure TestClass_ExternalMethod;
  382. Procedure TestClass_ExternalVirtualNameMismatchFail;
  383. Procedure TestClass_ExternalOverrideFail;
  384. Procedure TestClass_ExternalVar;
  385. Procedure TestClass_Const;
  386. Procedure TestClass_LocalVarSelfFail;
  387. Procedure TestClass_ArgSelfFail;
  388. Procedure TestClass_NestedProcSelf;
  389. Procedure TestClass_NestedProcSelf2;
  390. Procedure TestClass_NestedProcClassSelf;
  391. Procedure TestClass_NestedProcCallInherited;
  392. Procedure TestClass_TObjectFree;
  393. Procedure TestClass_TObjectFreeNewInstance;
  394. Procedure TestClass_TObjectFreeLowerCase;
  395. Procedure TestClass_TObjectFreeFunctionFail;
  396. Procedure TestClass_TObjectFreePropertyFail;
  397. Procedure TestClass_ForIn;
  398. // class of
  399. Procedure TestClassOf_Create;
  400. Procedure TestClassOf_Call;
  401. Procedure TestClassOf_Assign;
  402. Procedure TestClassOf_Is;
  403. Procedure TestClassOf_Compare;
  404. Procedure TestClassOf_ClassVar;
  405. Procedure TestClassOf_ClassMethod;
  406. Procedure TestClassOf_ClassProperty;
  407. Procedure TestClassOf_ClassMethodSelf;
  408. Procedure TestClassOf_TypeCast;
  409. Procedure TestClassOf_ImplicitFunctionCall;
  410. Procedure TestClassOf_Const;
  411. // nested class
  412. Procedure TestNestedClass_Fail;
  413. // external class
  414. Procedure TestExternalClass_Var;
  415. Procedure TestExternalClass_Const;
  416. Procedure TestExternalClass_Dollar;
  417. Procedure TestExternalClass_DuplicateVarFail;
  418. Procedure TestExternalClass_Method;
  419. Procedure TestExternalClass_ClassMethod;
  420. Procedure TestExternalClass_NonExternalOverride;
  421. Procedure TestExternalClass_Property;
  422. Procedure TestExternalClass_ClassProperty;
  423. Procedure TestExternalClass_ClassOf;
  424. Procedure TestExternalClass_ClassOtherUnit;
  425. Procedure TestExternalClass_Is;
  426. Procedure TestExternalClass_As;
  427. Procedure TestExternalClass_DestructorFail;
  428. Procedure TestExternalClass_New;
  429. Procedure TestExternalClass_ClassOf_New;
  430. Procedure TestExternalClass_FuncClassOf_New;
  431. Procedure TestExternalClass_LocalConstSameName;
  432. Procedure TestExternalClass_ReintroduceOverload;
  433. Procedure TestExternalClass_Inherited;
  434. Procedure TestExternalClass_PascalAncestorFail;
  435. Procedure TestExternalClass_NewInstance;
  436. Procedure TestExternalClass_NewInstance_NonVirtualFail;
  437. Procedure TestExternalClass_NewInstance_FirstParamNotString_Fail;
  438. Procedure TestExternalClass_NewInstance_SecondParamTyped_Fail;
  439. Procedure TestExternalClass_PascalProperty;
  440. Procedure TestExternalClass_TypeCastToRootClass;
  441. Procedure TestExternalClass_TypeCastToJSObject;
  442. Procedure TestExternalClass_TypeCastStringToExternalString;
  443. Procedure TestExternalClass_CallClassFunctionOfInstanceFail;
  444. Procedure TestExternalClass_BracketAccessor;
  445. Procedure TestExternalClass_BracketAccessor_2ParamsFail;
  446. Procedure TestExternalClass_BracketAccessor_ReadOnly;
  447. Procedure TestExternalClass_BracketAccessor_WriteOnly;
  448. Procedure TestExternalClass_BracketAccessor_MultiType;
  449. Procedure TestExternalClass_BracketAccessor_Index;
  450. Procedure TestExternalClass_ForInJSObject;
  451. // class interfaces
  452. Procedure TestClassInterface_Corba;
  453. Procedure TestClassInterface_ProcExternalFail;
  454. Procedure TestClassInterface_Overloads;
  455. Procedure TestClassInterface_DuplicateGUIInIntfListFail;
  456. Procedure TestClassInterface_DuplicateGUIInAncestorFail;
  457. Procedure TestClassInterface_AncestorImpl;
  458. Procedure TestClassInterface_ImplReintroduce;
  459. Procedure TestClassInterface_MethodResolution;
  460. Procedure TestClassInterface_AncestorMoreInterfaces;
  461. Procedure TestClassInterface_Corba_Delegation;
  462. Procedure TestClassInterface_Corba_DelegationStatic;
  463. Procedure TestClassInterface_Corba_Operators;
  464. Procedure TestClassInterface_Corba_Args;
  465. Procedure TestClassInterface_Corba_ForIn;
  466. Procedure TestClassInterface_COM_AssignVar;
  467. Procedure TestClassInterface_COM_AssignArg;
  468. Procedure TestClassInterface_COM_FunctionResult;
  469. Procedure TestClassInterface_COM_InheritedFuncResult;
  470. Procedure TestClassInterface_COM_IsAsTypeCasts;
  471. Procedure TestClassInterface_COM_PassAsArg;
  472. Procedure TestClassInterface_COM_PassToUntypedParam;
  473. Procedure TestClassInterface_COM_FunctionInExpr;
  474. Procedure TestClassInterface_COM_Property;
  475. Procedure TestClassInterface_COM_IntfProperty;
  476. Procedure TestClassInterface_COM_Delegation;
  477. Procedure TestClassInterface_COM_With;
  478. Procedure TestClassInterface_COM_ForIn;
  479. Procedure TestClassInterface_COM_ArrayOfIntfFail;
  480. Procedure TestClassInterface_COM_RecordIntfFail;
  481. Procedure TestClassInterface_COM_UnitInitialization;
  482. Procedure TestClassInterface_GUID;
  483. Procedure TestClassInterface_GUIDProperty;
  484. // proc types
  485. Procedure TestProcType;
  486. Procedure TestProcType_Arg;
  487. Procedure TestProcType_FunctionFPC;
  488. Procedure TestProcType_FunctionDelphi;
  489. Procedure TestProcType_ProcedureDelphi;
  490. Procedure TestProcType_AsParam;
  491. Procedure TestProcType_MethodFPC;
  492. Procedure TestProcType_MethodDelphi;
  493. Procedure TestProcType_PropertyFPC;
  494. Procedure TestProcType_PropertyDelphi;
  495. Procedure TestProcType_WithClassInstDoPropertyFPC;
  496. Procedure TestProcType_Nested;
  497. Procedure TestProcType_NestedOfObject;
  498. Procedure TestProcType_ReferenceToProc;
  499. Procedure TestProcType_ReferenceToMethod;
  500. Procedure TestProcType_Typecast;
  501. Procedure TestProcType_PassProcToUntyped;
  502. Procedure TestProcType_PassProcToArray;
  503. // pointer
  504. Procedure TestPointer;
  505. Procedure TestPointer_Proc;
  506. Procedure TestPointer_AssignRecordFail;
  507. Procedure TestPointer_AssignStaticArrayFail;
  508. Procedure TestPointer_TypeCastJSValueToPointer;
  509. Procedure TestPointer_NonRecordFail;
  510. Procedure TestPointer_AnonymousArgTypeFail;
  511. Procedure TestPointer_AnonymousVarTypeFail;
  512. Procedure TestPointer_AnonymousResultTypeFail;
  513. Procedure TestPointer_AddrOperatorFail;
  514. Procedure TestPointer_ArrayParamsFail;
  515. Procedure TestPointer_PointerAddFail;
  516. Procedure TestPointer_IncPointerFail;
  517. Procedure TestPointer_Record;
  518. Procedure TestPointer_RecordArg;
  519. // jsvalue
  520. Procedure TestJSValue_AssignToJSValue;
  521. Procedure TestJSValue_TypeCastToBaseType;
  522. Procedure TestJSValue_Equal;
  523. Procedure TestJSValue_If;
  524. Procedure TestJSValue_Not;
  525. Procedure TestJSValue_Enum;
  526. Procedure TestJSValue_ClassInstance;
  527. Procedure TestJSValue_ClassOf;
  528. Procedure TestJSValue_ArrayOfJSValue;
  529. Procedure TestJSValue_Params;
  530. Procedure TestJSValue_UntypedParam;
  531. Procedure TestJSValue_FuncResultType;
  532. Procedure TestJSValue_ProcType_Assign;
  533. Procedure TestJSValue_ProcType_Equal;
  534. Procedure TestJSValue_ProcType_Param;
  535. Procedure TestJSValue_AssignToPointerFail;
  536. Procedure TestJSValue_OverloadDouble;
  537. Procedure TestJSValue_OverloadNativeInt;
  538. Procedure TestJSValue_OverloadWord;
  539. Procedure TestJSValue_OverloadString;
  540. Procedure TestJSValue_OverloadChar;
  541. Procedure TestJSValue_OverloadPointer;
  542. Procedure TestJSValue_ForIn;
  543. // RTTI
  544. Procedure TestRTTI_ProcType;
  545. Procedure TestRTTI_ProcType_ArgFromOtherUnit;
  546. Procedure TestRTTI_EnumAndSetType;
  547. Procedure TestRTTI_EnumRange;
  548. Procedure TestRTTI_AnonymousEnumType;
  549. Procedure TestRTTI_StaticArray;
  550. Procedure TestRTTI_DynArray;
  551. Procedure TestRTTI_ArrayNestedAnonymous;
  552. // ToDo: Procedure TestRTTI_Pointer;
  553. Procedure TestRTTI_PublishedMethodOverloadFail;
  554. Procedure TestRTTI_PublishedMethodExternalFail;
  555. Procedure TestRTTI_PublishedClassPropertyFail;
  556. Procedure TestRTTI_PublishedClassFieldFail;
  557. Procedure TestRTTI_PublishedFieldExternalFail;
  558. Procedure TestRTTI_IndexModifier;
  559. Procedure TestRTTI_StoredModifier;
  560. Procedure TestRTTI_DefaultValue;
  561. Procedure TestRTTI_DefaultValueSet;
  562. Procedure TestRTTI_DefaultValueRangeType;
  563. Procedure TestRTTI_Class_Field;
  564. Procedure TestRTTI_Class_Method;
  565. Procedure TestRTTI_Class_MethodArgFlags;
  566. Procedure TestRTTI_Class_Property;
  567. Procedure TestRTTI_Class_PropertyParams;
  568. Procedure TestRTTI_OverrideMethod;
  569. Procedure TestRTTI_OverloadProperty;
  570. // ToDo: array argument
  571. Procedure TestRTTI_ClassForward;
  572. Procedure TestRTTI_ClassOf;
  573. Procedure TestRTTI_Record;
  574. Procedure TestRTTI_RecordAnonymousArray;
  575. Procedure TestRTTI_LocalTypes;
  576. Procedure TestRTTI_TypeInfo_BaseTypes;
  577. Procedure TestRTTI_TypeInfo_LocalFail;
  578. Procedure TestRTTI_TypeInfo_ExtTypeInfoClasses1;
  579. Procedure TestRTTI_TypeInfo_ExtTypeInfoClasses2;
  580. Procedure TestRTTI_TypeInfo_ExtTypeInfoClasses3;
  581. Procedure TestRTTI_TypeInfo_FunctionClassType;
  582. Procedure TestRTTI_Interface_Corba;
  583. Procedure TestRTTI_Interface_COM;
  584. // Resourcestring
  585. Procedure TestResourcestringProgram;
  586. Procedure TestResourcestringUnit;
  587. Procedure TestResourcestringImplementation;
  588. // ToDo: in unit interface and implementation
  589. // Attributes
  590. Procedure TestAtributes_Ignore;
  591. // Assertions, checks
  592. procedure TestAssert;
  593. procedure TestAssert_SysUtils;
  594. procedure TestObjectChecks;
  595. procedure TestRangeChecks_AssignInt;
  596. procedure TestRangeChecks_AssignIntRange;
  597. procedure TestRangeChecks_AssignEnum;
  598. procedure TestRangeChecks_AssignEnumRange;
  599. procedure TestRangeChecks_AssignChar;
  600. procedure TestRangeChecks_AssignCharRange;
  601. procedure TestRangeChecks_ArrayIndex;
  602. end;
  603. function LinesToStr(Args: array of const): string;
  604. function ExtractFileUnitName(aFilename: string): string;
  605. function JSToStr(El: TJSElement): string;
  606. function CheckSrcDiff(Expected, Actual: string; out Msg: string): boolean;
  607. implementation
  608. function LinesToStr(Args: array of const): string;
  609. var
  610. s: String;
  611. i: Integer;
  612. begin
  613. s:='';
  614. for i:=Low(Args) to High(Args) do
  615. case Args[i].VType of
  616. vtChar: s += Args[i].VChar+LineEnding;
  617. vtString: s += Args[i].VString^+LineEnding;
  618. vtPChar: s += Args[i].VPChar+LineEnding;
  619. vtWideChar: s += AnsiString(Args[i].VWideChar)+LineEnding;
  620. vtPWideChar: s += AnsiString(Args[i].VPWideChar)+LineEnding;
  621. vtAnsiString: s += AnsiString(Args[i].VAnsiString)+LineEnding;
  622. vtWidestring: s += AnsiString(WideString(Args[i].VWideString))+LineEnding;
  623. vtUnicodeString:s += AnsiString(UnicodeString(Args[i].VUnicodeString))+LineEnding;
  624. end;
  625. Result:=s;
  626. end;
  627. function ExtractFileUnitName(aFilename: string): string;
  628. var
  629. p: Integer;
  630. begin
  631. Result:=ExtractFileName(aFilename);
  632. if Result='' then exit;
  633. for p:=length(Result) downto 1 do
  634. case Result[p] of
  635. '/','\': exit;
  636. '.':
  637. begin
  638. Delete(Result,p,length(Result));
  639. exit;
  640. end;
  641. end;
  642. end;
  643. function JSToStr(El: TJSElement): string;
  644. var
  645. aWriter: TBufferWriter;
  646. aJSWriter: TJSWriter;
  647. begin
  648. aJSWriter:=nil;
  649. aWriter:=TBufferWriter.Create(1000);
  650. try
  651. aJSWriter:=TJSWriter.Create(aWriter);
  652. aJSWriter.IndentSize:=2;
  653. aJSWriter.WriteJS(El);
  654. Result:=aWriter.AsAnsistring;
  655. finally
  656. aJSWriter.Free;
  657. aWriter.Free;
  658. end;
  659. end;
  660. function CheckSrcDiff(Expected, Actual: string; out Msg: string): boolean;
  661. // search diff, ignore changes in spaces
  662. const
  663. SpaceChars = [#9,#10,#13,' '];
  664. var
  665. ExpectedP, ActualP: PChar;
  666. function FindLineEnd(p: PChar): PChar;
  667. begin
  668. Result:=p;
  669. while not (Result^ in [#0,#10,#13]) do inc(Result);
  670. end;
  671. function FindLineStart(p, MinP: PChar): PChar;
  672. begin
  673. while (p>MinP) and not (p[-1] in [#10,#13]) do dec(p);
  674. Result:=p;
  675. end;
  676. procedure SkipLineEnd(var p: PChar);
  677. begin
  678. if p^ in [#10,#13] then
  679. begin
  680. if (p[1] in [#10,#13]) and (p^<>p[1]) then
  681. inc(p,2)
  682. else
  683. inc(p);
  684. end;
  685. end;
  686. procedure DiffFound;
  687. var
  688. ActLineStartP, ActLineEndP, p, StartPos: PChar;
  689. ExpLine, ActLine: String;
  690. i, LineNo, DiffLineNo: Integer;
  691. begin
  692. writeln('Diff found "',Msg,'". Lines:');
  693. // write correct lines
  694. p:=PChar(Expected);
  695. LineNo:=0;
  696. DiffLineNo:=0;
  697. repeat
  698. StartPos:=p;
  699. while not (p^ in [#0,#10,#13]) do inc(p);
  700. ExpLine:=copy(Expected,StartPos-PChar(Expected)+1,p-StartPos);
  701. SkipLineEnd(p);
  702. inc(LineNo);
  703. if (p<=ExpectedP) and (p^<>#0) then
  704. begin
  705. writeln('= ',ExpLine);
  706. end else begin
  707. // diff line
  708. if DiffLineNo=0 then DiffLineNo:=LineNo;
  709. // write actual line
  710. ActLineStartP:=FindLineStart(ActualP,PChar(Actual));
  711. ActLineEndP:=FindLineEnd(ActualP);
  712. ActLine:=copy(Actual,ActLineStartP-PChar(Actual)+1,ActLineEndP-ActLineStartP);
  713. writeln('- ',ActLine);
  714. // write expected line
  715. writeln('+ ',ExpLine);
  716. // write empty line with pointer ^
  717. for i:=1 to 2+ExpectedP-StartPos do write(' ');
  718. writeln('^');
  719. Msg:='expected "'+ExpLine+'", but got "'+ActLine+'".';
  720. CheckSrcDiff:=false;
  721. // write up to three following actual lines to get some context
  722. for i:=1 to 3 do begin
  723. ActLineStartP:=ActLineEndP;
  724. SkipLineEnd(ActLineStartP);
  725. if ActLineStartP^=#0 then break;
  726. ActLineEndP:=FindLineEnd(ActLineStartP);
  727. ActLine:=copy(Actual,ActLineStartP-PChar(Actual)+1,ActLineEndP-ActLineStartP);
  728. writeln('~ ',ActLine);
  729. end;
  730. exit;
  731. end;
  732. until p^=#0;
  733. writeln('DiffFound Actual:-----------------------');
  734. writeln(Actual);
  735. writeln('DiffFound Expected:---------------------');
  736. writeln(Expected);
  737. writeln('DiffFound ------------------------------');
  738. Msg:='diff found, but lines are the same, internal error';
  739. CheckSrcDiff:=false;
  740. end;
  741. var
  742. IsSpaceNeeded: Boolean;
  743. LastChar, Quote: Char;
  744. begin
  745. Result:=true;
  746. Msg:='';
  747. if Expected='' then Expected:=' ';
  748. if Actual='' then Actual:=' ';
  749. ExpectedP:=PChar(Expected);
  750. ActualP:=PChar(Actual);
  751. repeat
  752. //writeln('TTestModule.CheckDiff Exp="',ExpectedP^,'" Act="',ActualP^,'"');
  753. case ExpectedP^ of
  754. #0:
  755. begin
  756. // check that rest of Actual has only spaces
  757. while ActualP^ in SpaceChars do inc(ActualP);
  758. if ActualP^<>#0 then
  759. begin
  760. DiffFound;
  761. exit;
  762. end;
  763. exit(true);
  764. end;
  765. ' ',#9,#10,#13:
  766. begin
  767. // skip space in Expected
  768. IsSpaceNeeded:=false;
  769. if ExpectedP>PChar(Expected) then
  770. LastChar:=ExpectedP[-1]
  771. else
  772. LastChar:=#0;
  773. while ExpectedP^ in SpaceChars do inc(ExpectedP);
  774. if (LastChar in ['a'..'z','A'..'Z','0'..'9','_','$'])
  775. and (ExpectedP^ in ['a'..'z','A'..'Z','0'..'9','_','$']) then
  776. IsSpaceNeeded:=true;
  777. if IsSpaceNeeded and (not (ActualP^ in SpaceChars)) then
  778. begin
  779. DiffFound;
  780. exit;
  781. end;
  782. while ActualP^ in SpaceChars do inc(ActualP);
  783. end;
  784. '''','"':
  785. begin
  786. while ActualP^ in SpaceChars do inc(ActualP);
  787. if ExpectedP^<>ActualP^ then
  788. begin
  789. DiffFound;
  790. exit;
  791. end;
  792. Quote:=ExpectedP^;
  793. repeat
  794. inc(ExpectedP);
  795. inc(ActualP);
  796. if ExpectedP^<>ActualP^ then
  797. begin
  798. DiffFound;
  799. exit;
  800. end;
  801. if (ExpectedP^ in [#0,#10,#13]) then
  802. break
  803. else if (ExpectedP^=Quote) then
  804. begin
  805. inc(ExpectedP);
  806. inc(ActualP);
  807. break;
  808. end;
  809. until false;
  810. end;
  811. else
  812. while ActualP^ in SpaceChars do inc(ActualP);
  813. if ExpectedP^<>ActualP^ then
  814. begin
  815. DiffFound;
  816. exit;
  817. end;
  818. inc(ExpectedP);
  819. inc(ActualP);
  820. end;
  821. until false;
  822. end;
  823. { TTestEnginePasResolver }
  824. procedure TTestEnginePasResolver.SetModule(AValue: TPasModule);
  825. begin
  826. if FModule=AValue then Exit;
  827. if Module<>nil then
  828. Module.Release;
  829. FModule:=AValue;
  830. if Module<>nil then
  831. Module.AddRef;
  832. end;
  833. destructor TTestEnginePasResolver.Destroy;
  834. begin
  835. FreeAndNil(FStreamResolver);
  836. Module:=nil;
  837. FreeAndNil(FParser);
  838. FreeAndNil(FScanner);
  839. FreeAndNil(FStreamResolver);
  840. inherited Destroy;
  841. end;
  842. function TTestEnginePasResolver.FindUnit(const AName, InFilename: String;
  843. NameExpr, InFileExpr: TPasExpr): TPasModule;
  844. begin
  845. Result:=nil;
  846. if InFilename<>'' then
  847. RaiseNotYetImplemented(20180224101926,InFileExpr,'Use testcase tcunitsearch instead');
  848. if Assigned(OnFindUnit) then
  849. Result:=OnFindUnit(AName);
  850. if NameExpr=nil then ;
  851. end;
  852. procedure TTestEnginePasResolver.UsedInterfacesFinished(Section: TPasSection);
  853. begin
  854. // do not parse recursively
  855. // parse via the queue
  856. if Section=nil then ;
  857. end;
  858. { TCustomTestModule }
  859. function TCustomTestModule.GetResolverCount: integer;
  860. begin
  861. Result:=FModules.Count;
  862. end;
  863. function TCustomTestModule.GetResolvers(Index: integer
  864. ): TTestEnginePasResolver;
  865. begin
  866. Result:=TTestEnginePasResolver(FModules[Index]);
  867. end;
  868. function TCustomTestModule.OnPasResolverFindUnit(const aUnitName: String
  869. ): TPasModule;
  870. var
  871. DefNamespace: String;
  872. begin
  873. //writeln('TTestModule.OnPasResolverFindUnit START Unit="',aUnitName,'"');
  874. if (Pos('.',aUnitName)<1) then
  875. begin
  876. DefNamespace:=GetDefaultNamespace;
  877. if DefNamespace<>'' then
  878. begin
  879. Result:=LoadUnit(DefNamespace+'.'+aUnitName);
  880. if Result<>nil then exit;
  881. end;
  882. end;
  883. Result:=LoadUnit(aUnitName);
  884. if Result<>nil then exit;
  885. writeln('TTestModule.OnPasResolverFindUnit missing unit "',aUnitName,'"');
  886. Fail('can''t find unit "'+aUnitName+'"');
  887. end;
  888. function TCustomTestModule.LoadUnit(const aUnitName: String): TPasModule;
  889. var
  890. i: Integer;
  891. CurEngine: TTestEnginePasResolver;
  892. CurUnitName: String;
  893. begin
  894. //writeln('TTestModule.FindUnit START Unit="',aUnitName,'"');
  895. Result:=nil;
  896. if (Module.ClassType=TPasModule)
  897. and (CompareText(Module.Name,aUnitName)=0) then
  898. exit(Module);
  899. for i:=0 to ResolverCount-1 do
  900. begin
  901. CurEngine:=Resolvers[i];
  902. CurUnitName:=ExtractFileUnitName(CurEngine.Filename);
  903. //writeln('TTestModule.FindUnit Checking ',i,'/',ResolverCount,' ',CurEngine.Filename,' ',CurUnitName);
  904. if CompareText(aUnitName,CurUnitName)=0 then
  905. begin
  906. Result:=CurEngine.Module;
  907. if Result<>nil then exit;
  908. //writeln('TTestModule.FindUnit PARSING unit "',CurEngine.Filename,'"');
  909. FileResolver.FindSourceFile(aUnitName);
  910. CurEngine.StreamResolver:=TStreamResolver.Create;
  911. CurEngine.StreamResolver.OwnsStreams:=True;
  912. //writeln('TTestModule.FindUnit SOURCE=',CurEngine.Source);
  913. CurEngine.StreamResolver.AddStream(CurEngine.FileName,TStringStream.Create(CurEngine.Source));
  914. CurEngine.Scanner:=TPascalScanner.Create(CurEngine.StreamResolver);
  915. InitScanner(CurEngine.Scanner);
  916. CurEngine.Parser:=TTestPasParser.Create(CurEngine.Scanner,CurEngine.StreamResolver,CurEngine);
  917. CurEngine.Parser.Options:=po_tcmodules;
  918. if CompareText(CurUnitName,'System')=0 then
  919. CurEngine.Parser.ImplicitUses.Clear;
  920. CurEngine.Scanner.OpenFile(CurEngine.Filename);
  921. try
  922. CurEngine.Parser.NextToken;
  923. CurEngine.Parser.ParseUnit(CurEngine.FModule);
  924. except
  925. on E: Exception do
  926. HandleException(E);
  927. end;
  928. //writeln('TTestModule.FindUnit END ',CurUnitName);
  929. Result:=CurEngine.Module;
  930. exit;
  931. end;
  932. end;
  933. end;
  934. procedure TCustomTestModule.SetUp;
  935. begin
  936. inherited SetUp;
  937. FSkipTests:=false;
  938. FSource:=TStringList.Create;
  939. FModules:=TObjectList.Create(true);
  940. FFilename:='test1.pp';
  941. FFileResolver:=TStreamResolver.Create;
  942. FFileResolver.OwnsStreams:=True;
  943. FScanner:=TPascalScanner.Create(FFileResolver);
  944. InitScanner(FScanner);
  945. FEngine:=AddModule(Filename);
  946. FEngine.Scanner:=FScanner;
  947. FParser:=TTestPasParser.Create(FScanner,FFileResolver,FEngine);
  948. FEngine.Parser:=FParser;
  949. Parser.Options:=po_tcmodules;
  950. FModule:=Nil;
  951. FConverter:=CreateConverter;
  952. FExpectedErrorClass:=nil;
  953. end;
  954. function TCustomTestModule.CreateConverter: TPasToJSConverter;
  955. begin
  956. Result:=TPasToJSConverter.Create;
  957. Result.Options:=co_tcmodules;
  958. end;
  959. procedure TCustomTestModule.InitScanner(aScanner: TPascalScanner);
  960. begin
  961. aScanner.AllowedModeSwitches:=msAllPas2jsModeSwitches;
  962. aScanner.ReadOnlyModeSwitches:=msAllPas2jsModeSwitchesReadOnly;
  963. aScanner.CurrentModeSwitches:=OBJFPCModeSwitches*msAllPas2jsModeSwitches+msAllPas2jsModeSwitchesReadOnly;
  964. aScanner.AllowedBoolSwitches:=msAllPas2jsBoolSwitches;
  965. aScanner.CurrentBoolSwitches:=[bsHints,bsNotes,bsWarnings];
  966. end;
  967. procedure TCustomTestModule.TearDown;
  968. begin
  969. FSkipTests:=false;
  970. FJSModule:=nil;
  971. FJSRegModuleCall:=nil;
  972. FJSModuleCallArgs:=nil;
  973. FJSImplentationUses:=nil;
  974. FJSInterfaceUses:=nil;
  975. FJSModuleSrc:=nil;
  976. FJSInitBody:=nil;
  977. FreeAndNil(FJSSource);
  978. FreeAndNil(FJSModule);
  979. FreeAndNil(FConverter);
  980. Engine.Clear;
  981. if Assigned(FModule) then
  982. begin
  983. FModule.Release;
  984. FModule:=nil;
  985. end;
  986. FreeAndNil(FSource);
  987. FreeAndNil(FFileResolver);
  988. if FModules<>nil then
  989. begin
  990. FreeAndNil(FModules);
  991. FEngine:=nil;
  992. end;
  993. inherited TearDown;
  994. end;
  995. procedure TCustomTestModule.Add(Line: string);
  996. begin
  997. Source.Add(Line);
  998. end;
  999. procedure TCustomTestModule.Add(const Lines: array of string);
  1000. var
  1001. i: Integer;
  1002. begin
  1003. for i:=low(Lines) to high(Lines) do
  1004. Add(Lines[i]);
  1005. end;
  1006. procedure TCustomTestModule.StartParsing;
  1007. var
  1008. Src: String;
  1009. begin
  1010. Src:=Source.Text;
  1011. FEngine.Source:=Src;
  1012. FileResolver.AddStream(FileName,TStringStream.Create(Src));
  1013. Scanner.OpenFile(FileName);
  1014. Writeln('// Test : ',Self.TestName);
  1015. Writeln(Src);
  1016. end;
  1017. procedure TCustomTestModule.ParseModuleQueue;
  1018. var
  1019. i: Integer;
  1020. CurResolver: TTestEnginePasResolver;
  1021. Found: Boolean;
  1022. Section: TPasSection;
  1023. begin
  1024. // parse til exception or all modules finished
  1025. while not SkipTests do
  1026. begin
  1027. Found:=false;
  1028. for i:=0 to ResolverCount-1 do
  1029. begin
  1030. CurResolver:=Resolvers[i];
  1031. if CurResolver.CurrentParser=nil then continue;
  1032. if not CurResolver.CurrentParser.CanParseContinue(Section) then
  1033. continue;
  1034. CurResolver.Parser.ParseContinue;
  1035. Found:=true;
  1036. break;
  1037. end;
  1038. if not Found then break;
  1039. end;
  1040. for i:=0 to ResolverCount-1 do
  1041. begin
  1042. CurResolver:=Resolvers[i];
  1043. if CurResolver.Parser=nil then
  1044. begin
  1045. if CurResolver.CurrentParser<>nil then
  1046. Fail('TCustomTestModule.ParseModuleQueue '+CurResolver.Filename+' '+GetObjName(CurResolver.Parser)+'=Parser<>CurrentParser='+GetObjName(CurResolver.CurrentParser));
  1047. continue;
  1048. end;
  1049. if CurResolver.Parser.CurModule<>nil then
  1050. Fail('TCustomTestModule.ParseModuleQueue '+CurResolver.Filename+' NOT FINISHED CurModule='+GetObjName(CurResolver.Parser.CurModule));
  1051. end;
  1052. end;
  1053. procedure TCustomTestModule.ParseModule;
  1054. begin
  1055. if SkipTests then exit;
  1056. FFirstPasStatement:=nil;
  1057. try
  1058. StartParsing;
  1059. Parser.ParseMain(FModule);
  1060. ParseModuleQueue;
  1061. except
  1062. on E: Exception do
  1063. HandleException(E);
  1064. end;
  1065. if SkipTests then exit;
  1066. AssertNotNull('Module resulted in Module',FModule);
  1067. AssertEquals('modulename',lowercase(ChangeFileExt(FFileName,'')),lowercase(Module.Name));
  1068. TAssert.AssertSame('Has resolver',Engine,Parser.Engine);
  1069. end;
  1070. procedure TCustomTestModule.ParseProgram;
  1071. begin
  1072. if SkipTests then exit;
  1073. ParseModule;
  1074. if SkipTests then exit;
  1075. AssertEquals('Has program',TPasProgram,Module.ClassType);
  1076. FPasProgram:=TPasProgram(Module);
  1077. AssertNotNull('Has program section',PasProgram.ProgramSection);
  1078. AssertNotNull('Has initialization section',PasProgram.InitializationSection);
  1079. if (PasProgram.InitializationSection.Elements.Count>0) then
  1080. if TObject(PasProgram.InitializationSection.Elements[0]) is TPasImplBlock then
  1081. FFirstPasStatement:=TPasImplBlock(PasProgram.InitializationSection.Elements[0]);
  1082. end;
  1083. procedure TCustomTestModule.ParseUnit;
  1084. begin
  1085. if SkipTests then exit;
  1086. ParseModule;
  1087. if SkipTests then exit;
  1088. AssertEquals('Has unit (TPasModule)',TPasModule,Module.ClassType);
  1089. AssertNotNull('Has interface section',Module.InterfaceSection);
  1090. AssertNotNull('Has implementation section',Module.ImplementationSection);
  1091. if (Module.InitializationSection<>nil)
  1092. and (Module.InitializationSection.Elements.Count>0)
  1093. and (TObject(Module.InitializationSection.Elements[0]) is TPasImplBlock) then
  1094. FFirstPasStatement:=TPasImplBlock(Module.InitializationSection.Elements[0]);
  1095. end;
  1096. function TCustomTestModule.FindModuleWithFilename(aFilename: string
  1097. ): TTestEnginePasResolver;
  1098. var
  1099. i: Integer;
  1100. begin
  1101. for i:=0 to ResolverCount-1 do
  1102. if CompareText(Resolvers[i].Filename,aFilename)=0 then
  1103. exit(Resolvers[i]);
  1104. Result:=nil;
  1105. end;
  1106. function TCustomTestModule.AddModule(aFilename: string
  1107. ): TTestEnginePasResolver;
  1108. begin
  1109. //writeln('TTestModuleConverter.AddModule ',aFilename);
  1110. if FindModuleWithFilename(aFilename)<>nil then
  1111. Fail('TTestModuleConverter.AddModule: file "'+aFilename+'" already exists');
  1112. Result:=TTestEnginePasResolver.Create;
  1113. Result.Filename:=aFilename;
  1114. Result.AddObjFPCBuiltInIdentifiers(btAllJSBaseTypes,bfAllJSBaseProcs);
  1115. Result.OnFindUnit:=@OnPasResolverFindUnit;
  1116. FModules.Add(Result);
  1117. end;
  1118. function TCustomTestModule.AddModuleWithSrc(aFilename, Src: string
  1119. ): TTestEnginePasResolver;
  1120. begin
  1121. Result:=AddModule(aFilename);
  1122. Result.Source:=Src;
  1123. end;
  1124. function TCustomTestModule.AddModuleWithIntfImplSrc(aFilename, InterfaceSrc,
  1125. ImplementationSrc: string): TTestEnginePasResolver;
  1126. var
  1127. Src: String;
  1128. begin
  1129. Src:='unit '+ExtractFileUnitName(aFilename)+';'+LineEnding;
  1130. Src+=LineEnding;
  1131. Src+='interface'+LineEnding;
  1132. Src+=LineEnding;
  1133. Src+=InterfaceSrc;
  1134. Src+='implementation'+LineEnding;
  1135. Src+=LineEnding;
  1136. Src+=ImplementationSrc;
  1137. Src+='end.'+LineEnding;
  1138. Result:=AddModuleWithSrc(aFilename,Src);
  1139. end;
  1140. procedure TCustomTestModule.AddSystemUnit;
  1141. begin
  1142. AddModuleWithIntfImplSrc('system.pp',
  1143. // interface
  1144. LinesToStr([
  1145. 'type',
  1146. ' integer=longint;',
  1147. 'var',
  1148. ' ExitCode: Longint;',
  1149. ''
  1150. // implementation
  1151. ]),LinesToStr([
  1152. ''
  1153. ]));
  1154. end;
  1155. procedure TCustomTestModule.StartProgram(NeedSystemUnit: boolean);
  1156. begin
  1157. if NeedSystemUnit then
  1158. AddSystemUnit
  1159. else
  1160. Parser.ImplicitUses.Clear;
  1161. Add('program '+ExtractFileUnitName(Filename)+';');
  1162. Add('');
  1163. end;
  1164. procedure TCustomTestModule.StartUnit(NeedSystemUnit: boolean);
  1165. begin
  1166. if NeedSystemUnit then
  1167. AddSystemUnit
  1168. else
  1169. Parser.ImplicitUses.Clear;
  1170. Add('unit Test1;');
  1171. Add('');
  1172. end;
  1173. procedure TCustomTestModule.ConvertModule;
  1174. procedure CheckUsesList(UsesName: String; Arg: TJSArrayLiteralElement;
  1175. out UsesLit: TJSArrayLiteral);
  1176. var
  1177. i: Integer;
  1178. Item: TJSElement;
  1179. Lit: TJSLiteral;
  1180. begin
  1181. UsesLit:=nil;
  1182. AssertNotNull(UsesName+' uses section',Arg.Expr);
  1183. if (Arg.Expr.ClassType=TJSLiteral) and TJSLiteral(Arg.Expr).Value.IsNull then
  1184. exit; // null is ok
  1185. AssertEquals(UsesName+' uses section param is array',TJSArrayLiteral,Arg.Expr.ClassType);
  1186. FJSInterfaceUses:=TJSArrayLiteral(Arg.Expr);
  1187. for i:=0 to FJSInterfaceUses.Elements.Count-1 do
  1188. begin
  1189. Item:=FJSInterfaceUses.Elements.Elements[i].Expr;
  1190. AssertNotNull(UsesName+' uses section item['+IntToStr(i)+'].Expr',Item);
  1191. AssertEquals(UsesName+' uses section item['+IntToStr(i)+'] is lit',TJSLiteral,Item.ClassType);
  1192. Lit:=TJSLiteral(Item);
  1193. AssertEquals(UsesName+' uses section item['+IntToStr(i)+'] is string lit',
  1194. ord(jsbase.jstString),ord(Lit.Value.ValueType));
  1195. end;
  1196. end;
  1197. procedure CheckFunctionParam(ParamName: string; Arg: TJSArrayLiteralElement;
  1198. out Src: TJSSourceElements);
  1199. var
  1200. FunDecl: TJSFunctionDeclarationStatement;
  1201. FunDef: TJSFuncDef;
  1202. FunBody: TJSFunctionBody;
  1203. begin
  1204. Src:=nil;
  1205. AssertNotNull(ParamName,Arg.Expr);
  1206. AssertEquals(ParamName+' Arg.Expr type',TJSFunctionDeclarationStatement,Arg.Expr.ClassType);
  1207. FunDecl:=Arg.Expr as TJSFunctionDeclarationStatement;
  1208. AssertNotNull(ParamName+' FunDecl.AFunction',FunDecl.AFunction);
  1209. AssertEquals(ParamName+' FunDecl.AFunction type',TJSFuncDef,FunDecl.AFunction.ClassType);
  1210. FunDef:=FunDecl.AFunction as TJSFuncDef;
  1211. AssertEquals(ParamName+' name empty','',String(FunDef.Name));
  1212. AssertNotNull(ParamName+' body',FunDef.Body);
  1213. AssertEquals(ParamName+' body type',TJSFunctionBody,FunDef.Body.ClassType);
  1214. FunBody:=FunDef.Body as TJSFunctionBody;
  1215. AssertNotNull(ParamName+' body.A',FunBody.A);
  1216. AssertEquals(ParamName+' body.A type',TJSSourceElements,FunBody.A.ClassType);
  1217. Src:=FunBody.A as TJSSourceElements;
  1218. end;
  1219. var
  1220. ModuleNameExpr: TJSLiteral;
  1221. InitFunction: TJSFunctionDeclarationStatement;
  1222. InitAssign: TJSSimpleAssignStatement;
  1223. InitName: String;
  1224. LastNode: TJSElement;
  1225. Arg: TJSArrayLiteralElement;
  1226. begin
  1227. if SkipTests then exit;
  1228. try
  1229. FJSModule:=FConverter.ConvertPasElement(Module,Engine) as TJSSourceElements;
  1230. except
  1231. on E: Exception do
  1232. HandleException(E);
  1233. end;
  1234. if SkipTests then exit;
  1235. if ExpectedErrorClass<>nil then
  1236. Fail('Missing '+ExpectedErrorClass.ClassName+' error {'+ExpectedErrorMsg+'} ('+IntToStr(ExpectedErrorNumber)+')');
  1237. FJSSource:=TStringList.Create;
  1238. FJSSource.Text:=ConvertJSModuleToString(JSModule);
  1239. {$IFDEF VerbosePas2JS}
  1240. writeln('TTestModule.ConvertModule JS:');
  1241. write(FJSSource.Text);
  1242. {$ENDIF}
  1243. // rtl.module(...
  1244. AssertEquals('jsmodule has one statement - the call',1,JSModule.Statements.Count);
  1245. AssertNotNull('register module call',JSModule.Statements.Nodes[0].Node);
  1246. AssertEquals('register module call',TJSCallExpression,JSModule.Statements.Nodes[0].Node.ClassType);
  1247. FJSRegModuleCall:=JSModule.Statements.Nodes[0].Node as TJSCallExpression;
  1248. AssertNotNull('register module rtl.module expr',JSRegModuleCall.Expr);
  1249. AssertNotNull('register module rtl.module args',JSRegModuleCall.Args);
  1250. AssertEquals('rtl.module args',TJSArguments,JSRegModuleCall.Args.ClassType);
  1251. FJSModuleCallArgs:=JSRegModuleCall.Args as TJSArguments;
  1252. // parameter 'unitname'
  1253. if JSModuleCallArgs.Elements.Count<1 then
  1254. Fail('rtl.module first param unit missing');
  1255. Arg:=JSModuleCallArgs.Elements.Elements[0];
  1256. AssertNotNull('module name param',Arg.Expr);
  1257. ModuleNameExpr:=Arg.Expr as TJSLiteral;
  1258. AssertEquals('module name param is string',ord(jstString),ord(ModuleNameExpr.Value.ValueType));
  1259. if Module is TPasProgram then
  1260. AssertEquals('module name','program',String(ModuleNameExpr.Value.AsString))
  1261. else
  1262. AssertEquals('module name',Module.Name,String(ModuleNameExpr.Value.AsString));
  1263. // main uses section
  1264. if JSModuleCallArgs.Elements.Count<2 then
  1265. Fail('rtl.module second param main uses missing');
  1266. Arg:=JSModuleCallArgs.Elements.Elements[1];
  1267. CheckUsesList('interface',Arg,FJSInterfaceUses);
  1268. // program/library/interface function()
  1269. if JSModuleCallArgs.Elements.Count<3 then
  1270. Fail('rtl.module third param intf-function missing');
  1271. Arg:=JSModuleCallArgs.Elements.Elements[2];
  1272. CheckFunctionParam('module intf-function',Arg,FJSModuleSrc);
  1273. // search for $mod.$init or $mod.$main - the last statement
  1274. if Module is TPasProgram then
  1275. begin
  1276. InitName:='$main';
  1277. AssertEquals('$mod.'+InitName+' function 1',true,JSModuleSrc.Statements.Count>0);
  1278. end
  1279. else
  1280. InitName:='$init';
  1281. FJSInitBody:=nil;
  1282. if JSModuleSrc.Statements.Count>0 then
  1283. begin
  1284. LastNode:=JSModuleSrc.Statements.Nodes[JSModuleSrc.Statements.Count-1].Node;
  1285. if LastNode is TJSSimpleAssignStatement then
  1286. begin
  1287. InitAssign:=LastNode as TJSSimpleAssignStatement;
  1288. if GetDottedIdentifier(InitAssign.LHS)='$mod.'+InitName then
  1289. begin
  1290. InitFunction:=InitAssign.Expr as TJSFunctionDeclarationStatement;
  1291. FJSInitBody:=InitFunction.AFunction.Body as TJSFunctionBody;
  1292. end
  1293. else if Module is TPasProgram then
  1294. CheckDottedIdentifier('init function',InitAssign.LHS,'$mod.'+InitName);
  1295. end;
  1296. end;
  1297. // optional: implementation uses section
  1298. if JSModuleCallArgs.Elements.Count<4 then
  1299. exit;
  1300. Arg:=JSModuleCallArgs.Elements.Elements[3];
  1301. CheckUsesList('implementation',Arg,FJSImplentationUses);
  1302. // optional: implementation function()
  1303. if JSModuleCallArgs.Elements.Count<5 then
  1304. exit;
  1305. Arg:=JSModuleCallArgs.Elements.Elements[4];
  1306. CheckFunctionParam('module impl-function',Arg,FJSImplementationSrc);
  1307. end;
  1308. procedure TCustomTestModule.ConvertProgram;
  1309. begin
  1310. Add('end.');
  1311. ParseProgram;
  1312. ConvertModule;
  1313. end;
  1314. procedure TCustomTestModule.ConvertUnit;
  1315. begin
  1316. Add('end.');
  1317. ParseUnit;
  1318. ConvertModule;
  1319. end;
  1320. function TCustomTestModule.ConvertJSModuleToString(El: TJSElement): string;
  1321. begin
  1322. Result:=tcmodules.JSToStr(El);
  1323. end;
  1324. procedure TCustomTestModule.CheckDottedIdentifier(Msg: string; El: TJSElement;
  1325. DottedName: string);
  1326. begin
  1327. if DottedName='' then
  1328. begin
  1329. AssertNull(Msg,El);
  1330. end
  1331. else
  1332. begin
  1333. AssertNotNull(Msg,El);
  1334. AssertEquals(Msg,DottedName,GetDottedIdentifier(El));
  1335. end;
  1336. end;
  1337. function TCustomTestModule.GetDottedIdentifier(El: TJSElement): string;
  1338. begin
  1339. if El=nil then
  1340. Result:=''
  1341. else if El is TJSPrimaryExpressionIdent then
  1342. Result:=String(TJSPrimaryExpressionIdent(El).Name)
  1343. else if El is TJSDotMemberExpression then
  1344. Result:=GetDottedIdentifier(TJSDotMemberExpression(El).MExpr)+'.'+String(TJSDotMemberExpression(El).Name)
  1345. else
  1346. AssertEquals('GetDottedIdentifier',TJSPrimaryExpressionIdent,El.ClassType);
  1347. end;
  1348. procedure TCustomTestModule.CheckSource(Msg, Statements: String;
  1349. InitStatements: string; ImplStatements: string);
  1350. var
  1351. ActualSrc, ExpectedSrc, InitName: String;
  1352. begin
  1353. ActualSrc:=JSToStr(JSModuleSrc);
  1354. ExpectedSrc:=
  1355. 'var $mod = this;'+LineEnding
  1356. +Statements;
  1357. if coUseStrict in Converter.Options then
  1358. ExpectedSrc:='"use strict";'+LineEnding+ExpectedSrc;
  1359. if Module is TPasProgram then
  1360. InitName:='$main'
  1361. else
  1362. InitName:='$init';
  1363. if (Module is TPasProgram) or (Trim(InitStatements)<>'') then
  1364. ExpectedSrc:=ExpectedSrc+LineEnding
  1365. +'$mod.'+InitName+' = function () {'+LineEnding
  1366. +InitStatements
  1367. +'};'+LineEnding;
  1368. //writeln('TCustomTestModule.CheckSource ExpectedIntf="',ExpectedSrc,'"');
  1369. //writeln('TTestModule.CheckSource InitStatements="',Trim(InitStatements),'"');
  1370. CheckDiff(Msg,ExpectedSrc,ActualSrc);
  1371. if (JSImplementationSrc<>nil) then
  1372. begin
  1373. ActualSrc:=JSToStr(JSImplementationSrc);
  1374. ExpectedSrc:=
  1375. 'var $mod = this;'+LineEnding
  1376. +'var $impl = $mod.$impl;'+LineEnding
  1377. +ImplStatements;
  1378. end
  1379. else
  1380. begin
  1381. ActualSrc:='';
  1382. ExpectedSrc:=ImplStatements;
  1383. end;
  1384. //writeln('TTestModule.CheckSource InitStatements="',InitStatements,'"');
  1385. //writeln('TCustomTestModule.CheckSource Expected: ',ExpectedSrc);
  1386. CheckDiff(Msg,ExpectedSrc,ActualSrc);
  1387. end;
  1388. procedure TCustomTestModule.CheckDiff(Msg, Expected, Actual: string);
  1389. // search diff, ignore changes in spaces
  1390. var
  1391. s: string;
  1392. begin
  1393. if CheckSrcDiff(Expected,Actual,s) then exit;
  1394. Fail(Msg+': '+s);
  1395. end;
  1396. procedure TCustomTestModule.CheckUnit(Filename, ExpectedSrc: string);
  1397. var
  1398. aResolver: TTestEnginePasResolver;
  1399. aConverter: TPasToJSConverter;
  1400. aJSModule: TJSSourceElements;
  1401. ActualSrc: String;
  1402. begin
  1403. aResolver:=GetResolver(Filename);
  1404. AssertNotNull('missing resolver of unit '+Filename,aResolver);
  1405. {$IFDEF VerbosePas2JS}
  1406. writeln('CheckUnit '+Filename+' converting ...');
  1407. {$ENDIF}
  1408. aConverter:=CreateConverter;
  1409. try
  1410. try
  1411. aJSModule:=aConverter.ConvertPasElement(aResolver.Module,aResolver) as TJSSourceElements;
  1412. except
  1413. on E: Exception do
  1414. HandleException(E);
  1415. end;
  1416. ActualSrc:=ConvertJSModuleToString(aJSModule);
  1417. {$IFDEF VerbosePas2JS}
  1418. writeln('TTestModule.CheckUnit ',Filename,' Pas:');
  1419. write(aResolver.Source);
  1420. writeln('TTestModule.CheckUnit ',Filename,' JS:');
  1421. write(ActualSrc);
  1422. {$ENDIF}
  1423. CheckDiff('Converted unit: "'+ChangeFileExt(Filename,'.js')+'"',ExpectedSrc,ActualSrc);
  1424. finally
  1425. aConverter.Free;
  1426. end;
  1427. end;
  1428. procedure TCustomTestModule.SetExpectedScannerError(Msg: string;
  1429. MsgNumber: integer);
  1430. begin
  1431. ExpectedErrorClass:=EScannerError;
  1432. ExpectedErrorMsg:=Msg;
  1433. ExpectedErrorNumber:=MsgNumber;
  1434. end;
  1435. procedure TCustomTestModule.SetExpectedParserError(Msg: string;
  1436. MsgNumber: integer);
  1437. begin
  1438. ExpectedErrorClass:=EParserError;
  1439. ExpectedErrorMsg:=Msg;
  1440. ExpectedErrorNumber:=MsgNumber;
  1441. end;
  1442. procedure TCustomTestModule.SetExpectedPasResolverError(Msg: string;
  1443. MsgNumber: integer);
  1444. begin
  1445. ExpectedErrorClass:=EPasResolve;
  1446. ExpectedErrorMsg:=Msg;
  1447. ExpectedErrorNumber:=MsgNumber;
  1448. end;
  1449. procedure TCustomTestModule.SetExpectedConverterError(Msg: string;
  1450. MsgNumber: integer);
  1451. begin
  1452. ExpectedErrorClass:=EPas2JS;
  1453. ExpectedErrorMsg:=Msg;
  1454. ExpectedErrorNumber:=MsgNumber;
  1455. end;
  1456. function TCustomTestModule.IsErrorExpected(E: Exception): boolean;
  1457. var
  1458. MsgNumber: Integer;
  1459. Msg: String;
  1460. begin
  1461. Result:=false;
  1462. if (ExpectedErrorClass=nil) or (ExpectedErrorClass<>E.ClassType) then exit;
  1463. Msg:=E.Message;
  1464. if E is EPas2JS then
  1465. MsgNumber:=EPas2JS(E).MsgNumber
  1466. else if E is EPasResolve then
  1467. MsgNumber:=EPasResolve(E).MsgNumber
  1468. else if E is EParserError then
  1469. MsgNumber:=Parser.LastMsgNumber
  1470. else if E is EScannerError then
  1471. begin
  1472. MsgNumber:=Scanner.LastMsgNumber;
  1473. Msg:=Scanner.LastMsg;
  1474. end
  1475. else
  1476. MsgNumber:=0;
  1477. Result:=(MsgNumber=ExpectedErrorNumber) and (Msg=ExpectedErrorMsg);
  1478. if Result then
  1479. SkipTests:=true;
  1480. end;
  1481. procedure TCustomTestModule.HandleScannerError(E: EScannerError);
  1482. begin
  1483. if IsErrorExpected(E) then exit;
  1484. WriteSources(Scanner.CurFilename,Scanner.CurRow,Scanner.CurColumn);
  1485. writeln('ERROR: TCustomTestModule.HandleScannerError '+E.ClassName+':'+E.Message
  1486. +' '+Scanner.CurFilename
  1487. +'('+IntToStr(Scanner.CurRow)+','+IntToStr(Scanner.CurColumn)+')');
  1488. FailException(E);
  1489. end;
  1490. procedure TCustomTestModule.HandleParserError(E: EParserError);
  1491. begin
  1492. if IsErrorExpected(E) then exit;
  1493. WriteSources(E.Filename,E.Row,E.Column);
  1494. writeln('ERROR: TCustomTestModule.HandleParserError '+E.ClassName+':'+E.Message
  1495. +' '+E.Filename+'('+IntToStr(E.Row)+','+IntToStr(E.Column)+')'
  1496. +' MainModuleScannerLine="'+Scanner.CurLine+'"'
  1497. );
  1498. FailException(E);
  1499. end;
  1500. procedure TCustomTestModule.HandlePasResolveError(E: EPasResolve);
  1501. var
  1502. P: TPasSourcePos;
  1503. begin
  1504. if IsErrorExpected(E) then exit;
  1505. P:=E.SourcePos;
  1506. WriteSources(P.FileName,P.Row,P.Column);
  1507. writeln('ERROR: TCustomTestModule.HandlePasResolveError '+E.ClassName+':'+E.Message
  1508. +' '+P.FileName+'('+IntToStr(P.Row)+','+IntToStr(P.Column)+')');
  1509. FailException(E);
  1510. end;
  1511. procedure TCustomTestModule.HandlePas2JSError(E: EPas2JS);
  1512. var
  1513. Row, Col: integer;
  1514. begin
  1515. if IsErrorExpected(E) then exit;
  1516. Engine.UnmangleSourceLineNumber(E.PasElement.SourceLinenumber,Row,Col);
  1517. WriteSources(E.PasElement.SourceFilename,Row,Col);
  1518. writeln('ERROR: TCustomTestModule.HandlePas2JSError '+E.ClassName+':'+E.Message
  1519. +' '+E.PasElement.SourceFilename
  1520. +'('+IntToStr(Row)+','+IntToStr(Col)+')');
  1521. FailException(E);
  1522. end;
  1523. procedure TCustomTestModule.HandleException(E: Exception);
  1524. begin
  1525. if E is EScannerError then
  1526. HandleScannerError(EScannerError(E))
  1527. else if E is EParserError then
  1528. HandleParserError(EParserError(E))
  1529. else if E is EPasResolve then
  1530. HandlePasResolveError(EPasResolve(E))
  1531. else if E is EPas2JS then
  1532. HandlePas2JSError(EPas2JS(E))
  1533. else
  1534. begin
  1535. if IsErrorExpected(E) then exit;
  1536. if not (E is EAssertionFailedError) then
  1537. begin
  1538. WriteSources('',0,0);
  1539. writeln('ERROR: TCustomTestModule.HandleException '+E.ClassName+':'+E.Message);
  1540. end;
  1541. FailException(E);
  1542. end;
  1543. end;
  1544. procedure TCustomTestModule.FailException(E: Exception);
  1545. var
  1546. MsgNumber: Integer;
  1547. begin
  1548. if ExpectedErrorClass<>nil then
  1549. begin
  1550. if FExpectedErrorClass=E.ClassType then
  1551. begin
  1552. if E is EPas2JS then
  1553. MsgNumber:=EPas2JS(E).MsgNumber
  1554. else if E is EPasResolve then
  1555. MsgNumber:=EPasResolve(E).MsgNumber
  1556. else if E is EParserError then
  1557. MsgNumber:=Parser.LastMsgNumber
  1558. else if E is EScannerError then
  1559. MsgNumber:=Scanner.LastMsgNumber
  1560. else
  1561. MsgNumber:=0;
  1562. AssertEquals('Expected error message ('+IntToStr(ExpectedErrorNumber)+')','{'+ExpectedErrorMsg+'}','{'+E.Message+'}');
  1563. AssertEquals('Expected {'+ExpectedErrorMsg+'}, but got msg {'+E.Message+'} number',
  1564. ExpectedErrorNumber,MsgNumber);
  1565. end else begin
  1566. AssertEquals('Wrong exception class',ExpectedErrorClass.ClassName,E.ClassName);
  1567. end;
  1568. end;
  1569. Fail(E.Message);
  1570. end;
  1571. procedure TCustomTestModule.WriteSources(const aFilename: string; aRow,
  1572. aCol: integer);
  1573. var
  1574. IsSrc: Boolean;
  1575. i, j: Integer;
  1576. SrcLines: TStringList;
  1577. Line: string;
  1578. aModule: TTestEnginePasResolver;
  1579. begin
  1580. writeln('TCustomTestModule.WriteSources File="',aFilename,'" Row=',aRow,' Col=',aCol);
  1581. for i:=0 to ResolverCount-1 do
  1582. begin
  1583. aModule:=Resolvers[i];
  1584. SrcLines:=TStringList.Create;
  1585. try
  1586. SrcLines.Text:=aModule.Source;
  1587. IsSrc:=ExtractFilename(aModule.Filename)=ExtractFileName(aFilename);
  1588. writeln('Testcode:-File="',aModule.Filename,'"----------------------------------:');
  1589. for j:=1 to SrcLines.Count do
  1590. begin
  1591. Line:=SrcLines[j-1];
  1592. if IsSrc and (j=aRow) then
  1593. begin
  1594. write('*');
  1595. Line:=LeftStr(Line,aCol-1)+'|'+copy(Line,aCol,length(Line));
  1596. end;
  1597. writeln(Format('%:4d: ',[j]),Line);
  1598. end;
  1599. finally
  1600. SrcLines.Free;
  1601. end;
  1602. end;
  1603. end;
  1604. function TCustomTestModule.IndexOfResolver(const Filename: string): integer;
  1605. var
  1606. i: Integer;
  1607. begin
  1608. for i:=0 to ResolverCount-1 do
  1609. if Filename=Resolvers[i].Filename then exit(i);
  1610. Result:=-1;
  1611. end;
  1612. function TCustomTestModule.GetResolver(const Filename: string
  1613. ): TTestEnginePasResolver;
  1614. var
  1615. i: Integer;
  1616. begin
  1617. i:=IndexOfResolver(Filename);
  1618. if i<0 then exit(nil);
  1619. Result:=Resolvers[i];
  1620. end;
  1621. function TCustomTestModule.GetDefaultNamespace: string;
  1622. var
  1623. C: TClass;
  1624. begin
  1625. Result:='';
  1626. if FModule=nil then exit;
  1627. C:=FModule.ClassType;
  1628. if (C=TPasProgram) or (C=TPasLibrary) or (C=TPasPackage) then
  1629. Result:=Engine.DefaultNameSpace;
  1630. end;
  1631. { TTestModule }
  1632. procedure TTestModule.TestEmptyProgram;
  1633. begin
  1634. StartProgram(false);
  1635. Add('begin');
  1636. ConvertProgram;
  1637. CheckSource('TestEmptyProgram','','');
  1638. end;
  1639. procedure TTestModule.TestEmptyProgramUseStrict;
  1640. begin
  1641. Converter.Options:=Converter.Options+[coUseStrict];
  1642. StartProgram(false);
  1643. Add('begin');
  1644. ConvertProgram;
  1645. CheckSource('TestEmptyProgramUseStrict','','');
  1646. end;
  1647. procedure TTestModule.TestEmptyUnit;
  1648. begin
  1649. StartUnit(false);
  1650. Add('interface');
  1651. Add('implementation');
  1652. ConvertUnit;
  1653. CheckSource('TestEmptyUnit',
  1654. LinesToStr([
  1655. ]),
  1656. '');
  1657. end;
  1658. procedure TTestModule.TestEmptyUnitUseStrict;
  1659. begin
  1660. Converter.Options:=Converter.Options+[coUseStrict];
  1661. StartUnit(false);
  1662. Add('interface');
  1663. Add('implementation');
  1664. ConvertUnit;
  1665. CheckSource('TestEmptyUnitUseStrict',
  1666. LinesToStr([
  1667. ''
  1668. ]),
  1669. '');
  1670. end;
  1671. procedure TTestModule.TestDottedUnitNames;
  1672. begin
  1673. AddModuleWithIntfImplSrc('NS1.Unit2.pas',
  1674. LinesToStr([
  1675. 'var iV: longint;'
  1676. ]),
  1677. '');
  1678. FFilename:='ns1.test1.pp';
  1679. StartProgram(true);
  1680. Add('uses unIt2;');
  1681. Add('implementation');
  1682. Add('var');
  1683. Add(' i: longint;');
  1684. Add('begin');
  1685. Add(' i:=iv;');
  1686. Add(' i:=uNit2.iv;');
  1687. Add(' i:=Ns1.TEst1.i;');
  1688. ConvertProgram;
  1689. CheckSource('TestDottedUnitNames',
  1690. LinesToStr([
  1691. 'this.i = 0;',
  1692. '']),
  1693. LinesToStr([ // this.$init
  1694. '$mod.i = pas["NS1.Unit2"].iV;',
  1695. '$mod.i = pas["NS1.Unit2"].iV;',
  1696. '$mod.i = $mod.i;',
  1697. '']) );
  1698. end;
  1699. procedure TTestModule.TestDottedUnitNameImpl;
  1700. begin
  1701. AddModuleWithIntfImplSrc('TEST.UnitA.pas',
  1702. LinesToStr([
  1703. 'type',
  1704. ' TObject = class end;',
  1705. ' TTestA = class',
  1706. ' end;'
  1707. ]),
  1708. LinesToStr(['uses TEST.UnitB;'])
  1709. );
  1710. AddModuleWithIntfImplSrc('TEST.UnitB.pas',
  1711. LinesToStr([
  1712. 'uses TEST.UnitA;',
  1713. 'type TTestB = class(TTestA);'
  1714. ]),
  1715. ''
  1716. );
  1717. StartProgram(true);
  1718. Add('uses TEST.UnitA;');
  1719. Add('begin');
  1720. ConvertProgram;
  1721. CheckSource('TestDottedUnitNameImpl',
  1722. LinesToStr([
  1723. '']),
  1724. LinesToStr([ // this.$init
  1725. '']) );
  1726. CheckUnit('TEST.UnitA.pas',
  1727. LinesToStr([
  1728. 'rtl.module("TEST.UnitA", ["system"], function () {',
  1729. ' var $mod = this;',
  1730. ' rtl.createClass($mod, "TObject", null, function () {',
  1731. ' this.$init = function () {',
  1732. ' };',
  1733. ' this.$final = function () {',
  1734. ' };',
  1735. ' });',
  1736. ' rtl.createClass($mod, "TTestA", $mod.TObject, function () {',
  1737. ' });',
  1738. '}, ["TEST.UnitB"]);'
  1739. ]));
  1740. CheckUnit('TEST.UnitB.pas',
  1741. LinesToStr([
  1742. 'rtl.module("TEST.UnitB", ["system","TEST.UnitA"], function () {',
  1743. ' var $mod = this;',
  1744. ' rtl.createClass($mod, "TTestB", pas["TEST.UnitA"].TTestA, function () {',
  1745. ' });',
  1746. '});'
  1747. ]));
  1748. end;
  1749. procedure TTestModule.TestDottedUnitExpr;
  1750. begin
  1751. AddModuleWithIntfImplSrc('NS2.SubNs2.Unit2.pas',
  1752. LinesToStr([
  1753. 'procedure DoIt;'
  1754. ]),
  1755. 'procedure DoIt; begin end;');
  1756. FFilename:='Ns1.SubNs1.Test1.pp';
  1757. StartProgram(true);
  1758. Add('uses Ns2.sUbnS2.unIt2;');
  1759. Add('implementation');
  1760. Add('var');
  1761. Add(' i: longint;');
  1762. Add('begin');
  1763. Add(' ns2.subns2.unit2.doit;');
  1764. Add(' i:=Ns1.SubNS1.TEst1.i;');
  1765. ConvertProgram;
  1766. CheckSource('TestDottedUnitExpr',
  1767. LinesToStr([
  1768. 'this.i = 0;',
  1769. '']),
  1770. LinesToStr([ // this.$init
  1771. 'pas["NS2.SubNs2.Unit2"].DoIt();',
  1772. '$mod.i = $mod.i;',
  1773. '']) );
  1774. end;
  1775. procedure TTestModule.Test_ModeFPCFail;
  1776. begin
  1777. StartProgram(false);
  1778. Add('{$mode FPC}');
  1779. Add('begin');
  1780. SetExpectedScannerError('Invalid mode: "FPC"',nErrInvalidMode);
  1781. ConvertProgram;
  1782. end;
  1783. procedure TTestModule.Test_ModeSwitchCBlocksFail;
  1784. begin
  1785. StartProgram(false);
  1786. Add('{$modeswitch cblocks-}');
  1787. Add('begin');
  1788. SetExpectedScannerError('Invalid mode switch: "cblocks-"',nErrInvalidModeSwitch);
  1789. ConvertProgram;
  1790. end;
  1791. procedure TTestModule.TestUnit_Intf1Impl2Intf1;
  1792. begin
  1793. AddModuleWithIntfImplSrc('unit1.pp',
  1794. LinesToStr([
  1795. 'type number = longint;']),
  1796. LinesToStr([
  1797. 'uses test1;',
  1798. 'procedure DoIt;',
  1799. 'begin',
  1800. ' i:=3;',
  1801. 'end;']));
  1802. StartUnit(true);
  1803. Add([
  1804. 'interface',
  1805. 'uses unit1;',
  1806. 'var i: number;',
  1807. 'implementation']);
  1808. ConvertUnit;
  1809. CheckSource('TestUnit_Intf1Impl2Intf1',
  1810. LinesToStr([
  1811. 'this.i = 0;',
  1812. '']),
  1813. LinesToStr([
  1814. '']) );
  1815. end;
  1816. procedure TTestModule.TestVarInt;
  1817. begin
  1818. StartProgram(false);
  1819. Add('var MyI: longint;');
  1820. Add('begin');
  1821. ConvertProgram;
  1822. CheckSource('TestVarInt','this.MyI=0;','');
  1823. end;
  1824. procedure TTestModule.TestVarBaseTypes;
  1825. begin
  1826. StartProgram(false);
  1827. Add('var');
  1828. Add(' i: longint;');
  1829. Add(' s: string;');
  1830. Add(' c: char;');
  1831. Add(' b: boolean;');
  1832. Add(' d: double;');
  1833. Add(' i2: longint = 3;');
  1834. Add(' s2: string = ''foo'';');
  1835. Add(' c2: char = ''4'';');
  1836. Add(' b2: boolean = true;');
  1837. Add(' d2: double = 5.6;');
  1838. Add(' i3: longint = $707;');
  1839. Add(' i4: nativeint = 4503599627370495;');
  1840. Add(' i5: nativeint = -4503599627370496;');
  1841. Add(' i6: nativeint = $fffffffffffff;');
  1842. Add(' i7: nativeint = -$10000000000000;');
  1843. Add(' u8: nativeuint = $fffffffffffff;');
  1844. Add(' u9: nativeuint = $0000000000000;');
  1845. Add('begin');
  1846. ConvertProgram;
  1847. CheckSource('TestVarBaseTypes',
  1848. LinesToStr([
  1849. 'this.i=0;',
  1850. 'this.s="";',
  1851. 'this.c="";',
  1852. 'this.b=false;',
  1853. 'this.d=0.0;',
  1854. 'this.i2=3;',
  1855. 'this.s2="foo";',
  1856. 'this.c2="4";',
  1857. 'this.b2=true;',
  1858. 'this.d2=5.6;',
  1859. 'this.i3=0x707;',
  1860. 'this.i4= 4503599627370495;',
  1861. 'this.i5= -4503599627370496;',
  1862. 'this.i6= 0xfffffffffffff;',
  1863. 'this.i7=-0x10000000000000;',
  1864. 'this.u8= 0xfffffffffffff;',
  1865. 'this.u9= 0x0000000000000;'
  1866. ]),
  1867. '');
  1868. end;
  1869. procedure TTestModule.TestBaseTypeSingleFail;
  1870. begin
  1871. StartProgram(false);
  1872. Add('var s: single;');
  1873. SetExpectedPasResolverError('identifier not found "single"',PasResolveEval.nIdentifierNotFound);
  1874. ConvertProgram;
  1875. end;
  1876. procedure TTestModule.TestBaseTypeExtendedFail;
  1877. begin
  1878. StartProgram(false);
  1879. Add('var e: extended;');
  1880. SetExpectedPasResolverError('identifier not found "extended"',PasResolveEval.nIdentifierNotFound);
  1881. ConvertProgram;
  1882. end;
  1883. procedure TTestModule.TestConstBaseTypes;
  1884. begin
  1885. StartProgram(false);
  1886. Add('const');
  1887. Add(' i: longint = 3;');
  1888. Add(' s: string = ''foo'';');
  1889. Add(' c: char = ''4'';');
  1890. Add(' b: boolean = true;');
  1891. Add(' d: double = 5.6;');
  1892. Add(' e = low(word);');
  1893. Add(' f = high(word);');
  1894. Add('begin');
  1895. ConvertProgram;
  1896. CheckSource('TestVarBaseTypes',
  1897. LinesToStr([
  1898. 'this.i=3;',
  1899. 'this.s="foo";',
  1900. 'this.c="4";',
  1901. 'this.b=true;',
  1902. 'this.d=5.6;',
  1903. 'this.e = 0;',
  1904. 'this.f = 65535;'
  1905. ]),
  1906. '');
  1907. end;
  1908. procedure TTestModule.TestAliasTypeRef;
  1909. begin
  1910. StartProgram(false);
  1911. Add('type');
  1912. Add(' a=longint;');
  1913. Add(' b=a;');
  1914. Add('var');
  1915. Add(' c: A;');
  1916. Add(' d: B;');
  1917. Add('begin');
  1918. ConvertProgram;
  1919. CheckSource('TestAliasTypeRef',
  1920. LinesToStr([ // statements
  1921. 'this.c = 0;',
  1922. 'this.d = 0;'
  1923. ]),
  1924. LinesToStr([ // this.$main
  1925. ''
  1926. ]));
  1927. end;
  1928. procedure TTestModule.TestTypeCast_BaseTypes;
  1929. begin
  1930. StartProgram(false);
  1931. Add([
  1932. 'var',
  1933. ' i: longint;',
  1934. ' b: boolean;',
  1935. ' d: double;',
  1936. ' s: string;',
  1937. ' c: char;',
  1938. 'begin',
  1939. ' i:=longint(i);',
  1940. ' i:=longint(b);',
  1941. ' b:=boolean(b);',
  1942. ' b:=boolean(i);',
  1943. ' d:=double(d);',
  1944. ' d:=double(i);',
  1945. ' s:=string(s);',
  1946. ' s:=string(c);',
  1947. ' c:=char(c);',
  1948. ' c:=char(i);',
  1949. ' c:=char(65);',
  1950. '']);
  1951. ConvertProgram;
  1952. CheckSource('TestAliasTypeRef',
  1953. LinesToStr([ // statements
  1954. 'this.i = 0;',
  1955. 'this.b = false;',
  1956. 'this.d = 0.0;',
  1957. 'this.s = "";',
  1958. 'this.c = "";',
  1959. '']),
  1960. LinesToStr([ // this.$main
  1961. '$mod.i = $mod.i;',
  1962. '$mod.i = ($mod.b ? 1 : 0);',
  1963. '$mod.b = $mod.b;',
  1964. '$mod.b = $mod.i != 0;',
  1965. '$mod.d = $mod.d;',
  1966. '$mod.d = $mod.i;',
  1967. '$mod.s = $mod.s;',
  1968. '$mod.s = $mod.c;',
  1969. '$mod.c = $mod.c;',
  1970. '$mod.c = String.fromCharCode($mod.i);',
  1971. '$mod.c = "A";',
  1972. '']));
  1973. end;
  1974. procedure TTestModule.TestTypeCast_AliasBaseTypes;
  1975. begin
  1976. StartProgram(false);
  1977. Add('type');
  1978. Add(' integer = longint;');
  1979. Add(' TYesNo = boolean;');
  1980. Add(' TFloat = double;');
  1981. Add(' TCaption = string;');
  1982. Add(' TChar = char;');
  1983. Add('var');
  1984. Add(' i: integer;');
  1985. Add(' b: TYesNo;');
  1986. Add(' d: TFloat;');
  1987. Add(' s: TCaption;');
  1988. Add(' c: TChar;');
  1989. Add('begin');
  1990. Add(' i:=integer(i);');
  1991. Add(' i:=integer(b);');
  1992. Add(' b:=TYesNo(b);');
  1993. Add(' b:=TYesNo(i);');
  1994. Add(' d:=TFloat(d);');
  1995. Add(' d:=TFloat(i);');
  1996. Add(' s:=TCaption(s);');
  1997. Add(' s:=TCaption(c);');
  1998. Add(' c:=TChar(c);');
  1999. ConvertProgram;
  2000. CheckSource('TestAliasTypeRef',
  2001. LinesToStr([ // statements
  2002. 'this.i = 0;',
  2003. 'this.b = false;',
  2004. 'this.d = 0.0;',
  2005. 'this.s = "";',
  2006. 'this.c = "";',
  2007. '']),
  2008. LinesToStr([ // this.$main
  2009. '$mod.i = $mod.i;',
  2010. '$mod.i = ($mod.b ? 1 : 0);',
  2011. '$mod.b = $mod.b;',
  2012. '$mod.b = $mod.i != 0;',
  2013. '$mod.d = $mod.d;',
  2014. '$mod.d = $mod.i;',
  2015. '$mod.s = $mod.s;',
  2016. '$mod.s = $mod.c;',
  2017. '$mod.c = $mod.c;',
  2018. '']));
  2019. end;
  2020. procedure TTestModule.TestEmptyProc;
  2021. begin
  2022. StartProgram(false);
  2023. Add('procedure Test;');
  2024. Add('begin');
  2025. Add('end;');
  2026. Add('begin');
  2027. ConvertProgram;
  2028. CheckSource('TestEmptyProc',
  2029. LinesToStr([ // statements
  2030. 'this.Test = function () {',
  2031. '};'
  2032. ]),
  2033. LinesToStr([ // this.$main
  2034. ''
  2035. ]));
  2036. end;
  2037. procedure TTestModule.TestProcOneParam;
  2038. begin
  2039. StartProgram(false);
  2040. Add('procedure ProcA(i: longint);');
  2041. Add('begin');
  2042. Add('end;');
  2043. Add('begin');
  2044. Add(' PROCA(3);');
  2045. ConvertProgram;
  2046. CheckSource('TestProcOneParam',
  2047. LinesToStr([ // statements
  2048. 'this.ProcA = function (i) {',
  2049. '};'
  2050. ]),
  2051. LinesToStr([ // this.$main
  2052. '$mod.ProcA(3);'
  2053. ]));
  2054. end;
  2055. procedure TTestModule.TestFunctionWithoutParams;
  2056. begin
  2057. StartProgram(false);
  2058. Add('function FuncA: longint;');
  2059. Add('begin');
  2060. Add('end;');
  2061. Add('var i: longint;');
  2062. Add('begin');
  2063. Add(' I:=FUNCA();');
  2064. Add(' I:=FUNCA;');
  2065. Add(' FUNCA();');
  2066. Add(' FUNCA;');
  2067. ConvertProgram;
  2068. CheckSource('TestProcWithoutParams',
  2069. LinesToStr([ // statements
  2070. 'this.FuncA = function () {',
  2071. ' var Result = 0;',
  2072. ' return Result;',
  2073. '};',
  2074. 'this.i=0;'
  2075. ]),
  2076. LinesToStr([ // this.$main
  2077. '$mod.i=$mod.FuncA();',
  2078. '$mod.i=$mod.FuncA();',
  2079. '$mod.FuncA();',
  2080. '$mod.FuncA();'
  2081. ]));
  2082. end;
  2083. procedure TTestModule.TestProcedureWithoutParams;
  2084. begin
  2085. StartProgram(false);
  2086. Add('procedure ProcA;');
  2087. Add('begin');
  2088. Add('end;');
  2089. Add('begin');
  2090. Add(' PROCA();');
  2091. Add(' PROCA;');
  2092. ConvertProgram;
  2093. CheckSource('TestProcWithoutParams',
  2094. LinesToStr([ // statements
  2095. 'this.ProcA = function () {',
  2096. '};'
  2097. ]),
  2098. LinesToStr([ // this.$main
  2099. '$mod.ProcA();',
  2100. '$mod.ProcA();'
  2101. ]));
  2102. end;
  2103. procedure TTestModule.TestIncDec;
  2104. begin
  2105. StartProgram(false);
  2106. Add([
  2107. 'procedure DoIt(var i: longint);',
  2108. 'begin',
  2109. ' inc(i);',
  2110. ' inc(i,2);',
  2111. 'end;',
  2112. 'var',
  2113. ' Bar: longint;',
  2114. 'begin',
  2115. ' inc(bar);',
  2116. ' inc(bar,2);',
  2117. ' dec(bar);',
  2118. ' dec(bar,3);',
  2119. '']);
  2120. ConvertProgram;
  2121. CheckSource('TestIncDec',
  2122. LinesToStr([ // statements
  2123. 'this.DoIt = function (i) {',
  2124. ' i.set(i.get()+1);',
  2125. ' i.set(i.get()+2);',
  2126. '};',
  2127. 'this.Bar = 0;'
  2128. ]),
  2129. LinesToStr([ // this.$main
  2130. '$mod.Bar+=1;',
  2131. '$mod.Bar+=2;',
  2132. '$mod.Bar-=1;',
  2133. '$mod.Bar-=3;'
  2134. ]));
  2135. end;
  2136. procedure TTestModule.TestAssignments;
  2137. begin
  2138. StartProgram(false);
  2139. Parser.Options:=Parser.Options+[po_cassignments];
  2140. Add('var');
  2141. Add(' Bar:longint;');
  2142. Add('begin');
  2143. Add(' bar:=3;');
  2144. Add(' bar+=4;');
  2145. Add(' bar-=5;');
  2146. Add(' bar*=6;');
  2147. ConvertProgram;
  2148. CheckSource('TestAssignments',
  2149. LinesToStr([ // statements
  2150. 'this.Bar = 0;'
  2151. ]),
  2152. LinesToStr([ // this.$main
  2153. '$mod.Bar=3;',
  2154. '$mod.Bar+=4;',
  2155. '$mod.Bar-=5;',
  2156. '$mod.Bar*=6;'
  2157. ]));
  2158. end;
  2159. procedure TTestModule.TestArithmeticOperators1;
  2160. begin
  2161. StartProgram(false);
  2162. Add('var');
  2163. Add(' vA,vB,vC:longint;');
  2164. Add('begin');
  2165. Add(' va:=1;');
  2166. Add(' vb:=va+va;');
  2167. Add(' vb:=va div vb;');
  2168. Add(' vb:=va mod vb;');
  2169. Add(' vb:=va+va*vb+va div vb;');
  2170. Add(' vc:=-va;');
  2171. Add(' va:=va-vb;');
  2172. Add(' vb:=va;');
  2173. Add(' if va<vb then vc:=va else vc:=vb;');
  2174. ConvertProgram;
  2175. CheckSource('TestArithmeticOperators1',
  2176. LinesToStr([ // statements
  2177. 'this.vA = 0;',
  2178. 'this.vB = 0;',
  2179. 'this.vC = 0;'
  2180. ]),
  2181. LinesToStr([ // this.$main
  2182. '$mod.vA = 1;',
  2183. '$mod.vB = $mod.vA + $mod.vA;',
  2184. '$mod.vB = Math.floor($mod.vA / $mod.vB);',
  2185. '$mod.vB = $mod.vA % $mod.vB;',
  2186. '$mod.vB = ($mod.vA + ($mod.vA * $mod.vB)) + Math.floor($mod.vA / $mod.vB);',
  2187. '$mod.vC = -$mod.vA;',
  2188. '$mod.vA = $mod.vA - $mod.vB;',
  2189. '$mod.vB = $mod.vA;',
  2190. 'if ($mod.vA < $mod.vB){ $mod.vC = $mod.vA } else $mod.vC = $mod.vB;'
  2191. ]));
  2192. end;
  2193. procedure TTestModule.TestLogicalOperators;
  2194. begin
  2195. StartProgram(false);
  2196. Add('var');
  2197. Add(' vA,vB,vC:boolean;');
  2198. Add('begin');
  2199. Add(' va:=vb and vc;');
  2200. Add(' va:=vb or vc;');
  2201. Add(' va:=vb xor vc;');
  2202. Add(' va:=true and vc;');
  2203. Add(' va:=(vb and vc) or (va and vb);');
  2204. Add(' va:=not vb;');
  2205. ConvertProgram;
  2206. CheckSource('TestLogicalOperators',
  2207. LinesToStr([ // statements
  2208. 'this.vA = false;',
  2209. 'this.vB = false;',
  2210. 'this.vC = false;'
  2211. ]),
  2212. LinesToStr([ // this.$main
  2213. '$mod.vA = $mod.vB && $mod.vC;',
  2214. '$mod.vA = $mod.vB || $mod.vC;',
  2215. '$mod.vA = $mod.vB ^ $mod.vC;',
  2216. '$mod.vA = true && $mod.vC;',
  2217. '$mod.vA = ($mod.vB && $mod.vC) || ($mod.vA && $mod.vB);',
  2218. '$mod.vA = !$mod.vB;'
  2219. ]));
  2220. end;
  2221. procedure TTestModule.TestBitwiseOperators;
  2222. begin
  2223. StartProgram(false);
  2224. Add('var');
  2225. Add(' vA,vB,vC:longint;');
  2226. Add('begin');
  2227. Add(' va:=vb and vc;');
  2228. Add(' va:=vb or vc;');
  2229. Add(' va:=vb xor vc;');
  2230. Add(' va:=vb shl vc;');
  2231. Add(' va:=vb shr vc;');
  2232. Add(' va:=3 and vc;');
  2233. Add(' va:=(vb and vc) or (va and vb);');
  2234. Add(' va:=not vb;');
  2235. ConvertProgram;
  2236. CheckSource('TestBitwiseOperators',
  2237. LinesToStr([ // statements
  2238. 'this.vA = 0;',
  2239. 'this.vB = 0;',
  2240. 'this.vC = 0;'
  2241. ]),
  2242. LinesToStr([ // this.$main
  2243. '$mod.vA = $mod.vB & $mod.vC;',
  2244. '$mod.vA = $mod.vB | $mod.vC;',
  2245. '$mod.vA = $mod.vB ^ $mod.vC;',
  2246. '$mod.vA = $mod.vB << $mod.vC;',
  2247. '$mod.vA = $mod.vB >>> $mod.vC;',
  2248. '$mod.vA = 3 & $mod.vC;',
  2249. '$mod.vA = ($mod.vB & $mod.vC) | ($mod.vA & $mod.vB);',
  2250. '$mod.vA = ~$mod.vB;'
  2251. ]));
  2252. end;
  2253. procedure TTestModule.TestPrgProcVar;
  2254. begin
  2255. StartProgram(false);
  2256. Add('procedure Proc1;');
  2257. Add('type');
  2258. Add(' t1=longint;');
  2259. Add('var');
  2260. Add(' vA:t1;');
  2261. Add('begin');
  2262. Add('end;');
  2263. Add('begin');
  2264. ConvertProgram;
  2265. CheckSource('TestPrgProcVar',
  2266. LinesToStr([ // statements
  2267. 'this.Proc1 = function () {',
  2268. ' var vA=0;',
  2269. '};'
  2270. ]),
  2271. LinesToStr([ // this.$main
  2272. ''
  2273. ]));
  2274. end;
  2275. procedure TTestModule.TestUnitProcVar;
  2276. begin
  2277. StartUnit(false);
  2278. Add('interface');
  2279. Add('');
  2280. Add('type tA=string; // unit scope');
  2281. Add('procedure Proc1;');
  2282. Add('');
  2283. Add('implementation');
  2284. Add('');
  2285. Add('procedure Proc1;');
  2286. Add('type tA=longint; // local proc scope');
  2287. Add('var v1:tA; // using local tA');
  2288. Add('begin');
  2289. Add('end;');
  2290. Add('var v2:tA; // using interface tA');
  2291. ConvertUnit;
  2292. CheckSource('TestUnitProcVar',
  2293. LinesToStr([ // statements
  2294. 'var $impl = $mod.$impl;',
  2295. 'this.Proc1 = function () {',
  2296. ' var v1 = 0;',
  2297. '};',
  2298. '']),
  2299. // this.$init
  2300. '',
  2301. // implementation
  2302. LinesToStr([
  2303. '$impl.v2 = "";',
  2304. '']));
  2305. end;
  2306. procedure TTestModule.TestImplProc;
  2307. begin
  2308. StartUnit(false);
  2309. Add('interface');
  2310. Add('');
  2311. Add('procedure Proc1;');
  2312. Add('');
  2313. Add('implementation');
  2314. Add('');
  2315. Add('procedure Proc1; begin end;');
  2316. Add('procedure Proc2; begin end;');
  2317. Add('initialization');
  2318. Add(' Proc1;');
  2319. Add(' Proc2;');
  2320. ConvertUnit;
  2321. CheckSource('TestImplProc',
  2322. LinesToStr([ // statements
  2323. 'var $impl = $mod.$impl;',
  2324. 'this.Proc1 = function () {',
  2325. '};',
  2326. '']),
  2327. LinesToStr([ // this.$init
  2328. '$mod.Proc1();',
  2329. '$impl.Proc2();',
  2330. '']),
  2331. LinesToStr([ // implementation
  2332. '$impl.Proc2 = function () {',
  2333. '};',
  2334. ''])
  2335. );
  2336. end;
  2337. procedure TTestModule.TestFunctionResult;
  2338. begin
  2339. StartProgram(false);
  2340. Add('function Func1: longint;');
  2341. Add('begin');
  2342. Add(' Result:=3;');
  2343. Add(' Func1:=4;');
  2344. Add('end;');
  2345. Add('begin');
  2346. ConvertProgram;
  2347. CheckSource('TestFunctionResult',
  2348. LinesToStr([ // statements
  2349. 'this.Func1 = function () {',
  2350. ' var Result = 0;',
  2351. ' Result = 3;',
  2352. ' Result = 4;',
  2353. ' return Result;',
  2354. '};'
  2355. ]),
  2356. '');
  2357. end;
  2358. procedure TTestModule.TestNestedProc;
  2359. begin
  2360. StartProgram(false);
  2361. Add([
  2362. 'var vInUnit: longint;',
  2363. 'function DoIt(pA,pD: longint): longint;',
  2364. 'var',
  2365. ' vB: longint;',
  2366. ' vC: longint;',
  2367. ' function Nesty(pA: longint): longint; ',
  2368. ' var vB: longint;',
  2369. ' begin',
  2370. ' Result:=pa+vb+vc+pd+vInUnit;',
  2371. ' nesty:=3;',
  2372. ' doit:=4;',
  2373. ' exit;',
  2374. ' end;',
  2375. 'begin',
  2376. ' Result:=pa+vb+vc;',
  2377. ' doit:=6;',
  2378. ' exit;',
  2379. 'end;',
  2380. 'begin']);
  2381. ConvertProgram;
  2382. CheckSource('TestNestedProc',
  2383. LinesToStr([ // statements
  2384. 'this.vInUnit = 0;',
  2385. 'this.DoIt = function (pA, pD) {',
  2386. ' var Result = 0;',
  2387. ' var vB = 0;',
  2388. ' var vC = 0;',
  2389. ' function Nesty(pA) {',
  2390. ' var Result$1 = 0;',
  2391. ' var vB = 0;',
  2392. ' Result$1 = (((pA + vB) + vC) + pD) + $mod.vInUnit;',
  2393. ' Result$1 = 3;',
  2394. ' Result = 4;',
  2395. ' return Result$1;',
  2396. ' return Result$1;',
  2397. ' };',
  2398. ' Result = (pA + vB) + vC;',
  2399. ' Result = 6;',
  2400. ' return Result;',
  2401. ' return Result;',
  2402. '};'
  2403. ]),
  2404. '');
  2405. end;
  2406. procedure TTestModule.TestNestedProc_ResultString;
  2407. begin
  2408. StartProgram(false);
  2409. Add([
  2410. 'function DoIt: string;',
  2411. ' function Nesty: string; ',
  2412. ' begin',
  2413. ' nesty:=#65#66;',
  2414. ' nesty[1]:=#67;',
  2415. ' doit:=#68;',
  2416. ' doit[2]:=#69;',
  2417. ' end;',
  2418. 'begin',
  2419. ' doit:=#70;',
  2420. ' doit[3]:=#71;',
  2421. 'end;',
  2422. 'begin']);
  2423. ConvertProgram;
  2424. CheckSource('TestNestedProc_ResultString',
  2425. LinesToStr([ // statements
  2426. 'this.DoIt = function () {',
  2427. ' var Result = "";',
  2428. ' function Nesty() {',
  2429. ' var Result$1 = "";',
  2430. ' Result$1 = "AB";',
  2431. ' Result$1 = rtl.setCharAt(Result$1, 0, "C");',
  2432. ' Result = "D";',
  2433. ' Result = rtl.setCharAt(Result, 1, "E");',
  2434. ' return Result$1;',
  2435. ' };',
  2436. ' Result = "F";',
  2437. ' Result = rtl.setCharAt(Result, 2, "G");',
  2438. ' return Result;',
  2439. '};'
  2440. ]),
  2441. '');
  2442. end;
  2443. procedure TTestModule.TestForwardProc;
  2444. begin
  2445. StartProgram(false);
  2446. Add('procedure FuncA(Bar: longint); forward;');
  2447. Add('procedure FuncB(Bar: longint);');
  2448. Add('begin');
  2449. Add(' funca(bar);');
  2450. Add('end;');
  2451. Add('procedure funca(bar: longint);');
  2452. Add('begin');
  2453. Add(' if bar=3 then ;');
  2454. Add('end;');
  2455. Add('begin');
  2456. Add(' funca(4);');
  2457. Add(' funcb(5);');
  2458. ConvertProgram;
  2459. CheckSource('TestForwardProc',
  2460. LinesToStr([ // statements'
  2461. 'this.FuncB = function (Bar) {',
  2462. ' $mod.FuncA(Bar);',
  2463. '};',
  2464. 'this.FuncA = function (Bar) {',
  2465. ' if (Bar === 3);',
  2466. '};'
  2467. ]),
  2468. LinesToStr([
  2469. '$mod.FuncA(4);',
  2470. '$mod.FuncB(5);'
  2471. ])
  2472. );
  2473. end;
  2474. procedure TTestModule.TestNestedForwardProc;
  2475. begin
  2476. StartProgram(false);
  2477. Add('procedure FuncA;');
  2478. Add(' procedure FuncB(i: longint); forward;');
  2479. Add(' procedure FuncC(i: longint);');
  2480. Add(' begin');
  2481. Add(' funcb(i);');
  2482. Add(' end;');
  2483. Add(' procedure FuncB(i: longint);');
  2484. Add(' begin');
  2485. Add(' if i=3 then ;');
  2486. Add(' end;');
  2487. Add('begin');
  2488. Add(' funcc(4)');
  2489. Add('end;');
  2490. Add('begin');
  2491. Add(' funca;');
  2492. ConvertProgram;
  2493. CheckSource('TestNestedForwardProc',
  2494. LinesToStr([ // statements'
  2495. 'this.FuncA = function () {',
  2496. ' function FuncC(i) {',
  2497. ' FuncB(i);',
  2498. ' };',
  2499. ' function FuncB(i) {',
  2500. ' if (i === 3);',
  2501. ' };',
  2502. ' FuncC(4);',
  2503. '};'
  2504. ]),
  2505. LinesToStr([
  2506. '$mod.FuncA();'
  2507. ])
  2508. );
  2509. end;
  2510. procedure TTestModule.TestAssignFunctionResult;
  2511. begin
  2512. StartProgram(false);
  2513. Add('function Func1: longint;');
  2514. Add('begin');
  2515. Add('end;');
  2516. Add('var i: longint;');
  2517. Add('begin');
  2518. Add(' i:=func1();');
  2519. Add(' i:=func1()+func1();');
  2520. ConvertProgram;
  2521. CheckSource('TestAssignFunctionResult',
  2522. LinesToStr([ // statements
  2523. 'this.Func1 = function () {',
  2524. ' var Result = 0;',
  2525. ' return Result;',
  2526. '};',
  2527. 'this.i = 0;'
  2528. ]),
  2529. LinesToStr([
  2530. '$mod.i = $mod.Func1();',
  2531. '$mod.i = $mod.Func1() + $mod.Func1();'
  2532. ]));
  2533. end;
  2534. procedure TTestModule.TestFunctionResultInCondition;
  2535. begin
  2536. StartProgram(false);
  2537. Add('function Func1: longint;');
  2538. Add('begin');
  2539. Add('end;');
  2540. Add('function Func2: boolean;');
  2541. Add('begin');
  2542. Add('end;');
  2543. Add('var i: longint;');
  2544. Add('begin');
  2545. Add(' if func2 then ;');
  2546. Add(' if i=func1() then ;');
  2547. Add(' if i=func1 then ;');
  2548. ConvertProgram;
  2549. CheckSource('TestFunctionResultInCondition',
  2550. LinesToStr([ // statements
  2551. 'this.Func1 = function () {',
  2552. ' var Result = 0;',
  2553. ' return Result;',
  2554. '};',
  2555. 'this.Func2 = function () {',
  2556. ' var Result = false;',
  2557. ' return Result;',
  2558. '};',
  2559. 'this.i = 0;'
  2560. ]),
  2561. LinesToStr([
  2562. 'if ($mod.Func2());',
  2563. 'if ($mod.i === $mod.Func1());',
  2564. 'if ($mod.i === $mod.Func1());'
  2565. ]));
  2566. end;
  2567. procedure TTestModule.TestFunctionResultInForLoop;
  2568. begin
  2569. StartProgram(false);
  2570. Add([
  2571. 'function Func1(a: array of longint): longint;',
  2572. 'begin',
  2573. ' for Result:=High(a) downto Low(a) do if a[Result]=0 then exit;',
  2574. ' for Result in a do if a[Result]=0 then exit;',
  2575. 'end;',
  2576. 'begin',
  2577. ' Func1([1,2,3])']);
  2578. ConvertProgram;
  2579. CheckSource('TestFunctionResultInForLoop',
  2580. LinesToStr([ // statements
  2581. 'this.Func1 = function (a) {',
  2582. ' var Result = 0;',
  2583. ' for (var $l1 = rtl.length(a) - 1; $l1 >= 0; $l1--) {',
  2584. ' Result = $l1;',
  2585. ' if (a[Result] === 0) return Result;',
  2586. ' };',
  2587. ' for (var $in2 = a, $l3 = 0, $end4 = rtl.length($in2) - 1; $l3 <= $end4; $l3++) {',
  2588. ' Result = $in2[$l3];',
  2589. ' if (a[Result] === 0) return Result;',
  2590. ' };',
  2591. ' return Result;',
  2592. '};',
  2593. '']),
  2594. LinesToStr([
  2595. '$mod.Func1([1, 2, 3]);'
  2596. ]));
  2597. end;
  2598. procedure TTestModule.TestExit;
  2599. begin
  2600. StartProgram(false);
  2601. Add('procedure ProcA;');
  2602. Add('begin');
  2603. Add(' exit;');
  2604. Add('end;');
  2605. Add('function FuncB: longint;');
  2606. Add('begin');
  2607. Add(' exit;');
  2608. Add(' exit(3);');
  2609. Add('end;');
  2610. Add('function FuncC: string;');
  2611. Add('begin');
  2612. Add(' exit;');
  2613. Add(' exit(''a'');');
  2614. Add(' exit(''abc'');');
  2615. Add('end;');
  2616. Add('begin');
  2617. Add(' exit;');
  2618. Add(' exit(1);');
  2619. ConvertProgram;
  2620. CheckSource('TestExit',
  2621. LinesToStr([ // statements
  2622. 'this.ProcA = function () {',
  2623. ' return;',
  2624. '};',
  2625. 'this.FuncB = function () {',
  2626. ' var Result = 0;',
  2627. ' return Result;',
  2628. ' return 3;',
  2629. ' return Result;',
  2630. '};',
  2631. 'this.FuncC = function () {',
  2632. ' var Result = "";',
  2633. ' return Result;',
  2634. ' return "a";',
  2635. ' return "abc";',
  2636. ' return Result;',
  2637. '};'
  2638. ]),
  2639. LinesToStr([
  2640. 'return;',
  2641. 'return 1;',
  2642. '']));
  2643. end;
  2644. procedure TTestModule.TestBreak;
  2645. begin
  2646. StartProgram(false);
  2647. Add([
  2648. 'var',
  2649. ' i: longint;',
  2650. 'begin',
  2651. ' repeat',
  2652. ' break;',
  2653. ' until true;',
  2654. ' while true do',
  2655. ' break;',
  2656. ' for i:=1 to 2 do',
  2657. ' break;']);
  2658. ConvertProgram;
  2659. CheckSource('TestBreak',
  2660. LinesToStr([ // statements
  2661. 'this.i = 0;'
  2662. ]),
  2663. LinesToStr([
  2664. 'do {',
  2665. ' break;',
  2666. '} while (!true);',
  2667. 'while (true) break;',
  2668. 'for ($mod.i = 1; $mod.i <= 2; $mod.i++) break;',
  2669. '']));
  2670. end;
  2671. procedure TTestModule.TestBreakAsVar;
  2672. begin
  2673. StartProgram(false);
  2674. Add([
  2675. 'procedure DoIt(break: boolean);',
  2676. 'begin',
  2677. ' if break then ;',
  2678. 'end;',
  2679. 'var',
  2680. ' break: boolean;',
  2681. 'begin',
  2682. ' if break then ;']);
  2683. ConvertProgram;
  2684. CheckSource('TestBreakAsVar',
  2685. LinesToStr([ // statements
  2686. 'this.DoIt = function (Break) {',
  2687. ' if (Break) ;',
  2688. '};',
  2689. 'this.Break = false;',
  2690. '']),
  2691. LinesToStr([
  2692. 'if($mod.Break) ;',
  2693. '']));
  2694. end;
  2695. procedure TTestModule.TestContinue;
  2696. begin
  2697. StartProgram(false);
  2698. Add('var i: longint;');
  2699. Add('begin');
  2700. Add(' repeat');
  2701. Add(' continue;');
  2702. Add(' until true;');
  2703. Add(' while true do');
  2704. Add(' continue;');
  2705. Add(' for i:=1 to 2 do');
  2706. Add(' continue;');
  2707. ConvertProgram;
  2708. CheckSource('TestContinue',
  2709. LinesToStr([ // statements
  2710. 'this.i = 0;'
  2711. ]),
  2712. LinesToStr([
  2713. 'do {',
  2714. ' continue;',
  2715. '} while (!true);',
  2716. 'while (true) continue;',
  2717. 'for ($mod.i = 1; $mod.i <= 2; $mod.i++) continue;',
  2718. '']));
  2719. end;
  2720. procedure TTestModule.TestProc_External;
  2721. begin
  2722. StartProgram(false);
  2723. Add('procedure Foo; external name ''console.log'';');
  2724. Add('function Bar: longint; external name ''get.item'';');
  2725. Add('function Bla(s: string): longint; external name ''apply.something'';');
  2726. Add('var');
  2727. Add(' i: longint;');
  2728. Add('begin');
  2729. Add(' Foo;');
  2730. Add(' i:=Bar;');
  2731. Add(' i:=Bla(''abc'');');
  2732. ConvertProgram;
  2733. CheckSource('TestProc_External',
  2734. LinesToStr([ // statements
  2735. 'this.i = 0;'
  2736. ]),
  2737. LinesToStr([
  2738. 'console.log();',
  2739. '$mod.i = get.item();',
  2740. '$mod.i = apply.something("abc");'
  2741. ]));
  2742. end;
  2743. procedure TTestModule.TestProc_ExternalOtherUnit;
  2744. begin
  2745. AddModuleWithIntfImplSrc('unit2.pas',
  2746. LinesToStr([
  2747. 'procedure Now; external name ''Date.now'';',
  2748. 'procedure DoIt;'
  2749. ]),
  2750. 'procedure doit; begin end;');
  2751. StartUnit(true);
  2752. Add('interface');
  2753. Add('uses unit2;');
  2754. Add('implementation');
  2755. Add('begin');
  2756. Add(' now;');
  2757. Add(' now();');
  2758. Add(' uNit2.now;');
  2759. Add(' uNit2.now();');
  2760. Add(' doit;');
  2761. Add(' uNit2.doit;');
  2762. ConvertUnit;
  2763. CheckSource('TestProc_ExternalOtherUnit',
  2764. LinesToStr([
  2765. '']),
  2766. LinesToStr([
  2767. 'Date.now();',
  2768. 'Date.now();',
  2769. 'Date.now();',
  2770. 'Date.now();',
  2771. 'pas.unit2.DoIt();',
  2772. 'pas.unit2.DoIt();',
  2773. '']));
  2774. end;
  2775. procedure TTestModule.TestProc_Asm;
  2776. begin
  2777. StartProgram(false);
  2778. Add([
  2779. 'function DoIt: longint;',
  2780. 'begin;',
  2781. ' asm',
  2782. ' { a:{ b:{}, c:[]}, d:''1'' };',
  2783. ' end;',
  2784. ' asm console.log(); end;',
  2785. 'end;',
  2786. 'begin']);
  2787. ConvertProgram;
  2788. CheckSource('TestProc_Asm',
  2789. LinesToStr([ // statements
  2790. 'this.DoIt = function () {',
  2791. ' var Result = 0;',
  2792. ' { a:{ b:{}, c:[]}, d:''1'' };',
  2793. ' console.log();',
  2794. ' return Result;',
  2795. '};'
  2796. ]),
  2797. LinesToStr([
  2798. ''
  2799. ]));
  2800. end;
  2801. procedure TTestModule.TestProc_Assembler;
  2802. begin
  2803. StartProgram(false);
  2804. Add('function DoIt: longint; assembler;');
  2805. Add('asm');
  2806. Add('{ a:{ b:{}, c:[]}, d:''1'' };');
  2807. Add('end;');
  2808. Add('begin');
  2809. ConvertProgram;
  2810. CheckSource('TestProc_Assembler',
  2811. LinesToStr([ // statements
  2812. 'this.DoIt = function () {',
  2813. ' { a:{ b:{}, c:[]}, d:''1'' };',
  2814. '};'
  2815. ]),
  2816. LinesToStr([
  2817. ''
  2818. ]));
  2819. end;
  2820. procedure TTestModule.TestProc_VarParam;
  2821. begin
  2822. StartProgram(false);
  2823. Add('type integer = longint;');
  2824. Add('procedure DoIt(vG: integer; const vH: integer; var vI: integer);');
  2825. Add('var vJ: integer;');
  2826. Add('begin');
  2827. Add(' vg:=vg+1;');
  2828. Add(' vj:=vh+2;');
  2829. Add(' vi:=vi+3;');
  2830. Add(' doit(vg,vg,vg);');
  2831. Add(' doit(vh,vh,vj);');
  2832. Add(' doit(vi,vi,vi);');
  2833. Add(' doit(vj,vj,vj);');
  2834. Add('end;');
  2835. Add('var i: integer;');
  2836. Add('begin');
  2837. Add(' doit(i,i,i);');
  2838. ConvertProgram;
  2839. CheckSource('TestProc_VarParam',
  2840. LinesToStr([ // statements
  2841. 'this.DoIt = function (vG,vH,vI) {',
  2842. ' var vJ = 0;',
  2843. ' vG = vG + 1;',
  2844. ' vJ = vH + 2;',
  2845. ' vI.set(vI.get()+3);',
  2846. ' $mod.DoIt(vG, vG, {',
  2847. ' get: function () {',
  2848. ' return vG;',
  2849. ' },',
  2850. ' set: function (v) {',
  2851. ' vG = v;',
  2852. ' }',
  2853. ' });',
  2854. ' $mod.DoIt(vH, vH, {',
  2855. ' get: function () {',
  2856. ' return vJ;',
  2857. ' },',
  2858. ' set: function (v) {',
  2859. ' vJ = v;',
  2860. ' }',
  2861. ' });',
  2862. ' $mod.DoIt(vI.get(), vI.get(), vI);',
  2863. ' $mod.DoIt(vJ, vJ, {',
  2864. ' get: function () {',
  2865. ' return vJ;',
  2866. ' },',
  2867. ' set: function (v) {',
  2868. ' vJ = v;',
  2869. ' }',
  2870. ' });',
  2871. '};',
  2872. 'this.i = 0;'
  2873. ]),
  2874. LinesToStr([
  2875. '$mod.DoIt($mod.i,$mod.i,{',
  2876. ' p: $mod,',
  2877. ' get: function () {',
  2878. ' return this.p.i;',
  2879. ' },',
  2880. ' set: function (v) {',
  2881. ' this.p.i = v;',
  2882. ' }',
  2883. '});'
  2884. ]));
  2885. end;
  2886. procedure TTestModule.TestProc_VarParamString;
  2887. begin
  2888. StartProgram(false);
  2889. Add(['type TCaption = string;',
  2890. 'procedure DoIt(vA: TCaption; var vB: TCaption; out vC: TCaption);',
  2891. 'var c: char;',
  2892. 'begin',
  2893. ' va[1]:=c;',
  2894. ' vb[2]:=c;',
  2895. ' vc[3]:=c;',
  2896. 'end;',
  2897. 'begin']);
  2898. ConvertProgram;
  2899. CheckSource('TestProc_VarParamString',
  2900. LinesToStr([ // statements
  2901. 'this.DoIt = function (vA,vB,vC) {',
  2902. ' var c = "";',
  2903. ' vA = rtl.setCharAt(vA, 0, c);',
  2904. ' vB.set(rtl.setCharAt(vB.get(), 1, c));',
  2905. ' vC.set(rtl.setCharAt(vC.get(), 2, c));',
  2906. '};',
  2907. '']),
  2908. LinesToStr([
  2909. ]));
  2910. end;
  2911. procedure TTestModule.TestProc_VarParamV;
  2912. begin
  2913. StartProgram(false);
  2914. Add([
  2915. 'procedure Inc2(var i: longint);',
  2916. 'begin',
  2917. ' i:=i+2;',
  2918. 'end;',
  2919. 'procedure DoIt(v: longint);',
  2920. 'var p: array of longint;',
  2921. 'begin',
  2922. ' Inc2(v);',
  2923. ' Inc2(p[v]);',
  2924. 'end;',
  2925. 'begin']);
  2926. ConvertProgram;
  2927. CheckSource('TestProc_VarParamV',
  2928. LinesToStr([ // statements
  2929. 'this.Inc2 = function (i) {',
  2930. ' i.set(i.get()+2);',
  2931. '};',
  2932. 'this.DoIt = function (v) {',
  2933. ' var p = [];',
  2934. ' $mod.Inc2({get: function () {',
  2935. ' return v;',
  2936. ' }, set: function (w) {',
  2937. ' v = w;',
  2938. ' }});',
  2939. ' $mod.Inc2({',
  2940. ' a: v,',
  2941. ' p: p,',
  2942. ' get: function () {',
  2943. ' return this.p[this.a];',
  2944. ' },',
  2945. ' set: function (v) {',
  2946. ' this.p[this.a] = v;',
  2947. ' }',
  2948. ' });',
  2949. '};',
  2950. '']),
  2951. LinesToStr([
  2952. '']));
  2953. end;
  2954. procedure TTestModule.TestProc_Overload;
  2955. begin
  2956. StartProgram(false);
  2957. Add('procedure DoIt(vI: longint); begin end;');
  2958. Add('procedure DoIt(vI, vJ: longint); begin end;');
  2959. Add('procedure DoIt(vD: double); begin end;');
  2960. Add('begin');
  2961. Add(' DoIt(1);');
  2962. Add(' DoIt(2,3);');
  2963. Add(' DoIt(4.5);');
  2964. ConvertProgram;
  2965. CheckSource('TestProcedureOverload',
  2966. LinesToStr([ // statements
  2967. 'this.DoIt = function (vI) {',
  2968. '};',
  2969. 'this.DoIt$1 = function (vI, vJ) {',
  2970. '};',
  2971. 'this.DoIt$2 = function (vD) {',
  2972. '};',
  2973. '']),
  2974. LinesToStr([
  2975. '$mod.DoIt(1);',
  2976. '$mod.DoIt$1(2, 3);',
  2977. '$mod.DoIt$2(4.5);',
  2978. '']));
  2979. end;
  2980. procedure TTestModule.TestProc_OverloadForward;
  2981. begin
  2982. StartProgram(false);
  2983. Add('procedure DoIt(vI: longint); forward;');
  2984. Add('procedure DoIt(vI, vJ: longint); begin end;');
  2985. Add('procedure doit(vi: longint); begin end;');
  2986. Add('begin');
  2987. Add(' doit(1);');
  2988. Add(' doit(2,3);');
  2989. ConvertProgram;
  2990. CheckSource('TestProcedureOverloadForward',
  2991. LinesToStr([ // statements
  2992. 'this.DoIt$1 = function (vI, vJ) {',
  2993. '};',
  2994. 'this.DoIt = function (vI) {',
  2995. '};',
  2996. '']),
  2997. LinesToStr([
  2998. '$mod.DoIt(1);',
  2999. '$mod.DoIt$1(2, 3);',
  3000. '']));
  3001. end;
  3002. procedure TTestModule.TestProc_OverloadIntfImpl;
  3003. begin
  3004. StartUnit(false);
  3005. Add('interface');
  3006. Add('procedure DoIt(vI: longint);');
  3007. Add('procedure DoIt(vI, vJ: longint);');
  3008. Add('implementation');
  3009. Add('procedure DoIt(vI, vJ, vK, vL, vM: longint); forward;');
  3010. Add('procedure DoIt(vI, vJ, vK: longint); begin end;');
  3011. Add('procedure DoIt(vi: longint); begin end;');
  3012. Add('procedure DoIt(vI, vJ, vK, vL: longint); begin end;');
  3013. Add('procedure DoIt(vi, vj: longint); begin end;');
  3014. Add('procedure DoIt(vi, vj, vk, vl, vm: longint); begin end;');
  3015. Add('begin');
  3016. Add(' doit(1);');
  3017. Add(' doit(2,3);');
  3018. Add(' doit(4,5,6);');
  3019. Add(' doit(7,8,9,10);');
  3020. Add(' doit(11,12,13,14,15);');
  3021. ConvertUnit;
  3022. CheckSource('TestProcedureOverloadUnit',
  3023. LinesToStr([ // statements
  3024. 'var $impl = $mod.$impl;',
  3025. 'this.DoIt = function (vI) {',
  3026. '};',
  3027. 'this.DoIt$1 = function (vI, vJ) {',
  3028. '};',
  3029. '']),
  3030. LinesToStr([ // this.$init
  3031. '$mod.DoIt(1);',
  3032. '$mod.DoIt$1(2, 3);',
  3033. '$impl.DoIt$3(4,5,6);',
  3034. '$impl.DoIt$4(7,8,9,10);',
  3035. '$impl.DoIt$2(11,12,13,14,15);',
  3036. '']),
  3037. LinesToStr([ // implementation
  3038. '$impl.DoIt$3 = function (vI, vJ, vK) {',
  3039. '};',
  3040. '$impl.DoIt$4 = function (vI, vJ, vK, vL) {',
  3041. '};',
  3042. '$impl.DoIt$2 = function (vI, vJ, vK, vL, vM) {',
  3043. '};',
  3044. '']));
  3045. end;
  3046. procedure TTestModule.TestProc_OverloadNested;
  3047. begin
  3048. StartProgram(false);
  3049. Add([
  3050. 'procedure DoIt(vA: longint); overload; forward;',
  3051. 'procedure DoIt(vB, vC: longint); overload;',
  3052. 'begin // 2 param overload',
  3053. ' doit(1);',
  3054. ' doit(1,2);',
  3055. 'end;',
  3056. 'procedure doit(vA: longint);',
  3057. ' procedure DoIt(vA, vB, vC: longint); overload; forward;',
  3058. ' procedure DoIt(vA, vB, vC, vD: longint); overload;',
  3059. ' begin // 4 param overload',
  3060. ' doit(1);',
  3061. ' doit(1,2);',
  3062. ' doit(1,2,3);',
  3063. ' doit(1,2,3,4);',
  3064. ' end;',
  3065. ' procedure doit(vA, vB, vC: longint);',
  3066. ' procedure DoIt(vA, vB, vC, vD, vE: longint); overload; forward;',
  3067. ' procedure DoIt(vA, vB, vC, vD, vE, vF: longint); overload;',
  3068. ' begin // 6 param overload',
  3069. ' doit(1);',
  3070. ' doit(1,2);',
  3071. ' doit(1,2,3);',
  3072. ' doit(1,2,3,4);',
  3073. ' doit(1,2,3,4,5);',
  3074. ' doit(1,2,3,4,5,6);',
  3075. ' end;',
  3076. ' procedure doit(vA, vB, vC, vD, vE: longint);',
  3077. ' begin // 5 param overload',
  3078. ' doit(1);',
  3079. ' doit(1,2);',
  3080. ' doit(1,2,3);',
  3081. ' doit(1,2,3,4);',
  3082. ' doit(1,2,3,4,5);',
  3083. ' doit(1,2,3,4,5,6);',
  3084. ' end;',
  3085. ' begin // 3 param overload',
  3086. ' doit(1);',
  3087. ' doit(1,2);',
  3088. ' doit(1,2,3);',
  3089. ' doit(1,2,3,4);',
  3090. ' doit(1,2,3,4,5);',
  3091. ' doit(1,2,3,4,5,6);',
  3092. ' end;',
  3093. 'begin // 1 param overload',
  3094. ' doit(1);',
  3095. ' doit(1,2);',
  3096. ' doit(1,2,3);',
  3097. ' doit(1,2,3,4);',
  3098. 'end;',
  3099. 'begin // main',
  3100. ' doit(1);',
  3101. ' doit(1,2);']);
  3102. ConvertProgram;
  3103. CheckSource('TestProcedureOverloadNested',
  3104. LinesToStr([ // statements
  3105. 'this.DoIt$1 = function (vB, vC) {',
  3106. ' $mod.DoIt(1);',
  3107. ' $mod.DoIt$1(1, 2);',
  3108. '};',
  3109. 'this.DoIt = function (vA) {',
  3110. ' function DoIt$3(vA, vB, vC, vD) {',
  3111. ' $mod.DoIt(1);',
  3112. ' $mod.DoIt$1(1, 2);',
  3113. ' DoIt$2(1, 2, 3);',
  3114. ' DoIt$3(1, 2, 3, 4);',
  3115. ' };',
  3116. ' function DoIt$2(vA, vB, vC) {',
  3117. ' function DoIt$5(vA, vB, vC, vD, vE, vF) {',
  3118. ' $mod.DoIt(1);',
  3119. ' $mod.DoIt$1(1, 2);',
  3120. ' DoIt$2(1, 2, 3);',
  3121. ' DoIt$3(1, 2, 3, 4);',
  3122. ' DoIt$4(1, 2, 3, 4, 5);',
  3123. ' DoIt$5(1, 2, 3, 4, 5, 6);',
  3124. ' };',
  3125. ' function DoIt$4(vA, vB, vC, vD, vE) {',
  3126. ' $mod.DoIt(1);',
  3127. ' $mod.DoIt$1(1, 2);',
  3128. ' DoIt$2(1, 2, 3);',
  3129. ' DoIt$3(1, 2, 3, 4);',
  3130. ' DoIt$4(1, 2, 3, 4, 5);',
  3131. ' DoIt$5(1, 2, 3, 4, 5, 6);',
  3132. ' };',
  3133. ' $mod.DoIt(1);',
  3134. ' $mod.DoIt$1(1, 2);',
  3135. ' DoIt$2(1, 2, 3);',
  3136. ' DoIt$3(1, 2, 3, 4);',
  3137. ' DoIt$4(1, 2, 3, 4, 5);',
  3138. ' DoIt$5(1, 2, 3, 4, 5, 6);',
  3139. ' };',
  3140. ' $mod.DoIt(1);',
  3141. ' $mod.DoIt$1(1, 2);',
  3142. ' DoIt$2(1, 2, 3);',
  3143. ' DoIt$3(1, 2, 3, 4);',
  3144. '};',
  3145. '']),
  3146. LinesToStr([
  3147. '$mod.DoIt(1);',
  3148. '$mod.DoIt$1(1, 2);',
  3149. '']));
  3150. end;
  3151. procedure TTestModule.TestProc_OverloadUnitCycle;
  3152. begin
  3153. AddModuleWithIntfImplSrc('Unit2.pas',
  3154. LinesToStr([
  3155. 'type',
  3156. ' TObject = class',
  3157. ' procedure DoIt(b: boolean); virtual; abstract;',
  3158. ' procedure DoIt(i: longint); virtual; abstract;',
  3159. ' end;',
  3160. '']),
  3161. 'uses test1;');
  3162. StartUnit(true);
  3163. Add([
  3164. 'interface',
  3165. 'uses unit2;',
  3166. 'type',
  3167. ' TEagle = class(TObject)',
  3168. ' procedure DoIt(b: boolean); override;',
  3169. ' procedure DoIt(i: longint); override;',
  3170. ' end;',
  3171. 'implementation',
  3172. 'procedure TEagle.DoIt(b: boolean); begin end;',
  3173. 'procedure TEagle.DoIt(i: longint); begin end;',
  3174. '']);
  3175. ConvertUnit;
  3176. CheckSource('TestProc_OverloadUnitCycle',
  3177. LinesToStr([ // statements
  3178. 'rtl.createClass($mod, "TEagle", pas.Unit2.TObject, function () {',
  3179. ' this.DoIt = function (b) {',
  3180. ' };',
  3181. ' this.DoIt$1 = function (i) {',
  3182. ' };',
  3183. '});',
  3184. '']),
  3185. '',
  3186. LinesToStr([
  3187. '']));
  3188. end;
  3189. procedure TTestModule.TestProc_Varargs;
  3190. begin
  3191. StartProgram(false);
  3192. Add([
  3193. 'procedure ProcA(i:longint); varargs; external name ''ProcA'';',
  3194. 'procedure ProcB; varargs; external name ''ProcB'';',
  3195. 'procedure ProcC(i: longint = 17); varargs; external name ''ProcC'';',
  3196. 'function GetIt: longint; begin end;',
  3197. 'begin',
  3198. ' ProcA(1);',
  3199. ' ProcA(1,2);',
  3200. ' ProcA(1,2.0);',
  3201. ' ProcA(1,2,3);',
  3202. ' ProcA(1,''2'');',
  3203. ' ProcA(2,'''');',
  3204. ' ProcA(3,false);',
  3205. ' ProcB;',
  3206. ' ProcB();',
  3207. ' ProcB(4);',
  3208. ' ProcB(''foo'');',
  3209. ' ProcC;',
  3210. ' ProcC();',
  3211. ' ProcC(4);',
  3212. ' ProcC(5,''foo'');',
  3213. ' ProcB(GetIt);',
  3214. ' ProcB(GetIt());',
  3215. ' ProcB(GetIt,GetIt());']);
  3216. ConvertProgram;
  3217. CheckSource('TestProc_Varargs',
  3218. LinesToStr([ // statements
  3219. 'this.GetIt = function () {',
  3220. ' var Result = 0;',
  3221. ' return Result;',
  3222. '};',
  3223. '']),
  3224. LinesToStr([
  3225. 'ProcA(1);',
  3226. 'ProcA(1, 2);',
  3227. 'ProcA(1, 2.0);',
  3228. 'ProcA(1, 2, 3);',
  3229. 'ProcA(1, "2");',
  3230. 'ProcA(2, "");',
  3231. 'ProcA(3, false);',
  3232. 'ProcB();',
  3233. 'ProcB();',
  3234. 'ProcB(4);',
  3235. 'ProcB("foo");',
  3236. 'ProcC(17);',
  3237. 'ProcC(17);',
  3238. 'ProcC(4);',
  3239. 'ProcC(5, "foo");',
  3240. 'ProcB($mod.GetIt());',
  3241. 'ProcB($mod.GetIt());',
  3242. 'ProcB($mod.GetIt(), $mod.GetIt());',
  3243. '']));
  3244. end;
  3245. procedure TTestModule.TestProc_ConstOrder;
  3246. begin
  3247. StartProgram(false);
  3248. Add([
  3249. 'const A = 3;',
  3250. 'const B = A+1;',
  3251. 'procedure DoIt;',
  3252. 'const C = A+1;',
  3253. 'const D = B+1;',
  3254. 'const E = D+C+B+A;',
  3255. 'begin',
  3256. 'end;',
  3257. 'begin'
  3258. ]);
  3259. ConvertProgram;
  3260. CheckSource('TestProc_ConstOrder',
  3261. LinesToStr([ // statements
  3262. 'this.A = 3;',
  3263. 'this.B = 3 + 1;',
  3264. 'var C = 3 + 1;',
  3265. 'var D = 4 + 1;',
  3266. 'var E = ((5 + 4) + 4) + 3;',
  3267. 'this.DoIt = function () {',
  3268. '};',
  3269. '']),
  3270. LinesToStr([
  3271. ''
  3272. ]));
  3273. end;
  3274. procedure TTestModule.TestProc_DuplicateConst;
  3275. begin
  3276. StartProgram(false);
  3277. Add([
  3278. 'const A = 1;',
  3279. 'procedure DoIt;',
  3280. 'const A = 2;',
  3281. ' procedure SubIt;',
  3282. ' const A = 21;',
  3283. ' begin',
  3284. ' end;',
  3285. 'begin',
  3286. 'end;',
  3287. 'procedure DoSome;',
  3288. 'const A = 3;',
  3289. 'begin',
  3290. 'end;',
  3291. 'begin'
  3292. ]);
  3293. ConvertProgram;
  3294. CheckSource('TestProc_DuplicateConst',
  3295. LinesToStr([ // statements
  3296. 'this.A = 1;',
  3297. 'var A$1 = 2;',
  3298. 'var A$2 = 21;',
  3299. 'this.DoIt = function () {',
  3300. ' function SubIt() {',
  3301. ' };',
  3302. '};',
  3303. 'var A$3 = 3;',
  3304. 'this.DoSome = function () {',
  3305. '};',
  3306. '']),
  3307. LinesToStr([
  3308. ''
  3309. ]));
  3310. end;
  3311. procedure TTestModule.TestProc_LocalVarAbsolute;
  3312. begin
  3313. StartProgram(false);
  3314. Add([
  3315. 'type',
  3316. ' TObject = class',
  3317. ' Index: longint;',
  3318. ' end;',
  3319. 'procedure DoIt(i: longint);',
  3320. 'var',
  3321. ' d: double absolute i;',
  3322. ' s: string absolute d;',
  3323. ' o: TObject absolute i;',
  3324. 'begin',
  3325. ' if d=d then d:=d;',
  3326. ' if s=s then s:=s;',
  3327. ' if o.Index<o.Index then o.Index:=o.Index;',
  3328. 'end;',
  3329. 'begin']);
  3330. ConvertProgram;
  3331. CheckSource('TestProc_LocalVarAbsolute',
  3332. LinesToStr([ // statements
  3333. 'rtl.createClass($mod, "TObject", null, function () {',
  3334. ' this.$init = function () {',
  3335. ' this.Index = 0;',
  3336. ' };',
  3337. ' this.$final = function () {',
  3338. ' };',
  3339. '});',
  3340. 'this.DoIt = function (i) {',
  3341. ' if (i === i) i = i;',
  3342. ' if (i === i) i = i;',
  3343. ' if (i.Index < i.Index) i.Index = i.Index;',
  3344. '};'
  3345. ]),
  3346. LinesToStr([
  3347. ]));
  3348. end;
  3349. procedure TTestModule.TestEnum_Name;
  3350. begin
  3351. StartProgram(false);
  3352. Add('type TMyEnum = (Red, Green, Blue);');
  3353. Add('var e: TMyEnum;');
  3354. Add('var f: TMyEnum = Blue;');
  3355. Add('begin');
  3356. Add(' e:=green;');
  3357. ConvertProgram;
  3358. CheckSource('TestEnumName',
  3359. LinesToStr([ // statements
  3360. 'this.TMyEnum = {',
  3361. ' "0":"Red",',
  3362. ' Red:0,',
  3363. ' "1":"Green",',
  3364. ' Green:1,',
  3365. ' "2":"Blue",',
  3366. ' Blue:2',
  3367. ' };',
  3368. 'this.e = 0;',
  3369. 'this.f = $mod.TMyEnum.Blue;'
  3370. ]),
  3371. LinesToStr([
  3372. '$mod.e=$mod.TMyEnum.Green;'
  3373. ]));
  3374. end;
  3375. procedure TTestModule.TestEnum_Number;
  3376. begin
  3377. Converter.Options:=Converter.Options+[coEnumNumbers];
  3378. StartProgram(false);
  3379. Add('type TMyEnum = (Red, Green);');
  3380. Add('var');
  3381. Add(' e: TMyEnum;');
  3382. Add(' f: TMyEnum = Green;');
  3383. Add(' i: longint;');
  3384. Add('begin');
  3385. Add(' e:=green;');
  3386. Add(' i:=longint(e);');
  3387. ConvertProgram;
  3388. CheckSource('TestEnumNumber',
  3389. LinesToStr([ // statements
  3390. 'this.TMyEnum = {',
  3391. ' "0":"Red",',
  3392. ' Red:0,',
  3393. ' "1":"Green",',
  3394. ' Green:1',
  3395. ' };',
  3396. 'this.e = 0;',
  3397. 'this.f = 1;',
  3398. 'this.i = 0;'
  3399. ]),
  3400. LinesToStr([
  3401. '$mod.e=1;',
  3402. '$mod.i=$mod.e;'
  3403. ]));
  3404. end;
  3405. procedure TTestModule.TestEnum_ConstFail;
  3406. begin
  3407. StartProgram(false);
  3408. Add([
  3409. 'type TMyEnum = (Red = 100, Green = 101);',
  3410. 'var',
  3411. ' e: TMyEnum;',
  3412. ' f: TMyEnum = Green;',
  3413. 'begin',
  3414. ' e:=green;']);
  3415. SetExpectedPasResolverError('not yet implemented: Red:TPasEnumValue [20180126202434] enum const',3002);
  3416. ConvertProgram;
  3417. end;
  3418. procedure TTestModule.TestEnum_Functions;
  3419. begin
  3420. StartProgram(false);
  3421. Add('type TMyEnum = (Red, Green);');
  3422. Add('var');
  3423. Add(' e: TMyEnum;');
  3424. Add(' i: longint;');
  3425. Add(' s: string;');
  3426. Add(' b: boolean;');
  3427. Add('begin');
  3428. Add(' i:=ord(red);');
  3429. Add(' i:=ord(green);');
  3430. Add(' i:=ord(e);');
  3431. Add(' i:=ord(b);');
  3432. Add(' e:=low(tmyenum);');
  3433. Add(' e:=low(e);');
  3434. Add(' b:=low(boolean);');
  3435. Add(' e:=high(tmyenum);');
  3436. Add(' e:=high(e);');
  3437. Add(' b:=high(boolean);');
  3438. Add(' e:=pred(green);');
  3439. Add(' e:=pred(e);');
  3440. Add(' b:=pred(b);');
  3441. Add(' e:=succ(red);');
  3442. Add(' e:=succ(e);');
  3443. Add(' b:=succ(b);');
  3444. Add(' e:=tmyenum(1);');
  3445. Add(' e:=tmyenum(i);');
  3446. Add(' s:=str(e);');
  3447. Add(' str(e,s);');
  3448. Add(' s:=str(e:3);');
  3449. Add(' e:=TMyEnum(i);');
  3450. Add(' i:=longint(e);');
  3451. ConvertProgram;
  3452. CheckSource('TestEnum_Functions',
  3453. LinesToStr([ // statements
  3454. 'this.TMyEnum = {',
  3455. ' "0":"Red",',
  3456. ' Red:0,',
  3457. ' "1":"Green",',
  3458. ' Green:1',
  3459. ' };',
  3460. 'this.e = 0;',
  3461. 'this.i = 0;',
  3462. 'this.s = "";',
  3463. 'this.b = false;',
  3464. '']),
  3465. LinesToStr([
  3466. '$mod.i=$mod.TMyEnum.Red;',
  3467. '$mod.i=$mod.TMyEnum.Green;',
  3468. '$mod.i=$mod.e;',
  3469. '$mod.i=$mod.b+0;',
  3470. '$mod.e=$mod.TMyEnum.Red;',
  3471. '$mod.e=$mod.TMyEnum.Red;',
  3472. '$mod.b=false;',
  3473. '$mod.e=$mod.TMyEnum.Green;',
  3474. '$mod.e=$mod.TMyEnum.Green;',
  3475. '$mod.b=true;',
  3476. '$mod.e=$mod.TMyEnum.Green-1;',
  3477. '$mod.e=$mod.e-1;',
  3478. '$mod.b=false;',
  3479. '$mod.e=$mod.TMyEnum.Red+1;',
  3480. '$mod.e=$mod.e+1;',
  3481. '$mod.b=true;',
  3482. '$mod.e=1;',
  3483. '$mod.e=$mod.i;',
  3484. '$mod.s = $mod.TMyEnum[$mod.e];',
  3485. '$mod.s = $mod.TMyEnum[$mod.e];',
  3486. '$mod.s = rtl.spaceLeft($mod.TMyEnum[$mod.e], 3);',
  3487. '$mod.e=$mod.i;',
  3488. '$mod.i=$mod.e;',
  3489. '']));
  3490. end;
  3491. procedure TTestModule.TestEnum_AsParams;
  3492. begin
  3493. StartProgram(false);
  3494. Add('type TEnum = (Red,Blue);');
  3495. Add('procedure DoIt(vG: TEnum; const vH: TEnum; var vI: TEnum);');
  3496. Add('var vJ: TEnum;');
  3497. Add('begin');
  3498. Add(' vg:=vg;');
  3499. Add(' vj:=vh;');
  3500. Add(' vi:=vi;');
  3501. Add(' doit(vg,vg,vg);');
  3502. Add(' doit(vh,vh,vj);');
  3503. Add(' doit(vi,vi,vi);');
  3504. Add(' doit(vj,vj,vj);');
  3505. Add('end;');
  3506. Add('var i: TEnum;');
  3507. Add('begin');
  3508. Add(' doit(i,i,i);');
  3509. ConvertProgram;
  3510. CheckSource('TestEnum_AsParams',
  3511. LinesToStr([ // statements
  3512. 'this.TEnum = {',
  3513. ' "0": "Red",',
  3514. ' Red: 0,',
  3515. ' "1": "Blue",',
  3516. ' Blue: 1',
  3517. '};',
  3518. 'this.DoIt = function (vG,vH,vI) {',
  3519. ' var vJ = 0;',
  3520. ' vG = vG;',
  3521. ' vJ = vH;',
  3522. ' vI.set(vI.get());',
  3523. ' $mod.DoIt(vG, vG, {',
  3524. ' get: function () {',
  3525. ' return vG;',
  3526. ' },',
  3527. ' set: function (v) {',
  3528. ' vG = v;',
  3529. ' }',
  3530. ' });',
  3531. ' $mod.DoIt(vH, vH, {',
  3532. ' get: function () {',
  3533. ' return vJ;',
  3534. ' },',
  3535. ' set: function (v) {',
  3536. ' vJ = v;',
  3537. ' }',
  3538. ' });',
  3539. ' $mod.DoIt(vI.get(), vI.get(), vI);',
  3540. ' $mod.DoIt(vJ, vJ, {',
  3541. ' get: function () {',
  3542. ' return vJ;',
  3543. ' },',
  3544. ' set: function (v) {',
  3545. ' vJ = v;',
  3546. ' }',
  3547. ' });',
  3548. '};',
  3549. 'this.i = 0;'
  3550. ]),
  3551. LinesToStr([
  3552. '$mod.DoIt($mod.i,$mod.i,{',
  3553. ' p: $mod,',
  3554. ' get: function () {',
  3555. ' return this.p.i;',
  3556. ' },',
  3557. ' set: function (v) {',
  3558. ' this.p.i = v;',
  3559. ' }',
  3560. '});'
  3561. ]));
  3562. end;
  3563. procedure TTestModule.TestEnumRange_Array;
  3564. begin
  3565. StartProgram(false);
  3566. Add([
  3567. 'type',
  3568. ' TEnum = (Red, Green, Blue);',
  3569. ' TEnumRg = green..blue;',
  3570. ' TArr = array[TEnumRg] of byte;',
  3571. ' TArr2 = array[green..blue] of byte;',
  3572. 'var',
  3573. ' a: TArr;',
  3574. ' b: TArr = (3,4);',
  3575. ' c: TArr2 = (5,6);',
  3576. 'begin',
  3577. ' a[green] := b[blue];',
  3578. ' c[green] := c[blue];',
  3579. '']);
  3580. ConvertProgram;
  3581. CheckSource('TestEnumRange_Array',
  3582. LinesToStr([ // statements
  3583. 'this.TEnum = {',
  3584. ' "0": "Red",',
  3585. ' Red: 0,',
  3586. ' "1": "Green",',
  3587. ' Green: 1,',
  3588. ' "2": "Blue",',
  3589. ' Blue: 2',
  3590. '};',
  3591. 'this.a = rtl.arraySetLength(null, 0, 2);',
  3592. 'this.b = [3, 4];',
  3593. 'this.c = [5, 6];',
  3594. '']),
  3595. LinesToStr([
  3596. ' $mod.a[$mod.TEnum.Green - 1] = $mod.b[$mod.TEnum.Blue - 1];',
  3597. ' $mod.c[$mod.TEnum.Green - 1] = $mod.c[$mod.TEnum.Blue - 1];',
  3598. '']));
  3599. end;
  3600. procedure TTestModule.TestEnum_ForIn;
  3601. begin
  3602. StartProgram(false);
  3603. Add([
  3604. 'type',
  3605. ' TEnum = (Red, Green, Blue);',
  3606. ' TEnumRg = green..blue;',
  3607. ' TArr = array[TEnum] of byte;',
  3608. ' TArrRg = array[TEnumRg] of byte;',
  3609. 'var',
  3610. ' e: TEnum;',
  3611. ' a1: TArr = (3,4,5);',
  3612. ' a2: TArrRg = (11,12);',
  3613. ' b: byte;',
  3614. 'begin',
  3615. ' for e in TEnum do ;',
  3616. ' for e in TEnumRg do ;',
  3617. ' for e in TArr do ;',
  3618. ' for e in TArrRg do ;',
  3619. ' for b in a1 do ;',
  3620. ' for b in a2 do ;',
  3621. '']);
  3622. ConvertProgram;
  3623. CheckSource('TestEnum_ForIn',
  3624. LinesToStr([ // statements
  3625. 'this.TEnum = {',
  3626. ' "0": "Red",',
  3627. ' Red: 0,',
  3628. ' "1": "Green",',
  3629. ' Green: 1,',
  3630. ' "2": "Blue",',
  3631. ' Blue: 2',
  3632. '};',
  3633. 'this.e = 0;',
  3634. 'this.a1 = [3, 4, 5];',
  3635. 'this.a2 = [11, 12];',
  3636. 'this.b = 0;',
  3637. '']),
  3638. LinesToStr([
  3639. ' for ($mod.e = 0; $mod.e <= 2; $mod.e++) ;',
  3640. ' for ($mod.e = 1; $mod.e <= 2; $mod.e++) ;',
  3641. ' for ($mod.e = 0; $mod.e <= 2; $mod.e++) ;',
  3642. ' for ($mod.e = 1; $mod.e <= 2; $mod.e++) ;',
  3643. ' for (var $in1 = $mod.a1, $l2 = 0, $end3 = rtl.length($in1) - 1; $l2 <= $end3; $l2++) $mod.b = $in1[$l2];',
  3644. ' for (var $in4 = $mod.a2, $l5 = 0, $end6 = rtl.length($in4) - 1; $l5 <= $end6; $l5++) $mod.b = $in4[$l5];',
  3645. '']));
  3646. end;
  3647. procedure TTestModule.TestEnum_ScopedNumber;
  3648. begin
  3649. Converter.Options:=Converter.Options+[coEnumNumbers];
  3650. StartProgram(false);
  3651. Add([
  3652. 'type',
  3653. ' TEnum = (Red, Green);',
  3654. 'var',
  3655. ' e: TEnum;',
  3656. 'begin',
  3657. ' e:=TEnum.Green;',
  3658. '']);
  3659. ConvertProgram;
  3660. CheckSource('TestEnum_ScopedNumber',
  3661. LinesToStr([ // statements
  3662. 'this.TEnum = {',
  3663. ' "0": "Red",',
  3664. ' Red: 0,',
  3665. ' "1": "Green",',
  3666. ' Green: 1',
  3667. '};',
  3668. 'this.e = 0;',
  3669. '']),
  3670. LinesToStr([
  3671. '$mod.e = 1;']));
  3672. end;
  3673. procedure TTestModule.TestSet;
  3674. begin
  3675. StartProgram(false);
  3676. Add([
  3677. 'type',
  3678. ' TColor = (Red, Green, Blue);',
  3679. ' TColors = set of TColor;',
  3680. 'var',
  3681. ' c: TColor;',
  3682. ' s: TColors;',
  3683. ' t: TColors = [];',
  3684. ' u: TColors = [Red];',
  3685. 'begin',
  3686. ' s:=[];',
  3687. ' s:=[Green];',
  3688. ' s:=[Green,Blue];',
  3689. ' s:=[Red..Blue];',
  3690. ' s:=[Red,Green..Blue];',
  3691. ' s:=[Red,c];',
  3692. ' s:=t;']);
  3693. ConvertProgram;
  3694. CheckSource('TestEnumName',
  3695. LinesToStr([ // statements
  3696. 'this.TColor = {',
  3697. ' "0":"Red",',
  3698. ' Red:0,',
  3699. ' "1":"Green",',
  3700. ' Green:1,',
  3701. ' "2":"Blue",',
  3702. ' Blue:2',
  3703. ' };',
  3704. 'this.c = 0;',
  3705. 'this.s = {};',
  3706. 'this.t = {};',
  3707. 'this.u = rtl.createSet($mod.TColor.Red);'
  3708. ]),
  3709. LinesToStr([
  3710. '$mod.s={};',
  3711. '$mod.s=rtl.createSet($mod.TColor.Green);',
  3712. '$mod.s=rtl.createSet($mod.TColor.Green,$mod.TColor.Blue);',
  3713. '$mod.s=rtl.createSet(null,$mod.TColor.Red,$mod.TColor.Blue);',
  3714. '$mod.s=rtl.createSet($mod.TColor.Red,null,$mod.TColor.Green,$mod.TColor.Blue);',
  3715. '$mod.s=rtl.createSet($mod.TColor.Red,$mod.c);',
  3716. '$mod.s=rtl.refSet($mod.t);',
  3717. '']));
  3718. end;
  3719. procedure TTestModule.TestSet_Operators;
  3720. begin
  3721. StartProgram(false);
  3722. Add('type');
  3723. Add(' TColor = (Red, Green, Blue);');
  3724. Add(' TColors = set of tcolor;');
  3725. Add('var');
  3726. Add(' vC: TColor;');
  3727. Add(' vS: TColors;');
  3728. Add(' vT: TColors;');
  3729. Add(' vU: TColors;');
  3730. Add(' B: boolean;');
  3731. Add('begin');
  3732. Add(' include(vs,green);');
  3733. Add(' exclude(vs,vc);');
  3734. Add(' vs:=vt+vu;');
  3735. Add(' vs:=vt+[red];');
  3736. Add(' vs:=[red]+vt;');
  3737. Add(' vs:=[red]+[green];');
  3738. Add(' vs:=vt-vu;');
  3739. Add(' vs:=vt-[red];');
  3740. Add(' vs:=[red]-vt;');
  3741. Add(' vs:=[red]-[green];');
  3742. Add(' vs:=vt*vu;');
  3743. Add(' vs:=vt*[red];');
  3744. Add(' vs:=[red]*vt;');
  3745. Add(' vs:=[red]*[green];');
  3746. Add(' vs:=vt><vu;');
  3747. Add(' vs:=vt><[red];');
  3748. Add(' vs:=[red]><vt;');
  3749. Add(' vs:=[red]><[green];');
  3750. Add(' b:=vt=vu;');
  3751. Add(' b:=vt=[red];');
  3752. Add(' b:=[red]=vt;');
  3753. Add(' b:=[red]=[green];');
  3754. Add(' b:=vt<>vu;');
  3755. Add(' b:=vt<>[red];');
  3756. Add(' b:=[red]<>vt;');
  3757. Add(' b:=[red]<>[green];');
  3758. Add(' b:=vt<=vu;');
  3759. Add(' b:=vt<=[red];');
  3760. Add(' b:=[red]<=vt;');
  3761. Add(' b:=[red]<=[green];');
  3762. Add(' b:=vt>=vu;');
  3763. Add(' b:=vt>=[red];');
  3764. Add(' b:=[red]>=vt;');
  3765. Add(' b:=[red]>=[green];');
  3766. ConvertProgram;
  3767. CheckSource('TestSet_Operators',
  3768. LinesToStr([ // statements
  3769. 'this.TColor = {',
  3770. ' "0":"Red",',
  3771. ' Red:0,',
  3772. ' "1":"Green",',
  3773. ' Green:1,',
  3774. ' "2":"Blue",',
  3775. ' Blue:2',
  3776. ' };',
  3777. 'this.vC = 0;',
  3778. 'this.vS = {};',
  3779. 'this.vT = {};',
  3780. 'this.vU = {};',
  3781. 'this.B = false;'
  3782. ]),
  3783. LinesToStr([
  3784. '$mod.vS = rtl.includeSet($mod.vS,$mod.TColor.Green);',
  3785. '$mod.vS = rtl.excludeSet($mod.vS,$mod.vC);',
  3786. '$mod.vS = rtl.unionSet($mod.vT, $mod.vU);',
  3787. '$mod.vS = rtl.unionSet($mod.vT, rtl.createSet($mod.TColor.Red));',
  3788. '$mod.vS = rtl.unionSet(rtl.createSet($mod.TColor.Red), $mod.vT);',
  3789. '$mod.vS = rtl.unionSet(rtl.createSet($mod.TColor.Red), rtl.createSet($mod.TColor.Green));',
  3790. '$mod.vS = rtl.diffSet($mod.vT, $mod.vU);',
  3791. '$mod.vS = rtl.diffSet($mod.vT, rtl.createSet($mod.TColor.Red));',
  3792. '$mod.vS = rtl.diffSet(rtl.createSet($mod.TColor.Red), $mod.vT);',
  3793. '$mod.vS = rtl.diffSet(rtl.createSet($mod.TColor.Red), rtl.createSet($mod.TColor.Green));',
  3794. '$mod.vS = rtl.intersectSet($mod.vT, $mod.vU);',
  3795. '$mod.vS = rtl.intersectSet($mod.vT, rtl.createSet($mod.TColor.Red));',
  3796. '$mod.vS = rtl.intersectSet(rtl.createSet($mod.TColor.Red), $mod.vT);',
  3797. '$mod.vS = rtl.intersectSet(rtl.createSet($mod.TColor.Red), rtl.createSet($mod.TColor.Green));',
  3798. '$mod.vS = rtl.symDiffSet($mod.vT, $mod.vU);',
  3799. '$mod.vS = rtl.symDiffSet($mod.vT, rtl.createSet($mod.TColor.Red));',
  3800. '$mod.vS = rtl.symDiffSet(rtl.createSet($mod.TColor.Red), $mod.vT);',
  3801. '$mod.vS = rtl.symDiffSet(rtl.createSet($mod.TColor.Red), rtl.createSet($mod.TColor.Green));',
  3802. '$mod.B = rtl.eqSet($mod.vT, $mod.vU);',
  3803. '$mod.B = rtl.eqSet($mod.vT, rtl.createSet($mod.TColor.Red));',
  3804. '$mod.B = rtl.eqSet(rtl.createSet($mod.TColor.Red), $mod.vT);',
  3805. '$mod.B = rtl.eqSet(rtl.createSet($mod.TColor.Red), rtl.createSet($mod.TColor.Green));',
  3806. '$mod.B = rtl.neSet($mod.vT, $mod.vU);',
  3807. '$mod.B = rtl.neSet($mod.vT, rtl.createSet($mod.TColor.Red));',
  3808. '$mod.B = rtl.neSet(rtl.createSet($mod.TColor.Red), $mod.vT);',
  3809. '$mod.B = rtl.neSet(rtl.createSet($mod.TColor.Red), rtl.createSet($mod.TColor.Green));',
  3810. '$mod.B = rtl.leSet($mod.vT, $mod.vU);',
  3811. '$mod.B = rtl.leSet($mod.vT, rtl.createSet($mod.TColor.Red));',
  3812. '$mod.B = rtl.leSet(rtl.createSet($mod.TColor.Red), $mod.vT);',
  3813. '$mod.B = rtl.leSet(rtl.createSet($mod.TColor.Red), rtl.createSet($mod.TColor.Green));',
  3814. '$mod.B = rtl.geSet($mod.vT, $mod.vU);',
  3815. '$mod.B = rtl.geSet($mod.vT, rtl.createSet($mod.TColor.Red));',
  3816. '$mod.B = rtl.geSet(rtl.createSet($mod.TColor.Red), $mod.vT);',
  3817. '$mod.B = rtl.geSet(rtl.createSet($mod.TColor.Red), rtl.createSet($mod.TColor.Green));',
  3818. '']));
  3819. end;
  3820. procedure TTestModule.TestSet_Operator_In;
  3821. begin
  3822. StartProgram(false);
  3823. Add('type');
  3824. Add(' TColor = (Red, Green, Blue);');
  3825. Add(' TColors = set of tcolor;');
  3826. Add('var');
  3827. Add(' vC: tcolor;');
  3828. Add(' vT: tcolors;');
  3829. Add(' B: boolean;');
  3830. Add('begin');
  3831. Add(' b:=red in vt;');
  3832. Add(' b:=vc in vt;');
  3833. Add(' b:=green in [red..blue];');
  3834. Add(' b:=vc in [red..blue];');
  3835. Add(' ');
  3836. Add(' if red in vt then ;');
  3837. Add(' while vC in vt do ;');
  3838. Add(' repeat');
  3839. Add(' until vC in vt;');
  3840. ConvertProgram;
  3841. CheckSource('TestSet_Operator_In',
  3842. LinesToStr([ // statements
  3843. 'this.TColor = {',
  3844. ' "0":"Red",',
  3845. ' Red:0,',
  3846. ' "1":"Green",',
  3847. ' Green:1,',
  3848. ' "2":"Blue",',
  3849. ' Blue:2',
  3850. ' };',
  3851. 'this.vC = 0;',
  3852. 'this.vT = {};',
  3853. 'this.B = false;'
  3854. ]),
  3855. LinesToStr([
  3856. '$mod.B = $mod.TColor.Red in $mod.vT;',
  3857. '$mod.B = $mod.vC in $mod.vT;',
  3858. '$mod.B = $mod.TColor.Green in rtl.createSet(null, $mod.TColor.Red, $mod.TColor.Blue);',
  3859. '$mod.B = $mod.vC in rtl.createSet(null, $mod.TColor.Red, $mod.TColor.Blue);',
  3860. 'if ($mod.TColor.Red in $mod.vT) ;',
  3861. 'while ($mod.vC in $mod.vT) {',
  3862. '};',
  3863. 'do {',
  3864. '} while (!($mod.vC in $mod.vT));',
  3865. '']));
  3866. end;
  3867. procedure TTestModule.TestSet_Functions;
  3868. begin
  3869. StartProgram(false);
  3870. Add('type');
  3871. Add(' TMyEnum = (Red, Green);');
  3872. Add(' TMyEnums = set of TMyEnum;');
  3873. Add('var');
  3874. Add(' e: TMyEnum;');
  3875. Add(' s: TMyEnums;');
  3876. Add('begin');
  3877. Add(' e:=Low(TMyEnums);');
  3878. Add(' e:=Low(s);');
  3879. Add(' e:=High(TMyEnums);');
  3880. Add(' e:=High(s);');
  3881. ConvertProgram;
  3882. CheckSource('TestSetFunctions',
  3883. LinesToStr([ // statements
  3884. 'this.TMyEnum = {',
  3885. ' "0":"Red",',
  3886. ' Red:0,',
  3887. ' "1":"Green",',
  3888. ' Green:1',
  3889. ' };',
  3890. 'this.e = 0;',
  3891. 'this.s = {};'
  3892. ]),
  3893. LinesToStr([
  3894. '$mod.e=$mod.TMyEnum.Red;',
  3895. '$mod.e=$mod.TMyEnum.Red;',
  3896. '$mod.e=$mod.TMyEnum.Green;',
  3897. '$mod.e=$mod.TMyEnum.Green;',
  3898. '']));
  3899. end;
  3900. procedure TTestModule.TestSet_PassAsArgClone;
  3901. begin
  3902. StartProgram(false);
  3903. Add('type');
  3904. Add(' TMyEnum = (Red, Green);');
  3905. Add(' TMyEnums = set of TMyEnum;');
  3906. Add('procedure DoDefault(s: tmyenums); begin end;');
  3907. Add('procedure DoConst(const s: tmyenums); begin end;');
  3908. Add('var');
  3909. Add(' aSet: tmyenums;');
  3910. Add('begin');
  3911. Add(' dodefault(aset);');
  3912. Add(' doconst(aset);');
  3913. ConvertProgram;
  3914. CheckSource('TestSetFunctions',
  3915. LinesToStr([ // statements
  3916. 'this.TMyEnum = {',
  3917. ' "0":"Red",',
  3918. ' Red:0,',
  3919. ' "1":"Green",',
  3920. ' Green:1',
  3921. ' };',
  3922. 'this.DoDefault = function (s) {',
  3923. '};',
  3924. 'this.DoConst = function (s) {',
  3925. '};',
  3926. 'this.aSet = {};'
  3927. ]),
  3928. LinesToStr([
  3929. '$mod.DoDefault(rtl.refSet($mod.aSet));',
  3930. '$mod.DoConst($mod.aSet);',
  3931. '']));
  3932. end;
  3933. procedure TTestModule.TestSet_AsParams;
  3934. begin
  3935. StartProgram(false);
  3936. Add('type TEnum = (Red,Blue);');
  3937. Add('type TEnums = set of TEnum;');
  3938. Add('procedure DoIt(vG: TEnums; const vH: TEnums; var vI: TEnums);');
  3939. Add('var vJ: TEnums;');
  3940. Add('begin');
  3941. Add(' vg:=vg;');
  3942. Add(' vj:=vh;');
  3943. Add(' vi:=vi;');
  3944. Add(' doit(vg,vg,vg);');
  3945. Add(' doit(vh,vh,vj);');
  3946. Add(' doit(vi,vi,vi);');
  3947. Add(' doit(vj,vj,vj);');
  3948. Add('end;');
  3949. Add('var i: TEnums;');
  3950. Add('begin');
  3951. Add(' doit(i,i,i);');
  3952. ConvertProgram;
  3953. CheckSource('TestSet_AsParams',
  3954. LinesToStr([ // statements
  3955. 'this.TEnum = {',
  3956. ' "0": "Red",',
  3957. ' Red: 0,',
  3958. ' "1": "Blue",',
  3959. ' Blue: 1',
  3960. '};',
  3961. 'this.DoIt = function (vG,vH,vI) {',
  3962. ' var vJ = {};',
  3963. ' vG = rtl.refSet(vG);',
  3964. ' vJ = rtl.refSet(vH);',
  3965. ' vI.set(rtl.refSet(vI.get()));',
  3966. ' $mod.DoIt(rtl.refSet(vG), vG, {',
  3967. ' get: function () {',
  3968. ' return vG;',
  3969. ' },',
  3970. ' set: function (v) {',
  3971. ' vG = v;',
  3972. ' }',
  3973. ' });',
  3974. ' $mod.DoIt(rtl.refSet(vH), vH, {',
  3975. ' get: function () {',
  3976. ' return vJ;',
  3977. ' },',
  3978. ' set: function (v) {',
  3979. ' vJ = v;',
  3980. ' }',
  3981. ' });',
  3982. ' $mod.DoIt(rtl.refSet(vI.get()), vI.get(), vI);',
  3983. ' $mod.DoIt(rtl.refSet(vJ), vJ, {',
  3984. ' get: function () {',
  3985. ' return vJ;',
  3986. ' },',
  3987. ' set: function (v) {',
  3988. ' vJ = v;',
  3989. ' }',
  3990. ' });',
  3991. '};',
  3992. 'this.i = {};'
  3993. ]),
  3994. LinesToStr([
  3995. '$mod.DoIt(rtl.refSet($mod.i),$mod.i,{',
  3996. ' p: $mod,',
  3997. ' get: function () {',
  3998. ' return this.p.i;',
  3999. ' },',
  4000. ' set: function (v) {',
  4001. ' this.p.i = v;',
  4002. ' }',
  4003. '});'
  4004. ]));
  4005. end;
  4006. procedure TTestModule.TestSet_Property;
  4007. begin
  4008. StartProgram(false);
  4009. Add('type');
  4010. Add(' TEnum = (Red,Blue);');
  4011. Add(' TEnums = set of TEnum;');
  4012. Add(' TObject = class');
  4013. Add(' function GetColors: TEnums; external name ''GetColors'';');
  4014. Add(' procedure SetColors(const Value: TEnums); external name ''SetColors'';');
  4015. Add(' property Colors: TEnums read GetColors write SetColors;');
  4016. Add(' end;');
  4017. Add('procedure DoIt(i: TEnums; const j: TEnums; var k: TEnums; out l: TEnums);');
  4018. Add('begin end;');
  4019. Add('var Obj: TObject;');
  4020. Add('begin');
  4021. Add(' Include(Obj.Colors,Red);');
  4022. Add(' Exclude(Obj.Colors,Red);');
  4023. //Add(' DoIt(Obj.Colors,Obj.Colors,Obj.Colors,Obj.Colors);');
  4024. ConvertProgram;
  4025. CheckSource('TestSet_Property',
  4026. LinesToStr([ // statements
  4027. 'this.TEnum = {',
  4028. ' "0": "Red",',
  4029. ' Red: 0,',
  4030. ' "1": "Blue",',
  4031. ' Blue: 1',
  4032. '};',
  4033. 'rtl.createClass($mod, "TObject", null, function () {',
  4034. ' this.$init = function () {',
  4035. ' };',
  4036. ' this.$final = function () {',
  4037. ' };',
  4038. '});',
  4039. 'this.DoIt = function (i, j, k, l) {',
  4040. '};',
  4041. 'this.Obj = null;',
  4042. '']),
  4043. LinesToStr([
  4044. '$mod.Obj.SetColors(rtl.includeSet($mod.Obj.GetColors(), $mod.TEnum.Red));',
  4045. '$mod.Obj.SetColors(rtl.excludeSet($mod.Obj.GetColors(), $mod.TEnum.Red));',
  4046. '']));
  4047. end;
  4048. procedure TTestModule.TestSet_EnumConst;
  4049. begin
  4050. StartProgram(false);
  4051. Add('type');
  4052. Add(' TEnum = (Red,Blue);');
  4053. Add(' TEnums = set of TEnum;');
  4054. Add('const');
  4055. Add(' Orange = red;');
  4056. Add('var');
  4057. Add(' Enum: tenum;');
  4058. Add(' Enums: tenums;');
  4059. Add('begin');
  4060. Add(' Include(enums,orange);');
  4061. Add(' Exclude(enums,orange);');
  4062. Add(' if orange in enums then;');
  4063. Add(' if orange in [orange,red] then;');
  4064. ConvertProgram;
  4065. CheckSource('TestEnumConst',
  4066. LinesToStr([ // statements
  4067. 'this.TEnum = {',
  4068. ' "0": "Red",',
  4069. ' Red: 0,',
  4070. ' "1": "Blue",',
  4071. ' Blue: 1',
  4072. '};',
  4073. 'this.Orange = $mod.TEnum.Red;',
  4074. 'this.Enum = 0;',
  4075. 'this.Enums = {};',
  4076. '']),
  4077. LinesToStr([
  4078. '$mod.Enums = rtl.includeSet($mod.Enums, $mod.TEnum.Red);',
  4079. '$mod.Enums = rtl.excludeSet($mod.Enums, $mod.TEnum.Red);',
  4080. 'if ($mod.TEnum.Red in $mod.Enums) ;',
  4081. 'if ($mod.TEnum.Red in rtl.createSet($mod.TEnum.Red, $mod.TEnum.Red)) ;',
  4082. '']));
  4083. end;
  4084. procedure TTestModule.TestSet_AnonymousEnumType;
  4085. begin
  4086. StartProgram(false);
  4087. Add('type');
  4088. Add(' TFlags = set of (red, green);');
  4089. Add('const');
  4090. Add(' favorite = red;');
  4091. Add('var');
  4092. Add(' f: TFlags;');
  4093. Add(' i: longint;');
  4094. Add('begin');
  4095. Add(' Include(f,red);');
  4096. Add(' Include(f,favorite);');
  4097. Add(' i:=ord(red);');
  4098. Add(' i:=ord(favorite);');
  4099. Add(' i:=ord(low(TFlags));');
  4100. Add(' i:=ord(low(f));');
  4101. Add(' i:=ord(low(favorite));');
  4102. Add(' i:=ord(high(TFlags));');
  4103. Add(' i:=ord(high(f));');
  4104. Add(' i:=ord(high(favorite));');
  4105. Add(' f:=[green,favorite];');
  4106. ConvertProgram;
  4107. CheckSource('TestSet_AnonymousEnumType',
  4108. LinesToStr([ // statements
  4109. 'this.TFlags$a = {',
  4110. ' "0": "red",',
  4111. ' red: 0,',
  4112. ' "1": "green",',
  4113. ' green: 1',
  4114. '};',
  4115. 'this.favorite = $mod.TFlags$a.red;',
  4116. 'this.f = {};',
  4117. 'this.i = 0;',
  4118. '']),
  4119. LinesToStr([
  4120. '$mod.f = rtl.includeSet($mod.f, $mod.TFlags$a.red);',
  4121. '$mod.f = rtl.includeSet($mod.f, $mod.TFlags$a.red);',
  4122. '$mod.i = $mod.TFlags$a.red;',
  4123. '$mod.i = $mod.TFlags$a.red;',
  4124. '$mod.i = $mod.TFlags$a.red;',
  4125. '$mod.i = $mod.TFlags$a.red;',
  4126. '$mod.i = $mod.TFlags$a.red;',
  4127. '$mod.i = $mod.TFlags$a.green;',
  4128. '$mod.i = $mod.TFlags$a.green;',
  4129. '$mod.i = $mod.TFlags$a.green;',
  4130. '$mod.f = rtl.createSet($mod.TFlags$a.green, $mod.TFlags$a.red);',
  4131. '']));
  4132. end;
  4133. procedure TTestModule.TestSet_AnonymousEnumTypeChar;
  4134. begin
  4135. exit;
  4136. StartProgram(false);
  4137. Add([
  4138. 'type',
  4139. ' TAtoZ = ''A''..''Z'';',
  4140. ' TSetOfAZ = set of TAtoZ;',
  4141. 'var',
  4142. ' c: char;',
  4143. ' a: TAtoZ;',
  4144. ' s: TSetOfAZ = [''P'',''A''];',
  4145. ' i: longint;',
  4146. 'begin',
  4147. ' Include(s,''S'');',
  4148. ' Include(s,c);',
  4149. ' Include(s,a);',
  4150. ' c:=low(TAtoZ);',
  4151. ' i:=ord(low(TAtoZ));',
  4152. ' a:=high(TAtoZ);',
  4153. ' a:=high(TSetOfAtoZ);',
  4154. ' s:=[a,c,''M''];',
  4155. '']);
  4156. ConvertProgram;
  4157. CheckSource('TestSet_AnonymousEnumTypeChar',
  4158. LinesToStr([ // statements
  4159. '']),
  4160. LinesToStr([
  4161. '']));
  4162. end;
  4163. procedure TTestModule.TestSet_ConstEnum;
  4164. begin
  4165. StartProgram(false);
  4166. Add([
  4167. 'type',
  4168. ' TEnum = (red,blue,green);',
  4169. ' TEnums = set of TEnum;',
  4170. 'const',
  4171. ' teAny = [low(TEnum)..high(TEnum)];',
  4172. ' teRedBlue = [low(TEnum)..pred(high(TEnum))];',
  4173. 'var',
  4174. ' e: TEnum;',
  4175. ' s: TEnums;',
  4176. 'begin',
  4177. ' if blue in teAny then;',
  4178. ' if blue in teAny+[e] then;',
  4179. ' if blue in teAny+teRedBlue then;',
  4180. ' if e in [red,blue] then;',
  4181. ' s:=teAny;',
  4182. ' s:=teAny+[e];',
  4183. ' s:=[e]+teAny;',
  4184. ' s:=teAny+teRedBlue;',
  4185. ' s:=teAny+teRedBlue+[e];',
  4186. '']);
  4187. ConvertProgram;
  4188. CheckSource('TestSet_ConstEnum',
  4189. LinesToStr([ // statements
  4190. 'this.TEnum = {',
  4191. ' "0": "red",',
  4192. ' red: 0,',
  4193. ' "1": "blue",',
  4194. ' blue: 1,',
  4195. ' "2": "green",',
  4196. ' green: 2',
  4197. '};',
  4198. 'this.teAny = rtl.createSet(null, $mod.TEnum.red, $mod.TEnum.green);',
  4199. 'this.teRedBlue = rtl.createSet(null, $mod.TEnum.red, $mod.TEnum.green - 1);',
  4200. 'this.e = 0;',
  4201. 'this.s = {};',
  4202. '']),
  4203. LinesToStr([
  4204. 'if ($mod.TEnum.blue in $mod.teAny) ;',
  4205. 'if ($mod.TEnum.blue in rtl.unionSet($mod.teAny, rtl.createSet($mod.e))) ;',
  4206. 'if ($mod.TEnum.blue in rtl.unionSet($mod.teAny, $mod.teRedBlue)) ;',
  4207. 'if ($mod.e in rtl.createSet($mod.TEnum.red, $mod.TEnum.blue)) ;',
  4208. '$mod.s = rtl.refSet($mod.teAny);',
  4209. '$mod.s = rtl.unionSet($mod.teAny, rtl.createSet($mod.e));',
  4210. '$mod.s = rtl.unionSet(rtl.createSet($mod.e), $mod.teAny);',
  4211. '$mod.s = rtl.unionSet($mod.teAny, $mod.teRedBlue);',
  4212. '$mod.s = rtl.unionSet(rtl.unionSet($mod.teAny, $mod.teRedBlue), rtl.createSet($mod.e));',
  4213. '']));
  4214. end;
  4215. procedure TTestModule.TestSet_ConstChar;
  4216. begin
  4217. StartProgram(false);
  4218. Add([
  4219. 'const',
  4220. ' LowChars = [''a''..''z''];',
  4221. ' Chars = LowChars+[''A''..''Z''];',
  4222. 'var',
  4223. ' c: char;',
  4224. ' s: string;',
  4225. 'begin',
  4226. ' if c in lowchars then ;',
  4227. ' if ''a'' in lowchars then ;',
  4228. ' if s[1] in lowchars then ;',
  4229. ' if c in chars then ;',
  4230. ' if c in [''a''..''z'',''_''] then ;',
  4231. ' if ''b'' in [''a''..''z'',''_''] then ;',
  4232. '']);
  4233. ConvertProgram;
  4234. CheckSource('TestSet_ConstChar',
  4235. LinesToStr([ // statements
  4236. 'this.LowChars = rtl.createSet(null, 97, 122);',
  4237. 'this.Chars = rtl.unionSet($mod.LowChars, rtl.createSet(null, 65, 90));',
  4238. 'this.c = "";',
  4239. 'this.s = "";',
  4240. '']),
  4241. LinesToStr([
  4242. 'if ($mod.c.charCodeAt() in $mod.LowChars) ;',
  4243. 'if (97 in $mod.LowChars) ;',
  4244. 'if ($mod.s.charCodeAt(0) in $mod.LowChars) ;',
  4245. 'if ($mod.c.charCodeAt() in $mod.Chars) ;',
  4246. 'if ($mod.c.charCodeAt() in rtl.createSet(null, 97, 122, 95)) ;',
  4247. 'if (98 in rtl.createSet(null, 97, 122, 95)) ;',
  4248. '']));
  4249. end;
  4250. procedure TTestModule.TestSet_ConstInt;
  4251. begin
  4252. StartProgram(false);
  4253. Add([
  4254. 'const',
  4255. ' Months = [1..12];',
  4256. ' Mirror = [-12..-1]+Months;',
  4257. 'var',
  4258. ' i: smallint;',
  4259. 'begin',
  4260. ' if 3 in Months then;',
  4261. ' if i in Months+[i] then;',
  4262. ' if i in Months+Mirror then;',
  4263. ' if i in [4..6,8] then;',
  4264. '']);
  4265. ConvertProgram;
  4266. CheckSource('TestSet_ConstInt',
  4267. LinesToStr([ // statements
  4268. 'this.Months = rtl.createSet(null, 1, 12);',
  4269. 'this.Mirror = rtl.unionSet(rtl.createSet(null, -12, -1), $mod.Months);',
  4270. 'this.i = 0;',
  4271. '']),
  4272. LinesToStr([
  4273. 'if (3 in $mod.Months) ;',
  4274. 'if ($mod.i in rtl.unionSet($mod.Months, rtl.createSet($mod.i))) ;',
  4275. 'if ($mod.i in rtl.unionSet($mod.Months, $mod.Mirror)) ;',
  4276. 'if ($mod.i in rtl.createSet(null, 4, 6, 8)) ;',
  4277. '']));
  4278. end;
  4279. procedure TTestModule.TestSet_ForIn;
  4280. begin
  4281. StartProgram(false);
  4282. Add([
  4283. 'type',
  4284. ' TEnum = (Red, Green, Blue);',
  4285. ' TEnumRg = green..blue;',
  4286. ' TSetOfEnum = set of TEnum;',
  4287. ' TSetOfEnumRg = set of TEnumRg;',
  4288. 'var',
  4289. ' e, e2: TEnum;',
  4290. ' er: TEnum;',
  4291. ' s: TSetOfEnum;',
  4292. 'begin',
  4293. ' for e in TSetOfEnum do ;',
  4294. ' for e in TSetOfEnumRg do ;',
  4295. ' for e in [] do e2:=e;',
  4296. ' for e in [red..green] do e2:=e;',
  4297. ' for e in [green,blue] do e2:=e;',
  4298. ' for e in [red,blue] do e2:=e;',
  4299. ' for e in s do e2:=e;',
  4300. ' for er in TSetOfEnumRg do ;',
  4301. '']);
  4302. ConvertProgram;
  4303. CheckSource('TestEnumName',
  4304. LinesToStr([ // statements
  4305. 'this.TEnum = {',
  4306. ' "0":"Red",',
  4307. ' Red:0,',
  4308. ' "1":"Green",',
  4309. ' Green:1,',
  4310. ' "2":"Blue",',
  4311. ' Blue:2',
  4312. ' };',
  4313. 'this.e = 0;',
  4314. 'this.e2 = 0;',
  4315. 'this.er = 0;',
  4316. 'this.s = {};',
  4317. '']),
  4318. LinesToStr([
  4319. 'for ($mod.e = 0; $mod.e <= 2; $mod.e++) ;',
  4320. 'for ($mod.e = 1; $mod.e <= 2; $mod.e++) ;',
  4321. 'for ($mod.e = 0; $mod.e <= 1; $mod.e++) $mod.e2 = $mod.e;',
  4322. 'for ($mod.e = 1; $mod.e <= 2; $mod.e++) $mod.e2 = $mod.e;',
  4323. 'for ($mod.e in rtl.createSet($mod.TEnum.Red, $mod.TEnum.Blue)) $mod.e2 = $mod.e;',
  4324. 'for ($mod.e in $mod.s) $mod.e2 = $mod.e;',
  4325. 'for ($mod.er = 1; $mod.er <= 2; $mod.er++) ;',
  4326. '']));
  4327. end;
  4328. procedure TTestModule.TestNestBegin;
  4329. begin
  4330. StartProgram(false);
  4331. Add('begin');
  4332. Add(' begin');
  4333. Add(' begin');
  4334. Add(' end;');
  4335. Add(' begin');
  4336. Add(' if true then ;');
  4337. Add(' end;');
  4338. Add(' end;');
  4339. ConvertProgram;
  4340. CheckSource('TestNestBegin',
  4341. '',
  4342. 'if (true) ;');
  4343. end;
  4344. procedure TTestModule.TestUnitImplVars;
  4345. begin
  4346. StartUnit(false);
  4347. Add('interface');
  4348. Add('implementation');
  4349. Add('var');
  4350. Add(' V1:longint;');
  4351. Add(' V2:longint = 3;');
  4352. Add(' V3:string = ''abc'';');
  4353. ConvertUnit;
  4354. CheckSource('TestUnitImplVars',
  4355. LinesToStr([ // statements
  4356. 'var $impl = $mod.$impl;',
  4357. '']),
  4358. '', // this.$init
  4359. LinesToStr([ // implementation
  4360. '$impl.V1 = 0;',
  4361. '$impl.V2 = 3;',
  4362. '$impl.V3 = "abc";',
  4363. '']) );
  4364. end;
  4365. procedure TTestModule.TestUnitImplConsts;
  4366. begin
  4367. StartUnit(false);
  4368. Add('interface');
  4369. Add('implementation');
  4370. Add('const');
  4371. Add(' v1 = 3;');
  4372. Add(' v2:longint = 4;');
  4373. Add(' v3:string = ''abc'';');
  4374. ConvertUnit;
  4375. CheckSource('TestUnitImplConsts',
  4376. LinesToStr([ // statements
  4377. 'var $impl = $mod.$impl;',
  4378. '']),
  4379. '', // this.$init
  4380. LinesToStr([ // implementation
  4381. '$impl.v1 = 3;',
  4382. '$impl.v2 = 4;',
  4383. '$impl.v3 = "abc";',
  4384. '']) );
  4385. end;
  4386. procedure TTestModule.TestUnitImplRecord;
  4387. begin
  4388. StartUnit(false);
  4389. Add('interface');
  4390. Add('implementation');
  4391. Add('type');
  4392. Add(' TMyRecord = record');
  4393. Add(' i: longint;');
  4394. Add(' end;');
  4395. Add('var aRec: TMyRecord;');
  4396. Add('initialization');
  4397. Add(' arec.i:=3;');
  4398. ConvertUnit;
  4399. CheckSource('TestUnitImplRecord',
  4400. LinesToStr([ // statements
  4401. 'var $impl = $mod.$impl;',
  4402. '']),
  4403. // this.$init
  4404. '$impl.aRec.i = 3;',
  4405. LinesToStr([ // implementation
  4406. '$impl.TMyRecord = function (s) {',
  4407. ' if (s) {',
  4408. ' this.i = s.i;',
  4409. ' } else {',
  4410. ' this.i = 0;',
  4411. ' };',
  4412. ' this.$equal = function (b) {',
  4413. ' return this.i === b.i;',
  4414. ' };',
  4415. '};',
  4416. '$impl.aRec = new $impl.TMyRecord();',
  4417. '']) );
  4418. end;
  4419. procedure TTestModule.TestRenameJSNameConflict;
  4420. begin
  4421. StartProgram(false);
  4422. Add('var apply: longint;');
  4423. Add('var bind: longint;');
  4424. Add('var call: longint;');
  4425. Add('begin');
  4426. ConvertProgram;
  4427. CheckSource('TestRenameJSNameConflict',
  4428. LinesToStr([ // statements
  4429. 'this.Apply = 0;',
  4430. 'this.Bind = 0;',
  4431. 'this.Call = 0;'
  4432. ]),
  4433. LinesToStr([ // this.$main
  4434. ''
  4435. ]));
  4436. end;
  4437. procedure TTestModule.TestLocalConst;
  4438. begin
  4439. StartProgram(false);
  4440. Add('procedure DoIt;');
  4441. Add('const');
  4442. Add(' cA: longint = 1;');
  4443. Add(' cB = 2;');
  4444. Add(' procedure Sub;');
  4445. Add(' const');
  4446. Add(' csA = 3;');
  4447. Add(' cB: double = 4;');
  4448. Add(' begin');
  4449. Add(' cb:=cb+csa;');
  4450. Add(' ca:=ca+csa+5;');
  4451. Add(' end;');
  4452. Add('begin');
  4453. Add(' ca:=ca+cb+6;');
  4454. Add('end;');
  4455. Add('begin');
  4456. ConvertProgram;
  4457. CheckSource('TestLocalConst',
  4458. LinesToStr([
  4459. 'var cA = 1;',
  4460. 'var cB = 2;',
  4461. 'var csA = 3;',
  4462. 'var cB$1 = 4;',
  4463. 'this.DoIt = function () {',
  4464. ' function Sub() {',
  4465. ' cB$1 = cB$1 + 3;',
  4466. ' cA = (cA + 3) + 5;',
  4467. ' };',
  4468. ' cA = (cA + 2) + 6;',
  4469. '};'
  4470. ]),
  4471. LinesToStr([
  4472. ]));
  4473. end;
  4474. procedure TTestModule.TestVarExternal;
  4475. begin
  4476. StartProgram(false);
  4477. Add('var');
  4478. Add(' NaN: double; external name ''Global.NaN'';');
  4479. Add(' d: double;');
  4480. Add('begin');
  4481. Add(' d:=NaN;');
  4482. ConvertProgram;
  4483. CheckSource('TestVarExternal',
  4484. LinesToStr([
  4485. 'this.d = 0.0;'
  4486. ]),
  4487. LinesToStr([
  4488. '$mod.d = Global.NaN;'
  4489. ]));
  4490. end;
  4491. procedure TTestModule.TestVarExternalOtherUnit;
  4492. begin
  4493. AddModuleWithIntfImplSrc('unit2.pas',
  4494. LinesToStr([
  4495. 'var NaN: double; external name ''Global.NaN'';',
  4496. 'var iV: longint;'
  4497. ]),
  4498. '');
  4499. StartUnit(true);
  4500. Add('interface');
  4501. Add('uses unit2;');
  4502. Add('implementation');
  4503. Add('var');
  4504. Add(' d: double;');
  4505. Add(' i: longint; external name ''$i'';');
  4506. Add('begin');
  4507. Add(' d:=nan;');
  4508. Add(' d:=uNit2.nan;');
  4509. Add(' d:=test1.d;');
  4510. Add(' i:=iv;');
  4511. Add(' i:=uNit2.iv;');
  4512. Add(' i:=test1.i;');
  4513. ConvertUnit;
  4514. CheckSource('TestVarExternalOtherUnit',
  4515. LinesToStr([
  4516. 'var $impl = $mod.$impl;',
  4517. '']),
  4518. LinesToStr([ // this.$init
  4519. '$impl.d = Global.NaN;',
  4520. '$impl.d = Global.NaN;',
  4521. '$impl.d = $impl.d;',
  4522. '$i = pas.unit2.iV;',
  4523. '$i = pas.unit2.iV;',
  4524. '$i = $i;',
  4525. '']),
  4526. LinesToStr([ // implementation
  4527. '$impl.d = 0.0;',
  4528. '']) );
  4529. end;
  4530. procedure TTestModule.TestVarAbsoluteFail;
  4531. begin
  4532. StartProgram(false);
  4533. Add([
  4534. 'var',
  4535. ' a: longint;',
  4536. ' b: longword absolute a;',
  4537. 'begin']);
  4538. SetExpectedPasResolverError('Invalid variable modifier "absolute"',nInvalidVariableModifier);
  4539. ConvertProgram;
  4540. end;
  4541. procedure TTestModule.TestDouble;
  4542. begin
  4543. StartProgram(false);
  4544. Add([
  4545. 'type',
  4546. ' TDateTime = double;',
  4547. 'const',
  4548. ' a = TDateTime(2.7);',
  4549. ' b = a + TDateTime(1.7);',
  4550. ' c = 0.9 + 0.1;',
  4551. ' f0_1 = 0.1;',
  4552. ' f0_3 = 0.3;',
  4553. ' fn0_1 = -0.1;',
  4554. ' fn0_3 = -0.3;',
  4555. ' fn0_003 = -0.003;',
  4556. ' fn0_123456789 = -0.123456789;',
  4557. ' fn300_0 = -300.0;',
  4558. ' fn123456_0 = -123456.0;',
  4559. ' fn1234567_8 = -1234567.8;',
  4560. ' fn12345678_9 = -12345678.9;',
  4561. ' f1_0En12 = 1E-12;',
  4562. ' fn1_0En12 = -1E-12;',
  4563. ' maxdouble = 1.7e+308;',
  4564. ' mindouble = -1.7e+308;',
  4565. ' MinSafeIntDouble = -$10000000000000;',
  4566. ' MaxSafeIntDouble = $fffffffffffff;',
  4567. 'var',
  4568. ' d: double = b;',
  4569. 'begin',
  4570. ' d:=1.0;',
  4571. ' d:=1.0/3.0;',
  4572. ' d:=1/3;',
  4573. ' d:=5.0E-324;',
  4574. ' d:=1.7E308;',
  4575. ' d:=10**3;',
  4576. ' d:=10 mod 3;',
  4577. ' d:=10 div 3;',
  4578. ' d:=c;',
  4579. ' d:=f0_1;',
  4580. ' d:=f0_3;',
  4581. ' d:=fn0_1;',
  4582. ' d:=fn0_3;',
  4583. ' d:=fn0_003;',
  4584. ' d:=fn0_123456789;',
  4585. ' d:=fn300_0;',
  4586. ' d:=fn123456_0;',
  4587. ' d:=fn1234567_8;',
  4588. ' d:=fn12345678_9;',
  4589. ' d:=f1_0En12;',
  4590. ' d:=fn1_0En12;',
  4591. ' d:=maxdouble;',
  4592. ' d:=mindouble;',
  4593. ' d:=MinSafeIntDouble;',
  4594. ' d:=MaxSafeIntDouble;',
  4595. '']);
  4596. ConvertProgram;
  4597. CheckSource('TestDouble',
  4598. LinesToStr([
  4599. 'this.a = 2.7;',
  4600. 'this.b = 2.7 + 1.7;',
  4601. 'this.c = 0.9 + 0.1;',
  4602. 'this.f0_1 = 0.1;',
  4603. 'this.f0_3 = 0.3;',
  4604. 'this.fn0_1 = -0.1;',
  4605. 'this.fn0_3 = -0.3;',
  4606. 'this.fn0_003 = -0.003;',
  4607. 'this.fn0_123456789 = -0.123456789;',
  4608. 'this.fn300_0 = -300.0;',
  4609. 'this.fn123456_0 = -123456.0;',
  4610. 'this.fn1234567_8 = -1234567.8;',
  4611. 'this.fn12345678_9 = -12345678.9;',
  4612. 'this.f1_0En12 = 1E-12;',
  4613. 'this.fn1_0En12 = -1E-12;',
  4614. 'this.maxdouble = 1.7e+308;',
  4615. 'this.mindouble = -1.7e+308;',
  4616. 'this.MinSafeIntDouble = -0x10000000000000;',
  4617. 'this.MaxSafeIntDouble = 0xfffffffffffff;',
  4618. 'this.d = 4.4;'
  4619. ]),
  4620. LinesToStr([
  4621. '$mod.d = 1.0;',
  4622. '$mod.d = 1.0 / 3.0;',
  4623. '$mod.d = 1 / 3;',
  4624. '$mod.d = 5.0E-324;',
  4625. '$mod.d = 1.7E308;',
  4626. '$mod.d = Math.pow(10, 3);',
  4627. '$mod.d = 10 % 3;',
  4628. '$mod.d = Math.floor(10 / 3);',
  4629. '$mod.d = 1;',
  4630. '$mod.d = 0.1;',
  4631. '$mod.d = 0.3;',
  4632. '$mod.d = -0.1;',
  4633. '$mod.d = -0.3;',
  4634. '$mod.d = -0.003;',
  4635. '$mod.d = -0.123456789;',
  4636. '$mod.d = -300;',
  4637. '$mod.d = -123456;',
  4638. '$mod.d = -1234567.8;',
  4639. '$mod.d = -1.23456789E7;',
  4640. '$mod.d = 1E-12;',
  4641. '$mod.d = -1E-12;',
  4642. '$mod.d = 1.7E308;',
  4643. '$mod.d = -1.7E308;',
  4644. '$mod.d = -4503599627370496;',
  4645. '$mod.d = 4503599627370495;',
  4646. '']));
  4647. end;
  4648. procedure TTestModule.TestInteger;
  4649. begin
  4650. StartProgram(false);
  4651. Add([
  4652. 'const',
  4653. ' MinInt = low(NativeInt);',
  4654. ' MaxInt = high(NativeInt);',
  4655. 'type',
  4656. ' {#TMyInt}TMyInt = MinInt..MaxInt;',
  4657. 'const',
  4658. ' a = low(TMyInt)+High(TMyInt);',
  4659. 'var',
  4660. ' i: TMyInt;',
  4661. 'begin',
  4662. ' i:=-MinInt;']);
  4663. ConvertProgram;
  4664. CheckSource('TestIntegerRange',
  4665. LinesToStr([
  4666. 'this.MinInt = -4503599627370496;',
  4667. 'this.MaxInt = 4503599627370495;',
  4668. 'this.a = -4503599627370496 + 4503599627370495;',
  4669. 'this.i = -4503599627370496;',
  4670. '']),
  4671. LinesToStr([
  4672. '$mod.i = - -4503599627370496;',
  4673. '']));
  4674. end;
  4675. procedure TTestModule.TestIntegerRange;
  4676. begin
  4677. StartProgram(false);
  4678. Add([
  4679. 'const',
  4680. ' MinInt = -1;',
  4681. ' MaxInt = +1;',
  4682. 'type',
  4683. ' {#TMyInt}TMyInt = MinInt..MaxInt;',
  4684. ' TInt2 = 1..3;',
  4685. 'const',
  4686. ' a = low(TMyInt)+High(TMyInt);',
  4687. ' b = low(TInt2)+High(TInt2);',
  4688. ' s1 = [1];',
  4689. ' s2 = [1,2];',
  4690. ' s3 = [1..3];',
  4691. ' s4 = [low(shortint)..high(shortint)];',
  4692. ' s5 = [succ(low(shortint))..pred(high(shortint))];',
  4693. ' s6 = 1 in s2;',
  4694. 'var',
  4695. ' i: TMyInt;',
  4696. ' i2: TInt2;',
  4697. 'begin',
  4698. ' i:=i2;',
  4699. ' if i=i2 then ;']);
  4700. ConvertProgram;
  4701. CheckSource('TestIntegerRange',
  4702. LinesToStr([
  4703. 'this.MinInt = -1;',
  4704. 'this.MaxInt = +1;',
  4705. 'this.a = -1 + 1;',
  4706. 'this.b = 1 + 3;',
  4707. 'this.s1 = rtl.createSet(1);',
  4708. 'this.s2 = rtl.createSet(1, 2);',
  4709. 'this.s3 = rtl.createSet(null, 1, 3);',
  4710. 'this.s4 = rtl.createSet(null, -128, 127);',
  4711. 'this.s5 = rtl.createSet(null, -128 + 1, 127 - 1);',
  4712. 'this.s6 = 1 in $mod.s2;',
  4713. 'this.i = -1;',
  4714. 'this.i2 = 1;',
  4715. '']),
  4716. LinesToStr([
  4717. '$mod.i = $mod.i2;',
  4718. 'if ($mod.i === $mod.i2) ;',
  4719. '']));
  4720. end;
  4721. procedure TTestModule.TestCurrency;
  4722. begin
  4723. StartProgram(false);
  4724. Add([
  4725. 'type',
  4726. ' TCoin = currency;',
  4727. 'const',
  4728. ' a = TCoin(2.7);',
  4729. ' b = a + TCoin(1.7);',
  4730. ' MinSafeIntCurrency: TCoin = -92233720368.5477;',
  4731. ' MaxSafeIntCurrency: TCoin = 92233720368.5477;',
  4732. 'var',
  4733. ' c: TCoin = b;',
  4734. ' i: nativeint;',
  4735. ' d: double;',
  4736. ' j: jsvalue;',
  4737. 'function DoIt(c: currency): currency; begin end;',
  4738. 'function GetIt(d: double): double; begin end;',
  4739. 'procedure Write(v: jsvalue); begin end;',
  4740. 'begin',
  4741. ' c:=1.0;',
  4742. ' c:=0.1;',
  4743. ' c:=1.0/3.0;',
  4744. ' c:=1/3;',
  4745. ' c:=a;',
  4746. ' d:=c;',
  4747. ' c:=d;',
  4748. ' c:=currency(d);',
  4749. ' d:=double(c);',
  4750. ' c:=c+a;',
  4751. ' c:=-c-a;',
  4752. ' c:=d+c;',
  4753. ' c:=c+d;',
  4754. ' c:=d-c;',
  4755. ' c:=c-d;',
  4756. ' c:=c*a;',
  4757. ' c:=a*c;',
  4758. ' c:=d*c;',
  4759. ' c:=c*d;',
  4760. ' c:=c/a;',
  4761. ' c:=a/c;',
  4762. ' c:=d/c;',
  4763. ' c:=c/d;',
  4764. ' c:=c**a;',
  4765. ' c:=a**c;',
  4766. ' c:=d**c;',
  4767. ' c:=c**d;',
  4768. ' if c=c then ;',
  4769. ' if c=a then ;',
  4770. ' if a=c then ;',
  4771. ' if d=c then ;',
  4772. ' if c=d then ;',
  4773. ' c:=DoIt(c);',
  4774. ' c:=DoIt(i);',
  4775. ' c:=DoIt(d);',
  4776. ' c:=GetIt(c);',
  4777. ' j:=c;',
  4778. ' Write(c);',
  4779. '']);
  4780. ConvertProgram;
  4781. CheckSource('TestCurrency',
  4782. LinesToStr([
  4783. 'this.a = 27000;',
  4784. 'this.b = $mod.a + 17000;',
  4785. 'this.MinSafeIntCurrency = -92233720368.5477;',
  4786. 'this.MaxSafeIntCurrency = 92233720368.5477;',
  4787. 'this.c = $mod.b;',
  4788. 'this.i = 0;',
  4789. 'this.d = 0.0;',
  4790. 'this.j = undefined;',
  4791. 'this.DoIt = function (c) {',
  4792. ' var Result = 0;',
  4793. ' return Result;',
  4794. '};',
  4795. 'this.GetIt = function (d) {',
  4796. ' var Result = 0.0;',
  4797. ' return Result;',
  4798. '};',
  4799. 'this.Write = function (v) {',
  4800. '};',
  4801. '']),
  4802. LinesToStr([
  4803. '$mod.c = 10000;',
  4804. '$mod.c = 1000;',
  4805. '$mod.c = Math.floor((1.0 / 3.0) * 10000);',
  4806. '$mod.c = Math.floor((1 / 3) * 10000);',
  4807. '$mod.c = $mod.a;',
  4808. '$mod.d = $mod.c / 10000;',
  4809. '$mod.c = Math.floor($mod.d * 10000);',
  4810. '$mod.c = $mod.d * 10000;',
  4811. '$mod.d = $mod.c / 10000;',
  4812. '$mod.c = $mod.c + $mod.a;',
  4813. '$mod.c = -$mod.c - $mod.a;',
  4814. '$mod.c = ($mod.d * 10000) + $mod.c;',
  4815. '$mod.c = $mod.c + ($mod.d * 10000);',
  4816. '$mod.c = ($mod.d * 10000) - $mod.c;',
  4817. '$mod.c = $mod.c - ($mod.d * 10000);',
  4818. '$mod.c = ($mod.c * $mod.a) / 10000;',
  4819. '$mod.c = ($mod.a * $mod.c) / 10000;',
  4820. '$mod.c = $mod.d * $mod.c;',
  4821. '$mod.c = $mod.c * $mod.d;',
  4822. '$mod.c = Math.floor(($mod.c / $mod.a) * 10000);',
  4823. '$mod.c = Math.floor(($mod.a / $mod.c) * 10000);',
  4824. '$mod.c = Math.floor($mod.d / $mod.c);',
  4825. '$mod.c = Math.floor($mod.c / $mod.d);',
  4826. '$mod.c = Math.floor(Math.pow($mod.c / 10000, $mod.a / 10000) * 10000);',
  4827. '$mod.c = Math.floor(Math.pow($mod.a / 10000, $mod.c / 10000) * 10000);',
  4828. '$mod.c = Math.floor(Math.pow($mod.d, $mod.c / 10000) * 10000);',
  4829. '$mod.c = Math.floor(Math.pow($mod.c / 10000, $mod.d) * 10000);',
  4830. 'if ($mod.c === $mod.c) ;',
  4831. 'if ($mod.c === $mod.a) ;',
  4832. 'if ($mod.a === $mod.c) ;',
  4833. 'if (($mod.d * 10000) === $mod.c) ;',
  4834. 'if ($mod.c === ($mod.d * 10000)) ;',
  4835. '$mod.c = $mod.DoIt($mod.c);',
  4836. '$mod.c = $mod.DoIt($mod.i * 10000);',
  4837. '$mod.c = $mod.DoIt($mod.d * 10000);',
  4838. '$mod.c = Math.floor($mod.GetIt($mod.c / 10000) * 10000);',
  4839. '$mod.j = $mod.c / 10000;',
  4840. '$mod.Write($mod.c / 10000);',
  4841. '']));
  4842. end;
  4843. procedure TTestModule.TestForBoolDo;
  4844. begin
  4845. StartProgram(false);
  4846. Add([
  4847. 'var b: boolean;',
  4848. 'begin',
  4849. ' for b:=false to true do ;',
  4850. ' for b:=b downto false do ;',
  4851. ' for b in boolean do ;',
  4852. '']);
  4853. ConvertProgram;
  4854. CheckSource('TestForBoolDo',
  4855. LinesToStr([ // statements
  4856. 'this.b = false;']),
  4857. LinesToStr([ // this.$main
  4858. 'for (var $l1 = 0; $l1 <= 1; $l1++) $mod.b = $l1 !== 0;',
  4859. 'for (var $l2 = +$mod.b; $l2 >= 0; $l2--) $mod.b = $l2 !== 0;',
  4860. 'for (var $l3 = 0; $l3 <= 1; $l3++) $mod.b = $l3 !== 0;',
  4861. '']));
  4862. end;
  4863. procedure TTestModule.TestForIntDo;
  4864. begin
  4865. StartProgram(false);
  4866. Add([
  4867. 'var i: longint;',
  4868. 'begin',
  4869. ' for i:=3 to 5 do ;',
  4870. ' for i:=i downto 2 do ;',
  4871. ' for i in byte do ;',
  4872. '']);
  4873. ConvertProgram;
  4874. CheckSource('TestForIntDo',
  4875. LinesToStr([ // statements
  4876. 'this.i = 0;']),
  4877. LinesToStr([ // this.$main
  4878. 'for ($mod.i = 3; $mod.i <= 5; $mod.i++) ;',
  4879. 'for (var $l1 = $mod.i; $l1 >= 2; $l1--) $mod.i = $l1;',
  4880. 'for (var $l2 = 0; $l2 <= 255; $l2++) $mod.i = $l2;',
  4881. '']));
  4882. end;
  4883. procedure TTestModule.TestForIntInDo;
  4884. begin
  4885. StartProgram(false);
  4886. Add([
  4887. 'type',
  4888. ' TSetOfInt = set of byte;',
  4889. ' TIntRg = 3..7;',
  4890. ' TSetOfIntRg = set of TIntRg;',
  4891. 'var',
  4892. ' i,i2: longint;',
  4893. ' a1: array of byte;',
  4894. ' a2: array[1..3] of byte;',
  4895. ' soi: TSetOfInt;',
  4896. ' soir: TSetOfIntRg;',
  4897. ' ir: TIntRg;',
  4898. 'begin',
  4899. ' for i in byte do ;',
  4900. ' for i in a1 do ;',
  4901. ' for i in a2 do ;',
  4902. ' for i in [11..13] do ;',
  4903. ' for i in TSetOfInt do ;',
  4904. ' for i in TIntRg do ;',
  4905. ' for i in soi do i2:=i;',
  4906. ' for i in TSetOfIntRg do ;',
  4907. ' for i in soir do ;',
  4908. ' for ir in TIntRg do ;',
  4909. ' for ir in TSetOfIntRg do ;',
  4910. ' for ir in soir do ;',
  4911. '']);
  4912. ConvertProgram;
  4913. CheckSource('TestForIntInDo',
  4914. LinesToStr([ // statements
  4915. 'this.i = 0;',
  4916. 'this.i2 = 0;',
  4917. 'this.a1 = [];',
  4918. 'this.a2 = rtl.arraySetLength(null, 0, 3);',
  4919. 'this.soi = {};',
  4920. 'this.soir = {};',
  4921. 'this.ir = 3;',
  4922. '']),
  4923. LinesToStr([ // this.$main
  4924. 'for (var $l1 = 0; $l1 <= 255; $l1++) $mod.i = $l1;',
  4925. 'for (var $in2 = $mod.a1, $l3 = 0, $end4 = rtl.length($in2) - 1; $l3 <= $end4; $l3++) $mod.i = $in2[$l3];',
  4926. 'for (var $in5 = $mod.a2, $l6 = 0, $end7 = rtl.length($in5) - 1; $l6 <= $end7; $l6++) $mod.i = $in5[$l6];',
  4927. 'for (var $l8 = 11; $l8 <= 13; $l8++) $mod.i = $l8;',
  4928. 'for (var $l9 = 0; $l9 <= 255; $l9++) $mod.i = $l9;',
  4929. 'for (var $l10 = 3; $l10 <= 7; $l10++) $mod.i = $l10;',
  4930. 'for ($mod.i in $mod.soi) $mod.i2 = $mod.i;',
  4931. 'for (var $l11 = 3; $l11 <= 7; $l11++) $mod.i = $l11;',
  4932. 'for ($mod.i in $mod.soir) ;',
  4933. 'for (var $l12 = 3; $l12 <= 7; $l12++) $mod.ir = $l12;',
  4934. 'for (var $l13 = 3; $l13 <= 7; $l13++) $mod.ir = $l13;',
  4935. 'for ($mod.ir in $mod.soir) ;',
  4936. '']));
  4937. end;
  4938. procedure TTestModule.TestCharConst;
  4939. begin
  4940. StartProgram(false);
  4941. Add('const');
  4942. Add(' c: char = ''1'';');
  4943. Add('begin');
  4944. Add(' c:=#0;');
  4945. Add(' c:=#1;');
  4946. Add(' c:=#9;');
  4947. Add(' c:=#10;');
  4948. Add(' c:=#13;');
  4949. Add(' c:=#31;');
  4950. Add(' c:=#32;');
  4951. Add(' c:=#$A;');
  4952. Add(' c:=#$0A;');
  4953. Add(' c:=#$b;');
  4954. Add(' c:=#$0b;');
  4955. Add(' c:=^A;');
  4956. Add(' c:=''"'';');
  4957. ConvertProgram;
  4958. CheckSource('TestCharConst',
  4959. LinesToStr([
  4960. 'this.c="1";'
  4961. ]),
  4962. LinesToStr([
  4963. '$mod.c="\x00";',
  4964. '$mod.c="\x01";',
  4965. '$mod.c="\t";',
  4966. '$mod.c="\n";',
  4967. '$mod.c="\r";',
  4968. '$mod.c="\x1F";',
  4969. '$mod.c=" ";',
  4970. '$mod.c="\n";',
  4971. '$mod.c="\n";',
  4972. '$mod.c="\x0B";',
  4973. '$mod.c="\x0B";',
  4974. '$mod.c="\x01";',
  4975. '$mod.c=''"'';'
  4976. ]));
  4977. end;
  4978. procedure TTestModule.TestChar_Compare;
  4979. begin
  4980. StartProgram(false);
  4981. Add('var');
  4982. Add(' c: char;');
  4983. Add(' b: boolean;');
  4984. Add('begin');
  4985. Add(' b:=c=''1'';');
  4986. Add(' b:=''2''=c;');
  4987. Add(' b:=''3''=''4'';');
  4988. Add(' b:=c<>''5'';');
  4989. Add(' b:=''6''<>c;');
  4990. Add(' b:=c>''7'';');
  4991. Add(' b:=''8''>c;');
  4992. Add(' b:=c>=''9'';');
  4993. Add(' b:=''A''>=c;');
  4994. Add(' b:=c<''B'';');
  4995. Add(' b:=''C''<c;');
  4996. Add(' b:=c<=''D'';');
  4997. Add(' b:=''E''<=c;');
  4998. ConvertProgram;
  4999. CheckSource('TestChar_Compare',
  5000. LinesToStr([
  5001. 'this.c="";',
  5002. 'this.b = false;'
  5003. ]),
  5004. LinesToStr([
  5005. '$mod.b = $mod.c === "1";',
  5006. '$mod.b = "2" === $mod.c;',
  5007. '$mod.b = "3" === "4";',
  5008. '$mod.b = $mod.c !== "5";',
  5009. '$mod.b = "6" !== $mod.c;',
  5010. '$mod.b = $mod.c > "7";',
  5011. '$mod.b = "8" > $mod.c;',
  5012. '$mod.b = $mod.c >= "9";',
  5013. '$mod.b = "A" >= $mod.c;',
  5014. '$mod.b = $mod.c < "B";',
  5015. '$mod.b = "C" < $mod.c;',
  5016. '$mod.b = $mod.c <= "D";',
  5017. '$mod.b = "E" <= $mod.c;',
  5018. '']));
  5019. end;
  5020. procedure TTestModule.TestChar_Ord;
  5021. begin
  5022. StartProgram(false);
  5023. Add('var');
  5024. Add(' c: char;');
  5025. Add(' i: longint;');
  5026. Add(' s: string;');
  5027. Add('begin');
  5028. Add(' i:=ord(c);');
  5029. Add(' i:=ord(s[i]);');
  5030. ConvertProgram;
  5031. CheckSource('TestChar_Ord',
  5032. LinesToStr([
  5033. 'this.c = "";',
  5034. 'this.i = 0;',
  5035. 'this.s = "";'
  5036. ]),
  5037. LinesToStr([
  5038. '$mod.i = $mod.c.charCodeAt();',
  5039. '$mod.i = $mod.s.charCodeAt($mod.i-1);',
  5040. '']));
  5041. end;
  5042. procedure TTestModule.TestChar_Chr;
  5043. begin
  5044. StartProgram(false);
  5045. Add('var');
  5046. Add(' c: char;');
  5047. Add(' i: longint;');
  5048. Add('begin');
  5049. Add(' c:=chr(i);');
  5050. ConvertProgram;
  5051. CheckSource('TestChar_Chr',
  5052. LinesToStr([
  5053. 'this.c = "";',
  5054. 'this.i = 0;'
  5055. ]),
  5056. LinesToStr([
  5057. '$mod.c = String.fromCharCode($mod.i);',
  5058. '']));
  5059. end;
  5060. procedure TTestModule.TestStringConst;
  5061. begin
  5062. StartProgram(false);
  5063. Add([
  5064. 'var',
  5065. ' s: string = ''abc'';',
  5066. 'begin',
  5067. ' s:='''';',
  5068. ' s:=#13#10;',
  5069. ' s:=#9''foo'';',
  5070. ' s:=#$A9;',
  5071. ' s:=''foo''#13''bar'';',
  5072. ' s:=''"'';',
  5073. ' s:=''"''''"'';',
  5074. '']);
  5075. ConvertProgram;
  5076. CheckSource('TestStringConst',
  5077. LinesToStr([
  5078. 'this.s="abc";'
  5079. ]),
  5080. LinesToStr([
  5081. '$mod.s="";',
  5082. '$mod.s="\r\n";',
  5083. '$mod.s="\tfoo";',
  5084. '$mod.s="©";',
  5085. '$mod.s="foo\rbar";',
  5086. '$mod.s=''"'';',
  5087. '$mod.s=''"\''"'';'
  5088. ]));
  5089. end;
  5090. procedure TTestModule.TestStringConstSurrogate;
  5091. begin
  5092. StartProgram(false);
  5093. Add([
  5094. 'var',
  5095. ' s: string;',
  5096. 'begin',
  5097. ' s:=''😊'';', // 1F60A
  5098. '']);
  5099. ConvertProgram;
  5100. CheckSource('TestStringConstSurrogate',
  5101. LinesToStr([
  5102. 'this.s="";'
  5103. ]),
  5104. LinesToStr([
  5105. '$mod.s="😊";'
  5106. ]));
  5107. end;
  5108. procedure TTestModule.TestString_Length;
  5109. begin
  5110. StartProgram(false);
  5111. Add('const c = ''foo'';');
  5112. Add('var');
  5113. Add(' s: string;');
  5114. Add(' i: longint;');
  5115. Add('begin');
  5116. Add(' i:=length(s);');
  5117. Add(' i:=length(s+s);');
  5118. Add(' i:=length(''abc'');');
  5119. Add(' i:=length(c);');
  5120. ConvertProgram;
  5121. CheckSource('TestString_Length',
  5122. LinesToStr([
  5123. 'this.c = "foo";',
  5124. 'this.s = "";',
  5125. 'this.i = 0;',
  5126. '']),
  5127. LinesToStr([
  5128. '$mod.i = $mod.s.length;',
  5129. '$mod.i = ($mod.s+$mod.s).length;',
  5130. '$mod.i = "abc".length;',
  5131. '$mod.i = $mod.c.length;',
  5132. '']));
  5133. end;
  5134. procedure TTestModule.TestString_Compare;
  5135. begin
  5136. StartProgram(false);
  5137. Add('var');
  5138. Add(' s, t: string;');
  5139. Add(' b: boolean;');
  5140. Add('begin');
  5141. Add(' b:=s=t;');
  5142. Add(' b:=s<>t;');
  5143. Add(' b:=s>t;');
  5144. Add(' b:=s>=t;');
  5145. Add(' b:=s<t;');
  5146. Add(' b:=s<=t;');
  5147. ConvertProgram;
  5148. CheckSource('TestString_Compare',
  5149. LinesToStr([ // statements
  5150. 'this.s = "";',
  5151. 'this.t = "";',
  5152. 'this.b =false;'
  5153. ]),
  5154. LinesToStr([ // this.$main
  5155. '$mod.b = $mod.s === $mod.t;',
  5156. '$mod.b = $mod.s !== $mod.t;',
  5157. '$mod.b = $mod.s > $mod.t;',
  5158. '$mod.b = $mod.s >= $mod.t;',
  5159. '$mod.b = $mod.s < $mod.t;',
  5160. '$mod.b = $mod.s <= $mod.t;',
  5161. '']));
  5162. end;
  5163. procedure TTestModule.TestString_SetLength;
  5164. begin
  5165. StartProgram(false);
  5166. Add([
  5167. 'procedure DoIt(var s: string);',
  5168. 'begin',
  5169. ' SetLength(s,2);',
  5170. 'end;',
  5171. 'var s: string;',
  5172. 'begin',
  5173. ' SetLength(s,3);',
  5174. '']);
  5175. ConvertProgram;
  5176. CheckSource('TestString_SetLength',
  5177. LinesToStr([ // statements
  5178. 'this.DoIt = function (s) {',
  5179. ' s.set(rtl.strSetLength(s.get(), 2));',
  5180. '};',
  5181. 'this.s = "";',
  5182. '']),
  5183. LinesToStr([ // this.$main
  5184. '$mod.s = rtl.strSetLength($mod.s, 3);'
  5185. ]));
  5186. end;
  5187. procedure TTestModule.TestString_CharAt;
  5188. begin
  5189. StartProgram(false);
  5190. Add([
  5191. 'var',
  5192. ' s: string;',
  5193. ' c: char;',
  5194. ' b: boolean;',
  5195. 'begin',
  5196. ' b:= s[1] = c;',
  5197. ' b:= c = s[1];',
  5198. ' b:= c <> s[1];',
  5199. ' b:= c > s[1];',
  5200. ' b:= c >= s[1];',
  5201. ' b:= c < s[2];',
  5202. ' b:= c <= s[1];',
  5203. ' s[1] := c;',
  5204. ' s[2+3] := c;']);
  5205. ConvertProgram;
  5206. CheckSource('TestString_CharAt',
  5207. LinesToStr([ // statements
  5208. 'this.s = "";',
  5209. 'this.c = "";',
  5210. 'this.b = false;'
  5211. ]),
  5212. LinesToStr([ // this.$main
  5213. '$mod.b = $mod.s.charAt(0) === $mod.c;',
  5214. '$mod.b = $mod.c === $mod.s.charAt(0);',
  5215. '$mod.b = $mod.c !== $mod.s.charAt(0);',
  5216. '$mod.b = $mod.c > $mod.s.charAt(0);',
  5217. '$mod.b = $mod.c >= $mod.s.charAt(0);',
  5218. '$mod.b = $mod.c < $mod.s.charAt(1);',
  5219. '$mod.b = $mod.c <= $mod.s.charAt(0);',
  5220. '$mod.s = rtl.setCharAt($mod.s, 0, $mod.c);',
  5221. '$mod.s = rtl.setCharAt($mod.s, (2 + 3) - 1, $mod.c);',
  5222. '']));
  5223. end;
  5224. procedure TTestModule.TestStr;
  5225. begin
  5226. StartProgram(false);
  5227. Add('var');
  5228. Add(' b: boolean;');
  5229. Add(' i: longint;');
  5230. Add(' d: double;');
  5231. Add(' s: string;');
  5232. Add('begin');
  5233. Add(' str(b,s);');
  5234. Add(' str(i,s);');
  5235. Add(' str(d,s);');
  5236. Add(' str(i:3,s);');
  5237. Add(' str(d:3:2,s);');
  5238. Add(' Str(12.456:12:1,s);');
  5239. Add(' Str(12.456:12,s);');
  5240. Add(' s:=str(b);');
  5241. Add(' s:=str(i);');
  5242. Add(' s:=str(d);');
  5243. Add(' s:=str(i,i);');
  5244. Add(' s:=str(i:3);');
  5245. Add(' s:=str(d:3:2);');
  5246. Add(' s:=str(i:4,i);');
  5247. Add(' s:=str(i,i:5);');
  5248. Add(' s:=str(i:4,i:5);');
  5249. Add(' s:=str(s,s);');
  5250. Add(' s:=str(s,''foo'');');
  5251. ConvertProgram;
  5252. CheckSource('TestStr',
  5253. LinesToStr([ // statements
  5254. 'this.b = false;',
  5255. 'this.i = 0;',
  5256. 'this.d = 0.0;',
  5257. 'this.s = "";',
  5258. '']),
  5259. LinesToStr([ // this.$main
  5260. '$mod.s = ""+$mod.b;',
  5261. '$mod.s = ""+$mod.i;',
  5262. '$mod.s = rtl.floatToStr($mod.d);',
  5263. '$mod.s = rtl.spaceLeft(""+$mod.i,3);',
  5264. '$mod.s = rtl.floatToStr($mod.d,3,2);',
  5265. '$mod.s = rtl.floatToStr(12.456,12,1);',
  5266. '$mod.s = rtl.floatToStr(12.456,12);',
  5267. '$mod.s = ""+$mod.b;',
  5268. '$mod.s = ""+$mod.i;',
  5269. '$mod.s = rtl.floatToStr($mod.d);',
  5270. '$mod.s = (""+$mod.i)+$mod.i;',
  5271. '$mod.s = rtl.spaceLeft(""+$mod.i,3);',
  5272. '$mod.s = rtl.floatToStr($mod.d,3,2);',
  5273. '$mod.s = rtl.spaceLeft("" + $mod.i, 4) + $mod.i;',
  5274. '$mod.s = ("" + $mod.i) + rtl.spaceLeft("" + $mod.i, 5);',
  5275. '$mod.s = rtl.spaceLeft("" + $mod.i, 4) + rtl.spaceLeft("" + $mod.i, 5);',
  5276. '$mod.s = $mod.s + $mod.s;',
  5277. '$mod.s = $mod.s + "foo";',
  5278. '']));
  5279. end;
  5280. procedure TTestModule.TestBaseType_AnsiStringFail;
  5281. begin
  5282. StartProgram(false);
  5283. Add('var s: AnsiString');
  5284. SetExpectedPasResolverError('identifier not found "AnsiString"',PasResolveEval.nIdentifierNotFound);
  5285. ConvertProgram;
  5286. end;
  5287. procedure TTestModule.TestBaseType_WideStringFail;
  5288. begin
  5289. StartProgram(false);
  5290. Add('var s: WideString');
  5291. SetExpectedPasResolverError('identifier not found "WideString"',PasResolveEval.nIdentifierNotFound);
  5292. ConvertProgram;
  5293. end;
  5294. procedure TTestModule.TestBaseType_ShortStringFail;
  5295. begin
  5296. StartProgram(false);
  5297. Add('var s: ShortString');
  5298. SetExpectedPasResolverError('identifier not found "ShortString"',PasResolveEval.nIdentifierNotFound);
  5299. ConvertProgram;
  5300. end;
  5301. procedure TTestModule.TestBaseType_RawByteStringFail;
  5302. begin
  5303. StartProgram(false);
  5304. Add('var s: RawByteString');
  5305. SetExpectedPasResolverError('identifier not found "RawByteString"',PasResolveEval.nIdentifierNotFound);
  5306. ConvertProgram;
  5307. end;
  5308. procedure TTestModule.TestTypeShortstring_Fail;
  5309. begin
  5310. StartProgram(false);
  5311. Add('type t = string[12];');
  5312. Add('var s: t;');
  5313. Add('begin');
  5314. SetExpectedPasResolverError('illegal qualifier "["',nIllegalQualifier);
  5315. ConvertProgram;
  5316. end;
  5317. procedure TTestModule.TestCharSet_Custom;
  5318. begin
  5319. StartProgram(false);
  5320. Add([
  5321. 'type',
  5322. ' TCharRg = ''a''..''z'';',
  5323. ' TSetOfCharRg = set of TCharRg;',
  5324. ' TCharRg2 = ''m''..''p'';',
  5325. 'const',
  5326. ' crg: TCharRg = ''b'';',
  5327. 'var',
  5328. ' c: char;',
  5329. ' crg2: TCharRg2;',
  5330. ' s: TSetOfCharRg;',
  5331. 'begin',
  5332. ' c:=crg;',
  5333. ' crg:=c;',
  5334. ' crg2:=crg;',
  5335. ' if c=crg then ;',
  5336. ' if crg=c then ;',
  5337. ' if crg=crg2 then ;',
  5338. ' if c in s then ;',
  5339. ' if crg2 in s then ;',
  5340. '']);
  5341. ConvertProgram;
  5342. CheckSource('TestCharSet_Custom',
  5343. LinesToStr([ // statements
  5344. 'this.crg = "b";',
  5345. 'this.c = "";',
  5346. 'this.crg2 = "m";',
  5347. 'this.s = {};',
  5348. '']),
  5349. LinesToStr([ // this.$main
  5350. '$mod.c = $mod.crg;',
  5351. '$mod.crg = $mod.c;',
  5352. '$mod.crg2 = $mod.crg;',
  5353. 'if ($mod.c === $mod.crg) ;',
  5354. 'if ($mod.crg === $mod.c) ;',
  5355. 'if ($mod.crg === $mod.crg2) ;',
  5356. 'if ($mod.c.charCodeAt() in $mod.s) ;',
  5357. 'if ($mod.crg2.charCodeAt() in $mod.s) ;',
  5358. '']));
  5359. end;
  5360. procedure TTestModule.TestForCharDo;
  5361. begin
  5362. StartProgram(false);
  5363. Add([
  5364. 'var c: char;',
  5365. 'begin',
  5366. ' for c:=''a'' to ''c'' do ;',
  5367. ' for c:=c downto ''a'' do ;',
  5368. '']);
  5369. ConvertProgram;
  5370. CheckSource('TestForCharDo',
  5371. LinesToStr([ // statements
  5372. 'this.c = "";']),
  5373. LinesToStr([ // this.$main
  5374. 'for (var $l1 = 97; $l1 <= 99; $l1++) $mod.c = String.fromCharCode($l1);',
  5375. 'for (var $l2 = $mod.c.charCodeAt(); $l2 >= 97; $l2--) $mod.c = String.fromCharCode($l2);',
  5376. '']));
  5377. end;
  5378. procedure TTestModule.TestForCharInDo;
  5379. begin
  5380. StartProgram(false);
  5381. Add([
  5382. 'type',
  5383. ' TSetOfChar = set of char;',
  5384. ' TCharRg = ''a''..''z'';',
  5385. ' TSetOfCharRg = set of TCharRg;',
  5386. 'const Foo = ''foo'';',
  5387. 'var',
  5388. ' c,c2: char;',
  5389. ' s: string;',
  5390. ' a1: array of char;',
  5391. ' a2: array[1..3] of char;',
  5392. ' soc: TSetOfChar;',
  5393. ' socr: TSetOfCharRg;',
  5394. ' cr: TCharRg;',
  5395. 'begin',
  5396. ' for c in foo do ;',
  5397. ' for c in s do ;',
  5398. ' for c in char do ;',
  5399. ' for c in a1 do ;',
  5400. ' for c in a2 do ;',
  5401. ' for c in [''1''..''3''] do ;',
  5402. ' for c in TSetOfChar do ;',
  5403. ' for c in TCharRg do ;',
  5404. ' for c in soc do c2:=c;',
  5405. ' for c in TSetOfCharRg do ;',
  5406. ' for c in socr do ;',
  5407. ' for cr in TCharRg do ;',
  5408. ' for cr in TSetOfCharRg do ;',
  5409. ' for cr in socr do ;',
  5410. '']);
  5411. ConvertProgram;
  5412. CheckSource('TestForCharInDo',
  5413. LinesToStr([ // statements
  5414. 'this.Foo = "foo";',
  5415. 'this.c = "";',
  5416. 'this.c2 = "";',
  5417. 'this.s = "";',
  5418. 'this.a1 = [];',
  5419. 'this.a2 = rtl.arraySetLength(null, "", 3);',
  5420. 'this.soc = {};',
  5421. 'this.socr = {};',
  5422. 'this.cr = "a";',
  5423. '']),
  5424. LinesToStr([ // this.$main
  5425. 'for (var $in1 = $mod.Foo, $l2 = 0, $end3 = $in1.length - 1; $l2 <= $end3; $l2++) $mod.c = $in1.charAt($l2);',
  5426. 'for (var $in4 = $mod.s, $l5 = 0, $end6 = $in4.length - 1; $l5 <= $end6; $l5++) $mod.c = $in4.charAt($l5);',
  5427. 'for (var $l7 = 0; $l7 <= 65535; $l7++) $mod.c = String.fromCharCode($l7);',
  5428. 'for (var $in8 = $mod.a1, $l9 = 0, $end10 = rtl.length($in8) - 1; $l9 <= $end10; $l9++) $mod.c = $in8[$l9];',
  5429. 'for (var $in11 = $mod.a2, $l12 = 0, $end13 = rtl.length($in11) - 1; $l12 <= $end13; $l12++) $mod.c = $in11[$l12];',
  5430. 'for (var $l14 = 49; $l14 <= 51; $l14++) $mod.c = String.fromCharCode($l14);',
  5431. 'for (var $l15 = 0; $l15 <= 65535; $l15++) $mod.c = String.fromCharCode($l15);',
  5432. 'for (var $l16 = 97; $l16 <= 122; $l16++) $mod.c = String.fromCharCode($l16);',
  5433. 'for (var $l17 in $mod.soc) {',
  5434. ' $mod.c = String.fromCharCode($l17);',
  5435. ' $mod.c2 = $mod.c;',
  5436. '};',
  5437. 'for (var $l18 = 97; $l18 <= 122; $l18++) $mod.c = String.fromCharCode($l18);',
  5438. 'for (var $l19 in $mod.socr) $mod.c = String.fromCharCode($l19);',
  5439. 'for (var $l20 = 97; $l20 <= 122; $l20++) $mod.cr = String.fromCharCode($l20);',
  5440. 'for (var $l21 = 97; $l21 <= 122; $l21++) $mod.cr = String.fromCharCode($l21);',
  5441. 'for (var $l22 in $mod.socr) $mod.cr = String.fromCharCode($l22);',
  5442. '']));
  5443. end;
  5444. procedure TTestModule.TestProcTwoArgs;
  5445. begin
  5446. StartProgram(false);
  5447. Add('procedure Test(a,b: longint);');
  5448. Add('begin');
  5449. Add('end;');
  5450. Add('begin');
  5451. ConvertProgram;
  5452. CheckSource('TestProcTwoArgs',
  5453. LinesToStr([ // statements
  5454. 'this.Test = function (a,b) {',
  5455. '};'
  5456. ]),
  5457. LinesToStr([ // this.$main
  5458. ''
  5459. ]));
  5460. end;
  5461. procedure TTestModule.TestProc_DefaultValue;
  5462. begin
  5463. StartProgram(false);
  5464. Add('procedure p1(i: longint = 1);');
  5465. Add('begin');
  5466. Add('end;');
  5467. Add('procedure p2(i: longint = 1; c: char = ''a'');');
  5468. Add('begin');
  5469. Add('end;');
  5470. Add('procedure p3(d: double = 1.0; b: boolean = false; s: string = ''abc'');');
  5471. Add('begin');
  5472. Add('end;');
  5473. Add('begin');
  5474. Add(' p1;');
  5475. Add(' p1();');
  5476. Add(' p1(11);');
  5477. Add(' p2;');
  5478. Add(' p2();');
  5479. Add(' p2(12);');
  5480. Add(' p2(13,''b'');');
  5481. Add(' p3();');
  5482. ConvertProgram;
  5483. CheckSource('TestProc_DefaultValue',
  5484. LinesToStr([ // statements
  5485. 'this.p1 = function (i) {',
  5486. '};',
  5487. 'this.p2 = function (i,c) {',
  5488. '};',
  5489. 'this.p3 = function (d,b,s) {',
  5490. '};'
  5491. ]),
  5492. LinesToStr([ // this.$main
  5493. ' $mod.p1(1);',
  5494. ' $mod.p1(1);',
  5495. ' $mod.p1(11);',
  5496. ' $mod.p2(1,"a");',
  5497. ' $mod.p2(1,"a");',
  5498. ' $mod.p2(12,"a");',
  5499. ' $mod.p2(13,"b");',
  5500. ' $mod.p3(1.0,false,"abc");'
  5501. ]));
  5502. end;
  5503. procedure TTestModule.TestFunctionInt;
  5504. begin
  5505. StartProgram(false);
  5506. Add('function MyTest(Bar: longint): longint;');
  5507. Add('begin');
  5508. Add(' Result:=2*bar');
  5509. Add('end;');
  5510. Add('begin');
  5511. ConvertProgram;
  5512. CheckSource('TestFunctionInt',
  5513. LinesToStr([ // statements
  5514. 'this.MyTest = function (Bar) {',
  5515. ' var Result = 0;',
  5516. ' Result = 2*Bar;',
  5517. ' return Result;',
  5518. '};'
  5519. ]),
  5520. LinesToStr([ // this.$main
  5521. ''
  5522. ]));
  5523. end;
  5524. procedure TTestModule.TestFunctionString;
  5525. begin
  5526. StartProgram(false);
  5527. Add('function Test(Bar: string): string;');
  5528. Add('begin');
  5529. Add(' Result:=bar+BAR');
  5530. Add('end;');
  5531. Add('begin');
  5532. ConvertProgram;
  5533. CheckSource('TestFunctionString',
  5534. LinesToStr([ // statements
  5535. 'this.Test = function (Bar) {',
  5536. ' var Result = "";',
  5537. ' Result = Bar+Bar;',
  5538. ' return Result;',
  5539. '};'
  5540. ]),
  5541. LinesToStr([ // this.$main
  5542. ''
  5543. ]));
  5544. end;
  5545. procedure TTestModule.TestForLoop;
  5546. begin
  5547. StartProgram(false);
  5548. Add('var');
  5549. Add(' vI, vJ, vN: longint;');
  5550. Add('begin');
  5551. Add(' VJ:=0;');
  5552. Add(' VN:=3;');
  5553. Add(' for VI:=1 to VN do');
  5554. Add(' begin');
  5555. Add(' VJ:=VJ+VI;');
  5556. Add(' end;');
  5557. ConvertProgram;
  5558. CheckSource('TestForLoop',
  5559. LinesToStr([ // statements
  5560. 'this.vI = 0;',
  5561. 'this.vJ = 0;',
  5562. 'this.vN = 0;'
  5563. ]),
  5564. LinesToStr([ // this.$main
  5565. ' $mod.vJ = 0;',
  5566. ' $mod.vN = 3;',
  5567. ' for (var $l1 = 1, $end2 = $mod.vN; $l1 <= $end2; $l1++) {',
  5568. ' $mod.vI = $l1;',
  5569. ' $mod.vJ = $mod.vJ + $mod.vI;',
  5570. ' };',
  5571. '']));
  5572. end;
  5573. procedure TTestModule.TestForLoopInsideFunction;
  5574. begin
  5575. StartProgram(false);
  5576. Add('function SumNumbers(Count: longint): longint;');
  5577. Add('var');
  5578. Add(' vI, vJ: longint;');
  5579. Add('begin');
  5580. Add(' vj:=0;');
  5581. Add(' for vi:=1 to count do');
  5582. Add(' begin');
  5583. Add(' vj:=vj+vi;');
  5584. Add(' end;');
  5585. Add('end;');
  5586. Add('begin');
  5587. Add(' sumnumbers(3);');
  5588. ConvertProgram;
  5589. CheckSource('TestForLoopInsideFunction',
  5590. LinesToStr([ // statements
  5591. 'this.SumNumbers = function (Count) {',
  5592. ' var Result = 0;',
  5593. ' var vI = 0;',
  5594. ' var vJ = 0;',
  5595. ' vJ = 0;',
  5596. ' for (var $l1 = 1, $end2 = Count; $l1 <= $end2; $l1++) {',
  5597. ' vI = $l1;',
  5598. ' vJ = vJ + vI;',
  5599. ' };',
  5600. ' return Result;',
  5601. '};'
  5602. ]),
  5603. LinesToStr([ // $mod.$main
  5604. ' $mod.SumNumbers(3);'
  5605. ]));
  5606. end;
  5607. procedure TTestModule.TestForLoop_ReadVarAfter;
  5608. begin
  5609. StartProgram(false);
  5610. Add('var');
  5611. Add(' vI: longint;');
  5612. Add('begin');
  5613. Add(' for vi:=1 to 2 do ;');
  5614. Add(' if vi=3 then ;');
  5615. ConvertProgram;
  5616. CheckSource('TestForLoop',
  5617. LinesToStr([ // statements
  5618. 'this.vI = 0;'
  5619. ]),
  5620. LinesToStr([ // this.$main
  5621. ' for ($mod.vI = 1; $mod.vI <= 2; $mod.vI++) ;',
  5622. ' if ($mod.vI===3) ;'
  5623. ]));
  5624. end;
  5625. procedure TTestModule.TestForLoop_Nested;
  5626. begin
  5627. StartProgram(false);
  5628. Add('function SumNumbers(Count: longint): longint;');
  5629. Add('var');
  5630. Add(' vI, vJ, vK: longint;');
  5631. Add('begin');
  5632. Add(' VK:=0;');
  5633. Add(' for VI:=1 to count do');
  5634. Add(' begin');
  5635. Add(' for vj:=1 to vi do');
  5636. Add(' begin');
  5637. Add(' vk:=VK+VI;');
  5638. Add(' end;');
  5639. Add(' end;');
  5640. Add('end;');
  5641. Add('begin');
  5642. Add(' sumnumbers(3);');
  5643. ConvertProgram;
  5644. CheckSource('TestForLoopInFunction',
  5645. LinesToStr([ // statements
  5646. 'this.SumNumbers = function (Count) {',
  5647. ' var Result = 0;',
  5648. ' var vI = 0;',
  5649. ' var vJ = 0;',
  5650. ' var vK = 0;',
  5651. ' vK = 0;',
  5652. ' for (var $l1 = 1, $end2 = Count; $l1 <= $end2; $l1++) {',
  5653. ' vI = $l1;',
  5654. ' for (var $l3 = 1, $end4 = vI; $l3 <= $end4; $l3++) {',
  5655. ' vJ = $l3;',
  5656. ' vK = vK + vI;',
  5657. ' };',
  5658. ' };',
  5659. ' return Result;',
  5660. '};'
  5661. ]),
  5662. LinesToStr([ // $mod.$main
  5663. ' $mod.SumNumbers(3);'
  5664. ]));
  5665. end;
  5666. procedure TTestModule.TestRepeatUntil;
  5667. begin
  5668. StartProgram(false);
  5669. Add('var');
  5670. Add(' vI, vJ, vN: longint;');
  5671. Add('begin');
  5672. Add(' vn:=3;');
  5673. Add(' vj:=0;');
  5674. Add(' VI:=0;');
  5675. Add(' repeat');
  5676. Add(' VI:=vi+1;');
  5677. Add(' vj:=VJ+vI;');
  5678. Add(' until vi>=vn');
  5679. ConvertProgram;
  5680. CheckSource('TestRepeatUntil',
  5681. LinesToStr([ // statements
  5682. 'this.vI = 0;',
  5683. 'this.vJ = 0;',
  5684. 'this.vN = 0;'
  5685. ]),
  5686. LinesToStr([ // $mod.$main
  5687. ' $mod.vN = 3;',
  5688. ' $mod.vJ = 0;',
  5689. ' $mod.vI = 0;',
  5690. ' do{',
  5691. ' $mod.vI = $mod.vI + 1;',
  5692. ' $mod.vJ = $mod.vJ + $mod.vI;',
  5693. ' }while(!($mod.vI>=$mod.vN));'
  5694. ]));
  5695. end;
  5696. procedure TTestModule.TestAsmBlock;
  5697. begin
  5698. StartProgram(false);
  5699. Add([
  5700. 'var',
  5701. ' vI: longint;',
  5702. 'begin',
  5703. ' vi:=1;',
  5704. ' asm',
  5705. ' if (vI===1) {',
  5706. ' vI=2;',
  5707. //' console.log(''end;'');', ToDo
  5708. ' }',
  5709. ' if (vI===2){ vI=3; }',
  5710. ' end;',
  5711. ' VI:=4;']);
  5712. ConvertProgram;
  5713. CheckSource('TestAsmBlock',
  5714. LinesToStr([ // statements
  5715. 'this.vI = 0;'
  5716. ]),
  5717. LinesToStr([ // $mod.$main
  5718. '$mod.vI = 1;',
  5719. 'if (vI===1) {',
  5720. ' vI=2;',
  5721. '}',
  5722. 'if (vI===2){ vI=3; }',
  5723. ';',
  5724. '$mod.vI = 4;'
  5725. ]));
  5726. end;
  5727. procedure TTestModule.TestAsmPas_Impl;
  5728. begin
  5729. StartUnit(false);
  5730. Add('interface');
  5731. Add('const cIntf: longint = 1;');
  5732. Add('var vIntf: longint;');
  5733. Add('implementation');
  5734. Add('const cImpl: longint = 2;');
  5735. Add('var vImpl: longint;');
  5736. Add('procedure DoIt;');
  5737. Add('const cLoc: longint = 3;');
  5738. Add('var vLoc: longint;');
  5739. Add('begin;');
  5740. Add(' asm');
  5741. //Add(' pas(vIntf)=pas(cIntf);');
  5742. //Add(' pas(vImpl)=pas(cImpl);');
  5743. //Add(' pas(vLoc)=pas(cLoc);');
  5744. Add(' end;');
  5745. Add('end;');
  5746. ConvertUnit;
  5747. CheckSource('TestAsmPas_Impl',
  5748. LinesToStr([
  5749. 'var $impl = $mod.$impl;',
  5750. 'this.cIntf = 1;',
  5751. 'this.vIntf = 0;',
  5752. '']),
  5753. '', // this.$init
  5754. LinesToStr([ // implementation
  5755. '$impl.cImpl = 2;',
  5756. '$impl.vImpl = 0;',
  5757. 'var cLoc = 3;',
  5758. '$impl.DoIt = function () {',
  5759. ' var vLoc = 0;',
  5760. '};',
  5761. '']) );
  5762. end;
  5763. procedure TTestModule.TestTryFinally;
  5764. begin
  5765. StartProgram(false);
  5766. Add('var i: longint;');
  5767. Add('begin');
  5768. Add(' try');
  5769. Add(' i:=0; i:=2 div i;');
  5770. Add(' finally');
  5771. Add(' i:=3');
  5772. Add(' end;');
  5773. ConvertProgram;
  5774. CheckSource('TestTryFinally',
  5775. LinesToStr([ // statements
  5776. 'this.i = 0;'
  5777. ]),
  5778. LinesToStr([ // $mod.$main
  5779. 'try {',
  5780. ' $mod.i = 0;',
  5781. ' $mod.i = Math.floor(2 / $mod.i);',
  5782. '} finally {',
  5783. ' $mod.i = 3;',
  5784. '};'
  5785. ]));
  5786. end;
  5787. procedure TTestModule.TestTryExcept;
  5788. begin
  5789. StartProgram(false);
  5790. Add('type');
  5791. Add(' TObject = class end;');
  5792. Add(' Exception = class Msg: string; end;');
  5793. Add(' EInvalidCast = class(Exception) end;');
  5794. Add('var vI: longint;');
  5795. Add('begin');
  5796. Add(' try');
  5797. Add(' vi:=1;');
  5798. Add(' except');
  5799. Add(' vi:=2');
  5800. Add(' end;');
  5801. Add(' try');
  5802. Add(' vi:=3;');
  5803. Add(' except');
  5804. Add(' raise;');
  5805. Add(' end;');
  5806. Add(' try');
  5807. Add(' VI:=4;');
  5808. Add(' except');
  5809. Add(' on einvalidcast do');
  5810. Add(' raise;');
  5811. Add(' on E: exception do');
  5812. Add(' if e.msg='''' then');
  5813. Add(' raise e;');
  5814. Add(' else');
  5815. Add(' vi:=5');
  5816. Add(' end;');
  5817. Add(' try');
  5818. Add(' VI:=6;');
  5819. Add(' except');
  5820. Add(' on einvalidcast do ;');
  5821. Add(' end;');
  5822. ConvertProgram;
  5823. CheckSource('TestTryExcept',
  5824. LinesToStr([ // statements
  5825. 'rtl.createClass($mod, "TObject", null, function () {',
  5826. ' this.$init = function () {',
  5827. ' };',
  5828. ' this.$final = function () {',
  5829. ' };',
  5830. '});',
  5831. 'rtl.createClass($mod, "Exception", $mod.TObject, function () {',
  5832. ' this.$init = function () {',
  5833. ' $mod.TObject.$init.call(this);',
  5834. ' this.Msg = "";',
  5835. ' };',
  5836. '});',
  5837. 'rtl.createClass($mod, "EInvalidCast", $mod.Exception, function () {',
  5838. '});',
  5839. 'this.vI = 0;'
  5840. ]),
  5841. LinesToStr([ // $mod.$main
  5842. 'try {',
  5843. ' $mod.vI = 1;',
  5844. '} catch ($e) {',
  5845. ' $mod.vI = 2;',
  5846. '};',
  5847. 'try {',
  5848. ' $mod.vI = 3;',
  5849. '} catch ($e) {',
  5850. ' throw $e;',
  5851. '};',
  5852. 'try {',
  5853. ' $mod.vI = 4;',
  5854. '} catch ($e) {',
  5855. ' if ($mod.EInvalidCast.isPrototypeOf($e)){',
  5856. ' throw $e',
  5857. ' } else if ($mod.Exception.isPrototypeOf($e)) {',
  5858. ' var E = $e;',
  5859. ' if (E.Msg === "") throw E;',
  5860. ' } else {',
  5861. ' $mod.vI = 5;',
  5862. ' }',
  5863. '};',
  5864. 'try {',
  5865. ' $mod.vI = 6;',
  5866. '} catch ($e) {',
  5867. ' if ($mod.EInvalidCast.isPrototypeOf($e)){' ,
  5868. ' } else throw $e',
  5869. '};',
  5870. '']));
  5871. end;
  5872. procedure TTestModule.TestCaseOf;
  5873. begin
  5874. StartProgram(false);
  5875. Add('var vI: longint;');
  5876. Add('begin');
  5877. Add(' case vi of');
  5878. Add(' 1: ;');
  5879. Add(' 2: vi:=3;');
  5880. Add(' else');
  5881. Add(' VI:=4');
  5882. Add(' end;');
  5883. ConvertProgram;
  5884. CheckSource('TestCaseOf',
  5885. LinesToStr([ // statements
  5886. 'this.vI = 0;'
  5887. ]),
  5888. LinesToStr([ // $mod.$main
  5889. 'var $tmp1 = $mod.vI;',
  5890. 'if ($tmp1 === 1) {} else if ($tmp1 === 2){ $mod.vI = 3 }else {',
  5891. ' $mod.vI = 4;',
  5892. '};'
  5893. ]));
  5894. end;
  5895. procedure TTestModule.TestCaseOf_UseSwitch;
  5896. begin
  5897. StartProgram(false);
  5898. Converter.UseSwitchStatement:=true;
  5899. Add('var Vi: longint;');
  5900. Add('begin');
  5901. Add(' case vi of');
  5902. Add(' 1: ;');
  5903. Add(' 2: VI:=3;');
  5904. Add(' else');
  5905. Add(' vi:=4');
  5906. Add(' end;');
  5907. ConvertProgram;
  5908. CheckSource('TestCaseOf_UseSwitch',
  5909. LinesToStr([ // statements
  5910. 'this.Vi = 0;'
  5911. ]),
  5912. LinesToStr([ // $mod.$main
  5913. 'switch ($mod.Vi) {',
  5914. 'case 1:',
  5915. ' break;',
  5916. 'case 2:',
  5917. ' $mod.Vi = 3;',
  5918. ' break;',
  5919. 'default:',
  5920. ' $mod.Vi = 4;',
  5921. '};'
  5922. ]));
  5923. end;
  5924. procedure TTestModule.TestCaseOfNoElse;
  5925. begin
  5926. StartProgram(false);
  5927. Add('var Vi: longint;');
  5928. Add('begin');
  5929. Add(' case vi of');
  5930. Add(' 1: begin vi:=2; VI:=3; end;');
  5931. Add(' end;');
  5932. ConvertProgram;
  5933. CheckSource('TestCaseOfNoElse',
  5934. LinesToStr([ // statements
  5935. 'this.Vi = 0;'
  5936. ]),
  5937. LinesToStr([ // $mod.$main
  5938. 'var $tmp1 = $mod.Vi;',
  5939. 'if ($tmp1 === 1) {',
  5940. ' $mod.Vi = 2;',
  5941. ' $mod.Vi = 3;',
  5942. '};'
  5943. ]));
  5944. end;
  5945. procedure TTestModule.TestCaseOfNoElse_UseSwitch;
  5946. begin
  5947. StartProgram(false);
  5948. Converter.UseSwitchStatement:=true;
  5949. Add('var vI: longint;');
  5950. Add('begin');
  5951. Add(' case vi of');
  5952. Add(' 1: begin VI:=2; vi:=3; end;');
  5953. Add(' end;');
  5954. ConvertProgram;
  5955. CheckSource('TestCaseOfNoElse_UseSwitch',
  5956. LinesToStr([ // statements
  5957. 'this.vI = 0;'
  5958. ]),
  5959. LinesToStr([ // $mod.$main
  5960. 'switch ($mod.vI) {',
  5961. 'case 1:',
  5962. ' $mod.vI = 2;',
  5963. ' $mod.vI = 3;',
  5964. ' break;',
  5965. '};'
  5966. ]));
  5967. end;
  5968. procedure TTestModule.TestCaseOfRange;
  5969. begin
  5970. StartProgram(false);
  5971. Add('var vI: longint;');
  5972. Add('begin');
  5973. Add(' case vi of');
  5974. Add(' 1..3: vi:=14;');
  5975. Add(' 4,5: vi:=16;');
  5976. Add(' 6..7,9..10: ;');
  5977. Add(' else ;');
  5978. Add(' end;');
  5979. ConvertProgram;
  5980. CheckSource('TestCaseOfRange',
  5981. LinesToStr([ // statements
  5982. 'this.vI = 0;'
  5983. ]),
  5984. LinesToStr([ // $mod.$main
  5985. 'var $tmp1 = $mod.vI;',
  5986. 'if (($tmp1 >= 1) && ($tmp1 <= 3)){',
  5987. ' $mod.vI = 14',
  5988. '} else if (($tmp1 === 4) || ($tmp1 === 5)){',
  5989. ' $mod.vI = 16',
  5990. '} else if ((($tmp1 >= 6) && ($tmp1 <= 7)) || (($tmp1 >= 9) && ($tmp1 <= 10))) ;'
  5991. ]));
  5992. end;
  5993. procedure TTestModule.TestArray_Dynamic;
  5994. begin
  5995. StartProgram(false);
  5996. Add('type');
  5997. Add(' TArrayInt = array of longint;');
  5998. Add('var');
  5999. Add(' Arr: TArrayInt;');
  6000. Add(' i: longint;');
  6001. Add(' b: boolean;');
  6002. Add('begin');
  6003. Add(' SetLength(arr,3);');
  6004. Add(' arr[0]:=4;');
  6005. Add(' arr[1]:=length(arr)+arr[0];');
  6006. Add(' arr[i]:=5;');
  6007. Add(' arr[arr[i]]:=arr[6];');
  6008. Add(' i:=low(arr);');
  6009. Add(' i:=high(arr);');
  6010. Add(' b:=Assigned(arr);');
  6011. ConvertProgram;
  6012. CheckSource('TestArray_Dynamic',
  6013. LinesToStr([ // statements
  6014. 'this.Arr = [];',
  6015. 'this.i = 0;',
  6016. 'this.b = false;'
  6017. ]),
  6018. LinesToStr([ // $mod.$main
  6019. '$mod.Arr = rtl.arraySetLength($mod.Arr,0,3);',
  6020. '$mod.Arr[0] = 4;',
  6021. '$mod.Arr[1] = rtl.length($mod.Arr) + $mod.Arr[0];',
  6022. '$mod.Arr[$mod.i] = 5;',
  6023. '$mod.Arr[$mod.Arr[$mod.i]] = $mod.Arr[6];',
  6024. '$mod.i = 0;',
  6025. '$mod.i = rtl.length($mod.Arr) - 1;',
  6026. '$mod.b = rtl.length($mod.Arr) > 0;',
  6027. '']));
  6028. end;
  6029. procedure TTestModule.TestArray_Dynamic_Nil;
  6030. begin
  6031. StartProgram(false);
  6032. Add('type');
  6033. Add(' TArrayInt = array of longint;');
  6034. Add('var');
  6035. Add(' Arr: TArrayInt;');
  6036. Add('procedure DoIt(const i: TArrayInt; j: TArrayInt); begin end;');
  6037. Add('begin');
  6038. Add(' arr:=nil;');
  6039. Add(' if arr=nil then;');
  6040. Add(' if nil=arr then;');
  6041. Add(' if arr<>nil then;');
  6042. Add(' if nil<>arr then;');
  6043. Add(' DoIt(nil,nil);');
  6044. ConvertProgram;
  6045. CheckSource('TestArray_Dynamic',
  6046. LinesToStr([ // statements
  6047. 'this.Arr = [];',
  6048. 'this.DoIt = function(i,j){',
  6049. '};'
  6050. ]),
  6051. LinesToStr([ // $mod.$main
  6052. '$mod.Arr = [];',
  6053. 'if (rtl.length($mod.Arr) === 0) ;',
  6054. 'if (rtl.length($mod.Arr) === 0) ;',
  6055. 'if (rtl.length($mod.Arr) > 0) ;',
  6056. 'if (rtl.length($mod.Arr) > 0) ;',
  6057. '$mod.DoIt([],[]);',
  6058. '']));
  6059. end;
  6060. procedure TTestModule.TestArray_DynMultiDimensional;
  6061. begin
  6062. StartProgram(false);
  6063. Add('type');
  6064. Add(' TArrayInt = array of longint;');
  6065. Add(' TArrayArrayInt = array of TArrayInt;');
  6066. Add('var');
  6067. Add(' Arr: TArrayInt;');
  6068. Add(' Arr2: TArrayArrayInt;');
  6069. Add(' i: longint;');
  6070. Add('begin');
  6071. Add(' arr2:=nil;');
  6072. Add(' if arr2=nil then;');
  6073. Add(' if nil=arr2 then;');
  6074. Add(' i:=low(arr2);');
  6075. Add(' i:=low(arr2[1]);');
  6076. Add(' i:=high(arr2);');
  6077. Add(' i:=high(arr2[2]);');
  6078. Add(' arr2[3]:=arr;');
  6079. Add(' arr2[4][5]:=i;');
  6080. Add(' i:=arr2[6][7];');
  6081. Add(' arr2[8,9]:=i;');
  6082. Add(' i:=arr2[10,11];');
  6083. Add(' SetLength(arr2,14);');
  6084. Add(' SetLength(arr2[15],16);');
  6085. ConvertProgram;
  6086. CheckSource('TestArray_Dynamic',
  6087. LinesToStr([ // statements
  6088. 'this.Arr = [];',
  6089. 'this.Arr2 = [];',
  6090. 'this.i = 0;'
  6091. ]),
  6092. LinesToStr([ // $mod.$main
  6093. '$mod.Arr2 = [];',
  6094. 'if (rtl.length($mod.Arr2) === 0) ;',
  6095. 'if (rtl.length($mod.Arr2) === 0) ;',
  6096. '$mod.i = 0;',
  6097. '$mod.i = 0;',
  6098. '$mod.i = rtl.length($mod.Arr2) - 1;',
  6099. '$mod.i = rtl.length($mod.Arr2[2]) - 1;',
  6100. '$mod.Arr2[3] = $mod.Arr;',
  6101. '$mod.Arr2[4][5] = $mod.i;',
  6102. '$mod.i = $mod.Arr2[6][7];',
  6103. '$mod.Arr2[8][9] = $mod.i;',
  6104. '$mod.i = $mod.Arr2[10][11];',
  6105. '$mod.Arr2 = rtl.arraySetLength($mod.Arr2, [], 14);',
  6106. '$mod.Arr2[15] = rtl.arraySetLength($mod.Arr2[15], 0, 16);',
  6107. '']));
  6108. end;
  6109. procedure TTestModule.TestArray_StaticInt;
  6110. begin
  6111. StartProgram(false);
  6112. Add('type');
  6113. Add(' TArrayInt = array[2..4] of longint;');
  6114. Add('var');
  6115. Add(' Arr: TArrayInt;');
  6116. Add(' Arr2: TArrayInt = (5,6,7);');
  6117. Add(' i: longint;');
  6118. Add(' b: boolean;');
  6119. Add('begin');
  6120. Add(' arr[2]:=4;');
  6121. Add(' arr[3]:=arr[2]+arr[3];');
  6122. Add(' arr[i]:=5;');
  6123. Add(' arr[arr[i]]:=arr[high(arr)];');
  6124. Add(' i:=low(arr);');
  6125. Add(' i:=high(arr);');
  6126. Add(' b:=arr[2]=arr[3];');
  6127. ConvertProgram;
  6128. CheckSource('TestArray_StaticInt',
  6129. LinesToStr([ // statements
  6130. 'this.Arr = rtl.arraySetLength(null,0,3);',
  6131. 'this.Arr2 = [5, 6, 7];',
  6132. 'this.i = 0;',
  6133. 'this.b = false;'
  6134. ]),
  6135. LinesToStr([ // $mod.$main
  6136. '$mod.Arr[0] = 4;',
  6137. '$mod.Arr[1] = $mod.Arr[0] + $mod.Arr[1];',
  6138. '$mod.Arr[$mod.i-2] = 5;',
  6139. '$mod.Arr[$mod.Arr[$mod.i-2]-2] = $mod.Arr[2];',
  6140. '$mod.i = 2;',
  6141. '$mod.i = 4;',
  6142. '$mod.b = $mod.Arr[0] === $mod.Arr[1];',
  6143. '']));
  6144. end;
  6145. procedure TTestModule.TestArray_StaticBool;
  6146. begin
  6147. StartProgram(false);
  6148. Add('type');
  6149. Add(' TBools = array[boolean] of boolean;');
  6150. Add(' TBool2 = array[true..true] of boolean;');
  6151. Add('var');
  6152. Add(' Arr: TBools;');
  6153. Add(' Arr2: TBool2;');
  6154. Add(' Arr3: TBools = (true,false);');
  6155. Add(' b: boolean;');
  6156. Add('begin');
  6157. Add(' b:=low(arr);');
  6158. Add(' b:=high(arr);');
  6159. Add(' arr[true]:=false;');
  6160. Add(' arr[false]:=arr[b] or arr[true];');
  6161. Add(' arr[b]:=true;');
  6162. Add(' arr[arr[b]]:=arr[high(arr)];');
  6163. Add(' b:=arr[false]=arr[true];');
  6164. Add(' b:=low(arr2);');
  6165. Add(' b:=high(arr2);');
  6166. Add(' arr2[true]:=true;');
  6167. Add(' arr2[true]:=arr2[true] and arr2[b];');
  6168. Add(' arr2[b]:=false;');
  6169. ConvertProgram;
  6170. CheckSource('TestArray_StaticBool',
  6171. LinesToStr([ // statements
  6172. 'this.Arr = rtl.arraySetLength(null,false,2);',
  6173. 'this.Arr2 = rtl.arraySetLength(null,false,1);',
  6174. 'this.Arr3 = [true, false];',
  6175. 'this.b = false;'
  6176. ]),
  6177. LinesToStr([ // $mod.$main
  6178. '$mod.b = false;',
  6179. '$mod.b = true;',
  6180. '$mod.Arr[1] = false;',
  6181. '$mod.Arr[0] = $mod.Arr[+$mod.b] || $mod.Arr[1];',
  6182. '$mod.Arr[+$mod.b] = true;',
  6183. '$mod.Arr[+$mod.Arr[+$mod.b]] = $mod.Arr[1];',
  6184. '$mod.b = $mod.Arr[0] === $mod.Arr[1];',
  6185. '$mod.b = true;',
  6186. '$mod.b = true;',
  6187. '$mod.Arr2[0] = true;',
  6188. '$mod.Arr2[0] = $mod.Arr2[0] && $mod.Arr2[1-$mod.b];',
  6189. '$mod.Arr2[1-$mod.b] = false;',
  6190. '']));
  6191. end;
  6192. procedure TTestModule.TestArray_StaticChar;
  6193. begin
  6194. StartProgram(false);
  6195. Add('type');
  6196. Add(' TChars = array[char] of char;');
  6197. Add(' TChars2 = array[''a''..''z''] of char;');
  6198. Add('var');
  6199. Add(' Arr: TChars;');
  6200. Add(' Arr2: TChars2;');
  6201. Add(' Arr3: array[2..4] of char = (''p'',''a'',''s'');');
  6202. Add(' Arr4: array[11..13] of char = ''pas'';');
  6203. Add(' Arr5: array[21..22] of char = ''äö'';');
  6204. Add(' c: char;');
  6205. Add(' b: boolean;');
  6206. Add('begin');
  6207. Add(' c:=low(arr);');
  6208. Add(' c:=high(arr);');
  6209. Add(' arr[''B'']:=''a'';');
  6210. Add(' arr[''D'']:=arr[c];');
  6211. Add(' arr[c]:=arr[''d''];');
  6212. Add(' arr[arr[c]]:=arr[high(arr)];');
  6213. Add(' b:=arr[low(arr)]=arr[''e''];');
  6214. Add(' c:=low(arr2);');
  6215. Add(' c:=high(arr2);');
  6216. Add(' arr2[''b'']:=''f'';');
  6217. Add(' arr2[''a'']:=arr2[c];');
  6218. Add(' arr2[c]:=arr2[''g''];');
  6219. ConvertProgram;
  6220. CheckSource('TestArray_StaticChar',
  6221. LinesToStr([ // statements
  6222. 'this.Arr = rtl.arraySetLength(null, "", 65536);',
  6223. 'this.Arr2 = rtl.arraySetLength(null, "", 26);',
  6224. 'this.Arr3 = ["p", "a", "s"];',
  6225. 'this.Arr4 = ["p", "a", "s"];',
  6226. 'this.Arr5 = ["ä", "ö"];',
  6227. 'this.c = "";',
  6228. 'this.b = false;',
  6229. '']),
  6230. LinesToStr([ // $mod.$main
  6231. '$mod.c = "\x00";',
  6232. '$mod.c = "'#$EF#$BF#$BF'";',
  6233. '$mod.Arr[66] = "a";',
  6234. '$mod.Arr[68] = $mod.Arr[$mod.c.charCodeAt()];',
  6235. '$mod.Arr[$mod.c.charCodeAt()] = $mod.Arr[100];',
  6236. '$mod.Arr[$mod.Arr[$mod.c.charCodeAt()].charCodeAt()] = $mod.Arr[65535];',
  6237. '$mod.b = $mod.Arr[0] === $mod.Arr[101];',
  6238. '$mod.c = "a";',
  6239. '$mod.c = "z";',
  6240. '$mod.Arr2[1] = "f";',
  6241. '$mod.Arr2[0] = $mod.Arr2[$mod.c.charCodeAt() - 97];',
  6242. '$mod.Arr2[$mod.c.charCodeAt() - 97] = $mod.Arr2[6];',
  6243. '']));
  6244. end;
  6245. procedure TTestModule.TestArray_StaticMultiDim;
  6246. begin
  6247. StartProgram(false);
  6248. Add([
  6249. 'type',
  6250. ' TArrayInt = array[1..3] of longint;',
  6251. ' TArrayArrayInt = array[5..6] of TArrayInt;',
  6252. 'var',
  6253. ' Arr: TArrayInt;',
  6254. ' Arr2: TArrayArrayInt;',
  6255. ' Arr3: array[boolean] of TArrayInt = ((11,12,13),(21,22,23));',
  6256. ' i: longint;',
  6257. 'begin',
  6258. ' i:=low(arr);',
  6259. ' i:=low(arr2);',
  6260. ' i:=low(arr2[5]);',
  6261. ' i:=high(arr);',
  6262. ' i:=high(arr2);',
  6263. ' i:=high(arr2[6]);',
  6264. ' arr2[5]:=arr;',
  6265. ' arr2[6][2]:=i;',
  6266. ' i:=arr2[6][3];',
  6267. ' arr2[6,3]:=i;',
  6268. ' i:=arr2[5,2];',
  6269. ' arr2:=arr2;',// clone multi dim static array
  6270. //' arr3:=arr3;',// clone anonymous multi dim static array
  6271. '']);
  6272. ConvertProgram;
  6273. CheckSource('TestArray_StaticMultiDim',
  6274. LinesToStr([ // statements
  6275. 'this.TArrayArrayInt$clone = function (a) {',
  6276. ' var r = [];',
  6277. ' for (var i = 0; i < 2; i++) r.push(a[i].slice(0));',
  6278. ' return r;',
  6279. '};',
  6280. 'this.Arr = rtl.arraySetLength(null, 0, 3);',
  6281. 'this.Arr2 = rtl.arraySetLength(null, 0, 2, 3);',
  6282. 'this.Arr3 = [[11, 12, 13], [21, 22, 23]];',
  6283. 'this.i = 0;'
  6284. ]),
  6285. LinesToStr([ // $mod.$main
  6286. '$mod.i = 1;',
  6287. '$mod.i = 5;',
  6288. '$mod.i = 1;',
  6289. '$mod.i = 3;',
  6290. '$mod.i = 6;',
  6291. '$mod.i = 3;',
  6292. '$mod.Arr2[0] = $mod.Arr.slice(0);',
  6293. '$mod.Arr2[1][1] = $mod.i;',
  6294. '$mod.i = $mod.Arr2[1][2];',
  6295. '$mod.Arr2[1][2] = $mod.i;',
  6296. '$mod.i = $mod.Arr2[0][1];',
  6297. '$mod.Arr2 = $mod.TArrayArrayInt$clone($mod.Arr2);',
  6298. '']));
  6299. end;
  6300. procedure TTestModule.TestArrayOfRecord;
  6301. begin
  6302. StartProgram(false);
  6303. Add('type');
  6304. Add(' TRec = record');
  6305. Add(' Int: longint;');
  6306. Add(' end;');
  6307. Add(' TArrayRec = array of TRec;');
  6308. Add('var');
  6309. Add(' Arr: TArrayRec;');
  6310. Add(' r: TRec;');
  6311. Add(' i: longint;');
  6312. Add('begin');
  6313. Add(' SetLength(arr,3);');
  6314. Add(' arr[0].int:=4;');
  6315. Add(' arr[1].int:=length(arr)+arr[2].int;');
  6316. Add(' arr[arr[i].int].int:=arr[5].int;');
  6317. Add(' arr[7]:=r;');
  6318. Add(' r:=arr[8];');
  6319. Add(' i:=low(arr);');
  6320. Add(' i:=high(arr);');
  6321. ConvertProgram;
  6322. CheckSource('TestArrayOfRecord',
  6323. LinesToStr([ // statements
  6324. 'this.TRec = function (s) {',
  6325. ' if (s) {',
  6326. ' this.Int = s.Int;',
  6327. ' } else {',
  6328. ' this.Int = 0;',
  6329. ' };',
  6330. ' this.$equal = function (b) {',
  6331. ' return this.Int === b.Int;',
  6332. ' };',
  6333. '};',
  6334. 'this.Arr = [];',
  6335. 'this.r = new $mod.TRec();',
  6336. 'this.i = 0;'
  6337. ]),
  6338. LinesToStr([ // $mod.$main
  6339. '$mod.Arr = rtl.arraySetLength($mod.Arr,$mod.TRec,3);',
  6340. '$mod.Arr[0].Int = 4;',
  6341. '$mod.Arr[1].Int = rtl.length($mod.Arr)+$mod.Arr[2].Int;',
  6342. '$mod.Arr[$mod.Arr[$mod.i].Int].Int = $mod.Arr[5].Int;',
  6343. '$mod.Arr[7] = new $mod.TRec($mod.r);',
  6344. '$mod.r = new $mod.TRec($mod.Arr[8]);',
  6345. '$mod.i = 0;',
  6346. '$mod.i = rtl.length($mod.Arr)-1;',
  6347. '']));
  6348. end;
  6349. procedure TTestModule.TestArray_DynAsParam;
  6350. begin
  6351. StartProgram(false);
  6352. Add([
  6353. 'type integer = longint;',
  6354. 'type TArrInt = array of integer;',
  6355. 'procedure DoIt(vG: TArrInt; const vH: TArrInt; var vI: TArrInt);',
  6356. 'var vJ: TArrInt;',
  6357. 'begin',
  6358. ' vg:=vg;',
  6359. ' vj:=vh;',
  6360. ' vi:=vi;',
  6361. ' doit(vg,vg,vg);',
  6362. ' doit(vh,vh,vj);',
  6363. ' doit(vi,vi,vi);',
  6364. ' doit(vj,vj,vj);',
  6365. 'end;',
  6366. 'var i: TArrInt;',
  6367. 'begin',
  6368. ' doit(i,i,i);']);
  6369. ConvertProgram;
  6370. CheckSource('TestArray_DynAsParams',
  6371. LinesToStr([ // statements
  6372. 'this.DoIt = function (vG,vH,vI) {',
  6373. ' var vJ = [];',
  6374. ' vG = vG;',
  6375. ' vJ = vH;',
  6376. ' vI.set(vI.get());',
  6377. ' $mod.DoIt(vG, vG, {',
  6378. ' get: function () {',
  6379. ' return vG;',
  6380. ' },',
  6381. ' set: function (v) {',
  6382. ' vG = v;',
  6383. ' }',
  6384. ' });',
  6385. ' $mod.DoIt(vH, vH, {',
  6386. ' get: function () {',
  6387. ' return vJ;',
  6388. ' },',
  6389. ' set: function (v) {',
  6390. ' vJ = v;',
  6391. ' }',
  6392. ' });',
  6393. ' $mod.DoIt(vI.get(), vI.get(), vI);',
  6394. ' $mod.DoIt(vJ, vJ, {',
  6395. ' get: function () {',
  6396. ' return vJ;',
  6397. ' },',
  6398. ' set: function (v) {',
  6399. ' vJ = v;',
  6400. ' }',
  6401. ' });',
  6402. '};',
  6403. 'this.i = [];'
  6404. ]),
  6405. LinesToStr([
  6406. '$mod.DoIt($mod.i,$mod.i,{',
  6407. ' p: $mod,',
  6408. ' get: function () {',
  6409. ' return this.p.i;',
  6410. ' },',
  6411. ' set: function (v) {',
  6412. ' this.p.i = v;',
  6413. ' }',
  6414. '});'
  6415. ]));
  6416. end;
  6417. procedure TTestModule.TestArray_StaticAsParam;
  6418. begin
  6419. StartProgram(false);
  6420. Add([
  6421. 'type integer = longint;',
  6422. 'type TArrInt = array[1..2] of integer;',
  6423. 'procedure DoIt(vG: TArrInt; const vH: TArrInt; var vI: TArrInt);',
  6424. 'var vJ: TArrInt;',
  6425. 'begin',
  6426. ' vg:=vg;',
  6427. ' vj:=vh;',
  6428. ' vi:=vi;',
  6429. ' doit(vg,vg,vg);',
  6430. ' doit(vh,vh,vj);',
  6431. ' doit(vi,vi,vi);',
  6432. ' doit(vj,vj,vj);',
  6433. 'end;',
  6434. 'var i: TArrInt;',
  6435. 'begin',
  6436. ' doit(i,i,i);']);
  6437. ConvertProgram;
  6438. CheckSource('TestArray_StaticAsParams',
  6439. LinesToStr([ // statements
  6440. 'this.DoIt = function (vG,vH,vI) {',
  6441. ' var vJ = rtl.arraySetLength(null, 0, 2);',
  6442. ' vG = vG.slice(0);',
  6443. ' vJ = vH.slice(0);',
  6444. ' vI.set(vI.get().slice(0));',
  6445. ' $mod.DoIt(vG.slice(0), vG, {',
  6446. ' get: function () {',
  6447. ' return vG;',
  6448. ' },',
  6449. ' set: function (v) {',
  6450. ' vG = v;',
  6451. ' }',
  6452. ' });',
  6453. ' $mod.DoIt(vH.slice(0), vH, {',
  6454. ' get: function () {',
  6455. ' return vJ;',
  6456. ' },',
  6457. ' set: function (v) {',
  6458. ' vJ = v;',
  6459. ' }',
  6460. ' });',
  6461. ' $mod.DoIt(vI.get().slice(0), vI.get(), vI);',
  6462. ' $mod.DoIt(vJ.slice(0), vJ, {',
  6463. ' get: function () {',
  6464. ' return vJ;',
  6465. ' },',
  6466. ' set: function (v) {',
  6467. ' vJ = v;',
  6468. ' }',
  6469. ' });',
  6470. '};',
  6471. 'this.i = rtl.arraySetLength(null, 0, 2);'
  6472. ]),
  6473. LinesToStr([
  6474. '$mod.DoIt($mod.i.slice(0),$mod.i,{',
  6475. ' p: $mod,',
  6476. ' get: function () {',
  6477. ' return this.p.i;',
  6478. ' },',
  6479. ' set: function (v) {',
  6480. ' this.p.i = v;',
  6481. ' }',
  6482. '});'
  6483. ]));
  6484. end;
  6485. procedure TTestModule.TestArrayElement_AsParams;
  6486. begin
  6487. StartProgram(false);
  6488. Add('type integer = longint;');
  6489. Add('type TArrayInt = array of integer;');
  6490. Add('procedure DoIt(vG: Integer; const vH: Integer; var vI: Integer);');
  6491. Add('var vJ: tarrayint;');
  6492. Add('begin');
  6493. Add(' vi:=vi;');
  6494. Add(' doit(vi,vi,vi);');
  6495. Add(' doit(vj[1+1],vj[1+2],vj[1+3]);');
  6496. Add('end;');
  6497. Add('var a: TArrayInt;');
  6498. Add('begin');
  6499. Add(' doit(a[1+4],a[1+5],a[1+6]);');
  6500. ConvertProgram;
  6501. CheckSource('TestArrayElement_AsParams',
  6502. LinesToStr([ // statements
  6503. 'this.DoIt = function (vG,vH,vI) {',
  6504. ' var vJ = [];',
  6505. ' vI.set(vI.get());',
  6506. ' $mod.DoIt(vI.get(), vI.get(), vI);',
  6507. ' $mod.DoIt(vJ[1+1], vJ[1+2], {',
  6508. ' a:1+3,',
  6509. ' p:vJ,',
  6510. ' get: function () {',
  6511. ' return this.p[this.a];',
  6512. ' },',
  6513. ' set: function (v) {',
  6514. ' this.p[this.a] = v;',
  6515. ' }',
  6516. ' });',
  6517. '};',
  6518. 'this.a = [];'
  6519. ]),
  6520. LinesToStr([
  6521. '$mod.DoIt($mod.a[1+4],$mod.a[1+5],{',
  6522. ' a: 1+6,',
  6523. ' p: $mod.a,',
  6524. ' get: function () {',
  6525. ' return this.p[this.a];',
  6526. ' },',
  6527. ' set: function (v) {',
  6528. ' this.p[this.a] = v;',
  6529. ' }',
  6530. '});'
  6531. ]));
  6532. end;
  6533. procedure TTestModule.TestArrayElementFromFuncResult_AsParams;
  6534. begin
  6535. StartProgram(false);
  6536. Add('type Integer = longint;');
  6537. Add('type TArrayInt = array of integer;');
  6538. Add('function GetArr(vB: integer = 0): tarrayint;');
  6539. Add('begin');
  6540. Add('end;');
  6541. Add('procedure DoIt(vG: integer; const vH: integer; var vI: integer);');
  6542. Add('begin');
  6543. Add('end;');
  6544. Add('begin');
  6545. Add(' doit(getarr[1+1],getarr[1+2],getarr[1+3]);');
  6546. Add(' doit(getarr()[2+1],getarr()[2+2],getarr()[2+3]);');
  6547. Add(' doit(getarr(7)[3+1],getarr(8)[3+2],getarr(9)[3+3]);');
  6548. ConvertProgram;
  6549. CheckSource('TestArrayElementFromFuncResult_AsParams',
  6550. LinesToStr([ // statements
  6551. 'this.GetArr = function (vB) {',
  6552. ' var Result = [];',
  6553. ' return Result;',
  6554. '};',
  6555. 'this.DoIt = function (vG,vH,vI) {',
  6556. '};'
  6557. ]),
  6558. LinesToStr([
  6559. '$mod.DoIt($mod.GetArr(0)[1+1],$mod.GetArr(0)[1+2],{',
  6560. ' a: 1+3,',
  6561. ' p: $mod.GetArr(0),',
  6562. ' get: function () {',
  6563. ' return this.p[this.a];',
  6564. ' },',
  6565. ' set: function (v) {',
  6566. ' this.p[this.a] = v;',
  6567. ' }',
  6568. '});',
  6569. '$mod.DoIt($mod.GetArr(0)[2+1],$mod.GetArr(0)[2+2],{',
  6570. ' a: 2+3,',
  6571. ' p: $mod.GetArr(0),',
  6572. ' get: function () {',
  6573. ' return this.p[this.a];',
  6574. ' },',
  6575. ' set: function (v) {',
  6576. ' this.p[this.a] = v;',
  6577. ' }',
  6578. '});',
  6579. '$mod.DoIt($mod.GetArr(7)[3+1],$mod.GetArr(8)[3+2],{',
  6580. ' a: 3+3,',
  6581. ' p: $mod.GetArr(9),',
  6582. ' get: function () {',
  6583. ' return this.p[this.a];',
  6584. ' },',
  6585. ' set: function (v) {',
  6586. ' this.p[this.a] = v;',
  6587. ' }',
  6588. '});',
  6589. '']));
  6590. end;
  6591. procedure TTestModule.TestArrayEnumTypeRange;
  6592. begin
  6593. StartProgram(false);
  6594. Add([
  6595. 'type',
  6596. ' TEnum = (red,blue);',
  6597. ' TEnumArray = array[TEnum] of longint;',
  6598. 'var',
  6599. ' e: TEnum;',
  6600. ' i: longint;',
  6601. ' a: TEnumArray;',
  6602. ' numbers: TEnumArray = (1,2);',
  6603. ' names: array[TEnum] of string = (''red'',''blue'');',
  6604. 'begin',
  6605. ' e:=low(a);',
  6606. ' e:=high(a);',
  6607. ' i:=a[red];',
  6608. ' a[e]:=a[e];']);
  6609. ConvertProgram;
  6610. CheckSource('TestArrayEnumTypeRange',
  6611. LinesToStr([ // statements
  6612. ' this.TEnum = {',
  6613. ' "0": "red",',
  6614. ' red: 0,',
  6615. ' "1": "blue",',
  6616. ' blue: 1',
  6617. '};',
  6618. 'this.e = 0;',
  6619. 'this.i = 0;',
  6620. 'this.a = rtl.arraySetLength(null,0,2);',
  6621. 'this.numbers = [1, 2];',
  6622. 'this.names = ["red", "blue"];',
  6623. '']),
  6624. LinesToStr([ // $mod.$main
  6625. '$mod.e = $mod.TEnum.red;',
  6626. '$mod.e = $mod.TEnum.blue;',
  6627. '$mod.i = $mod.a[$mod.TEnum.red];',
  6628. '$mod.a[$mod.e] = $mod.a[$mod.e];',
  6629. '']));
  6630. end;
  6631. procedure TTestModule.TestArray_SetLengthOutArg;
  6632. begin
  6633. StartProgram(false);
  6634. Add([
  6635. 'type TArrInt = array of longint;',
  6636. 'procedure DoIt(out a: TArrInt);',
  6637. 'begin',
  6638. ' SetLength(a,2);',
  6639. 'end;',
  6640. 'begin',
  6641. '']);
  6642. ConvertProgram;
  6643. CheckSource('TestArray_SetLengthOutArg',
  6644. LinesToStr([ // statements
  6645. 'this.DoIt = function (a) {',
  6646. ' a.set(rtl.arraySetLength(a.get(), 0, 2));',
  6647. '};',
  6648. '']),
  6649. LinesToStr([
  6650. '']));
  6651. end;
  6652. procedure TTestModule.TestArray_SetLengthProperty;
  6653. begin
  6654. StartProgram(false);
  6655. Add('type');
  6656. Add(' TArrInt = array of longint;');
  6657. Add(' TObject = class');
  6658. Add(' function GetColors: TArrInt; external name ''GetColors'';');
  6659. Add(' procedure SetColors(const Value: TArrInt); external name ''SetColors'';');
  6660. Add(' property Colors: TArrInt read GetColors write SetColors;');
  6661. Add(' end;');
  6662. Add('var Obj: TObject;');
  6663. Add('begin');
  6664. Add(' SetLength(Obj.Colors,2);');
  6665. ConvertProgram;
  6666. CheckSource('TestArray_SetLengthProperty',
  6667. LinesToStr([ // statements
  6668. 'rtl.createClass($mod, "TObject", null, function () {',
  6669. ' this.$init = function () {',
  6670. ' };',
  6671. ' this.$final = function () {',
  6672. ' };',
  6673. '});',
  6674. 'this.Obj = null;',
  6675. '']),
  6676. LinesToStr([
  6677. '$mod.Obj.SetColors(rtl.arraySetLength($mod.Obj.GetColors(), 0, 2));',
  6678. '']));
  6679. end;
  6680. procedure TTestModule.TestArray_SetLengthMultiDim;
  6681. begin
  6682. StartProgram(false);
  6683. Add([
  6684. 'type',
  6685. ' TArrArrInt = array of array of longint;',
  6686. 'var',
  6687. ' a: TArrArrInt;',
  6688. 'begin',
  6689. ' SetLength(a,2);',
  6690. ' SetLength(a,3,4);',
  6691. '']);
  6692. ConvertProgram;
  6693. CheckSource('TestArray_SetLengthMultiDim',
  6694. LinesToStr([ // statements
  6695. 'this.a = [];']),
  6696. LinesToStr([
  6697. '$mod.a = rtl.arraySetLength($mod.a, [], 2);',
  6698. '$mod.a = rtl.arraySetLength($mod.a, 0, 3, 4);',
  6699. '']));
  6700. end;
  6701. procedure TTestModule.TestArray_OpenArrayOfString;
  6702. begin
  6703. StartProgram(false);
  6704. Add('procedure DoIt(const a: array of String);');
  6705. Add('var');
  6706. Add(' i: longint;');
  6707. Add(' s: string;');
  6708. Add('begin');
  6709. Add(' for i:=low(a) to high(a) do s:=a[length(a)-i-1];');
  6710. Add('end;');
  6711. Add('var s: string;');
  6712. Add('begin');
  6713. Add(' DoIt([]);');
  6714. Add(' DoIt([s,''foo'','''',s+s]);');
  6715. ConvertProgram;
  6716. CheckSource('TestArray_OpenArrayOfString',
  6717. LinesToStr([ // statements
  6718. 'this.DoIt = function (a) {',
  6719. ' var i = 0;',
  6720. ' var s = "";',
  6721. ' for (var $l1 = 0, $end2 = rtl.length(a) - 1; $l1 <= $end2; $l1++) {',
  6722. ' i = $l1;',
  6723. ' s = a[(rtl.length(a) - i) - 1];',
  6724. ' };',
  6725. '};',
  6726. 'this.s = "";',
  6727. '']),
  6728. LinesToStr([
  6729. '$mod.DoIt([]);',
  6730. '$mod.DoIt([$mod.s, "foo", "", $mod.s + $mod.s]);',
  6731. '']));
  6732. end;
  6733. procedure TTestModule.TestArray_Concat;
  6734. begin
  6735. StartProgram(false);
  6736. Add('type');
  6737. Add(' integer = longint;');
  6738. Add(' TFlag = (big,small);');
  6739. Add(' TFlags = set of TFlag;');
  6740. Add(' TRec = record');
  6741. Add(' i: integer;');
  6742. Add(' end;');
  6743. Add(' TArrInt = array of integer;');
  6744. Add(' TArrRec = array of TRec;');
  6745. Add(' TArrSet = array of TFlags;');
  6746. Add(' TArrJSValue = array of jsvalue;');
  6747. Add('var');
  6748. Add(' ArrInt: tarrint;');
  6749. Add(' ArrRec: tarrrec;');
  6750. Add(' ArrSet: tarrset;');
  6751. Add(' ArrJSValue: tarrjsvalue;');
  6752. Add('begin');
  6753. Add(' arrint:=concat(arrint);');
  6754. Add(' arrint:=concat(arrint,arrint);');
  6755. Add(' arrint:=concat(arrint,arrint,arrint);');
  6756. Add(' arrrec:=concat(arrrec);');
  6757. Add(' arrrec:=concat(arrrec,arrrec);');
  6758. Add(' arrrec:=concat(arrrec,arrrec,arrrec);');
  6759. Add(' arrset:=concat(arrset);');
  6760. Add(' arrset:=concat(arrset,arrset);');
  6761. Add(' arrset:=concat(arrset,arrset,arrset);');
  6762. Add(' arrjsvalue:=concat(arrjsvalue);');
  6763. Add(' arrjsvalue:=concat(arrjsvalue,arrjsvalue);');
  6764. Add(' arrjsvalue:=concat(arrjsvalue,arrjsvalue,arrjsvalue);');
  6765. ConvertProgram;
  6766. CheckSource('TestArray_Concat',
  6767. LinesToStr([ // statements
  6768. 'this.TFlag = {',
  6769. ' "0": "big",',
  6770. ' big: 0,',
  6771. ' "1": "small",',
  6772. ' small: 1',
  6773. '};',
  6774. 'this.TRec = function (s) {',
  6775. ' if (s) {',
  6776. ' this.i = s.i;',
  6777. ' } else {',
  6778. ' this.i = 0;',
  6779. ' };',
  6780. ' this.$equal = function (b) {',
  6781. ' return this.i === b.i;',
  6782. ' };',
  6783. '};',
  6784. 'this.ArrInt = [];',
  6785. 'this.ArrRec = [];',
  6786. 'this.ArrSet = [];',
  6787. 'this.ArrJSValue = [];',
  6788. '']),
  6789. LinesToStr([ // $mod.$main
  6790. '$mod.ArrInt = $mod.ArrInt;',
  6791. '$mod.ArrInt = $mod.ArrInt.concat($mod.ArrInt);',
  6792. '$mod.ArrInt = $mod.ArrInt.concat($mod.ArrInt,$mod.ArrInt);',
  6793. '$mod.ArrRec = $mod.ArrRec;',
  6794. '$mod.ArrRec = rtl.arrayConcat($mod.TRec, $mod.ArrRec);',
  6795. '$mod.ArrRec = rtl.arrayConcat($mod.TRec, $mod.ArrRec, $mod.ArrRec);',
  6796. '$mod.ArrSet = $mod.ArrSet;',
  6797. '$mod.ArrSet = rtl.arrayConcat("refSet", $mod.ArrSet);',
  6798. '$mod.ArrSet = rtl.arrayConcat("refSet", $mod.ArrSet, $mod.ArrSet);',
  6799. '$mod.ArrJSValue = $mod.ArrJSValue;',
  6800. '$mod.ArrJSValue = $mod.ArrJSValue.concat($mod.ArrJSValue);',
  6801. '$mod.ArrJSValue = $mod.ArrJSValue.concat($mod.ArrJSValue, $mod.ArrJSValue);',
  6802. '']));
  6803. end;
  6804. procedure TTestModule.TestArray_Copy;
  6805. begin
  6806. StartProgram(false);
  6807. Add('type');
  6808. Add(' integer = longint;');
  6809. Add(' TFlag = (big,small);');
  6810. Add(' TFlags = set of TFlag;');
  6811. Add(' TRec = record');
  6812. Add(' i: integer;');
  6813. Add(' end;');
  6814. Add(' TArrInt = array of integer;');
  6815. Add(' TArrRec = array of TRec;');
  6816. Add(' TArrSet = array of TFlags;');
  6817. Add(' TArrJSValue = array of jsvalue;');
  6818. Add('var');
  6819. Add(' ArrInt: tarrint;');
  6820. Add(' ArrRec: tarrrec;');
  6821. Add(' ArrSet: tarrset;');
  6822. Add(' ArrJSValue: tarrjsvalue;');
  6823. Add('begin');
  6824. Add(' arrint:=copy(arrint);');
  6825. Add(' arrint:=copy(arrint,2);');
  6826. Add(' arrint:=copy(arrint,3,4);');
  6827. Add(' arrrec:=copy(arrrec);');
  6828. Add(' arrrec:=copy(arrrec,5);');
  6829. Add(' arrrec:=copy(arrrec,6,7);');
  6830. Add(' arrset:=copy(arrset);');
  6831. Add(' arrset:=copy(arrset,8);');
  6832. Add(' arrset:=copy(arrset,9,10);');
  6833. Add(' arrjsvalue:=copy(arrjsvalue);');
  6834. Add(' arrjsvalue:=copy(arrjsvalue,11);');
  6835. Add(' arrjsvalue:=copy(arrjsvalue,12,13);');
  6836. ConvertProgram;
  6837. CheckSource('TestArray_Copy',
  6838. LinesToStr([ // statements
  6839. 'this.TFlag = {',
  6840. ' "0": "big",',
  6841. ' big: 0,',
  6842. ' "1": "small",',
  6843. ' small: 1',
  6844. '};',
  6845. 'this.TRec = function (s) {',
  6846. ' if (s) {',
  6847. ' this.i = s.i;',
  6848. ' } else {',
  6849. ' this.i = 0;',
  6850. ' };',
  6851. ' this.$equal = function (b) {',
  6852. ' return this.i === b.i;',
  6853. ' };',
  6854. '};',
  6855. 'this.ArrInt = [];',
  6856. 'this.ArrRec = [];',
  6857. 'this.ArrSet = [];',
  6858. 'this.ArrJSValue = [];',
  6859. '']),
  6860. LinesToStr([ // $mod.$main
  6861. '$mod.ArrInt = rtl.arrayCopy(0, $mod.ArrInt, 0);',
  6862. '$mod.ArrInt = rtl.arrayCopy(0, $mod.ArrInt, 2);',
  6863. '$mod.ArrInt = rtl.arrayCopy(0, $mod.ArrInt, 3, 4);',
  6864. '$mod.ArrRec = rtl.arrayCopy($mod.TRec, $mod.ArrRec, 0);',
  6865. '$mod.ArrRec = rtl.arrayCopy($mod.TRec, $mod.ArrRec, 5);',
  6866. '$mod.ArrRec = rtl.arrayCopy($mod.TRec, $mod.ArrRec, 6, 7);',
  6867. '$mod.ArrSet = rtl.arrayCopy("refSet", $mod.ArrSet, 0);',
  6868. '$mod.ArrSet = rtl.arrayCopy("refSet", $mod.ArrSet, 8);',
  6869. '$mod.ArrSet = rtl.arrayCopy("refSet", $mod.ArrSet, 9, 10);',
  6870. '$mod.ArrJSValue = rtl.arrayCopy(0, $mod.ArrJSValue, 0);',
  6871. '$mod.ArrJSValue = rtl.arrayCopy(0, $mod.ArrJSValue, 11);',
  6872. '$mod.ArrJSValue = rtl.arrayCopy(0, $mod.ArrJSValue, 12, 13);',
  6873. '']));
  6874. end;
  6875. procedure TTestModule.TestArray_InsertDelete;
  6876. begin
  6877. StartProgram(false);
  6878. Add('type');
  6879. Add(' integer = longint;');
  6880. Add(' TFlag = (big,small);');
  6881. Add(' TFlags = set of TFlag;');
  6882. Add(' TRec = record');
  6883. Add(' i: integer;');
  6884. Add(' end;');
  6885. Add(' TArrInt = array of integer;');
  6886. Add(' TArrRec = array of TRec;');
  6887. Add(' TArrSet = array of TFlags;');
  6888. Add(' TArrJSValue = array of jsvalue;');
  6889. Add('var');
  6890. Add(' ArrInt: tarrint;');
  6891. Add(' ArrRec: tarrrec;');
  6892. Add(' ArrSet: tarrset;');
  6893. Add(' ArrJSValue: tarrjsvalue;');
  6894. Add('begin');
  6895. Add(' Insert(1,arrint,2);');
  6896. Add(' Insert(arrint[3],arrint,4);');
  6897. Add(' Insert(arrrec[5],arrrec,6);');
  6898. Add(' Insert(arrset[7],arrset,7);');
  6899. Add(' Insert(arrjsvalue[8],arrjsvalue,9);');
  6900. Add(' Insert(10,arrjsvalue,11);');
  6901. Add(' Delete(arrint,12,13);');
  6902. Add(' Delete(arrrec,14,15);');
  6903. Add(' Delete(arrset,17,18);');
  6904. Add(' Delete(arrjsvalue,19,10);');
  6905. ConvertProgram;
  6906. CheckSource('TestArray_InsertDelete',
  6907. LinesToStr([ // statements
  6908. 'this.TFlag = {',
  6909. ' "0": "big",',
  6910. ' big: 0,',
  6911. ' "1": "small",',
  6912. ' small: 1',
  6913. '};',
  6914. 'this.TRec = function (s) {',
  6915. ' if (s) {',
  6916. ' this.i = s.i;',
  6917. ' } else {',
  6918. ' this.i = 0;',
  6919. ' };',
  6920. ' this.$equal = function (b) {',
  6921. ' return this.i === b.i;',
  6922. ' };',
  6923. '};',
  6924. 'this.ArrInt = [];',
  6925. 'this.ArrRec = [];',
  6926. 'this.ArrSet = [];',
  6927. 'this.ArrJSValue = [];',
  6928. '']),
  6929. LinesToStr([ // $mod.$main
  6930. '$mod.ArrInt.splice(2, 0, 1);',
  6931. '$mod.ArrInt.splice(4, 0, $mod.ArrInt[3]);',
  6932. '$mod.ArrRec.splice(6, 0, $mod.ArrRec[5]);',
  6933. '$mod.ArrSet.splice(7, 0, $mod.ArrSet[7]);',
  6934. '$mod.ArrJSValue.splice(9, 0, $mod.ArrJSValue[8]);',
  6935. '$mod.ArrJSValue.splice(11, 0, 10);',
  6936. '$mod.ArrInt.splice(12, 13);',
  6937. '$mod.ArrRec.splice(14, 15);',
  6938. '$mod.ArrSet.splice(17, 18);',
  6939. '$mod.ArrJSValue.splice(19, 10);',
  6940. '']));
  6941. end;
  6942. procedure TTestModule.TestArray_DynArrayConst;
  6943. begin
  6944. StartProgram(false);
  6945. Add([
  6946. 'type',
  6947. ' integer = longint;',
  6948. ' TArrInt = array of integer;',
  6949. ' TArrStr = array of string;',
  6950. 'const',
  6951. ' Ints: TArrInt = (1,2,3);',
  6952. ' Names: array of string = (''a'',''foo'');',
  6953. ' Aliases: TarrStr = (''foo'',''b'');',
  6954. ' OneInt: TArrInt = (7);',
  6955. ' OneStr: array of integer = (7);',
  6956. //' Chars: array of char = ''aoc'';',
  6957. ' NameCount = low(Names)+high(Names)+length(Names);',
  6958. 'begin',
  6959. '']);
  6960. ConvertProgram;
  6961. CheckSource('TestArray_DynArrayConst',
  6962. LinesToStr([ // statements
  6963. 'this.Ints = [1, 2, 3];',
  6964. 'this.Names = ["a", "foo"];',
  6965. 'this.Aliases = ["foo", "b"];',
  6966. 'this.OneInt = [7];',
  6967. 'this.OneStr = [7];',
  6968. 'this.NameCount = (0 + (rtl.length($mod.Names) - 1)) + rtl.length($mod.Names);',
  6969. '']),
  6970. LinesToStr([ // $mod.$main
  6971. '']));
  6972. end;
  6973. procedure TTestModule.TestArray_ForInArrOfString;
  6974. begin
  6975. StartProgram(false);
  6976. Add([
  6977. 'type',
  6978. 'type',
  6979. ' TMonthNameArray = array [1..12] of string;',
  6980. ' TMonthNames = TMonthNameArray;',
  6981. ' TObject = class',
  6982. ' private',
  6983. ' function GetLongMonthNames: TMonthNames; virtual; abstract;',
  6984. ' public',
  6985. ' Property LongMonthNames : TMonthNames Read GetLongMonthNames;',
  6986. ' end;',
  6987. 'var f: TObject;',
  6988. ' Month: string;',
  6989. 'begin',
  6990. ' for Month in f.LongMonthNames do ;',
  6991. '']);
  6992. ConvertProgram;
  6993. CheckSource('TestArray_ForInArrOfString',
  6994. LinesToStr([ // statements
  6995. 'rtl.createClass($mod, "TObject", null, function () {',
  6996. ' this.$init = function () {',
  6997. ' };',
  6998. ' this.$final = function () {',
  6999. ' };',
  7000. '});',
  7001. 'this.f = null;',
  7002. 'this.Month = "";',
  7003. '']),
  7004. LinesToStr([ // $mod.$main
  7005. 'for (var $in1 = $mod.f.GetLongMonthNames(), $l2 = 0, $end3 = rtl.length($in1) - 1; $l2 <= $end3; $l2++) $mod.Month = $in1[$l2];',
  7006. '']));
  7007. end;
  7008. procedure TTestModule.TestExternalClass_TypeCastArrayToExternalArray;
  7009. begin
  7010. StartProgram(false);
  7011. Add([
  7012. '{$modeswitch externalclass}',
  7013. 'type',
  7014. ' TJSArray = class external name ''Array''',
  7015. ' class function isArray(Value: JSValue) : boolean;',
  7016. ' function concat() : TJSArray; varargs;',
  7017. ' end;',
  7018. 'var',
  7019. ' aObj: TJSArray;',
  7020. ' a: array of longint;',
  7021. 'begin',
  7022. ' if TJSArray.isArray(65) then ;',
  7023. ' aObj:=TJSArray(a).concat(a);']);
  7024. ConvertProgram;
  7025. CheckSource('TestExternalClass_TypeCastArrayToExternalArray',
  7026. LinesToStr([ // statements
  7027. 'this.aObj = null;',
  7028. 'this.a = [];',
  7029. '']),
  7030. LinesToStr([ // $mod.$main
  7031. 'if (Array.isArray(65)) ;',
  7032. '$mod.aObj = $mod.a.concat($mod.a);',
  7033. '']));
  7034. end;
  7035. procedure TTestModule.TestExternalClass_TypeCastArrayFromExternalArray;
  7036. begin
  7037. StartProgram(false);
  7038. Add('{$modeswitch externalclass}');
  7039. Add('type');
  7040. Add(' TArrStr = array of string;');
  7041. Add(' TJSArray = class external name ''Array''');
  7042. Add(' end;');
  7043. Add('var');
  7044. Add(' aObj: TJSArray;');
  7045. Add(' a: TArrStr;');
  7046. Add('begin');
  7047. Add(' a:=TArrStr(aObj);');
  7048. Add(' TArrStr(aObj)[1]:=TArrStr(aObj)[2];');
  7049. ConvertProgram;
  7050. CheckSource('TestExternalClass_TypeCastArrayFromExternalArray',
  7051. LinesToStr([ // statements
  7052. 'this.aObj = null;',
  7053. 'this.a = [];',
  7054. '']),
  7055. LinesToStr([ // $mod.$main
  7056. '$mod.a = $mod.aObj;',
  7057. '$mod.aObj[1] = $mod.aObj[2];',
  7058. '']));
  7059. end;
  7060. procedure TTestModule.TestRecord_Empty;
  7061. begin
  7062. StartProgram(false);
  7063. Add(['type',
  7064. ' TRecA = record',
  7065. ' end;',
  7066. 'var a,b: TRecA;',
  7067. 'begin',
  7068. ' if a=b then ;']);
  7069. ConvertProgram;
  7070. CheckSource('TestRecord_Empty',
  7071. LinesToStr([ // statements
  7072. 'this.TRecA = function (s) {',
  7073. ' this.$equal = function (b) {',
  7074. ' return true;',
  7075. ' };',
  7076. '};',
  7077. 'this.a = new $mod.TRecA();',
  7078. 'this.b = new $mod.TRecA();'
  7079. ]),
  7080. LinesToStr([ // $mod.$main
  7081. 'if ($mod.a.$equal($mod.b)) ;'
  7082. ]));
  7083. end;
  7084. procedure TTestModule.TestRecord_Var;
  7085. begin
  7086. StartProgram(false);
  7087. Add('type');
  7088. Add(' TRecA = record');
  7089. Add(' Bold: longint;');
  7090. Add(' end;');
  7091. Add('var Rec: TRecA;');
  7092. Add('begin');
  7093. Add(' rec.bold:=123');
  7094. ConvertProgram;
  7095. CheckSource('TestRecord_Var',
  7096. LinesToStr([ // statements
  7097. 'this.TRecA = function (s) {',
  7098. ' if (s) {',
  7099. ' this.Bold = s.Bold;',
  7100. ' } else {',
  7101. ' this.Bold = 0;',
  7102. ' };',
  7103. ' this.$equal = function (b) {',
  7104. ' return this.Bold === b.Bold;',
  7105. ' };',
  7106. '};',
  7107. 'this.Rec = new $mod.TRecA();'
  7108. ]),
  7109. LinesToStr([ // $mod.$main
  7110. '$mod.Rec.Bold = 123;'
  7111. ]));
  7112. end;
  7113. procedure TTestModule.TestWithRecordDo;
  7114. begin
  7115. StartProgram(false);
  7116. Add('type');
  7117. Add(' TRec = record');
  7118. Add(' vI: longint;');
  7119. Add(' end;');
  7120. Add('var');
  7121. Add(' Int: longint;');
  7122. Add(' r: TRec;');
  7123. Add('begin');
  7124. Add(' with r do');
  7125. Add(' int:=vi;');
  7126. Add(' with r do begin');
  7127. Add(' int:=vi;');
  7128. Add(' vi:=int;');
  7129. Add(' end;');
  7130. ConvertProgram;
  7131. CheckSource('TestWithRecordDo',
  7132. LinesToStr([ // statements
  7133. 'this.TRec = function (s) {',
  7134. ' if (s) {',
  7135. ' this.vI = s.vI;',
  7136. ' } else {',
  7137. ' this.vI = 0;',
  7138. ' };',
  7139. ' this.$equal = function (b) {',
  7140. ' return this.vI === b.vI;',
  7141. ' };',
  7142. '};',
  7143. 'this.Int = 0;',
  7144. 'this.r = new $mod.TRec();'
  7145. ]),
  7146. LinesToStr([ // $mod.$main
  7147. 'var $with1 = $mod.r;',
  7148. '$mod.Int = $with1.vI;',
  7149. 'var $with2 = $mod.r;',
  7150. '$mod.Int = $with2.vI;',
  7151. '$with2.vI = $mod.Int;'
  7152. ]));
  7153. end;
  7154. procedure TTestModule.TestRecord_Assign;
  7155. begin
  7156. StartProgram(false);
  7157. Add('type');
  7158. Add(' TEnum = (red,green);');
  7159. Add(' TEnums = set of TEnum;');
  7160. Add(' TSmallRec = record');
  7161. Add(' N: longint;');
  7162. Add(' end;');
  7163. Add(' TBigRec = record');
  7164. Add(' Int: longint;');
  7165. Add(' D: double;');
  7166. Add(' Arr: array of longint;');
  7167. Add(' Arr2: array[1..2] of longint;');
  7168. Add(' Small: TSmallRec;');
  7169. Add(' Enums: TEnums;');
  7170. Add(' end;');
  7171. Add('var');
  7172. Add(' r, s: TBigRec;');
  7173. Add('begin');
  7174. Add(' r:=s;');
  7175. ConvertProgram;
  7176. CheckSource('TestRecord_Assign',
  7177. LinesToStr([ // statements
  7178. 'this.TEnum = {',
  7179. ' "0": "red",',
  7180. ' red: 0,',
  7181. ' "1": "green",',
  7182. ' green: 1',
  7183. '};',
  7184. 'this.TSmallRec = function (s) {',
  7185. ' if(s){',
  7186. ' this.N = s.N;',
  7187. ' } else {',
  7188. ' this.N = 0;',
  7189. ' };',
  7190. ' this.$equal = function (b) {',
  7191. ' return this.N === b.N;',
  7192. ' };',
  7193. '};',
  7194. 'this.TBigRec = function (s) {',
  7195. ' if(s){',
  7196. ' this.Int = s.Int;',
  7197. ' this.D = s.D;',
  7198. ' this.Arr = s.Arr;',
  7199. ' this.Arr2 = s.Arr2.slice(0);',
  7200. ' this.Small = new $mod.TSmallRec(s.Small);',
  7201. ' this.Enums = rtl.refSet(s.Enums);',
  7202. ' } else {',
  7203. ' this.Int = 0;',
  7204. ' this.D = 0.0;',
  7205. ' this.Arr = [];',
  7206. ' this.Arr2 = rtl.arraySetLength(null, 0, 2);',
  7207. ' this.Small = new $mod.TSmallRec();',
  7208. ' this.Enums = {};',
  7209. ' };',
  7210. ' this.$equal = function (b) {',
  7211. ' return (this.Int === b.Int) && ((this.D === b.D) && ((this.Arr === b.Arr)',
  7212. ' && (rtl.arrayEq(this.Arr2, b.Arr2)',
  7213. ' && (this.Small.$equal(b.Small) && rtl.eqSet(this.Enums, b.Enums)))));',
  7214. ' };',
  7215. '};',
  7216. 'this.r = new $mod.TBigRec();',
  7217. 'this.s = new $mod.TBigRec();'
  7218. ]),
  7219. LinesToStr([ // $mod.$main
  7220. '$mod.r = new $mod.TBigRec($mod.s);',
  7221. '']));
  7222. end;
  7223. procedure TTestModule.TestRecord_PassAsArgClone;
  7224. begin
  7225. StartProgram(false);
  7226. Add('type');
  7227. Add(' TRecA = record');
  7228. Add(' Bold: longint;');
  7229. Add(' end;');
  7230. Add('procedure DoDefault(r: treca); begin end;');
  7231. Add('procedure DoConst(const r: treca); begin end;');
  7232. Add('var Rec: treca;');
  7233. Add('begin');
  7234. Add(' dodefault(rec);');
  7235. Add(' doconst(rec);');
  7236. ConvertProgram;
  7237. CheckSource('TestRecord_PassAsArgClone',
  7238. LinesToStr([ // statements
  7239. 'this.TRecA = function (s) {',
  7240. ' if (s) {',
  7241. ' this.Bold = s.Bold;',
  7242. ' } else {',
  7243. ' this.Bold = 0;',
  7244. ' };',
  7245. ' this.$equal = function (b) {',
  7246. ' return this.Bold === b.Bold;',
  7247. ' };',
  7248. '};',
  7249. 'this.DoDefault = function (r) {',
  7250. '};',
  7251. 'this.DoConst = function (r) {',
  7252. '};',
  7253. 'this.Rec = new $mod.TRecA();'
  7254. ]),
  7255. LinesToStr([ // $mod.$main
  7256. '$mod.DoDefault(new $mod.TRecA($mod.Rec));',
  7257. '$mod.DoConst($mod.Rec);',
  7258. '']));
  7259. end;
  7260. procedure TTestModule.TestRecord_AsParams;
  7261. begin
  7262. StartProgram(false);
  7263. Add('type');
  7264. Add(' integer = longint;');
  7265. Add(' TRecord = record');
  7266. Add(' i: integer;');
  7267. Add(' end;');
  7268. Add('procedure DoIt(vG: TRecord; const vH: TRecord; var vI: TRecord);');
  7269. Add('var vJ: TRecord;');
  7270. Add('begin');
  7271. Add(' vg:=vg;');
  7272. Add(' vj:=vh;');
  7273. Add(' vi:=vi;');
  7274. Add(' doit(vg,vg,vg);');
  7275. Add(' doit(vh,vh,vj);');
  7276. Add(' doit(vi,vi,vi);');
  7277. Add(' doit(vj,vj,vj);');
  7278. Add('end;');
  7279. Add('var i: TRecord;');
  7280. Add('begin');
  7281. Add(' doit(i,i,i);');
  7282. ConvertProgram;
  7283. CheckSource('TestRecord_AsParams',
  7284. LinesToStr([ // statements
  7285. 'this.TRecord = function (s) {',
  7286. ' if (s) {',
  7287. ' this.i = s.i;',
  7288. ' } else {',
  7289. ' this.i = 0;',
  7290. ' };',
  7291. ' this.$equal = function (b) {',
  7292. ' return this.i === b.i;',
  7293. ' };',
  7294. '};',
  7295. 'this.DoIt = function (vG,vH,vI) {',
  7296. ' var vJ = new $mod.TRecord();',
  7297. ' vG = new $mod.TRecord(vG);',
  7298. ' vJ = new $mod.TRecord(vH);',
  7299. ' vI.set(new $mod.TRecord(vI.get()));',
  7300. ' $mod.DoIt(new $mod.TRecord(vG), vG, {',
  7301. ' get: function () {',
  7302. ' return vG;',
  7303. ' },',
  7304. ' set: function (v) {',
  7305. ' vG = v;',
  7306. ' }',
  7307. ' });',
  7308. ' $mod.DoIt(new $mod.TRecord(vH), vH, {',
  7309. ' get: function () {',
  7310. ' return vJ;',
  7311. ' },',
  7312. ' set: function (v) {',
  7313. ' vJ = v;',
  7314. ' }',
  7315. ' });',
  7316. ' $mod.DoIt(new $mod.TRecord(vI.get()), vI.get(), vI);',
  7317. ' $mod.DoIt(new $mod.TRecord(vJ), vJ, {',
  7318. ' get: function () {',
  7319. ' return vJ;',
  7320. ' },',
  7321. ' set: function (v) {',
  7322. ' vJ = v;',
  7323. ' }',
  7324. ' });',
  7325. '};',
  7326. 'this.i = new $mod.TRecord();'
  7327. ]),
  7328. LinesToStr([
  7329. '$mod.DoIt(new $mod.TRecord($mod.i),$mod.i,{',
  7330. ' p: $mod,',
  7331. ' get: function () {',
  7332. ' return this.p.i;',
  7333. ' },',
  7334. ' set: function (v) {',
  7335. ' this.p.i = v;',
  7336. ' }',
  7337. '});'
  7338. ]));
  7339. end;
  7340. procedure TTestModule.TestRecordElement_AsParams;
  7341. begin
  7342. StartProgram(false);
  7343. Add('type');
  7344. Add(' integer = longint;');
  7345. Add(' TRecord = record');
  7346. Add(' i: integer;');
  7347. Add(' end;');
  7348. Add('procedure DoIt(vG: integer; const vH: integer; var vI: integer);');
  7349. Add('var vJ: TRecord;');
  7350. Add('begin');
  7351. Add(' doit(vj.i,vj.i,vj.i);');
  7352. Add('end;');
  7353. Add('var r: TRecord;');
  7354. Add('begin');
  7355. Add(' doit(r.i,r.i,r.i);');
  7356. ConvertProgram;
  7357. CheckSource('TestRecordElement_AsParams',
  7358. LinesToStr([ // statements
  7359. 'this.TRecord = function (s) {',
  7360. ' if (s) {',
  7361. ' this.i = s.i;',
  7362. ' } else {',
  7363. ' this.i = 0;',
  7364. ' };',
  7365. ' this.$equal = function (b) {',
  7366. ' return this.i === b.i;',
  7367. ' };',
  7368. '};',
  7369. 'this.DoIt = function (vG,vH,vI) {',
  7370. ' var vJ = new $mod.TRecord();',
  7371. ' $mod.DoIt(vJ.i, vJ.i, {',
  7372. ' p: vJ,',
  7373. ' get: function () {',
  7374. ' return this.p.i;',
  7375. ' },',
  7376. ' set: function (v) {',
  7377. ' this.p.i = v;',
  7378. ' }',
  7379. ' });',
  7380. '};',
  7381. 'this.r = new $mod.TRecord();'
  7382. ]),
  7383. LinesToStr([
  7384. '$mod.DoIt($mod.r.i,$mod.r.i,{',
  7385. ' p: $mod.r,',
  7386. ' get: function () {',
  7387. ' return this.p.i;',
  7388. ' },',
  7389. ' set: function (v) {',
  7390. ' this.p.i = v;',
  7391. ' }',
  7392. '});'
  7393. ]));
  7394. end;
  7395. procedure TTestModule.TestRecordElementFromFuncResult_AsParams;
  7396. begin
  7397. StartProgram(false);
  7398. Add('type');
  7399. Add(' integer = longint;');
  7400. Add(' TRecord = record');
  7401. Add(' i: integer;');
  7402. Add(' end;');
  7403. Add('function GetRec(vB: integer = 0): TRecord;');
  7404. Add('begin');
  7405. Add('end;');
  7406. Add('procedure DoIt(vG: integer; const vH: integer);');
  7407. Add('begin');
  7408. Add('end;');
  7409. Add('begin');
  7410. Add(' doit(getrec.i,getrec.i);');
  7411. Add(' doit(getrec().i,getrec().i);');
  7412. Add(' doit(getrec(1).i,getrec(2).i);');
  7413. ConvertProgram;
  7414. CheckSource('TestRecordElementFromFuncResult_AsParams',
  7415. LinesToStr([ // statements
  7416. 'this.TRecord = function (s) {',
  7417. ' if (s) {',
  7418. ' this.i = s.i;',
  7419. ' } else {',
  7420. ' this.i = 0;',
  7421. ' };',
  7422. ' this.$equal = function (b) {',
  7423. ' return this.i === b.i;',
  7424. ' };',
  7425. '};',
  7426. 'this.GetRec = function (vB) {',
  7427. ' var Result = new $mod.TRecord();',
  7428. ' return Result;',
  7429. '};',
  7430. 'this.DoIt = function (vG,vH) {',
  7431. '};'
  7432. ]),
  7433. LinesToStr([
  7434. '$mod.DoIt($mod.GetRec(0).i,$mod.GetRec(0).i);',
  7435. '$mod.DoIt($mod.GetRec(0).i,$mod.GetRec(0).i);',
  7436. '$mod.DoIt($mod.GetRec(1).i,$mod.GetRec(2).i);',
  7437. '']));
  7438. end;
  7439. procedure TTestModule.TestRecordElementFromWith_AsParams;
  7440. begin
  7441. StartProgram(false);
  7442. Add('type');
  7443. Add(' integer = longint;');
  7444. Add(' TRecord = record');
  7445. Add(' i: integer;');
  7446. Add(' end;');
  7447. Add('procedure DoIt(vG: integer; const vH: integer; var vI: integer);');
  7448. Add('begin');
  7449. Add('end;');
  7450. Add('var r: trecord;');
  7451. Add('begin');
  7452. Add(' with r do ');
  7453. Add(' doit(i,i,i);');
  7454. ConvertProgram;
  7455. CheckSource('TestRecordElementFromWith_AsParams',
  7456. LinesToStr([ // statements
  7457. 'this.TRecord = function (s) {',
  7458. ' if (s) {',
  7459. ' this.i = s.i;',
  7460. ' } else {',
  7461. ' this.i = 0;',
  7462. ' };',
  7463. ' this.$equal = function (b) {',
  7464. ' return this.i === b.i;',
  7465. ' };',
  7466. '};',
  7467. 'this.DoIt = function (vG,vH,vI) {',
  7468. '};',
  7469. 'this.r = new $mod.TRecord();'
  7470. ]),
  7471. LinesToStr([
  7472. 'var $with1 = $mod.r;',
  7473. '$mod.DoIt($with1.i,$with1.i,{',
  7474. ' p: $with1,',
  7475. ' get: function () {',
  7476. ' return this.p.i;',
  7477. ' },',
  7478. ' set: function (v) {',
  7479. ' this.p.i = v;',
  7480. ' }',
  7481. '});',
  7482. '']));
  7483. end;
  7484. procedure TTestModule.TestRecord_Equal;
  7485. begin
  7486. StartProgram(false);
  7487. Add('type');
  7488. Add(' integer = longint;');
  7489. Add(' TFlag = (red,blue);');
  7490. Add(' TFlags = set of TFlag;');
  7491. Add(' TProc = procedure;');
  7492. Add(' TRecord = record');
  7493. Add(' i: integer;');
  7494. Add(' Event: TProc;');
  7495. Add(' f: TFlags;');
  7496. Add(' end;');
  7497. Add(' TNested = record');
  7498. Add(' r: TRecord;');
  7499. Add(' end;');
  7500. Add('var');
  7501. Add(' b: boolean;');
  7502. Add(' r,s: trecord;');
  7503. Add('begin');
  7504. Add(' b:=r=s;');
  7505. Add(' b:=r<>s;');
  7506. ConvertProgram;
  7507. CheckSource('TestRecord_Equal',
  7508. LinesToStr([ // statements
  7509. 'this.TFlag = {',
  7510. ' "0": "red",',
  7511. ' red: 0,',
  7512. ' "1": "blue",',
  7513. ' blue: 1',
  7514. '};',
  7515. 'this.TRecord = function (s) {',
  7516. ' if (s) {',
  7517. ' this.i = s.i;',
  7518. ' this.Event = s.Event;',
  7519. ' this.f = rtl.refSet(s.f);',
  7520. ' } else {',
  7521. ' this.i = 0;',
  7522. ' this.Event = null;',
  7523. ' this.f = {};',
  7524. ' };',
  7525. ' this.$equal = function (b) {',
  7526. ' return (this.i === b.i) && (rtl.eqCallback(this.Event, b.Event) && rtl.eqSet(this.f, b.f));',
  7527. ' };',
  7528. '};',
  7529. 'this.TNested = function (s) {',
  7530. ' if (s) {',
  7531. ' this.r = new $mod.TRecord(s.r);',
  7532. ' } else {',
  7533. ' this.r = new $mod.TRecord();',
  7534. ' };',
  7535. ' this.$equal = function (b) {',
  7536. ' return this.r.$equal(b.r);',
  7537. ' };',
  7538. '};',
  7539. 'this.b = false;',
  7540. 'this.r = new $mod.TRecord();',
  7541. 'this.s = new $mod.TRecord();'
  7542. ]),
  7543. LinesToStr([
  7544. '$mod.b = $mod.r.$equal($mod.s);',
  7545. '$mod.b = !$mod.r.$equal($mod.s);',
  7546. '']));
  7547. end;
  7548. procedure TTestModule.TestRecord_TypeCastJSValueToRecord;
  7549. begin
  7550. StartProgram(false);
  7551. Add('type');
  7552. Add(' TRecord = record');
  7553. Add(' i: longint;');
  7554. Add(' end;');
  7555. Add('var');
  7556. Add(' Jv: jsvalue;');
  7557. Add(' Rec: trecord;');
  7558. Add('begin');
  7559. Add(' rec:=trecord(jv);');
  7560. ConvertProgram;
  7561. CheckSource('TestRecord_TypeCastJSValueToRecord',
  7562. LinesToStr([ // statements
  7563. 'this.TRecord = function (s) {',
  7564. ' if (s) {',
  7565. ' this.i = s.i;',
  7566. ' } else {',
  7567. ' this.i = 0;',
  7568. ' };',
  7569. ' this.$equal = function (b) {',
  7570. ' return this.i === b.i;',
  7571. ' };',
  7572. '};',
  7573. 'this.Jv = undefined;',
  7574. 'this.Rec = new $mod.TRecord();'
  7575. ]),
  7576. LinesToStr([
  7577. '$mod.Rec = new $mod.TRecord(rtl.getObject($mod.Jv));',
  7578. '']));
  7579. end;
  7580. procedure TTestModule.TestRecord_VariantFail;
  7581. begin
  7582. StartProgram(false);
  7583. Add([
  7584. 'type',
  7585. ' TRec = record',
  7586. ' case word of',
  7587. ' 0: (b0, b1: Byte);',
  7588. ' 1: (i: word);',
  7589. ' end;',
  7590. 'begin']);
  7591. SetExpectedPasResolverError('variant record is not supported',
  7592. nXIsNotSupported);
  7593. ConvertProgram;
  7594. end;
  7595. procedure TTestModule.TestRecord_FieldArray;
  7596. begin
  7597. StartProgram(false);
  7598. Add([
  7599. 'type',
  7600. ' TArrInt = array[3..4] of longint;',
  7601. ' TArrArrInt = array[3..4] of longint;',
  7602. ' TRec = record',
  7603. ' a: array of longint;',
  7604. ' s: array[1..2] of longint;',
  7605. ' m: array[1..2,3..4] of longint;',
  7606. ' o: TArrArrInt;',
  7607. ' end;',
  7608. 'begin']);
  7609. ConvertProgram;
  7610. CheckSource('TestRecord_FieldArray',
  7611. LinesToStr([ // statements
  7612. 'this.TRec = function (s) {',
  7613. ' if (s) {',
  7614. ' this.a = s.a;',
  7615. ' this.s = s.s.slice(0);',
  7616. ' this.m = s.m.slice(0);',
  7617. ' this.o = s.o.slice(0);',
  7618. ' } else {',
  7619. ' this.a = [];',
  7620. ' this.s = rtl.arraySetLength(null, 0, 2);',
  7621. ' this.m = rtl.arraySetLength(null, 0, 2, 2);',
  7622. ' this.o = rtl.arraySetLength(null, 0, 2);',
  7623. ' };',
  7624. ' this.$equal = function (b) {',
  7625. ' return (this.a === b.a) && (rtl.arrayEq(this.s, b.s) && (rtl.arrayEq(this.m, b.m) && rtl.arrayEq(this.o, b.o)));',
  7626. ' };',
  7627. '};',
  7628. '']),
  7629. LinesToStr([ // $mod.$main
  7630. '']));
  7631. end;
  7632. procedure TTestModule.TestClass_TObjectDefaultConstructor;
  7633. begin
  7634. StartProgram(false);
  7635. Add('type');
  7636. Add(' TObject = class');
  7637. Add(' public');
  7638. Add(' constructor Create;');
  7639. Add(' destructor Destroy;');
  7640. Add(' end;');
  7641. Add(' TBird = TObject;');
  7642. Add('constructor tobject.create;');
  7643. Add('begin end;');
  7644. Add('destructor tobject.destroy;');
  7645. Add('begin end;');
  7646. Add('var Obj: tobject;');
  7647. Add('begin');
  7648. Add(' obj:=tobject.create;');
  7649. Add(' obj:=tbird.create;');
  7650. Add(' obj.destroy;');
  7651. ConvertProgram;
  7652. CheckSource('TestClass_TObjectDefaultConstructor',
  7653. LinesToStr([ // statements
  7654. 'rtl.createClass($mod,"TObject",null,function(){',
  7655. ' this.$init = function () {',
  7656. ' };',
  7657. ' this.$final = function () {',
  7658. ' };',
  7659. ' this.Create = function(){',
  7660. ' };',
  7661. ' this.Destroy = function(){',
  7662. ' };',
  7663. '});',
  7664. 'this.Obj = null;'
  7665. ]),
  7666. LinesToStr([ // $mod.$main
  7667. '$mod.Obj = $mod.TObject.$create("Create");',
  7668. '$mod.Obj = $mod.TObject.$create("Create");',
  7669. '$mod.Obj.$destroy("Destroy");',
  7670. '']));
  7671. end;
  7672. procedure TTestModule.TestClass_TObjectConstructorWithParams;
  7673. begin
  7674. StartProgram(false);
  7675. Add('type');
  7676. Add(' TObject = class');
  7677. Add(' public');
  7678. Add(' constructor Create(Par: longint);');
  7679. Add(' end;');
  7680. Add('constructor tobject.create(par: longint);');
  7681. Add('begin end;');
  7682. Add('var Obj: tobject;');
  7683. Add('begin');
  7684. Add(' obj:=tobject.create(3);');
  7685. ConvertProgram;
  7686. CheckSource('TestClass_TObjectConstructorWithParams',
  7687. LinesToStr([ // statements
  7688. 'rtl.createClass($mod,"TObject",null,function(){',
  7689. ' this.$init = function () {',
  7690. ' };',
  7691. ' this.$final = function () {',
  7692. ' };',
  7693. ' this.Create = function(Par){',
  7694. ' };',
  7695. '});',
  7696. 'this.Obj = null;'
  7697. ]),
  7698. LinesToStr([ // $mod.$main
  7699. '$mod.Obj = $mod.TObject.$create("Create",[3]);'
  7700. ]));
  7701. end;
  7702. procedure TTestModule.TestClass_TObjectConstructorWithDefaultParam;
  7703. begin
  7704. StartProgram(false);
  7705. Add('type');
  7706. Add(' TObject = class');
  7707. Add(' public');
  7708. Add(' constructor Create;');
  7709. Add(' end;');
  7710. Add(' TTest = class(TObject)');
  7711. Add(' public');
  7712. Add(' constructor Create(const Par: longint = 1);');
  7713. Add(' end;');
  7714. Add('constructor tobject.create;');
  7715. Add('begin end;');
  7716. Add('constructor ttest.create(const par: longint);');
  7717. Add('begin end;');
  7718. Add('var t: ttest;');
  7719. Add('begin');
  7720. Add(' t:=ttest.create;');
  7721. Add(' t:=ttest.create(2);');
  7722. ConvertProgram;
  7723. CheckSource('TestClass_TObjectConstructorWithDefaultParam',
  7724. LinesToStr([ // statements
  7725. 'rtl.createClass($mod,"TObject",null,function(){',
  7726. ' this.$init = function () {',
  7727. ' };',
  7728. ' this.$final = function () {',
  7729. ' };',
  7730. ' this.Create = function(){',
  7731. ' };',
  7732. '});',
  7733. 'rtl.createClass($mod, "TTest", $mod.TObject, function () {',
  7734. ' this.Create$1 = function (Par) {',
  7735. ' };',
  7736. '});',
  7737. 'this.t = null;'
  7738. ]),
  7739. LinesToStr([ // $mod.$main
  7740. '$mod.t = $mod.TTest.$create("Create$1", [1]);',
  7741. '$mod.t = $mod.TTest.$create("Create$1", [2]);'
  7742. ]));
  7743. end;
  7744. procedure TTestModule.TestClass_Var;
  7745. begin
  7746. StartProgram(false);
  7747. Add('type');
  7748. Add(' TObject = class');
  7749. Add(' public');
  7750. Add(' vI: longint;');
  7751. Add(' constructor Create(Par: longint);');
  7752. Add(' end;');
  7753. Add('constructor tobject.create(par: longint);');
  7754. Add('begin');
  7755. Add(' vi:=par+3');
  7756. Add('end;');
  7757. Add('var Obj: tobject;');
  7758. Add('begin');
  7759. Add(' obj:=tobject.create(4);');
  7760. Add(' obj.vi:=obj.VI+5;');
  7761. ConvertProgram;
  7762. CheckSource('TestClass_Var',
  7763. LinesToStr([ // statements
  7764. 'rtl.createClass($mod,"TObject",null,function(){',
  7765. ' this.$init = function () {',
  7766. ' this.vI = 0;',
  7767. ' };',
  7768. ' this.$final = function () {',
  7769. ' };',
  7770. ' this.Create = function(Par){',
  7771. ' this.vI = Par+3;',
  7772. ' };',
  7773. '});',
  7774. 'this.Obj = null;'
  7775. ]),
  7776. LinesToStr([ // $mod.$main
  7777. '$mod.Obj = $mod.TObject.$create("Create",[4]);',
  7778. '$mod.Obj.vI = $mod.Obj.vI + 5;'
  7779. ]));
  7780. end;
  7781. procedure TTestModule.TestClass_Method;
  7782. begin
  7783. StartProgram(false);
  7784. Add('type');
  7785. Add(' TObject = class');
  7786. Add(' public');
  7787. Add(' vI: longint;');
  7788. Add(' Sub: TObject;');
  7789. Add(' constructor Create;');
  7790. Add(' function GetIt(Par: longint): tobject;');
  7791. Add(' end;');
  7792. Add('constructor tobject.create; begin end;');
  7793. Add('function tobject.getit(par: longint): tobject;');
  7794. Add('begin');
  7795. Add(' Self.vi:=par+3;');
  7796. Add(' Result:=self.sub;');
  7797. Add('end;');
  7798. Add('var Obj: tobject;');
  7799. Add('begin');
  7800. Add(' obj:=tobject.create;');
  7801. Add(' obj.getit(4);');
  7802. Add(' obj.sub.sub:=nil;');
  7803. Add(' obj.sub.getit(5);');
  7804. Add(' obj.sub.getit(6).SUB:=nil;');
  7805. Add(' obj.sub.getit(7).GETIT(8);');
  7806. Add(' obj.sub.getit(9).SuB.getit(10);');
  7807. ConvertProgram;
  7808. CheckSource('TestClass_Method',
  7809. LinesToStr([ // statements
  7810. 'rtl.createClass($mod,"TObject",null,function(){',
  7811. ' this.$init = function () {',
  7812. ' this.vI = 0;',
  7813. ' this.Sub = null;',
  7814. ' };',
  7815. ' this.$final = function () {',
  7816. ' this.Sub = undefined;',
  7817. ' };',
  7818. ' this.Create = function(){',
  7819. ' };',
  7820. ' this.GetIt = function(Par){',
  7821. ' var Result = null;',
  7822. ' this.vI = Par + 3;',
  7823. ' Result = this.Sub;',
  7824. ' return Result;',
  7825. ' };',
  7826. '});',
  7827. 'this.Obj = null;'
  7828. ]),
  7829. LinesToStr([ // $mod.$main
  7830. '$mod.Obj = $mod.TObject.$create("Create");',
  7831. '$mod.Obj.GetIt(4);',
  7832. '$mod.Obj.Sub.Sub=null;',
  7833. '$mod.Obj.Sub.GetIt(5);',
  7834. '$mod.Obj.Sub.GetIt(6).Sub=null;',
  7835. '$mod.Obj.Sub.GetIt(7).GetIt(8);',
  7836. '$mod.Obj.Sub.GetIt(9).Sub.GetIt(10);'
  7837. ]));
  7838. end;
  7839. procedure TTestModule.TestClass_Implementation;
  7840. begin
  7841. StartUnit(false);
  7842. Add([
  7843. 'interface',
  7844. 'type',
  7845. ' TObject = class',
  7846. ' constructor Create;',
  7847. ' end;',
  7848. 'implementation',
  7849. 'type',
  7850. ' TIntClass = class',
  7851. ' constructor Create; reintroduce;',
  7852. ' class procedure DoGlob;',
  7853. ' end;',
  7854. 'constructor tintclass.create;',
  7855. 'begin',
  7856. ' inherited;',
  7857. ' inherited create;',
  7858. ' doglob;',
  7859. 'end;',
  7860. 'class procedure tintclass.doglob;',
  7861. 'begin',
  7862. 'end;',
  7863. 'constructor tobject.create;',
  7864. 'var',
  7865. ' iC: tintclass;',
  7866. 'begin',
  7867. ' ic:=tintclass.create;',
  7868. ' tintclass.doglob;',
  7869. ' ic.doglob;',
  7870. 'end;',
  7871. 'initialization',
  7872. ' tintclass.doglob;',
  7873. '']);
  7874. ConvertUnit;
  7875. CheckSource('TestClass_Implementation',
  7876. LinesToStr([ // statements
  7877. 'var $impl = $mod.$impl;',
  7878. 'rtl.createClass($mod, "TObject", null, function () {',
  7879. ' this.$init = function () {',
  7880. ' };',
  7881. ' this.$final = function () {',
  7882. ' };',
  7883. ' this.Create = function () {',
  7884. ' var iC = null;',
  7885. ' iC = $impl.TIntClass.$create("Create$1");',
  7886. ' $impl.TIntClass.DoGlob();',
  7887. ' iC.$class.DoGlob();',
  7888. ' };',
  7889. '});',
  7890. '']),
  7891. LinesToStr([ // $mod.$main
  7892. '$impl.TIntClass.DoGlob();',
  7893. '']),
  7894. LinesToStr([
  7895. 'rtl.createClass($impl, "TIntClass", $mod.TObject, function () {',
  7896. ' this.Create$1 = function () {',
  7897. ' $mod.TObject.Create.apply(this, arguments);',
  7898. ' $mod.TObject.Create.call(this);',
  7899. ' this.$class.DoGlob();',
  7900. ' };',
  7901. ' this.DoGlob = function () {',
  7902. ' };',
  7903. '});',
  7904. '']));
  7905. end;
  7906. procedure TTestModule.TestClass_Inheritance;
  7907. begin
  7908. StartProgram(false);
  7909. Add('type');
  7910. Add(' TObject = class');
  7911. Add(' public');
  7912. Add(' constructor Create;');
  7913. Add(' end;');
  7914. Add(' TClassA = class');
  7915. Add(' end;');
  7916. Add(' TClassB = class(TObject)');
  7917. Add(' procedure ProcB;');
  7918. Add(' end;');
  7919. Add('constructor tobject.create; begin end;');
  7920. Add('procedure tclassb.procb; begin end;');
  7921. Add('var');
  7922. Add(' oO: TObject;');
  7923. Add(' oA: TClassA;');
  7924. Add(' oB: TClassB;');
  7925. Add('begin');
  7926. Add(' oO:=tobject.Create;');
  7927. Add(' oA:=tclassa.Create;');
  7928. Add(' ob:=tclassb.Create;');
  7929. Add(' if oo is tclassa then ;');
  7930. Add(' ob:=oo as tclassb;');
  7931. Add(' (oo as tclassb).procb;');
  7932. ConvertProgram;
  7933. CheckSource('TestClass_Inheritance',
  7934. LinesToStr([ // statements
  7935. 'rtl.createClass($mod,"TObject",null,function(){',
  7936. ' this.$init = function () {',
  7937. ' };',
  7938. ' this.$final = function () {',
  7939. ' };',
  7940. ' this.Create = function () {',
  7941. ' };',
  7942. '});',
  7943. 'rtl.createClass($mod,"TClassA",$mod.TObject,function(){',
  7944. '});',
  7945. 'rtl.createClass($mod,"TClassB",$mod.TObject,function(){',
  7946. ' this.ProcB = function () {',
  7947. ' };',
  7948. '});',
  7949. 'this.oO = null;',
  7950. 'this.oA = null;',
  7951. 'this.oB = null;'
  7952. ]),
  7953. LinesToStr([ // $mod.$main
  7954. '$mod.oO = $mod.TObject.$create("Create");',
  7955. '$mod.oA = $mod.TClassA.$create("Create");',
  7956. '$mod.oB = $mod.TClassB.$create("Create");',
  7957. 'if ($mod.TClassA.isPrototypeOf($mod.oO));',
  7958. '$mod.oB = rtl.as($mod.oO, $mod.TClassB);',
  7959. 'rtl.as($mod.oO, $mod.TClassB).ProcB();'
  7960. ]));
  7961. end;
  7962. procedure TTestModule.TestClass_AbstractMethod;
  7963. begin
  7964. StartProgram(false);
  7965. Add('type');
  7966. Add(' TObject = class');
  7967. Add(' public');
  7968. Add(' procedure DoIt; virtual; abstract;');
  7969. Add(' end;');
  7970. Add('begin');
  7971. ConvertProgram;
  7972. CheckSource('TestClass_AbstractMethod',
  7973. LinesToStr([ // statements
  7974. 'rtl.createClass($mod,"TObject",null,function(){',
  7975. ' this.$init = function () {',
  7976. ' };',
  7977. ' this.$final = function () {',
  7978. ' };',
  7979. '});'
  7980. ]),
  7981. LinesToStr([ // this.$main
  7982. ''
  7983. ]));
  7984. end;
  7985. procedure TTestModule.TestClass_CallInherited_NoParams;
  7986. begin
  7987. StartProgram(false);
  7988. Add('type');
  7989. Add(' TObject = class');
  7990. Add(' procedure DoAbstract; virtual; abstract;');
  7991. Add(' procedure DoVirtual; virtual;');
  7992. Add(' procedure DoIt;');
  7993. Add(' end;');
  7994. Add(' TA = class');
  7995. Add(' procedure doabstract; override;');
  7996. Add(' procedure dovirtual; override;');
  7997. Add(' procedure DoSome;');
  7998. Add(' end;');
  7999. Add('procedure tobject.dovirtual;');
  8000. Add('begin');
  8001. Add(' inherited; // call non existing ancestor -> ignore silently');
  8002. Add('end;');
  8003. Add('procedure tobject.doit;');
  8004. Add('begin');
  8005. Add('end;');
  8006. Add('procedure ta.doabstract;');
  8007. Add('begin');
  8008. Add(' inherited dovirtual; // call TObject.DoVirtual');
  8009. Add('end;');
  8010. Add('procedure ta.dovirtual;');
  8011. Add('begin');
  8012. Add(' inherited; // call TObject.DoVirtual');
  8013. Add(' inherited dovirtual; // call TObject.DoVirtual');
  8014. Add(' inherited dovirtual(); // call TObject.DoVirtual');
  8015. Add(' doit;');
  8016. Add(' doit();');
  8017. Add('end;');
  8018. Add('procedure ta.dosome;');
  8019. Add('begin');
  8020. Add(' inherited; // call non existing ancestor method -> silently ignore');
  8021. Add('end;');
  8022. Add('begin');
  8023. ConvertProgram;
  8024. CheckSource('TestClass_CallInherited_NoParams',
  8025. LinesToStr([ // statements
  8026. 'rtl.createClass($mod,"TObject",null,function(){',
  8027. ' this.$init = function () {',
  8028. ' };',
  8029. ' this.$final = function () {',
  8030. ' };',
  8031. ' this.DoVirtual = function () {',
  8032. ' };',
  8033. ' this.DoIt = function () {',
  8034. ' };',
  8035. '});',
  8036. 'rtl.createClass($mod, "TA", $mod.TObject, function () {',
  8037. ' this.DoAbstract = function () {',
  8038. ' $mod.TObject.DoVirtual.call(this);',
  8039. ' };',
  8040. ' this.DoVirtual = function () {',
  8041. ' $mod.TObject.DoVirtual.apply(this, arguments);',
  8042. ' $mod.TObject.DoVirtual.call(this);',
  8043. ' $mod.TObject.DoVirtual.call(this);',
  8044. ' this.DoIt();',
  8045. ' this.DoIt();',
  8046. ' };',
  8047. ' this.DoSome = function () {',
  8048. ' };',
  8049. '});'
  8050. ]),
  8051. LinesToStr([ // this.$main
  8052. ''
  8053. ]));
  8054. end;
  8055. procedure TTestModule.TestClass_CallInherited_WithParams;
  8056. begin
  8057. StartProgram(false);
  8058. Add('type');
  8059. Add(' TObject = class');
  8060. Add(' procedure DoAbstract(pA: longint; pB: longint = 0); virtual; abstract;');
  8061. Add(' procedure DoVirtual(pA: longint; pB: longint = 0); virtual;');
  8062. Add(' procedure DoIt(pA: longint; pB: longint = 0);');
  8063. Add(' procedure DoIt2(pA: longint = 1; pB: longint = 2);');
  8064. Add(' end;');
  8065. Add(' TClassA = class');
  8066. Add(' procedure DoAbstract(pA: longint; pB: longint = 0); override;');
  8067. Add(' procedure DoVirtual(pA: longint; pB: longint = 0); override;');
  8068. Add(' end;');
  8069. Add('procedure tobject.dovirtual(pa: longint; pb: longint = 0);');
  8070. Add('begin');
  8071. Add('end;');
  8072. Add('procedure tobject.doit(pa: longint; pb: longint = 0);');
  8073. Add('begin');
  8074. Add('end;');
  8075. Add('procedure tobject.doit2(pa: longint; pb: longint = 0);');
  8076. Add('begin');
  8077. Add('end;');
  8078. Add('procedure tclassa.doabstract(pa: longint; pb: longint = 0);');
  8079. Add('begin');
  8080. Add(' inherited dovirtual(pa,pb); // call TObject.DoVirtual(pA,pB)');
  8081. Add(' inherited dovirtual(pa); // call TObject.DoVirtual(pA,0)');
  8082. Add('end;');
  8083. Add('procedure tclassa.dovirtual(pa: longint; pb: longint = 0);');
  8084. Add('begin');
  8085. Add(' inherited; // call TObject.DoVirtual(pA,pB)');
  8086. Add(' inherited dovirtual(pa,pb); // call TObject.DoVirtual(pA,pB)');
  8087. Add(' inherited dovirtual(pa); // call TObject.DoVirtual(pA,0)');
  8088. Add(' doit(pa,pb);');
  8089. Add(' doit(pa);');
  8090. Add(' doit2(pa);');
  8091. Add(' doit2;');
  8092. Add('end;');
  8093. Add('begin');
  8094. ConvertProgram;
  8095. CheckSource('TestClass_CallInherited_WithParams',
  8096. LinesToStr([ // statements
  8097. 'rtl.createClass($mod,"TObject",null,function(){',
  8098. ' this.$init = function () {',
  8099. ' };',
  8100. ' this.$final = function () {',
  8101. ' };',
  8102. ' this.DoVirtual = function (pA,pB) {',
  8103. ' };',
  8104. ' this.DoIt = function (pA,pB) {',
  8105. ' };',
  8106. ' this.DoIt2 = function (pA,pB) {',
  8107. ' };',
  8108. '});',
  8109. 'rtl.createClass($mod, "TClassA", $mod.TObject, function () {',
  8110. ' this.DoAbstract = function (pA,pB) {',
  8111. ' $mod.TObject.DoVirtual.call(this,pA,pB);',
  8112. ' $mod.TObject.DoVirtual.call(this,pA,0);',
  8113. ' };',
  8114. ' this.DoVirtual = function (pA,pB) {',
  8115. ' $mod.TObject.DoVirtual.apply(this, arguments);',
  8116. ' $mod.TObject.DoVirtual.call(this,pA,pB);',
  8117. ' $mod.TObject.DoVirtual.call(this,pA,0);',
  8118. ' this.DoIt(pA,pB);',
  8119. ' this.DoIt(pA,0);',
  8120. ' this.DoIt2(pA,2);',
  8121. ' this.DoIt2(1,2);',
  8122. ' };',
  8123. '});'
  8124. ]),
  8125. LinesToStr([ // this.$main
  8126. ''
  8127. ]));
  8128. end;
  8129. procedure TTestModule.TestClasS_CallInheritedConstructor;
  8130. begin
  8131. StartProgram(false);
  8132. Add('type');
  8133. Add(' TObject = class');
  8134. Add(' constructor Create; virtual;');
  8135. Add(' constructor CreateWithB(b: boolean);');
  8136. Add(' end;');
  8137. Add(' TA = class');
  8138. Add(' constructor Create; override;');
  8139. Add(' constructor CreateWithC(c: char);');
  8140. Add(' procedure DoIt;');
  8141. Add(' class function DoSome: TObject;');
  8142. Add(' end;');
  8143. Add('constructor tobject.create;');
  8144. Add('begin');
  8145. Add(' inherited; // call non existing ancestor -> ignore silently');
  8146. Add('end;');
  8147. Add('constructor tobject.createwithb(b: boolean);');
  8148. Add('begin');
  8149. Add(' inherited; // call non existing ancestor -> ignore silently');
  8150. Add(' create; // normal call');
  8151. Add('end;');
  8152. Add('constructor ta.create;');
  8153. Add('begin');
  8154. Add(' inherited; // normal call TObject.Create');
  8155. Add(' inherited create; // normal call TObject.Create');
  8156. Add(' inherited createwithb(false); // normal call TObject.CreateWithB');
  8157. Add('end;');
  8158. Add('constructor ta.createwithc(c: char);');
  8159. Add('begin');
  8160. Add(' inherited create; // call TObject.Create');
  8161. Add(' inherited createwithb(true); // call TObject.CreateWithB');
  8162. Add(' doit;');
  8163. Add(' doit();');
  8164. Add(' dosome;');
  8165. Add('end;');
  8166. Add('procedure ta.doit;');
  8167. Add('begin');
  8168. Add(' create; // normal call');
  8169. Add(' createwithb(false); // normal call');
  8170. Add(' createwithc(''c''); // normal call');
  8171. Add('end;');
  8172. Add('class function ta.dosome: TObject;');
  8173. Add('begin');
  8174. Add(' Result:=create; // constructor');
  8175. Add(' Result:=createwithb(true); // constructor');
  8176. Add(' Result:=createwithc(''c''); // constructor');
  8177. Add('end;');
  8178. Add('begin');
  8179. ConvertProgram;
  8180. CheckSource('TestClass_CallInheritedConstructor',
  8181. LinesToStr([ // statements
  8182. 'rtl.createClass($mod,"TObject",null,function(){',
  8183. ' this.$init = function () {',
  8184. ' };',
  8185. ' this.$final = function () {',
  8186. ' };',
  8187. ' this.Create = function () {',
  8188. ' };',
  8189. ' this.CreateWithB = function (b) {',
  8190. ' this.Create();',
  8191. ' };',
  8192. '});',
  8193. 'rtl.createClass($mod, "TA", $mod.TObject, function () {',
  8194. ' this.Create = function () {',
  8195. ' $mod.TObject.Create.apply(this, arguments);',
  8196. ' $mod.TObject.Create.call(this);',
  8197. ' $mod.TObject.CreateWithB.call(this, false);',
  8198. ' };',
  8199. ' this.CreateWithC = function (c) {',
  8200. ' $mod.TObject.Create.call(this);',
  8201. ' $mod.TObject.CreateWithB.call(this, true);',
  8202. ' this.DoIt();',
  8203. ' this.DoIt();',
  8204. ' this.$class.DoSome();',
  8205. ' };',
  8206. ' this.DoIt = function () {',
  8207. ' this.Create();',
  8208. ' this.CreateWithB(false);',
  8209. ' this.CreateWithC("c");',
  8210. ' };',
  8211. ' this.DoSome = function () {',
  8212. ' var Result = null;',
  8213. ' Result = this.$create("Create");',
  8214. ' Result = this.$create("CreateWithB", [true]);',
  8215. ' Result = this.$create("CreateWithC", ["c"]);',
  8216. ' return Result;',
  8217. ' };',
  8218. '});'
  8219. ]),
  8220. LinesToStr([ // this.$main
  8221. ''
  8222. ]));
  8223. end;
  8224. procedure TTestModule.TestClass_ClassVar;
  8225. begin
  8226. StartProgram(false);
  8227. Add('type');
  8228. Add(' TObject = class');
  8229. Add(' public');
  8230. Add(' class var vI: longint;');
  8231. Add(' class var Sub: TObject;');
  8232. Add(' constructor Create;');
  8233. Add(' class function GetIt(Par: longint): tobject;');
  8234. Add(' end;');
  8235. Add('constructor tobject.create;');
  8236. Add('begin');
  8237. Add(' vi:=vi+1;');
  8238. Add(' Self.vi:=Self.vi+1;');
  8239. Add('end;');
  8240. Add('class function tobject.getit(par: longint): tobject;');
  8241. Add('begin');
  8242. Add(' vi:=vi+par;');
  8243. Add(' Self.vi:=Self.vi+par;');
  8244. Add(' Result:=self.sub;');
  8245. Add('end;');
  8246. Add('var Obj: tobject;');
  8247. Add('begin');
  8248. Add(' obj:=tobject.create;');
  8249. Add(' tobject.vi:=3;');
  8250. Add(' if tobject.vi=4 then ;');
  8251. Add(' tobject.sub:=nil;');
  8252. Add(' obj.sub:=nil;');
  8253. Add(' obj.sub.sub:=nil;');
  8254. ConvertProgram;
  8255. CheckSource('TestClass_ClassVar',
  8256. LinesToStr([ // statements
  8257. 'rtl.createClass($mod,"TObject",null,function(){',
  8258. ' this.vI = 0;',
  8259. ' this.Sub = null;',
  8260. ' this.$init = function () {',
  8261. ' };',
  8262. ' this.$final = function () {',
  8263. ' };',
  8264. ' this.Create = function(){',
  8265. ' this.$class.vI = this.vI+1;',
  8266. ' this.$class.vI = this.vI+1;',
  8267. ' };',
  8268. ' this.GetIt = function(Par){',
  8269. ' var Result = null;',
  8270. ' this.vI = this.vI + Par;',
  8271. ' this.vI = this.vI + Par;',
  8272. ' Result = this.Sub;',
  8273. ' return Result;',
  8274. ' };',
  8275. '});',
  8276. 'this.Obj = null;'
  8277. ]),
  8278. LinesToStr([ // $mod.$main
  8279. '$mod.Obj = $mod.TObject.$create("Create");',
  8280. '$mod.TObject.vI = 3;',
  8281. 'if ($mod.TObject.vI === 4);',
  8282. '$mod.TObject.Sub=null;',
  8283. '$mod.Obj.$class.Sub=null;',
  8284. '$mod.Obj.Sub.$class.Sub=null;',
  8285. '']));
  8286. end;
  8287. procedure TTestModule.TestClass_CallClassMethod;
  8288. begin
  8289. StartProgram(false);
  8290. Add('type');
  8291. Add(' TObject = class');
  8292. Add(' public');
  8293. Add(' class var vI: longint;');
  8294. Add(' class var Sub: TObject;');
  8295. Add(' constructor Create;');
  8296. Add(' function GetMore(Par: longint): longint;');
  8297. Add(' class function GetIt(Par: longint): tobject;');
  8298. Add(' end;');
  8299. Add('constructor tobject.create;');
  8300. Add('begin');
  8301. Add(' sub:=getit(3);');
  8302. Add(' vi:=getmore(4);');
  8303. Add(' sub:=Self.getit(5);');
  8304. Add(' vi:=Self.getmore(6);');
  8305. Add('end;');
  8306. Add('function tobject.getmore(par: longint): longint;');
  8307. Add('begin');
  8308. Add(' sub:=getit(11);');
  8309. Add(' vi:=getmore(12);');
  8310. Add(' sub:=self.getit(13);');
  8311. Add(' vi:=self.getmore(14);');
  8312. Add('end;');
  8313. Add('class function tobject.getit(par: longint): tobject;');
  8314. Add('begin');
  8315. Add(' sub:=getit(21);');
  8316. Add(' vi:=sub.getmore(22);');
  8317. Add(' sub:=self.getit(23);');
  8318. Add(' vi:=self.sub.getmore(24);');
  8319. Add('end;');
  8320. Add('var Obj: tobject;');
  8321. Add('begin');
  8322. Add(' obj:=tobject.create;');
  8323. Add(' tobject.getit(5);');
  8324. Add(' obj.getit(6);');
  8325. Add(' obj.sub.getit(7);');
  8326. Add(' obj.sub.getit(8).SUB:=nil;');
  8327. Add(' obj.sub.getit(9).GETIT(10);');
  8328. Add(' obj.sub.getit(11).SuB.getit(12);');
  8329. ConvertProgram;
  8330. CheckSource('TestClass_CallClassMethod',
  8331. LinesToStr([ // statements
  8332. 'rtl.createClass($mod,"TObject",null,function(){',
  8333. ' this.vI = 0;',
  8334. ' this.Sub = null;',
  8335. ' this.$init = function () {',
  8336. ' };',
  8337. ' this.$final = function () {',
  8338. ' };',
  8339. ' this.Create = function(){',
  8340. ' this.$class.Sub = this.$class.GetIt(3);',
  8341. ' this.$class.vI = this.GetMore(4);',
  8342. ' this.$class.Sub = this.$class.GetIt(5);',
  8343. ' this.$class.vI = this.GetMore(6);',
  8344. ' };',
  8345. ' this.GetMore = function(Par){',
  8346. ' var Result = 0;',
  8347. ' this.$class.Sub = this.$class.GetIt(11);',
  8348. ' this.$class.vI = this.GetMore(12);',
  8349. ' this.$class.Sub = this.$class.GetIt(13);',
  8350. ' this.$class.vI = this.GetMore(14);',
  8351. ' return Result;',
  8352. ' };',
  8353. ' this.GetIt = function(Par){',
  8354. ' var Result = null;',
  8355. ' this.Sub = this.GetIt(21);',
  8356. ' this.vI = this.Sub.GetMore(22);',
  8357. ' this.Sub = this.GetIt(23);',
  8358. ' this.vI = this.Sub.GetMore(24);',
  8359. ' return Result;',
  8360. ' };',
  8361. '});',
  8362. 'this.Obj = null;'
  8363. ]),
  8364. LinesToStr([ // $mod.$main
  8365. '$mod.Obj = $mod.TObject.$create("Create");',
  8366. '$mod.TObject.GetIt(5);',
  8367. '$mod.Obj.$class.GetIt(6);',
  8368. '$mod.Obj.Sub.$class.GetIt(7);',
  8369. '$mod.Obj.Sub.$class.GetIt(8).$class.Sub=null;',
  8370. '$mod.Obj.Sub.$class.GetIt(9).$class.GetIt(10);',
  8371. '$mod.Obj.Sub.$class.GetIt(11).Sub.$class.GetIt(12);',
  8372. '']));
  8373. end;
  8374. procedure TTestModule.TestClass_Property;
  8375. begin
  8376. StartProgram(false);
  8377. Add('type');
  8378. Add(' TObject = class');
  8379. Add(' Fx: longint;');
  8380. Add(' Fy: longint;');
  8381. Add(' function GetInt: longint;');
  8382. Add(' procedure SetInt(Value: longint);');
  8383. Add(' procedure DoIt;');
  8384. Add(' property IntA: longint read Fx write Fy;');
  8385. Add(' property IntB: longint read GetInt write SetInt;');
  8386. Add(' end;');
  8387. Add('function tobject.getint: longint;');
  8388. Add('begin');
  8389. Add(' result:=fx;');
  8390. Add('end;');
  8391. Add('procedure tobject.setint(value: longint);');
  8392. Add('begin');
  8393. Add(' if value=fy then exit;');
  8394. Add(' fy:=value;');
  8395. Add('end;');
  8396. Add('procedure tobject.doit;');
  8397. Add('begin');
  8398. Add(' IntA:=IntA+1;');
  8399. Add(' Self.IntA:=Self.IntA+1;');
  8400. Add(' IntB:=IntB+1;');
  8401. Add(' Self.IntB:=Self.IntB+1;');
  8402. Add('end;');
  8403. Add('var Obj: tobject;');
  8404. Add('begin');
  8405. Add(' obj.inta:=obj.inta+1;');
  8406. Add(' if obj.intb=2 then;');
  8407. Add(' obj.intb:=obj.intb+2;');
  8408. Add(' obj.setint(obj.inta);');
  8409. ConvertProgram;
  8410. CheckSource('TestClass_Property',
  8411. LinesToStr([ // statements
  8412. 'rtl.createClass($mod, "TObject", null, function () {',
  8413. ' this.$init = function () {',
  8414. ' this.Fx = 0;',
  8415. ' this.Fy = 0;',
  8416. ' };',
  8417. ' this.$final = function () {',
  8418. ' };',
  8419. ' this.GetInt = function () {',
  8420. ' var Result = 0;',
  8421. ' Result = this.Fx;',
  8422. ' return Result;',
  8423. ' };',
  8424. ' this.SetInt = function (Value) {',
  8425. ' if (Value === this.Fy) return;',
  8426. ' this.Fy = Value;',
  8427. ' };',
  8428. ' this.DoIt = function () {',
  8429. ' this.Fy = this.Fx + 1;',
  8430. ' this.Fy = this.Fx + 1;',
  8431. ' this.SetInt(this.GetInt() + 1);',
  8432. ' this.SetInt(this.GetInt() + 1);',
  8433. ' };',
  8434. '});',
  8435. 'this.Obj = null;'
  8436. ]),
  8437. LinesToStr([ // $mod.$main
  8438. '$mod.Obj.Fy = $mod.Obj.Fx + 1;',
  8439. 'if ($mod.Obj.GetInt() === 2);',
  8440. '$mod.Obj.SetInt($mod.Obj.GetInt() + 2);',
  8441. '$mod.Obj.SetInt($mod.Obj.Fx);'
  8442. ]));
  8443. end;
  8444. procedure TTestModule.TestClass_Property_ClassMethod;
  8445. begin
  8446. StartProgram(false);
  8447. Add('type');
  8448. Add(' TObject = class');
  8449. Add(' class var Fx: longint;');
  8450. Add(' class var Fy: longint;');
  8451. Add(' class function GetInt: longint;');
  8452. Add(' class procedure SetInt(Value: longint);');
  8453. Add(' class procedure DoIt;');
  8454. Add(' class property IntA: longint read Fx write Fy;');
  8455. Add(' class property IntB: longint read GetInt write SetInt;');
  8456. Add(' end;');
  8457. Add('class function tobject.getint: longint;');
  8458. Add('begin');
  8459. Add(' result:=fx;');
  8460. Add('end;');
  8461. Add('class procedure tobject.setint(value: longint);');
  8462. Add('begin');
  8463. Add('end;');
  8464. Add('class procedure tobject.doit;');
  8465. Add('begin');
  8466. Add(' IntA:=IntA+1;');
  8467. Add(' Self.IntA:=Self.IntA+1;');
  8468. Add(' IntB:=IntB+1;');
  8469. Add(' Self.IntB:=Self.IntB+1;');
  8470. Add('end;');
  8471. Add('var Obj: tobject;');
  8472. Add('begin');
  8473. Add(' tobject.inta:=tobject.inta+1;');
  8474. Add(' if tobject.intb=2 then;');
  8475. Add(' tobject.intb:=tobject.intb+2;');
  8476. Add(' tobject.setint(tobject.inta);');
  8477. Add(' obj.inta:=obj.inta+1;');
  8478. Add(' if obj.intb=2 then;');
  8479. Add(' obj.intb:=obj.intb+2;');
  8480. Add(' obj.setint(obj.inta);');
  8481. ConvertProgram;
  8482. CheckSource('TestClass_Property_ClassMethod',
  8483. LinesToStr([ // statements
  8484. 'rtl.createClass($mod, "TObject", null, function () {',
  8485. ' this.Fx = 0;',
  8486. ' this.Fy = 0;',
  8487. ' this.$init = function () {',
  8488. ' };',
  8489. ' this.$final = function () {',
  8490. ' };',
  8491. ' this.GetInt = function () {',
  8492. ' var Result = 0;',
  8493. ' Result = this.Fx;',
  8494. ' return Result;',
  8495. ' };',
  8496. ' this.SetInt = function (Value) {',
  8497. ' };',
  8498. ' this.DoIt = function () {',
  8499. ' this.Fy = this.Fx + 1;',
  8500. ' this.Fy = this.Fx + 1;',
  8501. ' this.SetInt(this.GetInt() + 1);',
  8502. ' this.SetInt(this.GetInt() + 1);',
  8503. ' };',
  8504. '});',
  8505. 'this.Obj = null;'
  8506. ]),
  8507. LinesToStr([ // $mod.$main
  8508. '$mod.TObject.Fy = $mod.TObject.Fx + 1;',
  8509. 'if ($mod.TObject.GetInt() === 2);',
  8510. '$mod.TObject.SetInt($mod.TObject.GetInt() + 2);',
  8511. '$mod.TObject.SetInt($mod.TObject.Fx);',
  8512. '$mod.Obj.$class.Fy = $mod.Obj.Fx + 1;',
  8513. 'if ($mod.Obj.$class.GetInt() === 2);',
  8514. '$mod.Obj.$class.SetInt($mod.Obj.$class.GetInt() + 2);',
  8515. '$mod.Obj.$class.SetInt($mod.Obj.Fx);'
  8516. ]));
  8517. end;
  8518. procedure TTestModule.TestClass_Property_Indexed;
  8519. begin
  8520. StartProgram(false);
  8521. Add('type');
  8522. Add(' TObject = class');
  8523. Add(' FItems: array of longint;');
  8524. Add(' function GetItems(Index: longint): longint;');
  8525. Add(' procedure SetItems(Index: longint; Value: longint);');
  8526. Add(' procedure DoIt;');
  8527. Add(' property Items[Index: longint]: longint read getitems write setitems;');
  8528. Add(' end;');
  8529. Add('function tobject.getitems(index: longint): longint;');
  8530. Add('begin');
  8531. Add(' Result:=fitems[index];');
  8532. Add('end;');
  8533. Add('procedure tobject.setitems(index: longint; value: longint);');
  8534. Add('begin');
  8535. Add(' fitems[index]:=value;');
  8536. Add('end;');
  8537. Add('procedure tobject.doit;');
  8538. Add('begin');
  8539. Add(' items[1]:=2;');
  8540. Add(' items[3]:=items[4];');
  8541. Add(' self.items[5]:=self.items[6];');
  8542. Add(' items[items[7]]:=items[items[8]];');
  8543. Add('end;');
  8544. Add('var Obj: tobject;');
  8545. Add('begin');
  8546. Add(' obj.Items[11]:=obj.Items[12];');
  8547. ConvertProgram;
  8548. CheckSource('TestClass_Property_Indexed',
  8549. LinesToStr([ // statements
  8550. 'rtl.createClass($mod, "TObject", null, function () {',
  8551. ' this.$init = function () {',
  8552. ' this.FItems = [];',
  8553. ' };',
  8554. ' this.$final = function () {',
  8555. ' this.FItems = undefined;',
  8556. ' };',
  8557. ' this.GetItems = function (Index) {',
  8558. ' var Result = 0;',
  8559. ' Result = this.FItems[Index];',
  8560. ' return Result;',
  8561. ' };',
  8562. ' this.SetItems = function (Index, Value) {',
  8563. ' this.FItems[Index] = Value;',
  8564. ' };',
  8565. ' this.DoIt = function () {',
  8566. ' this.SetItems(1, 2);',
  8567. ' this.SetItems(3,this.GetItems(4));',
  8568. ' this.SetItems(5,this.GetItems(6));',
  8569. ' this.SetItems(this.GetItems(7), this.GetItems(this.GetItems(8)));',
  8570. ' };',
  8571. '});',
  8572. 'this.Obj = null;'
  8573. ]),
  8574. LinesToStr([ // $mod.$main
  8575. '$mod.Obj.SetItems(11,$mod.Obj.GetItems(12));'
  8576. ]));
  8577. end;
  8578. procedure TTestModule.TestClass_Property_IndexSpec;
  8579. begin
  8580. StartProgram(false);
  8581. Add([
  8582. 'type',
  8583. ' TEnum = (red, blue);',
  8584. ' TObject = class',
  8585. ' function GetIntBool(Index: longint): boolean; virtual; abstract;',
  8586. ' procedure SetIntBool(Index: longint; b: boolean); virtual; abstract;',
  8587. ' function GetEnumBool(Index: TEnum): boolean; virtual; abstract;',
  8588. ' procedure SetEnumBool(Index: TEnum; b: boolean); virtual; abstract;',
  8589. ' function GetStrIntBool(A: String; I: longint): boolean; virtual; abstract;',
  8590. ' procedure SetStrIntBool(A: String; I: longint; b: boolean); virtual; abstract;',
  8591. ' property B1: boolean index 1 read GetIntBool write SetIntBool;',
  8592. ' property B2: boolean index TEnum.blue read GetEnumBool write SetEnumBool;',
  8593. ' property B3: boolean index ord(red) read GetIntBool write SetIntBool;',
  8594. ' property I1[A: String]: boolean index ord(blue) read GetStrIntBool write SetStrIntBool;',
  8595. ' end;',
  8596. 'procedure DoIt(b: boolean); begin end;',
  8597. 'var',
  8598. ' o: TObject;',
  8599. 'begin',
  8600. ' o.B1:=o.B1;',
  8601. ' o.B2:=o.B2;',
  8602. ' o.B3:=o.B3;',
  8603. ' o.I1[''a'']:=o.I1[''b''];',
  8604. ' doit(o.b1);',
  8605. ' doit(o.b2);',
  8606. ' doit(o.i1[''c'']);',
  8607. '']);
  8608. ConvertProgram;
  8609. CheckSource('TestClass_Property_IndexSpec',
  8610. LinesToStr([ // statements
  8611. 'this.TEnum = {',
  8612. ' "0": "red",',
  8613. ' red: 0,',
  8614. ' "1": "blue",',
  8615. ' blue: 1',
  8616. '};',
  8617. 'rtl.createClass($mod, "TObject", null, function () {',
  8618. ' this.$init = function () {',
  8619. ' };',
  8620. ' this.$final = function () {',
  8621. ' };',
  8622. '});',
  8623. 'this.DoIt = function (b) {',
  8624. '};',
  8625. 'this.o = null;',
  8626. '']),
  8627. LinesToStr([ // $mod.$main
  8628. '$mod.o.SetIntBool(1, $mod.o.GetIntBool(1));',
  8629. '$mod.o.SetEnumBool($mod.TEnum.blue, $mod.o.GetEnumBool($mod.TEnum.blue));',
  8630. '$mod.o.SetIntBool(0, $mod.o.GetIntBool(0));',
  8631. '$mod.o.SetStrIntBool("a", 1, $mod.o.GetStrIntBool("b", 1));',
  8632. '$mod.DoIt($mod.o.GetIntBool(1));',
  8633. '$mod.DoIt($mod.o.GetEnumBool($mod.TEnum.blue));',
  8634. '$mod.DoIt($mod.o.GetStrIntBool("c", 1));',
  8635. '']));
  8636. end;
  8637. procedure TTestModule.TestClass_PropertyOfTypeArray;
  8638. begin
  8639. StartProgram(false);
  8640. Add('type');
  8641. Add(' TArray = array of longint;');
  8642. Add(' TObject = class');
  8643. Add(' FItems: TArray;');
  8644. Add(' function GetItems: tarray;');
  8645. Add(' procedure SetItems(Value: tarray);');
  8646. Add(' property Items: tarray read getitems write setitems;');
  8647. Add(' end;');
  8648. Add('function tobject.getitems: tarray;');
  8649. Add('begin');
  8650. Add(' Result:=fitems;');
  8651. Add('end;');
  8652. Add('procedure tobject.setitems(value: tarray);');
  8653. Add('begin');
  8654. Add(' fitems:=value;');
  8655. Add(' fitems:=nil;');
  8656. Add(' Items:=nil;');
  8657. Add(' Items:=Items;');
  8658. Add(' Items[1]:=2;');
  8659. Add(' fitems[3]:=Items[4];');
  8660. Add(' Items[5]:=Items[6];');
  8661. Add(' Self.Items[7]:=8;');
  8662. Add(' Self.Items[9]:=Self.Items[10];');
  8663. Add(' Items[Items[11]]:=Items[Items[12]];');
  8664. Add('end;');
  8665. Add('var Obj: tobject;');
  8666. Add('begin');
  8667. Add(' obj.items:=nil;');
  8668. Add(' obj.items:=obj.items;');
  8669. Add(' obj.items[11]:=obj.items[12];');
  8670. ConvertProgram;
  8671. CheckSource('TestClass_PropertyOfTypeArray',
  8672. LinesToStr([ // statements
  8673. 'rtl.createClass($mod, "TObject", null, function () {',
  8674. ' this.$init = function () {',
  8675. ' this.FItems = [];',
  8676. ' };',
  8677. ' this.$final = function () {',
  8678. ' this.FItems = undefined;',
  8679. ' };',
  8680. ' this.GetItems = function () {',
  8681. ' var Result = [];',
  8682. ' Result = this.FItems;',
  8683. ' return Result;',
  8684. ' };',
  8685. ' this.SetItems = function (Value) {',
  8686. ' this.FItems = Value;',
  8687. ' this.FItems = [];',
  8688. ' this.SetItems([]);',
  8689. ' this.SetItems(this.GetItems());',
  8690. ' this.GetItems()[1] = 2;',
  8691. ' this.FItems[3] = this.GetItems()[4];',
  8692. ' this.GetItems()[5] = this.GetItems()[6];',
  8693. ' this.GetItems()[7] = 8;',
  8694. ' this.GetItems()[9] = this.GetItems()[10];',
  8695. ' this.GetItems()[this.GetItems()[11]] = this.GetItems()[this.GetItems()[12]];',
  8696. ' };',
  8697. '});',
  8698. 'this.Obj = null;'
  8699. ]),
  8700. LinesToStr([ // $mod.$main
  8701. '$mod.Obj.SetItems([]);',
  8702. '$mod.Obj.SetItems($mod.Obj.GetItems());',
  8703. '$mod.Obj.GetItems()[11] = $mod.Obj.GetItems()[12];'
  8704. ]));
  8705. end;
  8706. procedure TTestModule.TestClass_PropertyDefault;
  8707. begin
  8708. StartProgram(false);
  8709. Add('type');
  8710. Add(' TArray = array of longint;');
  8711. Add(' TObject = class');
  8712. Add(' FItems: TArray;');
  8713. Add(' function GetItems(Index: longint): longint;');
  8714. Add(' procedure SetItems(Index, Value: longint);');
  8715. Add(' property Items[Index: longint]: longint read getitems write setitems; default;');
  8716. Add(' end;');
  8717. Add('function tobject.getitems(index: longint): longint;');
  8718. Add('begin');
  8719. Add('end;');
  8720. Add('procedure tobject.setitems(index, value: longint);');
  8721. Add('begin');
  8722. Add(' Self[1]:=2;');
  8723. Add(' Self[3]:=Self[index];');
  8724. Add(' Self[index]:=Self[Self[value]];');
  8725. Add(' Self[Self[4]]:=value;');
  8726. Add('end;');
  8727. Add('var Obj: tobject;');
  8728. Add('begin');
  8729. Add(' obj[11]:=12;');
  8730. Add(' obj[13]:=obj[14];');
  8731. Add(' obj[obj[15]]:=obj[obj[15]];');
  8732. ConvertProgram;
  8733. CheckSource('TestClass_PropertyDefault',
  8734. LinesToStr([ // statements
  8735. 'rtl.createClass($mod, "TObject", null, function () {',
  8736. ' this.$init = function () {',
  8737. ' this.FItems = [];',
  8738. ' };',
  8739. ' this.$final = function () {',
  8740. ' this.FItems = undefined;',
  8741. ' };',
  8742. ' this.GetItems = function (Index) {',
  8743. ' var Result = 0;',
  8744. ' return Result;',
  8745. ' };',
  8746. ' this.SetItems = function (Index, Value) {',
  8747. ' this.SetItems(1, 2);',
  8748. ' this.SetItems(3, this.GetItems(Index));',
  8749. ' this.SetItems(Index, this.GetItems(this.GetItems(Value)));',
  8750. ' this.SetItems(this.GetItems(4), Value);',
  8751. ' };',
  8752. '});',
  8753. 'this.Obj = null;'
  8754. ]),
  8755. LinesToStr([ // $mod.$main
  8756. '$mod.Obj.SetItems(11, 12);',
  8757. '$mod.Obj.SetItems(13, $mod.Obj.GetItems(14));',
  8758. '$mod.Obj.SetItems($mod.Obj.GetItems(15), $mod.Obj.GetItems($mod.Obj.GetItems(15)));'
  8759. ]));
  8760. end;
  8761. procedure TTestModule.TestClass_PropertyOverride;
  8762. begin
  8763. StartProgram(false);
  8764. Add('type');
  8765. Add(' integer = longint;');
  8766. Add(' TObject = class');
  8767. Add(' FItem: integer;');
  8768. Add(' function GetItem: integer; external name ''GetItem'';');
  8769. Add(' procedure SetItem(Value: integer); external name ''SetItem'';');
  8770. Add(' property Item: integer read getitem write setitem;');
  8771. Add(' end;');
  8772. Add(' TCar = class');
  8773. Add(' FBag: integer;');
  8774. Add(' function GetBag: integer; external name ''GetBag'';');
  8775. Add(' property Item read getbag;');
  8776. Add(' end;');
  8777. Add('var');
  8778. Add(' Obj: tobject;');
  8779. Add(' Car: tcar;');
  8780. Add('begin');
  8781. Add(' Obj.Item:=Obj.Item;');
  8782. Add(' Car.Item:=Car.Item;');
  8783. ConvertProgram;
  8784. CheckSource('TestClass_PropertyOverride',
  8785. LinesToStr([ // statements
  8786. 'rtl.createClass($mod, "TObject", null, function () {',
  8787. ' this.$init = function () {',
  8788. ' this.FItem = 0;',
  8789. ' };',
  8790. ' this.$final = function () {',
  8791. ' };',
  8792. '});',
  8793. 'rtl.createClass($mod, "TCar", $mod.TObject, function () {',
  8794. ' this.$init = function () {',
  8795. ' $mod.TObject.$init.call(this);',
  8796. ' this.FBag = 0;',
  8797. ' };',
  8798. '});',
  8799. 'this.Obj = null;',
  8800. 'this.Car = null;',
  8801. '']),
  8802. LinesToStr([ // $mod.$main
  8803. '$mod.Obj.SetItem($mod.Obj.GetItem());',
  8804. '$mod.Car.SetItem($mod.Car.GetBag());',
  8805. '']));
  8806. end;
  8807. procedure TTestModule.TestClass_PropertyIncVisibility;
  8808. begin
  8809. AddModuleWithIntfImplSrc('unit1.pp',
  8810. LinesToStr([
  8811. 'type',
  8812. ' TNumber = longint;',
  8813. ' TInteger = longint;',
  8814. ' TObject = class',
  8815. ' private',
  8816. ' function GetItems(Index: TNumber): TInteger; virtual; abstract;',
  8817. ' procedure SetItems(Index: TInteger; Value: TNumber); virtual; abstract;',
  8818. ' protected',
  8819. ' property Items[Index: TNumber]: longint read GetItems write SetItems;',
  8820. ' end;']),
  8821. LinesToStr([
  8822. '']));
  8823. StartProgram(true);
  8824. Add([
  8825. 'uses unit1;',
  8826. 'type',
  8827. ' TBird = class',
  8828. ' public',
  8829. ' property Items;',
  8830. ' end;',
  8831. 'procedure DoIt(i: TInteger);',
  8832. 'begin',
  8833. 'end;',
  8834. 'var b: TBird;',
  8835. 'begin',
  8836. ' b.Items[1]:=2;',
  8837. ' b.Items[3]:=b.Items[4];',
  8838. ' DoIt(b.Items[5]);',
  8839. '']);
  8840. ConvertProgram;
  8841. CheckSource('TestClass_PropertyIncVisibility',
  8842. LinesToStr([ // statements
  8843. 'rtl.createClass($mod, "TBird", pas.unit1.TObject, function () {',
  8844. '});',
  8845. 'this.DoIt = function (i) {',
  8846. '};',
  8847. 'this.b = null;'
  8848. ]),
  8849. LinesToStr([ // $mod.$main
  8850. '$mod.b.SetItems(1, 2);',
  8851. '$mod.b.SetItems(3, $mod.b.GetItems(4));',
  8852. '$mod.DoIt($mod.b.GetItems(5));'
  8853. ]));
  8854. end;
  8855. procedure TTestModule.TestClass_Assigned;
  8856. begin
  8857. StartProgram(false);
  8858. Add('type');
  8859. Add(' TObject = class');
  8860. Add(' end;');
  8861. Add('var');
  8862. Add(' Obj: tobject;');
  8863. Add(' b: boolean;');
  8864. Add('begin');
  8865. Add(' if Assigned(obj) then ;');
  8866. Add(' b:=Assigned(obj) or false;');
  8867. ConvertProgram;
  8868. CheckSource('TestClass_Assigned',
  8869. LinesToStr([ // statements
  8870. 'rtl.createClass($mod, "TObject", null, function () {',
  8871. ' this.$init = function () {',
  8872. ' };',
  8873. ' this.$final = function () {',
  8874. ' };',
  8875. '});',
  8876. 'this.Obj = null;',
  8877. 'this.b = false;'
  8878. ]),
  8879. LinesToStr([ // $mod.$main
  8880. 'if ($mod.Obj != null);',
  8881. '$mod.b = ($mod.Obj != null) || false;'
  8882. ]));
  8883. end;
  8884. procedure TTestModule.TestClass_WithClassDoCreate;
  8885. begin
  8886. StartProgram(false);
  8887. Add('type');
  8888. Add(' TObject = class');
  8889. Add(' aBool: boolean;');
  8890. Add(' Arr: array of boolean;');
  8891. Add(' constructor Create;');
  8892. Add(' end;');
  8893. Add('constructor TObject.Create; begin end;');
  8894. Add('var');
  8895. Add(' Obj: tobject;');
  8896. Add(' b: boolean;');
  8897. Add('begin');
  8898. Add(' with tobject.create do begin');
  8899. Add(' b:=abool;');
  8900. Add(' abool:=b;');
  8901. Add(' b:=arr[1];');
  8902. Add(' arr[2]:=b;');
  8903. Add(' end;');
  8904. Add(' with tobject do');
  8905. Add(' obj:=create;');
  8906. Add(' with obj do begin');
  8907. Add(' create;');
  8908. Add(' b:=abool;');
  8909. Add(' abool:=b;');
  8910. Add(' b:=arr[3];');
  8911. Add(' arr[4]:=b;');
  8912. Add(' end;');
  8913. ConvertProgram;
  8914. CheckSource('TestClass_WithClassDoCreate',
  8915. LinesToStr([ // statements
  8916. 'rtl.createClass($mod, "TObject", null, function () {',
  8917. ' this.$init = function () {',
  8918. ' this.aBool = false;',
  8919. ' this.Arr = [];',
  8920. ' };',
  8921. ' this.$final = function () {',
  8922. ' this.Arr = undefined;',
  8923. ' };',
  8924. ' this.Create = function () {',
  8925. ' };',
  8926. '});',
  8927. 'this.Obj = null;',
  8928. 'this.b = false;'
  8929. ]),
  8930. LinesToStr([ // $mod.$main
  8931. 'var $with1 = $mod.TObject.$create("Create");',
  8932. '$mod.b = $with1.aBool;',
  8933. '$with1.aBool = $mod.b;',
  8934. '$mod.b = $with1.Arr[1];',
  8935. '$with1.Arr[2] = $mod.b;',
  8936. 'var $with2 = $mod.TObject;',
  8937. '$mod.Obj = $with2.$create("Create");',
  8938. 'var $with3 = $mod.Obj;',
  8939. '$with3.Create();',
  8940. '$mod.b = $with3.aBool;',
  8941. '$with3.aBool = $mod.b;',
  8942. '$mod.b = $with3.Arr[3];',
  8943. '$with3.Arr[4] = $mod.b;',
  8944. '']));
  8945. end;
  8946. procedure TTestModule.TestClass_WithClassInstDoProperty;
  8947. begin
  8948. StartProgram(false);
  8949. Add('type');
  8950. Add(' TObject = class');
  8951. Add(' FInt: longint;');
  8952. Add(' constructor Create;');
  8953. Add(' function GetSize: longint;');
  8954. Add(' procedure SetSize(Value: longint);');
  8955. Add(' property Int: longint read FInt write FInt;');
  8956. Add(' property Size: longint read GetSize write SetSize;');
  8957. Add(' end;');
  8958. Add('constructor TObject.Create; begin end;');
  8959. Add('function TObject.GetSize: longint; begin; end;');
  8960. Add('procedure TObject.SetSize(Value: longint); begin; end;');
  8961. Add('var');
  8962. Add(' Obj: tobject;');
  8963. Add(' i: longint;');
  8964. Add('begin');
  8965. Add(' with TObject.Create do begin');
  8966. Add(' i:=int;');
  8967. Add(' int:=i;');
  8968. Add(' i:=size;');
  8969. Add(' size:=i;');
  8970. Add(' end;');
  8971. Add(' with obj do begin');
  8972. Add(' i:=int;');
  8973. Add(' int:=i;');
  8974. Add(' i:=size;');
  8975. Add(' size:=i;');
  8976. Add(' end;');
  8977. ConvertProgram;
  8978. CheckSource('TestClass_WithClassInstDoProperty',
  8979. LinesToStr([ // statements
  8980. 'rtl.createClass($mod, "TObject", null, function () {',
  8981. ' this.$init = function () {',
  8982. ' this.FInt = 0;',
  8983. ' };',
  8984. ' this.$final = function () {',
  8985. ' };',
  8986. ' this.Create = function () {',
  8987. ' };',
  8988. ' this.GetSize = function () {',
  8989. ' var Result = 0;',
  8990. ' return Result;',
  8991. ' };',
  8992. ' this.SetSize = function (Value) {',
  8993. ' };',
  8994. '});',
  8995. 'this.Obj = null;',
  8996. 'this.i = 0;'
  8997. ]),
  8998. LinesToStr([ // $mod.$main
  8999. 'var $with1 = $mod.TObject.$create("Create");',
  9000. '$mod.i = $with1.FInt;',
  9001. '$with1.FInt = $mod.i;',
  9002. '$mod.i = $with1.GetSize();',
  9003. '$with1.SetSize($mod.i);',
  9004. 'var $with2 = $mod.Obj;',
  9005. '$mod.i = $with2.FInt;',
  9006. '$with2.FInt = $mod.i;',
  9007. '$mod.i = $with2.GetSize();',
  9008. '$with2.SetSize($mod.i);',
  9009. '']));
  9010. end;
  9011. procedure TTestModule.TestClass_WithClassInstDoPropertyWithParams;
  9012. begin
  9013. StartProgram(false);
  9014. Add('type');
  9015. Add(' TObject = class');
  9016. Add(' constructor Create;');
  9017. Add(' function GetItems(Index: longint): longint;');
  9018. Add(' procedure SetItems(Index, Value: longint);');
  9019. Add(' property Items[Index: longint]: longint read GetItems write SetItems;');
  9020. Add(' end;');
  9021. Add('constructor TObject.Create; begin end;');
  9022. Add('function tobject.getitems(index: longint): longint; begin; end;');
  9023. Add('procedure tobject.setitems(index, value: longint); begin; end;');
  9024. Add('var');
  9025. Add(' Obj: tobject;');
  9026. Add(' i: longint;');
  9027. Add('begin');
  9028. Add(' with TObject.Create do begin');
  9029. Add(' i:=Items[1];');
  9030. Add(' Items[2]:=i;');
  9031. Add(' end;');
  9032. Add(' with obj do begin');
  9033. Add(' i:=Items[3];');
  9034. Add(' Items[4]:=i;');
  9035. Add(' end;');
  9036. ConvertProgram;
  9037. CheckSource('TestClass_WithClassInstDoPropertyWithParams',
  9038. LinesToStr([ // statements
  9039. 'rtl.createClass($mod, "TObject", null, function () {',
  9040. ' this.$init = function () {',
  9041. ' };',
  9042. ' this.$final = function () {',
  9043. ' };',
  9044. ' this.Create = function () {',
  9045. ' };',
  9046. ' this.GetItems = function (Index) {',
  9047. ' var Result = 0;',
  9048. ' return Result;',
  9049. ' };',
  9050. ' this.SetItems = function (Index, Value) {',
  9051. ' };',
  9052. '});',
  9053. 'this.Obj = null;',
  9054. 'this.i = 0;'
  9055. ]),
  9056. LinesToStr([ // $mod.$main
  9057. 'var $with1 = $mod.TObject.$create("Create");',
  9058. '$mod.i = $with1.GetItems(1);',
  9059. '$with1.SetItems(2, $mod.i);',
  9060. 'var $with2 = $mod.Obj;',
  9061. '$mod.i = $with2.GetItems(3);',
  9062. '$with2.SetItems(4, $mod.i);',
  9063. '']));
  9064. end;
  9065. procedure TTestModule.TestClass_WithClassInstDoFunc;
  9066. begin
  9067. StartProgram(false);
  9068. Add('type');
  9069. Add(' TObject = class');
  9070. Add(' constructor Create;');
  9071. Add(' function GetSize: longint;');
  9072. Add(' procedure SetSize(Value: longint);');
  9073. Add(' end;');
  9074. Add('constructor TObject.Create; begin end;');
  9075. Add('function TObject.GetSize: longint; begin; end;');
  9076. Add('procedure TObject.SetSize(Value: longint); begin; end;');
  9077. Add('var');
  9078. Add(' Obj: tobject;');
  9079. Add(' i: longint;');
  9080. Add('begin');
  9081. Add(' with TObject.Create do begin');
  9082. Add(' i:=GetSize;');
  9083. Add(' i:=GetSize();');
  9084. Add(' SetSize(i);');
  9085. Add(' end;');
  9086. Add(' with obj do begin');
  9087. Add(' i:=GetSize;');
  9088. Add(' i:=GetSize();');
  9089. Add(' SetSize(i);');
  9090. Add(' end;');
  9091. ConvertProgram;
  9092. CheckSource('TestClass_WithClassInstDoFunc',
  9093. LinesToStr([ // statements
  9094. 'rtl.createClass($mod, "TObject", null, function () {',
  9095. ' this.$init = function () {',
  9096. ' };',
  9097. ' this.$final = function () {',
  9098. ' };',
  9099. ' this.Create = function () {',
  9100. ' };',
  9101. ' this.GetSize = function () {',
  9102. ' var Result = 0;',
  9103. ' return Result;',
  9104. ' };',
  9105. ' this.SetSize = function (Value) {',
  9106. ' };',
  9107. '});',
  9108. 'this.Obj = null;',
  9109. 'this.i = 0;'
  9110. ]),
  9111. LinesToStr([ // $mod.$main
  9112. 'var $with1 = $mod.TObject.$create("Create");',
  9113. '$mod.i = $with1.GetSize();',
  9114. '$mod.i = $with1.GetSize();',
  9115. '$with1.SetSize($mod.i);',
  9116. 'var $with2 = $mod.Obj;',
  9117. '$mod.i = $with2.GetSize();',
  9118. '$mod.i = $with2.GetSize();',
  9119. '$with2.SetSize($mod.i);',
  9120. '']));
  9121. end;
  9122. procedure TTestModule.TestClass_TypeCast;
  9123. begin
  9124. StartProgram(false);
  9125. Add('type');
  9126. Add(' TObject = class');
  9127. Add(' Next: TObject;');
  9128. Add(' constructor Create;');
  9129. Add(' end;');
  9130. Add(' TControl = class(TObject)');
  9131. Add(' Arr: array of TObject;');
  9132. Add(' function GetIt(vI: longint = 0): TObject;');
  9133. Add(' end;');
  9134. Add('constructor tobject.create; begin end;');
  9135. Add('function tcontrol.getit(vi: longint = 0): tobject; begin end;');
  9136. Add('var');
  9137. Add(' Obj: tobject;');
  9138. Add('begin');
  9139. Add(' obj:=tcontrol(obj).next;');
  9140. Add(' tcontrol(obj):=nil;');
  9141. Add(' obj:=tcontrol(obj);');
  9142. Add(' tcontrol(obj):=tcontrol(tcontrol(obj).getit);');
  9143. Add(' tcontrol(obj):=tcontrol(tcontrol(obj).getit());');
  9144. Add(' tcontrol(obj):=tcontrol(tcontrol(obj).getit(1));');
  9145. Add(' tcontrol(obj):=tcontrol(tcontrol(tcontrol(obj).getit).arr[2]);');
  9146. ConvertProgram;
  9147. CheckSource('TestClass_TypeCast',
  9148. LinesToStr([ // statements
  9149. 'rtl.createClass($mod, "TObject", null, function () {',
  9150. ' this.$init = function () {',
  9151. ' this.Next = null;',
  9152. ' };',
  9153. ' this.$final = function () {',
  9154. ' this.Next = undefined;',
  9155. ' };',
  9156. ' this.Create = function () {',
  9157. ' };',
  9158. '});',
  9159. 'rtl.createClass($mod, "TControl", $mod.TObject, function () {',
  9160. ' this.$init = function () {',
  9161. ' $mod.TObject.$init.call(this);',
  9162. ' this.Arr = [];',
  9163. ' };',
  9164. ' this.$final = function () {',
  9165. ' this.Arr = undefined;',
  9166. ' $mod.TObject.$final.call(this);',
  9167. ' };',
  9168. ' this.GetIt = function (vI) {',
  9169. ' var Result = null;',
  9170. ' return Result;',
  9171. ' };',
  9172. '});',
  9173. 'this.Obj = null;'
  9174. ]),
  9175. LinesToStr([ // $mod.$main
  9176. '$mod.Obj = $mod.Obj.Next;',
  9177. '$mod.Obj = null;',
  9178. '$mod.Obj = $mod.Obj;',
  9179. '$mod.Obj = $mod.Obj.GetIt(0);',
  9180. '$mod.Obj = $mod.Obj.GetIt(0);',
  9181. '$mod.Obj = $mod.Obj.GetIt(1);',
  9182. '$mod.Obj = $mod.Obj.GetIt(0).Arr[2];',
  9183. '']));
  9184. end;
  9185. procedure TTestModule.TestClass_TypeCastUntypedParam;
  9186. begin
  9187. StartProgram(false);
  9188. Add('type');
  9189. Add(' TObject = class end;');
  9190. Add('procedure ProcA(var A);');
  9191. Add('begin');
  9192. Add(' TObject(A):=nil;');
  9193. Add(' TObject(A):=TObject(A);');
  9194. Add(' if TObject(A)=nil then ;');
  9195. Add(' if nil=TObject(A) then ;');
  9196. Add('end;');
  9197. Add('procedure ProcB(out A);');
  9198. Add('begin');
  9199. Add(' TObject(A):=nil;');
  9200. Add(' TObject(A):=TObject(A);');
  9201. Add(' if TObject(A)=nil then ;');
  9202. Add(' if nil=TObject(A) then ;');
  9203. Add('end;');
  9204. Add('procedure ProcC(const A);');
  9205. Add('begin');
  9206. Add(' if TObject(A)=nil then ;');
  9207. Add(' if nil=TObject(A) then ;');
  9208. Add('end;');
  9209. Add('var o: TObject;');
  9210. Add('begin');
  9211. Add(' ProcA(o);');
  9212. Add(' ProcB(o);');
  9213. Add(' ProcC(o);');
  9214. ConvertProgram;
  9215. CheckSource('TestClass_TypeCastUntypedParam',
  9216. LinesToStr([ // statements
  9217. 'rtl.createClass($mod, "TObject", null, function () {',
  9218. ' this.$init = function () {',
  9219. ' };',
  9220. ' this.$final = function () {',
  9221. ' };',
  9222. '});',
  9223. 'this.ProcA = function (A) {',
  9224. ' A.set(null);',
  9225. ' A.set(A.get());',
  9226. ' if (A.get() === null);',
  9227. ' if (null === A.get());',
  9228. '};',
  9229. 'this.ProcB = function (A) {',
  9230. ' A.set(null);',
  9231. ' A.set(A.get());',
  9232. ' if (A.get() === null);',
  9233. ' if (null === A.get());',
  9234. '};',
  9235. 'this.ProcC = function (A) {',
  9236. ' if (A === null);',
  9237. ' if (null === A);',
  9238. '};',
  9239. 'this.o = null;',
  9240. '']),
  9241. LinesToStr([ // $mod.$main
  9242. '$mod.ProcA({',
  9243. ' p: $mod,',
  9244. ' get: function () {',
  9245. ' return this.p.o;',
  9246. ' },',
  9247. ' set: function (v) {',
  9248. ' this.p.o = v;',
  9249. ' }',
  9250. '});',
  9251. '$mod.ProcB({',
  9252. ' p: $mod,',
  9253. ' get: function () {',
  9254. ' return this.p.o;',
  9255. ' },',
  9256. ' set: function (v) {',
  9257. ' this.p.o = v;',
  9258. ' }',
  9259. '});',
  9260. '$mod.ProcC($mod.o);',
  9261. '']));
  9262. end;
  9263. procedure TTestModule.TestClass_Overloads;
  9264. begin
  9265. StartProgram(false);
  9266. Add('type');
  9267. Add(' TObject = class');
  9268. Add(' procedure DoIt;');
  9269. Add(' procedure DoIt(vI: longint);');
  9270. Add(' end;');
  9271. Add('procedure TObject.DoIt;');
  9272. Add('begin');
  9273. Add(' DoIt;');
  9274. Add(' DoIt(1);');
  9275. Add('end;');
  9276. Add('procedure TObject.DoIt(vI: longint); begin end;');
  9277. Add('begin');
  9278. ConvertProgram;
  9279. CheckSource('TestClass_Overloads',
  9280. LinesToStr([ // statements
  9281. 'rtl.createClass($mod, "TObject", null, function () {',
  9282. ' this.$init = function () {',
  9283. ' };',
  9284. ' this.$final = function () {',
  9285. ' };',
  9286. ' this.DoIt = function () {',
  9287. ' this.DoIt();',
  9288. ' this.DoIt$1(1);',
  9289. ' };',
  9290. ' this.DoIt$1 = function (vI) {',
  9291. ' };',
  9292. '});',
  9293. '']),
  9294. LinesToStr([ // $mod.$main
  9295. '']));
  9296. end;
  9297. procedure TTestModule.TestClass_OverloadsAncestor;
  9298. begin
  9299. StartProgram(false);
  9300. Add('type');
  9301. Add(' TObject = class;');
  9302. Add(' TObject = class');
  9303. Add(' procedure DoIt(vA: longint);');
  9304. Add(' procedure DoIt(vA, vB: longint);');
  9305. Add(' end;');
  9306. Add(' TCar = class;');
  9307. Add(' TCar = class');
  9308. Add(' procedure DoIt(vA: longint);');
  9309. Add(' procedure DoIt(vA, vB: longint);');
  9310. Add(' end;');
  9311. Add('procedure tobject.doit(va: longint);');
  9312. Add('begin');
  9313. Add(' doit(1);');
  9314. Add(' doit(1,2);');
  9315. Add('end;');
  9316. Add('procedure tobject.doit(va, vb: longint); begin end;');
  9317. Add('procedure tcar.doit(va: longint);');
  9318. Add('begin');
  9319. Add(' doit(1);');
  9320. Add(' doit(1,2);');
  9321. Add(' inherited doit(1);');
  9322. Add(' inherited doit(1,2);');
  9323. Add('end;');
  9324. Add('procedure tcar.doit(va, vb: longint); begin end;');
  9325. Add('begin');
  9326. ConvertProgram;
  9327. CheckSource('TestClass_OverloadsAncestor',
  9328. LinesToStr([ // statements
  9329. 'rtl.createClass($mod, "TObject", null, function () {',
  9330. ' this.$init = function () {',
  9331. ' };',
  9332. ' this.$final = function () {',
  9333. ' };',
  9334. ' this.DoIt = function (vA) {',
  9335. ' this.DoIt(1);',
  9336. ' this.DoIt$1(1,2);',
  9337. ' };',
  9338. ' this.DoIt$1 = function (vA, vB) {',
  9339. ' };',
  9340. '});',
  9341. 'rtl.createClass($mod, "TCar", $mod.TObject, function () {',
  9342. ' this.DoIt$2 = function (vA) {',
  9343. ' this.DoIt$2(1);',
  9344. ' this.DoIt$3(1, 2);',
  9345. ' $mod.TObject.DoIt.call(this, 1);',
  9346. ' $mod.TObject.DoIt$1.call(this, 1, 2);',
  9347. ' };',
  9348. ' this.DoIt$3 = function (vA, vB) {',
  9349. ' };',
  9350. '});',
  9351. '']),
  9352. LinesToStr([ // $mod.$main
  9353. '']));
  9354. end;
  9355. procedure TTestModule.TestClass_OverloadConstructor;
  9356. begin
  9357. StartProgram(false);
  9358. Add('type');
  9359. Add(' TObject = class');
  9360. Add(' constructor Create(vA: longint);');
  9361. Add(' constructor Create(vA, vB: longint);');
  9362. Add(' end;');
  9363. Add(' TCar = class');
  9364. Add(' constructor Create(vA: longint);');
  9365. Add(' constructor Create(vA, vB: longint);');
  9366. Add(' end;');
  9367. Add('constructor tobject.create(va: longint);');
  9368. Add('begin');
  9369. Add(' create(1);');
  9370. Add(' create(1,2);');
  9371. Add('end;');
  9372. Add('constructor tobject.create(va, vb: longint); begin end;');
  9373. Add('constructor tcar.create(va: longint);');
  9374. Add('begin');
  9375. Add(' create(1);');
  9376. Add(' create(1,2);');
  9377. Add(' inherited create(1);');
  9378. Add(' inherited create(1,2);');
  9379. Add('end;');
  9380. Add('constructor tcar.create(va, vb: longint); begin end;');
  9381. Add('begin');
  9382. Add(' tobject.create(1);');
  9383. Add(' tobject.create(1,2);');
  9384. Add(' tcar.create(1);');
  9385. Add(' tcar.create(1,2);');
  9386. ConvertProgram;
  9387. CheckSource('TestClass_OverloadConstructor',
  9388. LinesToStr([ // statements
  9389. 'rtl.createClass($mod, "TObject", null, function () {',
  9390. ' this.$init = function () {',
  9391. ' };',
  9392. ' this.$final = function () {',
  9393. ' };',
  9394. ' this.Create = function (vA) {',
  9395. ' this.Create(1);',
  9396. ' this.Create$1(1,2);',
  9397. ' };',
  9398. ' this.Create$1 = function (vA, vB) {',
  9399. ' };',
  9400. '});',
  9401. 'rtl.createClass($mod, "TCar", $mod.TObject, function () {',
  9402. ' this.Create$2 = function (vA) {',
  9403. ' this.Create$2(1);',
  9404. ' this.Create$3(1, 2);',
  9405. ' $mod.TObject.Create.call(this, 1);',
  9406. ' $mod.TObject.Create$1.call(this, 1, 2);',
  9407. ' };',
  9408. ' this.Create$3 = function (vA, vB) {',
  9409. ' };',
  9410. '});',
  9411. '']),
  9412. LinesToStr([ // $mod.$main
  9413. '$mod.TObject.$create("Create", [1]);',
  9414. '$mod.TObject.$create("Create$1", [1, 2]);',
  9415. '$mod.TCar.$create("Create$2", [1]);',
  9416. '$mod.TCar.$create("Create$3", [1, 2]);',
  9417. '']));
  9418. end;
  9419. procedure TTestModule.TestClass_OverloadDelphiOverride;
  9420. begin
  9421. StartProgram(false);
  9422. Add([
  9423. '{$mode delphi}',
  9424. 'type',
  9425. ' TObject = class end;',
  9426. ' TBird = class',
  9427. ' function {#a}GetValue: longint; overload; virtual;',
  9428. ' function {#b}GetValue(AValue: longint): longint; overload; virtual;',
  9429. ' end;',
  9430. ' TEagle = class(TBird)',
  9431. ' function {#c}GetValue: longint; overload; override;',
  9432. ' function {#d}GetValue(AValue: longint): longint; overload; override;',
  9433. ' end;',
  9434. 'function TBird.GetValue: longint;',
  9435. 'begin',
  9436. ' if 3={@a}GetValue then ;',
  9437. ' if 4={@b}GetValue(5) then ;',
  9438. 'end;',
  9439. 'function TBird.GetValue(AValue: longint): longint;',
  9440. 'begin',
  9441. 'end;',
  9442. 'function TEagle.GetValue: longint;',
  9443. 'begin',
  9444. ' if 13={@c}GetValue then ;',
  9445. ' if 14={@d}GetValue(15) then ;',
  9446. ' if 15=inherited {@a}GetValue then ;',
  9447. ' if 16=inherited {@b}GetValue(17) then ;',
  9448. 'end;',
  9449. 'function TEagle.GetValue(AValue: longint): longint;',
  9450. 'begin',
  9451. 'end;',
  9452. 'var',
  9453. ' e: TEagle;',
  9454. 'begin',
  9455. ' if 23=e.{@c}GetValue then ;',
  9456. ' if 24=e.{@d}GetValue(25) then ;']);
  9457. ConvertProgram;
  9458. CheckSource('TestClass_OverloadDelphiOverride',
  9459. LinesToStr([ // statements
  9460. 'rtl.createClass($mod, "TObject", null, function () {',
  9461. ' this.$init = function () {',
  9462. ' };',
  9463. ' this.$final = function () {',
  9464. ' };',
  9465. '});',
  9466. 'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
  9467. ' this.GetValue = function () {',
  9468. ' var Result = 0;',
  9469. ' if (3 === this.GetValue()) ;',
  9470. ' if (4 === this.GetValue$1(5)) ;',
  9471. ' return Result;',
  9472. ' };',
  9473. ' this.GetValue$1 = function (AValue) {',
  9474. ' var Result = 0;',
  9475. ' return Result;',
  9476. ' };',
  9477. '});',
  9478. 'rtl.createClass($mod, "TEagle", $mod.TBird, function () {',
  9479. ' this.GetValue = function () {',
  9480. ' var Result = 0;',
  9481. ' if (13 === this.GetValue()) ;',
  9482. ' if (14 === this.GetValue$1(15)) ;',
  9483. ' if (15 === $mod.TBird.GetValue.call(this)) ;',
  9484. ' if (16 === $mod.TBird.GetValue$1.call(this, 17)) ;',
  9485. ' return Result;',
  9486. ' };',
  9487. ' this.GetValue$1 = function (AValue) {',
  9488. ' var Result = 0;',
  9489. ' return Result;',
  9490. ' };',
  9491. '});',
  9492. 'this.e = null;',
  9493. '']),
  9494. LinesToStr([ // $mod.$main
  9495. 'if (23 === $mod.e.GetValue()) ;',
  9496. 'if (24 === $mod.e.GetValue$1(25)) ;',
  9497. '']));
  9498. end;
  9499. procedure TTestModule.TestClass_ReintroducedVar;
  9500. begin
  9501. StartProgram(false);
  9502. Add('type');
  9503. Add(' TObject = class');
  9504. Add(' strict private');
  9505. Add(' Some: longint;');
  9506. Add(' end;');
  9507. Add(' TMobile = class');
  9508. Add(' strict private');
  9509. Add(' Some: string;');
  9510. Add(' end;');
  9511. Add(' TCar = class(tmobile)');
  9512. Add(' procedure Some;');
  9513. Add(' procedure Some(vA: longint);');
  9514. Add(' end;');
  9515. Add('procedure tcar.some;');
  9516. Add('begin');
  9517. Add(' Some;');
  9518. Add(' Some(1);');
  9519. Add('end;');
  9520. Add('procedure tcar.some(va: longint); begin end;');
  9521. Add('begin');
  9522. ConvertProgram;
  9523. CheckSource('TestClass_ReintroducedVar',
  9524. LinesToStr([ // statements
  9525. 'rtl.createClass($mod, "TObject", null, function () {',
  9526. ' this.$init = function () {',
  9527. ' this.Some = 0;',
  9528. ' };',
  9529. ' this.$final = function () {',
  9530. ' };',
  9531. '});',
  9532. 'rtl.createClass($mod, "TMobile", $mod.TObject, function () {',
  9533. ' this.$init = function () {',
  9534. ' $mod.TObject.$init.call(this);',
  9535. ' this.Some$1 = "";',
  9536. ' };',
  9537. '});',
  9538. 'rtl.createClass($mod, "TCar", $mod.TMobile, function () {',
  9539. ' this.Some$2 = function () {',
  9540. ' this.Some$2();',
  9541. ' this.Some$3(1);',
  9542. ' };',
  9543. ' this.Some$3 = function (vA) {',
  9544. ' };',
  9545. '});',
  9546. '']),
  9547. LinesToStr([ // $mod.$main
  9548. '']));
  9549. end;
  9550. procedure TTestModule.TestClass_RaiseDescendant;
  9551. begin
  9552. StartProgram(false);
  9553. Add([
  9554. 'type',
  9555. ' TObject = class',
  9556. ' constructor Create(Msg: string);',
  9557. ' end;',
  9558. ' Exception = class',
  9559. ' end;',
  9560. ' EConvertError = class(Exception)',
  9561. ' end;',
  9562. 'constructor TObject.Create(Msg: string); begin end;',
  9563. 'function AssertConv(Msg: string = ''def''): EConvertError; begin end;',
  9564. 'begin',
  9565. ' raise Exception.Create(''Bar1'');',
  9566. ' raise EConvertError.Create(''Bar2'');',
  9567. ' raise AssertConv(''Bar2'');',
  9568. ' raise AssertConv;',
  9569. '']);
  9570. ConvertProgram;
  9571. CheckSource('TestClass_RaiseDescendant',
  9572. LinesToStr([ // statements
  9573. 'rtl.createClass($mod, "TObject", null, function () {',
  9574. ' this.$init = function () {',
  9575. ' };',
  9576. ' this.$final = function () {',
  9577. ' };',
  9578. ' this.Create = function (Msg) {',
  9579. ' };',
  9580. '});',
  9581. 'rtl.createClass($mod, "Exception", $mod.TObject, function () {',
  9582. '});',
  9583. 'rtl.createClass($mod, "EConvertError", $mod.Exception, function () {',
  9584. '});',
  9585. 'this.AssertConv = function (Msg) {',
  9586. ' var Result = null;',
  9587. ' return Result;',
  9588. '};',
  9589. '']),
  9590. LinesToStr([ // $mod.$main
  9591. 'throw $mod.Exception.$create("Create",["Bar1"]);',
  9592. 'throw $mod.EConvertError.$create("Create",["Bar2"]);',
  9593. 'throw $mod.AssertConv("Bar2");',
  9594. 'throw $mod.AssertConv("def");',
  9595. '']));
  9596. end;
  9597. procedure TTestModule.TestClass_ExternalMethod;
  9598. begin
  9599. AddModuleWithIntfImplSrc('unit2.pas',
  9600. LinesToStr([
  9601. 'type',
  9602. ' TObject = class',
  9603. ' public',
  9604. ' procedure Intern; external name ''$DoIntern'';',
  9605. ' end;',
  9606. '']),
  9607. LinesToStr([
  9608. '']));
  9609. StartUnit(true);
  9610. Add('interface');
  9611. Add('uses unit2;');
  9612. Add('type');
  9613. Add(' TCar = class(TObject)');
  9614. Add(' public');
  9615. Add(' procedure Intern2; external name ''$DoIntern2'';');
  9616. Add(' procedure DoIt;');
  9617. Add(' end;');
  9618. Add('implementation');
  9619. Add('procedure tcar.doit;');
  9620. Add('begin');
  9621. Add(' Intern;');
  9622. Add(' Intern();');
  9623. Add(' Intern2;');
  9624. Add(' Intern2();');
  9625. Add('end;');
  9626. Add('var Obj: TCar;');
  9627. Add('begin');
  9628. Add(' obj.intern;');
  9629. Add(' obj.intern();');
  9630. Add(' obj.intern2;');
  9631. Add(' obj.intern2();');
  9632. Add(' obj.doit;');
  9633. Add(' obj.doit();');
  9634. Add(' with obj do begin');
  9635. Add(' Intern;');
  9636. Add(' Intern();');
  9637. Add(' Intern2;');
  9638. Add(' Intern2();');
  9639. Add(' end;');
  9640. ConvertUnit;
  9641. CheckSource('TestClass_ExternalMethod',
  9642. LinesToStr([
  9643. 'var $impl = $mod.$impl;',
  9644. 'rtl.createClass($mod, "TCar", pas.unit2.TObject, function () {',
  9645. ' this.DoIt = function () {',
  9646. ' this.$DoIntern();',
  9647. ' this.$DoIntern();',
  9648. ' this.$DoIntern2();',
  9649. ' this.$DoIntern2();',
  9650. ' };',
  9651. ' });',
  9652. '']),
  9653. LinesToStr([ // this.$init
  9654. '$impl.Obj.$DoIntern();',
  9655. '$impl.Obj.$DoIntern();',
  9656. '$impl.Obj.$DoIntern2();',
  9657. '$impl.Obj.$DoIntern2();',
  9658. '$impl.Obj.DoIt();',
  9659. '$impl.Obj.DoIt();',
  9660. 'var $with1 = $impl.Obj;',
  9661. '$with1.$DoIntern();',
  9662. '$with1.$DoIntern();',
  9663. '$with1.$DoIntern2();',
  9664. '$with1.$DoIntern2();',
  9665. '']),
  9666. LinesToStr([ // implementation
  9667. '$impl.Obj = null;',
  9668. '']) );
  9669. end;
  9670. procedure TTestModule.TestClass_ExternalVirtualNameMismatchFail;
  9671. begin
  9672. StartProgram(false);
  9673. Add('type');
  9674. Add(' TObject = class');
  9675. Add(' procedure DoIt; virtual; external name ''Foo'';');
  9676. Add(' end;');
  9677. Add('begin');
  9678. SetExpectedPasResolverError('Virtual method name must match external',
  9679. nVirtualMethodNameMustMatchExternal);
  9680. ConvertProgram;
  9681. end;
  9682. procedure TTestModule.TestClass_ExternalOverrideFail;
  9683. begin
  9684. StartProgram(false);
  9685. Add('type');
  9686. Add(' TObject = class');
  9687. Add(' procedure DoIt; virtual; external name ''DoIt'';');
  9688. Add(' end;');
  9689. Add(' TCar = class');
  9690. Add(' procedure DoIt; override; external name ''DoIt'';');
  9691. Add(' end;');
  9692. Add('begin');
  9693. SetExpectedPasResolverError('Invalid procedure modifier override,external',
  9694. nInvalidXModifierY);
  9695. ConvertProgram;
  9696. end;
  9697. procedure TTestModule.TestClass_ExternalVar;
  9698. begin
  9699. AddModuleWithIntfImplSrc('unit2.pas',
  9700. LinesToStr([
  9701. '{$modeswitch externalclass}',
  9702. 'type',
  9703. ' TObject = class',
  9704. ' public',
  9705. ' Intern: longint external name ''$Intern'';',
  9706. ' end;',
  9707. '']),
  9708. LinesToStr([
  9709. '']));
  9710. StartUnit(true);
  9711. Add('interface');
  9712. Add('uses unit2;');
  9713. Add('{$modeswitch externalclass}');
  9714. Add('type');
  9715. Add(' TCar = class(tobject)');
  9716. Add(' public');
  9717. Add(' Intern2: longint external name ''$Intern2'';');
  9718. Add(' procedure DoIt;');
  9719. Add(' end;');
  9720. Add('implementation');
  9721. Add('procedure tcar.doit;');
  9722. Add('begin');
  9723. Add(' Intern:=Intern+1;');
  9724. Add(' Intern2:=Intern2+2;');
  9725. Add('end;');
  9726. Add('var Obj: TCar;');
  9727. Add('begin');
  9728. Add(' obj.intern:=obj.intern+1;');
  9729. Add(' obj.intern2:=obj.intern2+2;');
  9730. Add(' with obj do begin');
  9731. Add(' intern:=intern+1;');
  9732. Add(' intern2:=intern2+2;');
  9733. Add(' end;');
  9734. ConvertUnit;
  9735. CheckSource('TestClass_ExternalVar',
  9736. LinesToStr([
  9737. 'var $impl = $mod.$impl;',
  9738. 'rtl.createClass($mod, "TCar", pas.unit2.TObject, function () {',
  9739. ' this.DoIt = function () {',
  9740. ' this.$Intern = this.$Intern + 1;',
  9741. ' this.$Intern2 = this.$Intern2 + 2;',
  9742. ' };',
  9743. ' });',
  9744. '']),
  9745. LinesToStr([
  9746. '$impl.Obj.$Intern = $impl.Obj.$Intern + 1;',
  9747. '$impl.Obj.$Intern2 = $impl.Obj.$Intern2 + 2;',
  9748. 'var $with1 = $impl.Obj;',
  9749. '$with1.$Intern = $with1.$Intern + 1;',
  9750. '$with1.$Intern2 = $with1.$Intern2 + 2;',
  9751. '']),
  9752. LinesToStr([ // implementation
  9753. '$impl.Obj = null;',
  9754. '']));
  9755. end;
  9756. procedure TTestModule.TestClass_Const;
  9757. begin
  9758. StartProgram(false);
  9759. Add('type');
  9760. Add(' integer = longint;');
  9761. Add(' TClass = class of TObject;');
  9762. Add(' TObject = class');
  9763. Add(' public');
  9764. Add(' const cI: integer = 3;');
  9765. Add(' procedure DoIt;');
  9766. Add(' class procedure DoMore;');
  9767. Add(' end;');
  9768. Add('implementation');
  9769. Add('procedure tobject.doit;');
  9770. Add('begin');
  9771. Add(' if cI=4 then;');
  9772. Add(' if 5=cI then;');
  9773. Add(' if Self.cI=6 then;');
  9774. Add(' if 7=Self.cI then;');
  9775. Add(' with Self do begin');
  9776. Add(' if cI=11 then;');
  9777. Add(' if 12=cI then;');
  9778. Add(' end;');
  9779. Add('end;');
  9780. Add('class procedure tobject.domore;');
  9781. Add('begin');
  9782. Add(' if cI=8 then;');
  9783. Add(' if Self.cI=9 then;');
  9784. Add(' if 10=cI then;');
  9785. Add(' if 11=Self.cI then;');
  9786. Add(' with Self do begin');
  9787. Add(' if cI=13 then;');
  9788. Add(' if 14=cI then;');
  9789. Add(' end;');
  9790. Add('end;');
  9791. Add('var');
  9792. Add(' Obj: TObject;');
  9793. Add(' Cla: TClass;');
  9794. Add('begin');
  9795. Add(' if TObject.cI=21 then ;');
  9796. Add(' if Obj.cI=22 then ;');
  9797. Add(' if Cla.cI=23 then ;');
  9798. Add(' with obj do if ci=24 then;');
  9799. Add(' with TObject do if ci=25 then;');
  9800. Add(' with Cla do if ci=26 then;');
  9801. ConvertProgram;
  9802. CheckSource('TestClass_Const',
  9803. LinesToStr([
  9804. 'rtl.createClass($mod, "TObject", null, function () {',
  9805. ' this.cI = 3;',
  9806. ' this.$init = function () {',
  9807. ' };',
  9808. ' this.$final = function () {',
  9809. ' };',
  9810. ' this.DoIt = function () {',
  9811. ' if (this.cI === 4) ;',
  9812. ' if (5 === this.cI) ;',
  9813. ' if (this.cI === 6) ;',
  9814. ' if (7 === this.cI) ;',
  9815. ' if (this.cI === 11) ;',
  9816. ' if (12 === this.cI) ;',
  9817. ' };',
  9818. ' this.DoMore = function () {',
  9819. ' if (this.cI === 8) ;',
  9820. ' if (this.cI === 9) ;',
  9821. ' if (10 === this.cI) ;',
  9822. ' if (11 === this.cI) ;',
  9823. ' if (this.cI === 13) ;',
  9824. ' if (14 === this.cI) ;',
  9825. ' };',
  9826. '});',
  9827. 'this.Obj = null;',
  9828. 'this.Cla = null;',
  9829. '']),
  9830. LinesToStr([
  9831. 'if ($mod.TObject.cI === 21) ;',
  9832. 'if ($mod.Obj.cI === 22) ;',
  9833. 'if ($mod.Cla.cI === 23) ;',
  9834. 'var $with1 = $mod.Obj;',
  9835. 'if ($with1.cI === 24) ;',
  9836. 'var $with2 = $mod.TObject;',
  9837. 'if ($with2.cI === 25) ;',
  9838. 'var $with3 = $mod.Cla;',
  9839. 'if ($with3.cI === 26) ;',
  9840. '']));
  9841. end;
  9842. procedure TTestModule.TestClass_LocalVarSelfFail;
  9843. begin
  9844. StartProgram(false);
  9845. Add([
  9846. 'type',
  9847. ' TObject = class',
  9848. ' constructor Create;',
  9849. ' end;',
  9850. 'constructor tobject.create;',
  9851. 'var self: longint;',
  9852. 'begin',
  9853. 'end',
  9854. 'begin',
  9855. '']);
  9856. SetExpectedPasResolverError('Duplicate identifier "self" at (0)',nDuplicateIdentifier);
  9857. ConvertProgram;
  9858. end;
  9859. procedure TTestModule.TestClass_ArgSelfFail;
  9860. begin
  9861. StartProgram(false);
  9862. Add([
  9863. 'type',
  9864. ' TObject = class',
  9865. ' procedure DoIt(Self: longint);',
  9866. ' end;',
  9867. 'procedure tobject.doit(self: longint);',
  9868. 'begin',
  9869. 'end',
  9870. 'begin',
  9871. '']);
  9872. SetExpectedPasResolverError('Duplicate identifier "Self" at test1.pp(5,24)',nDuplicateIdentifier);
  9873. ConvertProgram;
  9874. end;
  9875. procedure TTestModule.TestClass_NestedProcSelf;
  9876. begin
  9877. StartProgram(false);
  9878. Add([
  9879. 'type',
  9880. ' TObject = class',
  9881. ' Key: longint;',
  9882. ' class var State: longint;',
  9883. ' procedure DoIt;',
  9884. ' function GetSize: longint; virtual; abstract;',
  9885. ' procedure SetSize(Value: longint); virtual; abstract;',
  9886. ' property Size: longint read GetSize write SetSize;',
  9887. ' end;',
  9888. 'procedure tobject.doit;',
  9889. ' procedure Sub;',
  9890. ' begin',
  9891. ' key:=key+2;',
  9892. ' self.key:=self.key+3;',
  9893. ' state:=state+4;',
  9894. ' self.state:=self.state+5;',
  9895. ' tobject.state:=tobject.state+6;',
  9896. ' size:=size+7;',
  9897. ' self.size:=self.size+8;',
  9898. ' end;',
  9899. 'begin',
  9900. ' sub;',
  9901. ' key:=key+12;',
  9902. ' self.key:=self.key+13;',
  9903. ' state:=state+14;',
  9904. ' self.state:=self.state+15;',
  9905. ' tobject.state:=tobject.state+16;',
  9906. ' size:=size+17;',
  9907. ' self.size:=self.size+18;',
  9908. 'end;',
  9909. 'begin',
  9910. '']);
  9911. ConvertProgram;
  9912. CheckSource('TestClass_NestedProcSelf',
  9913. LinesToStr([ // statements
  9914. 'rtl.createClass($mod, "TObject", null, function () {',
  9915. ' this.State = 0;',
  9916. ' this.$init = function () {',
  9917. ' this.Key = 0;',
  9918. ' };',
  9919. ' this.$final = function () {',
  9920. ' };',
  9921. ' this.DoIt = function () {',
  9922. ' var Self = this;',
  9923. ' function Sub() {',
  9924. ' Self.Key = Self.Key + 2;',
  9925. ' Self.Key = Self.Key + 3;',
  9926. ' Self.$class.State = Self.State + 4;',
  9927. ' Self.$class.State = Self.State + 5;',
  9928. ' $mod.TObject.State = $mod.TObject.State + 6;',
  9929. ' Self.SetSize(Self.GetSize() + 7);',
  9930. ' Self.SetSize(Self.GetSize() + 8);',
  9931. ' };',
  9932. ' Sub();',
  9933. ' Self.Key = Self.Key + 12;',
  9934. ' Self.Key = Self.Key + 13;',
  9935. ' Self.$class.State = Self.State + 14;',
  9936. ' Self.$class.State = Self.State + 15;',
  9937. ' $mod.TObject.State = $mod.TObject.State + 16;',
  9938. ' Self.SetSize(Self.GetSize() + 17);',
  9939. ' Self.SetSize(Self.GetSize() + 18);',
  9940. ' };',
  9941. '});',
  9942. '']),
  9943. LinesToStr([ // $mod.$main
  9944. '']));
  9945. end;
  9946. procedure TTestModule.TestClass_NestedProcSelf2;
  9947. begin
  9948. StartProgram(false);
  9949. Add([
  9950. 'type',
  9951. ' TObject = class',
  9952. ' Key: longint;',
  9953. ' class var State: longint;',
  9954. ' function GetSize: longint; virtual; abstract;',
  9955. ' procedure SetSize(Value: longint); virtual; abstract;',
  9956. ' property Size: longint read GetSize write SetSize;',
  9957. ' end;',
  9958. ' TBird = class',
  9959. ' procedure DoIt;',
  9960. ' end;',
  9961. 'procedure tbird.doit;',
  9962. ' procedure Sub;',
  9963. ' begin',
  9964. ' key:=key+2;',
  9965. ' self.key:=self.key+3;',
  9966. ' state:=state+4;',
  9967. ' self.state:=self.state+5;',
  9968. ' tobject.state:=tobject.state+6;',
  9969. ' size:=size+7;',
  9970. ' self.size:=self.size+8;',
  9971. ' end;',
  9972. 'begin',
  9973. ' sub;',
  9974. ' key:=key+12;',
  9975. ' self.key:=self.key+13;',
  9976. ' state:=state+14;',
  9977. ' self.state:=self.state+15;',
  9978. ' tobject.state:=tobject.state+16;',
  9979. ' size:=size+17;',
  9980. ' self.size:=self.size+18;',
  9981. 'end;',
  9982. 'begin',
  9983. '']);
  9984. ConvertProgram;
  9985. CheckSource('TestClass_NestedProcSelf2',
  9986. LinesToStr([ // statements
  9987. 'rtl.createClass($mod, "TObject", null, function () {',
  9988. ' this.State = 0;',
  9989. ' this.$init = function () {',
  9990. ' this.Key = 0;',
  9991. ' };',
  9992. ' this.$final = function () {',
  9993. ' };',
  9994. '});',
  9995. 'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
  9996. ' this.DoIt = function () {',
  9997. ' var Self = this;',
  9998. ' function Sub() {',
  9999. ' Self.Key = Self.Key + 2;',
  10000. ' Self.Key = Self.Key + 3;',
  10001. ' Self.$class.State = Self.State + 4;',
  10002. ' Self.$class.State = Self.State + 5;',
  10003. ' $mod.TObject.State = $mod.TObject.State + 6;',
  10004. ' Self.SetSize(Self.GetSize() + 7);',
  10005. ' Self.SetSize(Self.GetSize() + 8);',
  10006. ' };',
  10007. ' Sub();',
  10008. ' this.Key = this.Key + 12;',
  10009. ' Self.Key = Self.Key + 13;',
  10010. ' this.$class.State = this.State + 14;',
  10011. ' Self.$class.State = Self.State + 15;',
  10012. ' $mod.TObject.State = $mod.TObject.State + 16;',
  10013. ' this.SetSize(this.GetSize() + 17);',
  10014. ' Self.SetSize(Self.GetSize() + 18);',
  10015. ' };',
  10016. '});',
  10017. '']),
  10018. LinesToStr([ // $mod.$main
  10019. '']));
  10020. end;
  10021. procedure TTestModule.TestClass_NestedProcClassSelf;
  10022. begin
  10023. StartProgram(false);
  10024. Add([
  10025. 'type',
  10026. ' TObject = class',
  10027. ' class var State: longint;',
  10028. ' class procedure DoIt;',
  10029. ' class function GetSize: longint; virtual; abstract;',
  10030. ' class procedure SetSize(Value: longint); virtual; abstract;',
  10031. ' class property Size: longint read GetSize write SetSize;',
  10032. ' end;',
  10033. 'class procedure tobject.doit;',
  10034. ' procedure Sub;',
  10035. ' begin',
  10036. ' state:=state+2;',
  10037. ' self.state:=self.state+3;',
  10038. ' tobject.state:=tobject.state+4;',
  10039. ' size:=size+5;',
  10040. ' self.size:=self.size+6;',
  10041. ' tobject.size:=tobject.size+7;',
  10042. ' end;',
  10043. 'begin',
  10044. ' sub;',
  10045. ' state:=state+12;',
  10046. ' self.state:=self.state+13;',
  10047. ' tobject.state:=tobject.state+14;',
  10048. ' size:=size+15;',
  10049. ' self.size:=self.size+16;',
  10050. ' tobject.size:=tobject.size+17;',
  10051. 'end;',
  10052. 'begin',
  10053. '']);
  10054. ConvertProgram;
  10055. CheckSource('TestClass_NestedProcClassSelf',
  10056. LinesToStr([ // statements
  10057. 'rtl.createClass($mod, "TObject", null, function () {',
  10058. ' this.State = 0;',
  10059. ' this.$init = function () {',
  10060. ' };',
  10061. ' this.$final = function () {',
  10062. ' };',
  10063. ' this.DoIt = function () {',
  10064. ' var Self = this;',
  10065. ' function Sub() {',
  10066. ' Self.State = Self.State + 2;',
  10067. ' Self.State = Self.State + 3;',
  10068. ' $mod.TObject.State = $mod.TObject.State + 4;',
  10069. ' Self.SetSize(Self.GetSize() + 5);',
  10070. ' Self.SetSize(Self.GetSize() + 6);',
  10071. ' $mod.TObject.SetSize($mod.TObject.GetSize() + 7);',
  10072. ' };',
  10073. ' Sub();',
  10074. ' Self.State = Self.State + 12;',
  10075. ' Self.State = Self.State + 13;',
  10076. ' $mod.TObject.State = $mod.TObject.State + 14;',
  10077. ' Self.SetSize(Self.GetSize() + 15);',
  10078. ' Self.SetSize(Self.GetSize() + 16);',
  10079. ' $mod.TObject.SetSize($mod.TObject.GetSize() + 17);',
  10080. ' };',
  10081. '});',
  10082. '']),
  10083. LinesToStr([ // $mod.$main
  10084. '']));
  10085. end;
  10086. procedure TTestModule.TestClass_NestedProcCallInherited;
  10087. begin
  10088. StartProgram(false);
  10089. Add([
  10090. 'type',
  10091. ' TObject = class',
  10092. ' function DoIt(k: boolean): longint; virtual;',
  10093. ' end;',
  10094. ' TBird = class',
  10095. ' function DoIt(k: boolean): longint; override;',
  10096. ' end;',
  10097. 'function tobject.doit(k: boolean): longint;',
  10098. 'begin',
  10099. 'end;',
  10100. 'function tbird.doit(k: boolean): longint;',
  10101. ' procedure Sub;',
  10102. ' begin',
  10103. ' inherited DoIt(true);',
  10104. //' if inherited DoIt(false)=4 then ;',
  10105. ' end;',
  10106. 'begin',
  10107. ' Sub;',
  10108. ' inherited;',
  10109. ' inherited DoIt(true);',
  10110. //' if inherited DoIt(false)=14 then ;',
  10111. 'end;',
  10112. 'begin',
  10113. '']);
  10114. ConvertProgram;
  10115. CheckSource('TestClass_NestedProcCallInherited',
  10116. LinesToStr([ // statements
  10117. 'rtl.createClass($mod, "TObject", null, function () {',
  10118. ' this.$init = function () {',
  10119. ' };',
  10120. ' this.$final = function () {',
  10121. ' };',
  10122. ' this.DoIt = function (k) {',
  10123. ' var Result = 0;',
  10124. ' return Result;',
  10125. ' };',
  10126. '});',
  10127. 'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
  10128. ' this.DoIt = function (k) {',
  10129. ' var Self = this;',
  10130. ' var Result = 0;',
  10131. ' function Sub() {',
  10132. ' $mod.TObject.DoIt.call(Self, true);',
  10133. ' };',
  10134. ' Sub();',
  10135. ' $mod.TObject.DoIt.apply(Self, arguments);',
  10136. ' $mod.TObject.DoIt.call(Self, true);',
  10137. ' return Result;',
  10138. ' };',
  10139. '});',
  10140. '']),
  10141. LinesToStr([ // $mod.$main
  10142. '']));
  10143. end;
  10144. procedure TTestModule.TestClass_TObjectFree;
  10145. begin
  10146. StartProgram(false);
  10147. Add([
  10148. 'type',
  10149. ' TObject = class',
  10150. ' Obj: tobject;',
  10151. ' procedure Free;',
  10152. ' end;',
  10153. 'procedure tobject.free;',
  10154. 'begin',
  10155. 'end;',
  10156. 'function DoIt(o: tobject): tobject;',
  10157. 'var l: tobject;',
  10158. 'begin',
  10159. ' o.free;',
  10160. ' o.free();',
  10161. ' l.free;',
  10162. ' l.free();',
  10163. ' o.obj.free;',
  10164. ' o.obj.free();',
  10165. ' with o do obj.free;',
  10166. ' with o do obj.free();',
  10167. ' result.Free;',
  10168. ' result.Free();',
  10169. 'end;',
  10170. 'var o: tobject;',
  10171. ' a: array of tobject;',
  10172. 'begin',
  10173. ' o.free;',
  10174. ' o.obj.free;',
  10175. ' a[1+2].free;',
  10176. '']);
  10177. ConvertProgram;
  10178. CheckSource('TestClass_TObjectFree',
  10179. LinesToStr([ // statements
  10180. 'rtl.createClass($mod, "TObject", null, function () {',
  10181. ' this.$init = function () {',
  10182. ' this.Obj = null;',
  10183. ' };',
  10184. ' this.$final = function () {',
  10185. ' this.Obj = undefined;',
  10186. ' };',
  10187. ' this.Free = function () {',
  10188. ' };',
  10189. '});',
  10190. 'this.DoIt = function (o) {',
  10191. ' var Result = null;',
  10192. ' var l = null;',
  10193. ' o = rtl.freeLoc(o);',
  10194. ' o = rtl.freeLoc(o);',
  10195. ' l = rtl.freeLoc(l);',
  10196. ' l = rtl.freeLoc(l);',
  10197. ' rtl.free(o, "Obj");',
  10198. ' rtl.free(o, "Obj");',
  10199. ' rtl.free(o, "Obj");',
  10200. ' rtl.free(o, "Obj");',
  10201. ' Result = rtl.freeLoc(Result);',
  10202. ' Result = rtl.freeLoc(Result);',
  10203. ' return Result;',
  10204. '};',
  10205. 'this.o = null;',
  10206. 'this.a = [];',
  10207. '']),
  10208. LinesToStr([ // $mod.$main
  10209. 'rtl.free($mod, "o");',
  10210. 'rtl.free($mod.o, "Obj");',
  10211. 'rtl.free($mod.a, 1 + 2);',
  10212. '']));
  10213. end;
  10214. procedure TTestModule.TestClass_TObjectFreeNewInstance;
  10215. begin
  10216. StartProgram(false);
  10217. Add([
  10218. 'type',
  10219. ' TObject = class',
  10220. ' constructor Create;',
  10221. ' procedure Free;',
  10222. ' end;',
  10223. 'constructor TObject.Create; begin end;',
  10224. 'procedure tobject.free; begin end;',
  10225. 'begin',
  10226. ' with tobject.create do free;',
  10227. '']);
  10228. ConvertProgram;
  10229. CheckSource('TestClass_TObjectFreeNewInstance',
  10230. LinesToStr([ // statements
  10231. 'rtl.createClass($mod, "TObject", null, function () {',
  10232. ' this.$init = function () {',
  10233. ' };',
  10234. ' this.$final = function () {',
  10235. ' };',
  10236. ' this.Create = function () {',
  10237. ' };',
  10238. ' this.Free = function () {',
  10239. ' };',
  10240. '});',
  10241. '']),
  10242. LinesToStr([ // $mod.$main
  10243. 'var $with1 = $mod.TObject.$create("Create");',
  10244. '$with1=rtl.freeLoc($with1);',
  10245. '']));
  10246. end;
  10247. procedure TTestModule.TestClass_TObjectFreeLowerCase;
  10248. begin
  10249. StartProgram(false);
  10250. Add([
  10251. 'type',
  10252. ' TObject = class',
  10253. ' destructor Destroy;',
  10254. ' procedure Free;',
  10255. ' end;',
  10256. 'destructor TObject.Destroy; begin end;',
  10257. 'procedure tobject.free; begin end;',
  10258. 'var o: tobject;',
  10259. 'begin',
  10260. ' o.free;',
  10261. '']);
  10262. Converter.UseLowerCase:=true;
  10263. ConvertProgram;
  10264. CheckSource('TestClass_TObjectFreeLowerCase',
  10265. LinesToStr([ // statements
  10266. 'rtl.createClass($mod, "tobject", null, function () {',
  10267. ' this.$init = function () {',
  10268. ' };',
  10269. ' this.$final = function () {',
  10270. ' };',
  10271. ' rtl.tObjectDestroy = "destroy";',
  10272. ' this.destroy = function () {',
  10273. ' };',
  10274. ' this.free = function () {',
  10275. ' };',
  10276. '});',
  10277. 'this.o = null;',
  10278. '']),
  10279. LinesToStr([ // $mod.$main
  10280. 'rtl.free($mod, "o");',
  10281. '']));
  10282. end;
  10283. procedure TTestModule.TestClass_TObjectFreeFunctionFail;
  10284. begin
  10285. StartProgram(false);
  10286. Add([
  10287. 'type',
  10288. ' TObject = class',
  10289. ' procedure Free;',
  10290. ' function GetObj: tobject; virtual; abstract;',
  10291. ' end;',
  10292. 'procedure tobject.free;',
  10293. 'begin',
  10294. 'end;',
  10295. 'var o: tobject;',
  10296. 'begin',
  10297. ' o.getobj.free;',
  10298. '']);
  10299. SetExpectedPasResolverError(sFreeNeedsVar,nFreeNeedsVar);
  10300. ConvertProgram;
  10301. end;
  10302. procedure TTestModule.TestClass_TObjectFreePropertyFail;
  10303. begin
  10304. StartProgram(false);
  10305. Add([
  10306. 'type',
  10307. ' TObject = class',
  10308. ' procedure Free;',
  10309. ' FObj: TObject;',
  10310. ' property Obj: tobject read FObj write FObj;',
  10311. ' end;',
  10312. 'procedure tobject.free;',
  10313. 'begin',
  10314. 'end;',
  10315. 'var o: tobject;',
  10316. 'begin',
  10317. ' o.obj.free;',
  10318. '']);
  10319. SetExpectedPasResolverError(sFreeNeedsVar,nFreeNeedsVar);
  10320. ConvertProgram;
  10321. end;
  10322. procedure TTestModule.TestClass_ForIn;
  10323. begin
  10324. StartProgram(false);
  10325. Add([
  10326. 'type',
  10327. ' TObject = class end;',
  10328. ' TItem = TObject;',
  10329. ' TEnumerator = class',
  10330. ' FCurrent: TItem;',
  10331. ' property Current: TItem read FCurrent;',
  10332. ' function MoveNext: boolean;',
  10333. ' end;',
  10334. ' TBird = class',
  10335. ' function GetEnumerator: TEnumerator;',
  10336. ' end;',
  10337. 'function TEnumerator.MoveNext: boolean;',
  10338. 'begin',
  10339. 'end;',
  10340. 'function TBird.GetEnumerator: TEnumerator;',
  10341. 'begin',
  10342. 'end;',
  10343. 'var',
  10344. ' b: TBird;',
  10345. ' i, i2: TItem;',
  10346. 'begin',
  10347. ' for i in b do i2:=i;']);
  10348. ConvertProgram;
  10349. CheckSource('TestClass_ForIn',
  10350. LinesToStr([ // statements
  10351. 'rtl.createClass($mod, "TObject", null, function () {',
  10352. ' this.$init = function () {',
  10353. ' };',
  10354. ' this.$final = function () {',
  10355. ' };',
  10356. '});',
  10357. 'rtl.createClass($mod, "TEnumerator", $mod.TObject, function () {',
  10358. ' this.$init = function () {',
  10359. ' $mod.TObject.$init.call(this);',
  10360. ' this.FCurrent = null;',
  10361. ' };',
  10362. ' this.$final = function () {',
  10363. ' this.FCurrent = undefined;',
  10364. ' $mod.TObject.$final.call(this);',
  10365. ' };',
  10366. ' this.MoveNext = function () {',
  10367. ' var Result = false;',
  10368. ' return Result;',
  10369. ' };',
  10370. '});',
  10371. 'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
  10372. ' this.GetEnumerator = function () {',
  10373. ' var Result = null;',
  10374. ' return Result;',
  10375. ' };',
  10376. '});',
  10377. 'this.b = null;',
  10378. 'this.i = null;',
  10379. 'this.i2 = null;'
  10380. ]),
  10381. LinesToStr([ // $mod.$main
  10382. 'var $in1 = $mod.b.GetEnumerator();',
  10383. 'try {',
  10384. ' while ($in1.MoveNext()){',
  10385. ' $mod.i = $in1.FCurrent;',
  10386. ' $mod.i2 = $mod.i;',
  10387. ' }',
  10388. '} finally {',
  10389. ' $in1 = rtl.freeLoc($in1)',
  10390. '};',
  10391. '']));
  10392. end;
  10393. procedure TTestModule.TestClassOf_Create;
  10394. begin
  10395. StartProgram(false);
  10396. Add('type');
  10397. Add(' TObject = class');
  10398. Add(' constructor Create;');
  10399. Add(' end;');
  10400. Add(' TClass = class of TObject;');
  10401. Add('constructor tobject.create; begin end;');
  10402. Add('var');
  10403. Add(' Obj: tobject;');
  10404. Add(' C: tclass;');
  10405. Add('begin');
  10406. Add(' obj:=C.create;');
  10407. Add(' with c do obj:=create;');
  10408. ConvertProgram;
  10409. CheckSource('TestClassOf_Create',
  10410. LinesToStr([ // statements
  10411. 'rtl.createClass($mod, "TObject", null, function () {',
  10412. ' this.$init = function () {',
  10413. ' };',
  10414. ' this.$final = function () {',
  10415. ' };',
  10416. ' this.Create = function () {',
  10417. ' };',
  10418. '});',
  10419. 'this.Obj = null;',
  10420. 'this.C = null;'
  10421. ]),
  10422. LinesToStr([ // $mod.$main
  10423. '$mod.Obj = $mod.C.$create("Create");',
  10424. 'var $with1 = $mod.C;',
  10425. '$mod.Obj = $with1.$create("Create");',
  10426. '']));
  10427. end;
  10428. procedure TTestModule.TestClassOf_Call;
  10429. begin
  10430. StartProgram(false);
  10431. Add('type');
  10432. Add(' TObject = class');
  10433. Add(' class procedure DoIt;');
  10434. Add(' end;');
  10435. Add(' TClass = class of TObject;');
  10436. Add('class procedure tobject.doit; begin end;');
  10437. Add('var');
  10438. Add(' C: tclass;');
  10439. Add('begin');
  10440. Add(' c.doit;');
  10441. Add(' with c do doit;');
  10442. ConvertProgram;
  10443. CheckSource('TestClassOf_Call',
  10444. LinesToStr([ // statements
  10445. 'rtl.createClass($mod, "TObject", null, function () {',
  10446. ' this.$init = function () {',
  10447. ' };',
  10448. ' this.$final = function () {',
  10449. ' };',
  10450. ' this.DoIt = function () {',
  10451. ' };',
  10452. '});',
  10453. 'this.C = null;'
  10454. ]),
  10455. LinesToStr([ // $mod.$main
  10456. '$mod.C.DoIt();',
  10457. 'var $with1 = $mod.C;',
  10458. '$with1.DoIt();',
  10459. '']));
  10460. end;
  10461. procedure TTestModule.TestClassOf_Assign;
  10462. begin
  10463. StartProgram(false);
  10464. Add('type');
  10465. Add(' TClass = class of TObject;');
  10466. Add(' TObject = class');
  10467. Add(' ClassType: TClass; ');
  10468. Add(' end;');
  10469. Add('var');
  10470. Add(' Obj: tobject;');
  10471. Add(' C: tclass;');
  10472. Add('begin');
  10473. Add(' c:=nil;');
  10474. Add(' c:=obj.classtype;');
  10475. ConvertProgram;
  10476. CheckSource('TestClassOf_Assign',
  10477. LinesToStr([ // statements
  10478. 'rtl.createClass($mod, "TObject", null, function () {',
  10479. ' this.$init = function () {',
  10480. ' this.ClassType = null;',
  10481. ' };',
  10482. ' this.$final = function () {',
  10483. ' this.ClassType = undefined;',
  10484. ' };',
  10485. '});',
  10486. 'this.Obj = null;',
  10487. 'this.C = null;'
  10488. ]),
  10489. LinesToStr([ // $mod.$main
  10490. '$mod.C = null;',
  10491. '$mod.C = $mod.Obj.ClassType;',
  10492. '']));
  10493. end;
  10494. procedure TTestModule.TestClassOf_Is;
  10495. begin
  10496. StartProgram(false);
  10497. Add('type');
  10498. Add(' TClass = class of TObject;');
  10499. Add(' TObject = class');
  10500. Add(' end;');
  10501. Add(' TCar = class');
  10502. Add(' end;');
  10503. Add(' TCars = class of TCar;');
  10504. Add('var');
  10505. Add(' Obj: tobject;');
  10506. Add(' C: tclass;');
  10507. Add(' Cars: tcars;');
  10508. Add('begin');
  10509. Add(' if c is tcar then ;');
  10510. Add(' if c is tcars then ;');
  10511. ConvertProgram;
  10512. CheckSource('TestClassOf_Is',
  10513. LinesToStr([ // statements
  10514. 'rtl.createClass($mod, "TObject", null, function () {',
  10515. ' this.$init = function () {',
  10516. ' };',
  10517. ' this.$final = function () {',
  10518. ' };',
  10519. '});',
  10520. 'rtl.createClass($mod, "TCar", $mod.TObject, function () {',
  10521. '});',
  10522. 'this.Obj = null;',
  10523. 'this.C = null;',
  10524. 'this.Cars = null;'
  10525. ]),
  10526. LinesToStr([ // $mod.$main
  10527. 'if(rtl.is($mod.C,$mod.TCar));',
  10528. 'if(rtl.is($mod.C,$mod.TCar));',
  10529. '']));
  10530. end;
  10531. procedure TTestModule.TestClassOf_Compare;
  10532. begin
  10533. StartProgram(false);
  10534. Add('type');
  10535. Add(' TClass = class of TObject;');
  10536. Add(' TObject = class');
  10537. Add(' ClassType: TClass; ');
  10538. Add(' end;');
  10539. Add('var');
  10540. Add(' b: boolean;');
  10541. Add(' Obj: tobject;');
  10542. Add(' C: tclass;');
  10543. Add('begin');
  10544. Add(' b:=c=nil;');
  10545. Add(' b:=nil=c;');
  10546. Add(' b:=c=obj.classtype;');
  10547. Add(' b:=obj.classtype=c;');
  10548. Add(' b:=c=TObject;');
  10549. Add(' b:=TObject=c;');
  10550. Add(' b:=c<>nil;');
  10551. Add(' b:=nil<>c;');
  10552. Add(' b:=c<>obj.classtype;');
  10553. Add(' b:=obj.classtype<>c;');
  10554. Add(' b:=c<>TObject;');
  10555. Add(' b:=TObject<>c;');
  10556. ConvertProgram;
  10557. CheckSource('TestClassOf_Compare',
  10558. LinesToStr([ // statements
  10559. 'rtl.createClass($mod, "TObject", null, function () {',
  10560. ' this.$init = function () {',
  10561. ' this.ClassType = null;',
  10562. ' };',
  10563. ' this.$final = function () {',
  10564. ' this.ClassType = undefined;',
  10565. ' };',
  10566. '});',
  10567. 'this.b = false;',
  10568. 'this.Obj = null;',
  10569. 'this.C = null;'
  10570. ]),
  10571. LinesToStr([ // $mod.$main
  10572. '$mod.b = $mod.C === null;',
  10573. '$mod.b = null === $mod.C;',
  10574. '$mod.b = $mod.C === $mod.Obj.ClassType;',
  10575. '$mod.b = $mod.Obj.ClassType === $mod.C;',
  10576. '$mod.b = $mod.C === $mod.TObject;',
  10577. '$mod.b = $mod.TObject === $mod.C;',
  10578. '$mod.b = $mod.C !== null;',
  10579. '$mod.b = null !== $mod.C;',
  10580. '$mod.b = $mod.C !== $mod.Obj.ClassType;',
  10581. '$mod.b = $mod.Obj.ClassType !== $mod.C;',
  10582. '$mod.b = $mod.C !== $mod.TObject;',
  10583. '$mod.b = $mod.TObject !== $mod.C;',
  10584. '']));
  10585. end;
  10586. procedure TTestModule.TestClassOf_ClassVar;
  10587. begin
  10588. StartProgram(false);
  10589. Add('type');
  10590. Add(' TObject = class');
  10591. Add(' class var id: longint;');
  10592. Add(' end;');
  10593. Add(' TClass = class of TObject;');
  10594. Add('var');
  10595. Add(' C: tclass;');
  10596. Add('begin');
  10597. Add(' C.id:=C.id;');
  10598. ConvertProgram;
  10599. CheckSource('TestClassOf_ClassVar',
  10600. LinesToStr([ // statements
  10601. 'rtl.createClass($mod, "TObject", null, function () {',
  10602. ' this.id = 0;',
  10603. ' this.$init = function () {',
  10604. ' };',
  10605. ' this.$final = function () {',
  10606. ' };',
  10607. '});',
  10608. 'this.C = null;'
  10609. ]),
  10610. LinesToStr([ // $mod.$main
  10611. '$mod.C.id = $mod.C.id;',
  10612. '']));
  10613. end;
  10614. procedure TTestModule.TestClassOf_ClassMethod;
  10615. begin
  10616. StartProgram(false);
  10617. Add('type');
  10618. Add(' TObject = class');
  10619. Add(' class function DoIt(i: longint = 0): longint;');
  10620. Add(' end;');
  10621. Add(' TClass = class of TObject;');
  10622. Add('class function tobject.doit(i: longint = 0): longint; begin end;');
  10623. Add('var');
  10624. Add(' i: longint;');
  10625. Add(' C: tclass;');
  10626. Add('begin');
  10627. Add(' C.DoIt;');
  10628. Add(' C.DoIt();');
  10629. Add(' i:=C.DoIt;');
  10630. Add(' i:=C.DoIt();');
  10631. ConvertProgram;
  10632. CheckSource('TestClassOf_ClassMethod',
  10633. LinesToStr([ // statements
  10634. 'rtl.createClass($mod, "TObject", null, function () {',
  10635. ' this.$init = function () {',
  10636. ' };',
  10637. ' this.$final = function () {',
  10638. ' };',
  10639. ' this.DoIt = function (i) {',
  10640. ' var Result = 0;',
  10641. ' return Result;',
  10642. ' };',
  10643. '});',
  10644. 'this.i = 0;',
  10645. 'this.C = null;'
  10646. ]),
  10647. LinesToStr([ // $mod.$main
  10648. '$mod.C.DoIt(0);',
  10649. '$mod.C.DoIt(0);',
  10650. '$mod.i = $mod.C.DoIt(0);',
  10651. '$mod.i = $mod.C.DoIt(0);',
  10652. '']));
  10653. end;
  10654. procedure TTestModule.TestClassOf_ClassProperty;
  10655. begin
  10656. StartProgram(false);
  10657. Add('type');
  10658. Add(' TObject = class');
  10659. Add(' class var FA: longint;');
  10660. Add(' class function GetA: longint;');
  10661. Add(' class procedure SetA(Value: longint);');
  10662. Add(' class property pA: longint read fa write fa;');
  10663. Add(' class property pB: longint read geta write seta;');
  10664. Add(' end;');
  10665. Add(' TObjectClass = class of tobject;');
  10666. Add('class function tobject.geta: longint; begin end;');
  10667. Add('class procedure tobject.seta(value: longint); begin end;');
  10668. Add('var');
  10669. Add(' b: boolean;');
  10670. Add(' Obj: tobject;');
  10671. Add(' Cla: tobjectclass;');
  10672. Add('begin');
  10673. Add(' obj.pa:=obj.pa;');
  10674. Add(' obj.pb:=obj.pb;');
  10675. Add(' b:=obj.pa=4;');
  10676. Add(' b:=obj.pb=obj.pb;');
  10677. Add(' b:=5=obj.pa;');
  10678. Add(' cla.pa:=6;');
  10679. Add(' cla.pa:=cla.pa;');
  10680. Add(' cla.pb:=cla.pb;');
  10681. Add(' b:=cla.pa=7;');
  10682. Add(' b:=cla.pb=cla.pb;');
  10683. Add(' b:=8=cla.pa;');
  10684. Add(' tobject.pa:=9;');
  10685. Add(' tobject.pb:=tobject.pb;');
  10686. Add(' b:=tobject.pa=10;');
  10687. Add(' b:=11=tobject.pa;');
  10688. ConvertProgram;
  10689. CheckSource('TestClassOf_ClassProperty',
  10690. LinesToStr([ // statements
  10691. 'rtl.createClass($mod, "TObject", null, function () {',
  10692. ' this.FA = 0;',
  10693. ' this.$init = function () {',
  10694. ' };',
  10695. ' this.$final = function () {',
  10696. ' };',
  10697. ' this.GetA = function () {',
  10698. ' var Result = 0;',
  10699. ' return Result;',
  10700. ' };',
  10701. ' this.SetA = function (Value) {',
  10702. ' };',
  10703. '});',
  10704. 'this.b = false;',
  10705. 'this.Obj = null;',
  10706. 'this.Cla = null;'
  10707. ]),
  10708. LinesToStr([ // $mod.$main
  10709. '$mod.Obj.$class.FA = $mod.Obj.FA;',
  10710. '$mod.Obj.$class.SetA($mod.Obj.$class.GetA());',
  10711. '$mod.b = $mod.Obj.FA === 4;',
  10712. '$mod.b = $mod.Obj.$class.GetA() === $mod.Obj.$class.GetA();',
  10713. '$mod.b = 5 === $mod.Obj.FA;',
  10714. '$mod.Cla.FA = 6;',
  10715. '$mod.Cla.FA = $mod.Cla.FA;',
  10716. '$mod.Cla.SetA($mod.Cla.GetA());',
  10717. '$mod.b = $mod.Cla.FA === 7;',
  10718. '$mod.b = $mod.Cla.GetA() === $mod.Cla.GetA();',
  10719. '$mod.b = 8 === $mod.Cla.FA;',
  10720. '$mod.TObject.FA = 9;',
  10721. '$mod.TObject.SetA($mod.TObject.GetA());',
  10722. '$mod.b = $mod.TObject.FA === 10;',
  10723. '$mod.b = 11 === $mod.TObject.FA;',
  10724. '']));
  10725. end;
  10726. procedure TTestModule.TestClassOf_ClassMethodSelf;
  10727. begin
  10728. StartProgram(false);
  10729. Add('type');
  10730. Add(' TObject = class');
  10731. Add(' class var GlobalId: longint;');
  10732. Add(' class procedure ProcA;');
  10733. Add(' end;');
  10734. Add('class procedure tobject.proca;');
  10735. Add('var b: boolean;');
  10736. Add('begin');
  10737. Add(' b:=self=nil;');
  10738. Add(' b:=self.globalid=3;');
  10739. Add(' b:=4=self.globalid;');
  10740. Add(' self.globalid:=5;');
  10741. Add(' self.proca;');
  10742. Add('end;');
  10743. Add('begin');
  10744. ConvertProgram;
  10745. CheckSource('TestClassOf_ClassMethodSelf',
  10746. LinesToStr([ // statements
  10747. 'rtl.createClass($mod, "TObject", null, function () {',
  10748. ' this.GlobalId = 0;',
  10749. ' this.$init = function () {',
  10750. ' };',
  10751. ' this.$final = function () {',
  10752. ' };',
  10753. ' this.ProcA = function () {',
  10754. ' var b = false;',
  10755. ' b = this === null;',
  10756. ' b = this.GlobalId === 3;',
  10757. ' b = 4 === this.GlobalId;',
  10758. ' this.GlobalId = 5;',
  10759. ' this.ProcA();',
  10760. ' };',
  10761. '});'
  10762. ]),
  10763. LinesToStr([ // $mod.$main
  10764. '']));
  10765. end;
  10766. procedure TTestModule.TestClassOf_TypeCast;
  10767. begin
  10768. StartProgram(false);
  10769. Add('type');
  10770. Add(' TObject = class');
  10771. Add(' class procedure {#TObject_DoIt}DoIt;');
  10772. Add(' end;');
  10773. Add(' TClass = class of TObject;');
  10774. Add(' TMobile = class');
  10775. Add(' class procedure {#TMobile_DoIt}DoIt;');
  10776. Add(' end;');
  10777. Add(' TMobileClass = class of TMobile;');
  10778. Add(' TCar = class(TMobile)');
  10779. Add(' class procedure {#TCar_DoIt}DoIt;');
  10780. Add(' end;');
  10781. Add(' TCarClass = class of TCar;');
  10782. Add('class procedure TObject.DoIt;');
  10783. Add('begin');
  10784. Add(' TClass(Self).{@TObject_DoIt}DoIt;');
  10785. Add(' TMobileClass(Self).{@TMobile_DoIt}DoIt;');
  10786. Add('end;');
  10787. Add('class procedure TMobile.DoIt;');
  10788. Add('begin');
  10789. Add(' TClass(Self).{@TObject_DoIt}DoIt;');
  10790. Add(' TMobileClass(Self).{@TMobile_DoIt}DoIt;');
  10791. Add(' TCarClass(Self).{@TCar_DoIt}DoIt;');
  10792. Add('end;');
  10793. Add('class procedure TCar.DoIt; begin end;');
  10794. Add('var');
  10795. Add(' ObjC: TClass;');
  10796. Add(' MobileC: TMobileClass;');
  10797. Add(' CarC: TCarClass;');
  10798. Add('begin');
  10799. Add(' ObjC.{@TObject_DoIt}DoIt;');
  10800. Add(' MobileC.{@TMobile_DoIt}DoIt;');
  10801. Add(' CarC.{@TCar_DoIt}DoIt;');
  10802. Add(' TClass(ObjC).{@TObject_DoIt}DoIt;');
  10803. Add(' TMobileClass(ObjC).{@TMobile_DoIt}DoIt;');
  10804. Add(' TCarClass(ObjC).{@TCar_DoIt}DoIt;');
  10805. Add(' TClass(MobileC).{@TObject_DoIt}DoIt;');
  10806. Add(' TMobileClass(MobileC).{@TMobile_DoIt}DoIt;');
  10807. Add(' TCarClass(MobileC).{@TCar_DoIt}DoIt;');
  10808. Add(' TClass(CarC).{@TObject_DoIt}DoIt;');
  10809. Add(' TMobileClass(CarC).{@TMobile_DoIt}DoIt;');
  10810. Add(' TCarClass(CarC).{@TCar_DoIt}DoIt;');
  10811. ConvertProgram;
  10812. CheckSource('TestClassOf_TypeCast',
  10813. LinesToStr([ // statements
  10814. 'rtl.createClass($mod, "TObject", null, function () {',
  10815. ' this.$init = function () {',
  10816. ' };',
  10817. ' this.$final = function () {',
  10818. ' };',
  10819. ' this.DoIt = function () {',
  10820. ' this.DoIt();',
  10821. ' this.DoIt$1();',
  10822. ' };',
  10823. '});',
  10824. 'rtl.createClass($mod, "TMobile", $mod.TObject, function () {',
  10825. ' this.DoIt$1 = function () {',
  10826. ' this.DoIt();',
  10827. ' this.DoIt$1();',
  10828. ' this.DoIt$2();',
  10829. ' };',
  10830. '});',
  10831. 'rtl.createClass($mod, "TCar", $mod.TMobile, function () {',
  10832. ' this.DoIt$2 = function () {',
  10833. ' };',
  10834. '});',
  10835. 'this.ObjC = null;',
  10836. 'this.MobileC = null;',
  10837. 'this.CarC = null;',
  10838. '']),
  10839. LinesToStr([ // $mod.$main
  10840. '$mod.ObjC.DoIt();',
  10841. '$mod.MobileC.DoIt$1();',
  10842. '$mod.CarC.DoIt$2();',
  10843. '$mod.ObjC.DoIt();',
  10844. '$mod.ObjC.DoIt$1();',
  10845. '$mod.ObjC.DoIt$2();',
  10846. '$mod.MobileC.DoIt();',
  10847. '$mod.MobileC.DoIt$1();',
  10848. '$mod.MobileC.DoIt$2();',
  10849. '$mod.CarC.DoIt();',
  10850. '$mod.CarC.DoIt$1();',
  10851. '$mod.CarC.DoIt$2();',
  10852. '']));
  10853. end;
  10854. procedure TTestModule.TestClassOf_ImplicitFunctionCall;
  10855. begin
  10856. StartProgram(false);
  10857. Add('type');
  10858. Add(' TObject = class');
  10859. Add(' function CurNow: longint; ');
  10860. Add(' class function Now: longint; ');
  10861. Add(' end;');
  10862. Add('function TObject.CurNow: longint; begin end;');
  10863. Add('class function TObject.Now: longint; begin end;');
  10864. Add('var');
  10865. Add(' Obj: tobject;');
  10866. Add(' vI: longint;');
  10867. Add('begin');
  10868. Add(' obj.curnow;');
  10869. Add(' vi:=obj.curnow;');
  10870. Add(' tobject.now;');
  10871. Add(' vi:=tobject.now;');
  10872. ConvertProgram;
  10873. CheckSource('TestClassOf_ImplicitFunctionCall',
  10874. LinesToStr([ // statements
  10875. 'rtl.createClass($mod, "TObject", null, function () {',
  10876. ' this.$init = function () {',
  10877. ' };',
  10878. ' this.$final = function () {',
  10879. ' };',
  10880. ' this.CurNow = function () {',
  10881. ' var Result = 0;',
  10882. ' return Result;',
  10883. ' };',
  10884. ' this.Now = function () {',
  10885. ' var Result = 0;',
  10886. ' return Result;',
  10887. ' };',
  10888. '});',
  10889. 'this.Obj = null;',
  10890. 'this.vI = 0;',
  10891. '']),
  10892. LinesToStr([ // $mod.$main
  10893. '$mod.Obj.CurNow();',
  10894. '$mod.vI = $mod.Obj.CurNow();',
  10895. '$mod.TObject.Now();',
  10896. '$mod.vI = $mod.TObject.Now();',
  10897. '']));
  10898. end;
  10899. procedure TTestModule.TestClassOf_Const;
  10900. begin
  10901. StartProgram(false);
  10902. Add([
  10903. 'type',
  10904. ' TObject = class',
  10905. ' end;',
  10906. ' TBird = TObject;',
  10907. ' TBirds = class of TBird;',
  10908. ' TEagles = TBirds;',
  10909. ' THawk = class(TBird);',
  10910. 'const',
  10911. ' Hawk: TEagles = THawk;',
  10912. ' DefaultBirdClasses : Array [1..2] of TEagles = (',
  10913. ' TBird,',
  10914. ' THawk',
  10915. ' );',
  10916. 'begin']);
  10917. ConvertProgram;
  10918. CheckSource('TestClassOf_Const',
  10919. LinesToStr([ // statements
  10920. 'rtl.createClass($mod, "TObject", null, function () {',
  10921. ' this.$init = function () {',
  10922. ' };',
  10923. ' this.$final = function () {',
  10924. ' };',
  10925. '});',
  10926. 'rtl.createClass($mod, "THawk", $mod.TObject, function () {',
  10927. '});',
  10928. 'this.Hawk = $mod.THawk;',
  10929. 'this.DefaultBirdClasses = [$mod.TObject, $mod.THawk];',
  10930. '']),
  10931. LinesToStr([ // $mod.$main
  10932. '']));
  10933. end;
  10934. procedure TTestModule.TestNestedClass_Fail;
  10935. begin
  10936. StartProgram(false);
  10937. Add([
  10938. 'type',
  10939. ' TObject = class',
  10940. ' type TNested = longint;',
  10941. ' end;',
  10942. 'begin']);
  10943. SetExpectedPasResolverError('not yet implemented: TNested:TPasAliasType [20170608232534] nested types',
  10944. nNotYetImplemented);
  10945. ConvertProgram;
  10946. end;
  10947. procedure TTestModule.TestExternalClass_Var;
  10948. begin
  10949. StartProgram(false);
  10950. Add([
  10951. '{$modeswitch externalclass}',
  10952. 'type',
  10953. ' TExtA = class external name ''ExtObj''',
  10954. ' Id: longint external name ''$Id'';',
  10955. ' B: longint;',
  10956. ' end;',
  10957. 'var Obj: TExtA;',
  10958. 'begin',
  10959. ' obj.id:=obj.id+1;',
  10960. ' obj.B:=obj.B+1;']);
  10961. ConvertProgram;
  10962. CheckSource('TestExternalClass_Var',
  10963. LinesToStr([ // statements
  10964. 'this.Obj = null;',
  10965. '']),
  10966. LinesToStr([ // $mod.$main
  10967. '$mod.Obj.$Id = $mod.Obj.$Id + 1;',
  10968. '$mod.Obj.B = $mod.Obj.B + 1;',
  10969. '']));
  10970. end;
  10971. procedure TTestModule.TestExternalClass_Const;
  10972. begin
  10973. StartProgram(false);
  10974. Add([
  10975. '{$modeswitch externalclass}',
  10976. 'type',
  10977. ' TExtA = class external name ''ExtObj''',
  10978. ' const Two: longint = 2;',
  10979. ' const Three = 3;',
  10980. ' const Id: longint;',
  10981. ' end;',
  10982. ' TExtB = class external name ''ExtB''',
  10983. ' A: TExtA;',
  10984. ' end;',
  10985. 'var',
  10986. ' A: texta;',
  10987. ' B: textb;',
  10988. ' i: longint;',
  10989. 'begin',
  10990. ' i:=a.two;',
  10991. ' i:=texta.two;',
  10992. ' i:=a.three;',
  10993. ' i:=texta.three;',
  10994. ' i:=a.id;',
  10995. ' i:=texta.id;',
  10996. '']);
  10997. ConvertProgram;
  10998. CheckSource('TestExternalClass_Const',
  10999. LinesToStr([ // statements
  11000. 'this.A = null;',
  11001. 'this.B = null;',
  11002. 'this.i = 0;',
  11003. '']),
  11004. LinesToStr([ // $mod.$main
  11005. '$mod.i = 2;',
  11006. '$mod.i = 2;',
  11007. '$mod.i = 3;',
  11008. '$mod.i = 3;',
  11009. '$mod.i = $mod.A.Id;',
  11010. '$mod.i = ExtObj.Id;',
  11011. '']));
  11012. end;
  11013. procedure TTestModule.TestExternalClass_Dollar;
  11014. begin
  11015. StartProgram(false);
  11016. Add([
  11017. '{$modeswitch externalclass}',
  11018. 'type',
  11019. ' TExtA = class external name ''$''',
  11020. ' Id: longint external name ''$'';',
  11021. ' function Bla(i: longint): longint; external name ''$'';',
  11022. ' end;',
  11023. 'function dollar(k: longint): longint; external name ''$'';',
  11024. 'var Obj: TExtA;',
  11025. 'begin',
  11026. ' dollar(1);',
  11027. ' obj.id:=obj.id+2;',
  11028. ' obj.Bla(3);',
  11029. '']);
  11030. ConvertProgram;
  11031. CheckSource('TestExternalClass_Dollar',
  11032. LinesToStr([ // statements
  11033. 'this.Obj = null;',
  11034. '']),
  11035. LinesToStr([ // $mod.$main
  11036. '$(1);',
  11037. '$mod.Obj.$ = $mod.Obj.$ + 2;',
  11038. '$mod.Obj.$(3);',
  11039. '']));
  11040. end;
  11041. procedure TTestModule.TestExternalClass_DuplicateVarFail;
  11042. begin
  11043. StartProgram(false);
  11044. Add('{$modeswitch externalclass}');
  11045. Add('type');
  11046. Add(' TExtA = class external name ''ExtA''');
  11047. Add(' Id: longint external name ''$Id'';');
  11048. Add(' end;');
  11049. Add(' TExtB = class external ''lib'' name ''ExtB''(TExtA)');
  11050. Add(' Id: longint;');
  11051. Add(' end;');
  11052. Add('begin');
  11053. SetExpectedPasResolverError('Duplicate identifier "Id" at test1.pp(6,5)',nDuplicateIdentifier);
  11054. ConvertProgram;
  11055. end;
  11056. procedure TTestModule.TestExternalClass_Method;
  11057. begin
  11058. StartProgram(false);
  11059. Add('{$modeswitch externalclass}');
  11060. Add('type');
  11061. Add(' TExtA = class external name ''ExtObj''');
  11062. Add(' procedure DoIt(Id: longint = 1); external name ''$Execute'';');
  11063. Add(' procedure DoSome(Id: longint = 1);');
  11064. Add(' end;');
  11065. Add('var Obj: texta;');
  11066. Add('begin');
  11067. Add(' obj.doit;');
  11068. Add(' obj.doit();');
  11069. Add(' obj.doit(2);');
  11070. Add(' with obj do begin');
  11071. Add(' doit;');
  11072. Add(' doit();');
  11073. Add(' doit(3);');
  11074. Add(' end;');
  11075. ConvertProgram;
  11076. CheckSource('TestExternalClass_Method',
  11077. LinesToStr([ // statements
  11078. 'this.Obj = null;',
  11079. '']),
  11080. LinesToStr([ // $mod.$main
  11081. '$mod.Obj.$Execute(1);',
  11082. '$mod.Obj.$Execute(1);',
  11083. '$mod.Obj.$Execute(2);',
  11084. 'var $with1 = $mod.Obj;',
  11085. '$with1.$Execute(1);',
  11086. '$with1.$Execute(1);',
  11087. '$with1.$Execute(3);',
  11088. '']));
  11089. end;
  11090. procedure TTestModule.TestExternalClass_ClassMethod;
  11091. begin
  11092. StartProgram(false);
  11093. Add([
  11094. '{$modeswitch externalclass}',
  11095. 'type',
  11096. ' TExtA = class external name ''ExtObj''',
  11097. ' class procedure DoIt(Id: longint = 1); external name ''$Execute'';',
  11098. ' end;',
  11099. ' TExtB = TExtA;',
  11100. 'begin',
  11101. ' texta.doit;',
  11102. ' texta.doit();',
  11103. ' texta.doit(2);',
  11104. ' with texta do begin',
  11105. ' doit;',
  11106. ' doit();',
  11107. ' doit(3);',
  11108. ' end;',
  11109. ' textb.doit;',
  11110. ' textb.doit();',
  11111. ' textb.doit(4);',
  11112. ' with textb do begin',
  11113. ' doit;',
  11114. ' doit();',
  11115. ' doit(5);',
  11116. ' end;',
  11117. '']);
  11118. ConvertProgram;
  11119. CheckSource('TestExternalClass_ClassMethod',
  11120. LinesToStr([ // statements
  11121. '']),
  11122. LinesToStr([ // $mod.$main
  11123. 'ExtObj.$Execute(1);',
  11124. 'ExtObj.$Execute(1);',
  11125. 'ExtObj.$Execute(2);',
  11126. 'ExtObj.$Execute(1);',
  11127. 'ExtObj.$Execute(1);',
  11128. 'ExtObj.$Execute(3);',
  11129. 'ExtObj.$Execute(1);',
  11130. 'ExtObj.$Execute(1);',
  11131. 'ExtObj.$Execute(4);',
  11132. 'ExtObj.$Execute(1);',
  11133. 'ExtObj.$Execute(1);',
  11134. 'ExtObj.$Execute(5);',
  11135. '']));
  11136. end;
  11137. procedure TTestModule.TestExternalClass_NonExternalOverride;
  11138. begin
  11139. StartProgram(false);
  11140. Add('{$modeswitch externalclass}');
  11141. Add('type');
  11142. Add(' TExtA = class external name ''ExtObjA''');
  11143. Add(' procedure ProcA; virtual;');
  11144. Add(' procedure ProcB; virtual;');
  11145. Add(' end;');
  11146. Add(' TExtB = class external name ''ExtObjB'' (TExtA)');
  11147. Add(' end;');
  11148. Add(' TExtC = class (TExtB)');
  11149. Add(' procedure ProcA; override;');
  11150. Add(' end;');
  11151. Add('procedure TExtC.ProcA;');
  11152. Add('begin');
  11153. Add(' ProcA;');
  11154. Add(' Self.ProcA;');
  11155. Add(' ProcB;');
  11156. Add(' Self.ProcB;');
  11157. Add('end;');
  11158. Add('var');
  11159. Add(' A: texta;');
  11160. Add(' B: textb;');
  11161. Add(' C: textc;');
  11162. Add('begin');
  11163. Add(' a.proca;');
  11164. Add(' b.proca;');
  11165. Add(' c.proca;');
  11166. ConvertProgram;
  11167. CheckSource('TestExternalClass_NonExternalOverride',
  11168. LinesToStr([ // statements
  11169. 'rtl.createClassExt($mod, "TExtC", ExtObjB, "", function () {',
  11170. ' this.$init = function () {',
  11171. ' };',
  11172. ' this.$final = function () {',
  11173. ' };',
  11174. ' this.ProcA = function () {',
  11175. ' this.ProcA();',
  11176. ' this.ProcA();',
  11177. ' this.ProcB();',
  11178. ' this.ProcB();',
  11179. ' };',
  11180. '});',
  11181. 'this.A = null;',
  11182. 'this.B = null;',
  11183. 'this.C = null;',
  11184. '']),
  11185. LinesToStr([ // $mod.$main
  11186. '$mod.A.ProcA();',
  11187. '$mod.B.ProcA();',
  11188. '$mod.C.ProcA();',
  11189. '']));
  11190. end;
  11191. procedure TTestModule.TestExternalClass_Property;
  11192. begin
  11193. StartProgram(false);
  11194. Add('{$modeswitch externalclass}');
  11195. Add('type');
  11196. Add(' TExtA = class external name ''ExtA''');
  11197. Add(' function getYear: longint;');
  11198. Add(' procedure setYear(Value: longint);');
  11199. Add(' property Year: longint read getyear write setyear;');
  11200. Add(' end;');
  11201. Add(' TExtB = class (TExtA)');
  11202. Add(' procedure OtherSetYear(Value: longint);');
  11203. Add(' property year write othersetyear;');
  11204. Add(' end;');
  11205. Add('procedure textb.othersetyear(value: longint);');
  11206. Add('begin');
  11207. Add(' setYear(Value+4);');
  11208. Add('end;');
  11209. Add('var');
  11210. Add(' A: texta;');
  11211. Add(' B: textb;');
  11212. Add('begin');
  11213. Add(' a.year:=a.year+1;');
  11214. Add(' b.year:=b.year+2;');
  11215. ConvertProgram;
  11216. CheckSource('TestExternalClass_NonExternalOverride',
  11217. LinesToStr([ // statements
  11218. 'rtl.createClassExt($mod, "TExtB", ExtA, "", function () {',
  11219. ' this.$init = function () {',
  11220. ' };',
  11221. ' this.$final = function () {',
  11222. ' };',
  11223. ' this.OtherSetYear = function (Value) {',
  11224. ' this.setYear(Value+4);',
  11225. ' };',
  11226. '});',
  11227. 'this.A = null;',
  11228. 'this.B = null;',
  11229. '']),
  11230. LinesToStr([ // $mod.$main
  11231. '$mod.A.setYear($mod.A.getYear()+1);',
  11232. '$mod.B.OtherSetYear($mod.B.getYear()+2);',
  11233. '']));
  11234. end;
  11235. procedure TTestModule.TestExternalClass_ClassProperty;
  11236. begin
  11237. StartProgram(false);
  11238. Add('{$modeswitch externalclass}');
  11239. Add('type');
  11240. Add(' TExtA = class external name ''ExtA''');
  11241. Add(' class function getYear: longint;');
  11242. Add(' class procedure setYear(Value: longint);');
  11243. Add(' class property Year: longint read getyear write setyear;');
  11244. Add(' end;');
  11245. Add(' TExtB = class (TExtA)');
  11246. Add(' class function GetCentury: longint;');
  11247. Add(' class procedure SetCentury(Value: longint);');
  11248. Add(' class property Century: longint read getcentury write setcentury;');
  11249. Add(' end;');
  11250. Add('class function textb.getcentury: longint;');
  11251. Add('begin');
  11252. Add('end;');
  11253. Add('class procedure textb.setcentury(value: longint);');
  11254. Add('begin');
  11255. Add(' setyear(value+11);');
  11256. Add(' texta.year:=texta.year+12;');
  11257. Add(' year:=year+13;');
  11258. Add(' textb.century:=textb.century+14;');
  11259. Add(' century:=century+15;');
  11260. Add('end;');
  11261. Add('var');
  11262. Add(' A: texta;');
  11263. Add(' B: textb;');
  11264. Add('begin');
  11265. Add(' texta.year:=texta.year+1;');
  11266. Add(' textb.year:=textb.year+2;');
  11267. Add(' TextA.year:=TextA.year+3;');
  11268. Add(' b.year:=b.year+4;');
  11269. Add(' textb.century:=textb.century+5;');
  11270. Add(' b.century:=b.century+6;');
  11271. ConvertProgram;
  11272. CheckSource('TestExternalClass_ClassProperty',
  11273. LinesToStr([ // statements
  11274. 'rtl.createClassExt($mod, "TExtB", ExtA, "", function () {',
  11275. ' this.$init = function () {',
  11276. ' };',
  11277. ' this.$final = function () {',
  11278. ' };',
  11279. ' this.GetCentury = function () {',
  11280. ' var Result = 0;',
  11281. ' return Result;',
  11282. ' };',
  11283. ' this.SetCentury = function (Value) {',
  11284. ' this.setYear(Value + 11);',
  11285. ' ExtA.setYear(ExtA.getYear() + 12);',
  11286. ' this.setYear(this.getYear() + 13);',
  11287. ' $mod.TExtB.SetCentury($mod.TExtB.GetCentury() + 14);',
  11288. ' this.SetCentury(this.GetCentury() + 15);',
  11289. ' };',
  11290. '});',
  11291. 'this.A = null;',
  11292. 'this.B = null;',
  11293. '']),
  11294. LinesToStr([ // $mod.$main
  11295. 'ExtA.setYear(ExtA.getYear() + 1);',
  11296. '$mod.TExtB.setYear($mod.TExtB.getYear() + 2);',
  11297. 'ExtA.setYear(ExtA.getYear() + 3);',
  11298. '$mod.B.setYear($mod.B.getYear() + 4);',
  11299. '$mod.TExtB.SetCentury($mod.TExtB.GetCentury() + 5);',
  11300. '$mod.B.$class.SetCentury($mod.B.$class.GetCentury() + 6);',
  11301. '']));
  11302. end;
  11303. procedure TTestModule.TestExternalClass_ClassOf;
  11304. begin
  11305. StartProgram(false);
  11306. Add('{$modeswitch externalclass}');
  11307. Add('type');
  11308. Add(' TExtA = class external name ''ExtA''');
  11309. Add(' procedure ProcA; virtual;');
  11310. Add(' procedure ProcB; virtual;');
  11311. Add(' end;');
  11312. Add(' TExtAClass = class of TExtA;');
  11313. Add(' TExtB = class external name ''ExtB'' (TExtA)');
  11314. Add(' end;');
  11315. Add(' TExtBClass = class of TExtB;');
  11316. Add(' TExtC = class (TExtB)');
  11317. Add(' procedure ProcA; override;');
  11318. Add(' end;');
  11319. Add(' TExtCClass = class of TExtC;');
  11320. Add('procedure TExtC.ProcA; begin end;');
  11321. Add('var');
  11322. Add(' A: texta; ClA: TExtAClass;');
  11323. Add(' B: textb; ClB: TExtBClass;');
  11324. Add(' C: textc; ClC: TExtCClass;');
  11325. Add('begin');
  11326. Add(' ClA:=texta;');
  11327. Add(' ClA:=textb;');
  11328. Add(' ClA:=textc;');
  11329. Add(' ClB:=textb;');
  11330. Add(' ClB:=textc;');
  11331. Add(' ClC:=textc;');
  11332. ConvertProgram;
  11333. CheckSource('TestExternalClass_ClassOf',
  11334. LinesToStr([ // statements
  11335. 'rtl.createClassExt($mod, "TExtC", ExtB, "", function () {',
  11336. ' this.$init = function () {',
  11337. ' };',
  11338. ' this.$final = function () {',
  11339. ' };',
  11340. ' this.ProcA = function () {',
  11341. ' };',
  11342. '});',
  11343. 'this.A = null;',
  11344. 'this.ClA = null;',
  11345. 'this.B = null;',
  11346. 'this.ClB = null;',
  11347. 'this.C = null;',
  11348. 'this.ClC = null;',
  11349. '']),
  11350. LinesToStr([ // $mod.$main
  11351. '$mod.ClA = ExtA;',
  11352. '$mod.ClA = ExtB;',
  11353. '$mod.ClA = $mod.TExtC;',
  11354. '$mod.ClB = ExtB;',
  11355. '$mod.ClB = $mod.TExtC;',
  11356. '$mod.ClC = $mod.TExtC;',
  11357. '']));
  11358. end;
  11359. procedure TTestModule.TestExternalClass_ClassOtherUnit;
  11360. begin
  11361. AddModuleWithIntfImplSrc('unit2.pas',
  11362. LinesToStr([
  11363. '{$modeswitch externalclass}',
  11364. 'type',
  11365. ' TExtA = class external name ''ExtA''',
  11366. ' class var Id: longint;',
  11367. ' end;',
  11368. '']),
  11369. '');
  11370. StartUnit(true);
  11371. Add('interface');
  11372. Add('uses unit2;');
  11373. Add('implementation');
  11374. Add('begin');
  11375. Add(' unit2.texta.id:=unit2.texta.id+1;');
  11376. ConvertUnit;
  11377. CheckSource('TestExternalClass_ClassOtherUnit',
  11378. LinesToStr([
  11379. '']),
  11380. LinesToStr([
  11381. 'ExtA.Id = ExtA.Id + 1;',
  11382. '']));
  11383. end;
  11384. procedure TTestModule.TestExternalClass_Is;
  11385. begin
  11386. StartProgram(false);
  11387. Add('{$modeswitch externalclass}');
  11388. Add('type');
  11389. Add(' TExtA = class external name ''ExtA''');
  11390. Add(' end;');
  11391. Add(' TExtAClass = class of TExtA;');
  11392. Add(' TExtB = class external name ''ExtB'' (TExtA)');
  11393. Add(' end;');
  11394. Add(' TExtBClass = class of TExtB;');
  11395. Add(' TExtC = class (TExtB)');
  11396. Add(' end;');
  11397. Add(' TExtCClass = class of TExtC;');
  11398. Add('var');
  11399. Add(' A: texta; ClA: TExtAClass;');
  11400. Add(' B: textb; ClB: TExtBClass;');
  11401. Add(' C: textc; ClC: TExtCClass;');
  11402. Add('begin');
  11403. Add(' if a is textb then ;');
  11404. Add(' if a is textc then ;');
  11405. Add(' if b is textc then ;');
  11406. Add(' if cla is textb then ;');
  11407. Add(' if cla is textc then ;');
  11408. Add(' if clb is textc then ;');
  11409. ConvertProgram;
  11410. CheckSource('TestExternalClass_Is',
  11411. LinesToStr([ // statements
  11412. 'rtl.createClassExt($mod, "TExtC", ExtB, "", function () {',
  11413. ' this.$init = function () {',
  11414. ' };',
  11415. ' this.$final = function () {',
  11416. ' };',
  11417. '});',
  11418. 'this.A = null;',
  11419. 'this.ClA = null;',
  11420. 'this.B = null;',
  11421. 'this.ClB = null;',
  11422. 'this.C = null;',
  11423. 'this.ClC = null;',
  11424. '']),
  11425. LinesToStr([ // $mod.$main
  11426. 'if (rtl.isExt($mod.A, ExtB)) ;',
  11427. 'if ($mod.TExtC.isPrototypeOf($mod.A)) ;',
  11428. 'if ($mod.TExtC.isPrototypeOf($mod.B)) ;',
  11429. 'if (rtl.isExt($mod.ClA, ExtB)) ;',
  11430. 'if (rtl.is($mod.ClA, $mod.TExtC)) ;',
  11431. 'if (rtl.is($mod.ClB, $mod.TExtC)) ;',
  11432. '']));
  11433. end;
  11434. procedure TTestModule.TestExternalClass_As;
  11435. begin
  11436. StartProgram(false);
  11437. Add('{$modeswitch externalclass}');
  11438. Add('type');
  11439. Add(' TExtA = class external name ''ExtA''');
  11440. Add(' end;');
  11441. Add(' TExtB = class external name ''ExtB'' (TExtA)');
  11442. Add(' end;');
  11443. Add(' TExtC = class (TExtB)');
  11444. Add(' end;');
  11445. Add('var');
  11446. Add(' A: texta;');
  11447. Add(' B: textb;');
  11448. Add(' C: textc;');
  11449. Add('begin');
  11450. Add(' b:=a as textb;');
  11451. Add(' c:=a as textc;');
  11452. Add(' c:=b as textc;');
  11453. ConvertProgram;
  11454. CheckSource('TestExternalClass_Is',
  11455. LinesToStr([ // statements
  11456. 'rtl.createClassExt($mod, "TExtC", ExtB, "", function () {',
  11457. ' this.$init = function () {',
  11458. ' };',
  11459. ' this.$final = function () {',
  11460. ' };',
  11461. '});',
  11462. 'this.A = null;',
  11463. 'this.B = null;',
  11464. 'this.C = null;',
  11465. '']),
  11466. LinesToStr([ // $mod.$main
  11467. '$mod.B = rtl.asExt($mod.A, ExtB);',
  11468. '$mod.C = rtl.as($mod.A, $mod.TExtC);',
  11469. '$mod.C = rtl.as($mod.B, $mod.TExtC);',
  11470. '']));
  11471. end;
  11472. procedure TTestModule.TestExternalClass_DestructorFail;
  11473. begin
  11474. StartProgram(false);
  11475. Add('{$modeswitch externalclass}');
  11476. Add('type');
  11477. Add(' TExtA = class external name ''ExtA''');
  11478. Add(' destructor Free;');
  11479. Add(' end;');
  11480. SetExpectedPasResolverError('Pascal element not supported: destructor',
  11481. nPasElementNotSupported);
  11482. ConvertProgram;
  11483. end;
  11484. procedure TTestModule.TestExternalClass_New;
  11485. begin
  11486. StartProgram(false);
  11487. Add('{$modeswitch externalclass}');
  11488. Add('type');
  11489. Add(' TExtA = class external name ''ExtA''');
  11490. Add(' constructor New;');
  11491. Add(' constructor New(i: longint; j: longint = 2);');
  11492. Add(' end;');
  11493. Add('var');
  11494. Add(' A: texta;');
  11495. Add('begin');
  11496. Add(' a:=texta.new;');
  11497. Add(' a:=texta.new();');
  11498. Add(' a:=texta.new(1);');
  11499. Add(' with texta do begin');
  11500. Add(' a:=new;');
  11501. Add(' a:=new();');
  11502. Add(' a:=new(2);');
  11503. Add(' end;');
  11504. Add(' a:=test1.texta.new;');
  11505. Add(' a:=test1.texta.new();');
  11506. Add(' a:=test1.texta.new(3);');
  11507. ConvertProgram;
  11508. CheckSource('TestExternalClass_New',
  11509. LinesToStr([ // statements
  11510. 'this.A = null;',
  11511. '']),
  11512. LinesToStr([ // $mod.$main
  11513. '$mod.A = new ExtA();',
  11514. '$mod.A = new ExtA();',
  11515. '$mod.A = new ExtA(1,2);',
  11516. '$mod.A = new ExtA();',
  11517. '$mod.A = new ExtA();',
  11518. '$mod.A = new ExtA(2,2);',
  11519. '$mod.A = new ExtA();',
  11520. '$mod.A = new ExtA();',
  11521. '$mod.A = new ExtA(3,2);',
  11522. '']));
  11523. end;
  11524. procedure TTestModule.TestExternalClass_ClassOf_New;
  11525. begin
  11526. StartProgram(false);
  11527. Add('{$modeswitch externalclass}');
  11528. Add('type');
  11529. Add(' TExtAClass = class of TExtA;');
  11530. Add(' TExtA = class external name ''ExtA''');
  11531. Add(' constructor New;');
  11532. Add(' end;');
  11533. Add('var');
  11534. Add(' A: texta;');
  11535. Add(' C: textaclass;');
  11536. Add('begin');
  11537. Add(' a:=c.new;');
  11538. Add(' a:=c.new();');
  11539. Add(' with C do begin');
  11540. Add(' a:=new;');
  11541. Add(' a:=new();');
  11542. Add(' end;');
  11543. Add(' a:=test1.c.new;');
  11544. Add(' a:=test1.c.new();');
  11545. ConvertProgram;
  11546. CheckSource('TestExternalClass_ClassOf_New',
  11547. LinesToStr([ // statements
  11548. 'this.A = null;',
  11549. 'this.C = null;',
  11550. '']),
  11551. LinesToStr([ // $mod.$main
  11552. '$mod.A = new $mod.C();',
  11553. '$mod.A = new $mod.C();',
  11554. 'var $with1 = $mod.C;',
  11555. '$mod.A = new $with1();',
  11556. '$mod.A = new $with1();',
  11557. '$mod.A = new $mod.C();',
  11558. '$mod.A = new $mod.C();',
  11559. '']));
  11560. end;
  11561. procedure TTestModule.TestExternalClass_FuncClassOf_New;
  11562. begin
  11563. StartProgram(false);
  11564. Add('{$modeswitch externalclass}');
  11565. Add('type');
  11566. Add(' TExtAClass = class of TExtA;');
  11567. Add(' TExtA = class external name ''ExtA''');
  11568. Add(' constructor New;');
  11569. Add(' end;');
  11570. Add('function GetCreator: TExtAClass;');
  11571. Add('begin');
  11572. Add(' Result:=TExtA;');
  11573. Add('end;');
  11574. Add('var');
  11575. Add(' A: texta;');
  11576. Add('begin');
  11577. Add(' a:=getcreator.new;');
  11578. Add(' a:=getcreator().new;');
  11579. Add(' a:=getcreator().new();');
  11580. Add(' a:=getcreator.new();');
  11581. Add(' with getcreator do begin');
  11582. Add(' a:=new;');
  11583. Add(' a:=new();');
  11584. Add(' end;');
  11585. ConvertProgram;
  11586. CheckSource('TestExternalClass_FuncClassOf_New',
  11587. LinesToStr([ // statements
  11588. 'this.GetCreator = function () {',
  11589. ' var Result = null;',
  11590. ' Result = ExtA;',
  11591. ' return Result;',
  11592. '};',
  11593. 'this.A = null;',
  11594. '']),
  11595. LinesToStr([ // $mod.$main
  11596. '$mod.A = new ($mod.GetCreator())();',
  11597. '$mod.A = new ($mod.GetCreator())();',
  11598. '$mod.A = new ($mod.GetCreator())();',
  11599. '$mod.A = new ($mod.GetCreator())();',
  11600. 'var $with1 = $mod.GetCreator();',
  11601. '$mod.A = new $with1();',
  11602. '$mod.A = new $with1();',
  11603. '']));
  11604. end;
  11605. procedure TTestModule.TestExternalClass_LocalConstSameName;
  11606. begin
  11607. StartProgram(false);
  11608. Add('{$modeswitch externalclass}');
  11609. Add('type');
  11610. Add(' TExtA = class external name ''ExtA''');
  11611. Add(' constructor New;');
  11612. Add(' end;');
  11613. Add('function DoIt: longint;');
  11614. Add('const ExtA: longint = 3;');
  11615. Add('begin');
  11616. Add(' Result:=ExtA;');
  11617. Add('end;');
  11618. Add('var');
  11619. Add(' A: texta;');
  11620. Add('begin');
  11621. Add(' a:=texta.new;');
  11622. ConvertProgram;
  11623. CheckSource('TestExternalClass_LocalConstSameName',
  11624. LinesToStr([ // statements
  11625. 'var ExtA$1 = 3;',
  11626. 'this.DoIt = function () {',
  11627. ' var Result = 0;',
  11628. ' Result = ExtA$1;',
  11629. ' return Result;',
  11630. '};',
  11631. 'this.A = null;',
  11632. '']),
  11633. LinesToStr([ // $mod.$main
  11634. '$mod.A = new ExtA();',
  11635. '']));
  11636. end;
  11637. procedure TTestModule.TestExternalClass_ReintroduceOverload;
  11638. begin
  11639. StartProgram(false);
  11640. Add('{$modeswitch externalclass}');
  11641. Add('type');
  11642. Add(' TExtA = class external name ''ExtA''');
  11643. Add(' procedure DoIt;');
  11644. Add(' end;');
  11645. Add(' TMyA = class(TExtA)');
  11646. Add(' procedure DoIt;');
  11647. Add(' end;');
  11648. Add('procedure TMyA.DoIt; begin end;');
  11649. Add('begin');
  11650. ConvertProgram;
  11651. CheckSource('TestExternalClass_ReintroduceOverload',
  11652. LinesToStr([ // statements
  11653. 'rtl.createClassExt($mod, "TMyA", ExtA, "", function () {',
  11654. ' this.$init = function () {',
  11655. ' };',
  11656. ' this.$final = function () {',
  11657. ' };',
  11658. ' this.DoIt$1 = function () {',
  11659. ' };',
  11660. '});',
  11661. '']),
  11662. LinesToStr([ // $mod.$main
  11663. '']));
  11664. end;
  11665. procedure TTestModule.TestExternalClass_Inherited;
  11666. begin
  11667. StartProgram(false);
  11668. Add('{$modeswitch externalclass}');
  11669. Add('type');
  11670. Add(' TExtA = class external name ''ExtA''');
  11671. Add(' procedure DoIt(i: longint = 1); virtual;');
  11672. Add(' procedure DoSome(j: longint = 2);');
  11673. Add(' end;');
  11674. Add(' TExtB = class external name ''ExtB''(TExtA)');
  11675. Add(' end;');
  11676. Add(' TMyC = class(TExtB)');
  11677. Add(' procedure DoIt(i: longint = 1); override;');
  11678. Add(' procedure DoSome(j: longint = 2); reintroduce;');
  11679. Add(' end;');
  11680. Add('procedure TMyC.DoIt(i: longint);');
  11681. Add('begin');
  11682. Add(' inherited;');
  11683. Add(' inherited DoIt;');
  11684. Add(' inherited DoIt();');
  11685. Add(' inherited DoIt(3);');
  11686. Add(' inherited DoSome;');
  11687. Add(' inherited DoSome();');
  11688. Add(' inherited DoSome(4);');
  11689. Add('end;');
  11690. Add('procedure TMyC.DoSome(j: longint);');
  11691. Add('begin');
  11692. Add(' inherited;');
  11693. Add('end;');
  11694. Add('begin');
  11695. ConvertProgram;
  11696. CheckSource('TestExternalClass_ReintroduceOverload',
  11697. LinesToStr([ // statements
  11698. 'rtl.createClassExt($mod, "TMyC", ExtB, "", function () {',
  11699. ' this.$init = function () {',
  11700. ' };',
  11701. ' this.$final = function () {',
  11702. ' };',
  11703. ' this.DoIt = function (i) {',
  11704. ' ExtB.DoIt.apply(this, arguments);',
  11705. ' ExtB.DoIt.call(this, 1);',
  11706. ' ExtB.DoIt.call(this, 1);',
  11707. ' ExtB.DoIt.call(this, 3);',
  11708. ' ExtB.DoSome.call(this, 2);',
  11709. ' ExtB.DoSome.call(this, 2);',
  11710. ' ExtB.DoSome.call(this, 4);',
  11711. ' };',
  11712. ' this.DoSome$1 = function (j) {',
  11713. ' ExtB.DoSome.apply(this, arguments);',
  11714. ' };',
  11715. '});',
  11716. '']),
  11717. LinesToStr([ // $mod.$main
  11718. '']));
  11719. end;
  11720. procedure TTestModule.TestExternalClass_PascalAncestorFail;
  11721. begin
  11722. StartProgram(false);
  11723. Add('{$modeswitch externalclass}');
  11724. Add('type');
  11725. Add(' TObject = class');
  11726. Add(' end;');
  11727. Add(' TExtA = class external name ''ExtA''(TObject)');
  11728. Add(' end;');
  11729. Add('begin');
  11730. SetExpectedPasResolverError('Ancestor "TObject" is not external',nAncestorIsNotExternal);
  11731. ConvertProgram;
  11732. end;
  11733. procedure TTestModule.TestExternalClass_NewInstance;
  11734. begin
  11735. StartProgram(false);
  11736. Add('{$modeswitch externalclass}');
  11737. Add('type');
  11738. Add(' TExtA = class external name ''ExtA''');
  11739. Add(' end;');
  11740. Add(' TMyB = class(TExtA)');
  11741. Add(' protected');
  11742. Add(' class function NewInstance(fnname: string; const paramarray): TMyB; virtual;');
  11743. Add(' end;');
  11744. Add('class function TMyB.NewInstance(fnname: string; const paramarray): TMyB;');
  11745. Add('begin end;');
  11746. Add('begin');
  11747. ConvertProgram;
  11748. CheckSource('TestExternalClass_NewInstance',
  11749. LinesToStr([ // statements
  11750. 'rtl.createClassExt($mod, "TMyB", ExtA, "NewInstance", function () {',
  11751. ' this.$init = function () {',
  11752. ' };',
  11753. ' this.$final = function () {',
  11754. ' };',
  11755. ' this.NewInstance = function (fnname, paramarray) {',
  11756. ' var Result = null;',
  11757. ' return Result;',
  11758. ' };',
  11759. '});',
  11760. '']),
  11761. LinesToStr([ // $mod.$main
  11762. '']));
  11763. end;
  11764. procedure TTestModule.TestExternalClass_NewInstance_NonVirtualFail;
  11765. begin
  11766. StartProgram(false);
  11767. Add('{$modeswitch externalclass}');
  11768. Add('type');
  11769. Add(' TExtA = class external name ''ExtA''');
  11770. Add(' end;');
  11771. Add(' TMyB = class(TExtA)');
  11772. Add(' protected');
  11773. Add(' class function NewInstance(fnname: string; const paramarray): TMyB;');
  11774. Add(' end;');
  11775. Add('class function TMyB.NewInstance(fnname: string; const paramarray): TMyB;');
  11776. Add('begin end;');
  11777. Add('begin');
  11778. SetExpectedPasResolverError(sNewInstanceFunctionMustBeVirtual,nNewInstanceFunctionMustBeVirtual);
  11779. ConvertProgram;
  11780. end;
  11781. procedure TTestModule.TestExternalClass_NewInstance_FirstParamNotString_Fail;
  11782. begin
  11783. StartProgram(false);
  11784. Add('{$modeswitch externalclass}');
  11785. Add('type');
  11786. Add(' TExtA = class external name ''ExtA''');
  11787. Add(' end;');
  11788. Add(' TMyB = class(TExtA)');
  11789. Add(' protected');
  11790. Add(' class function NewInstance(fnname: longint; const paramarray): TMyB; virtual;');
  11791. Add(' end;');
  11792. Add('class function TMyB.NewInstance(fnname: longint; const paramarray): TMyB;');
  11793. Add('begin end;');
  11794. Add('begin');
  11795. SetExpectedPasResolverError('Incompatible type arg no. 1: Got "Longint", expected "String"',
  11796. nIncompatibleTypeArgNo);
  11797. ConvertProgram;
  11798. end;
  11799. procedure TTestModule.TestExternalClass_NewInstance_SecondParamTyped_Fail;
  11800. begin
  11801. StartProgram(false);
  11802. Add('{$modeswitch externalclass}');
  11803. Add('type');
  11804. Add(' TExtA = class external name ''ExtA''');
  11805. Add(' end;');
  11806. Add(' TMyB = class(TExtA)');
  11807. Add(' protected');
  11808. Add(' class function NewInstance(fnname: string; const paramarray: string): TMyB; virtual;');
  11809. Add(' end;');
  11810. Add('class function TMyB.NewInstance(fnname: string; const paramarray: string): TMyB;');
  11811. Add('begin end;');
  11812. Add('begin');
  11813. SetExpectedPasResolverError('Incompatible type arg no. 2: Got "type", expected "untyped"',
  11814. nIncompatibleTypeArgNo);
  11815. ConvertProgram;
  11816. end;
  11817. procedure TTestModule.TestExternalClass_PascalProperty;
  11818. begin
  11819. StartProgram(false);
  11820. Add('{$modeswitch externalclass}');
  11821. Add('type');
  11822. Add(' TJSElement = class;');
  11823. Add(' TJSNotifyEvent = procedure(Sender: TJSElement) of object;');
  11824. Add(' TJSElement = class external name ''ExtA''');
  11825. Add(' end;');
  11826. Add(' TControl = class(TJSElement)');
  11827. Add(' private');
  11828. Add(' FOnClick: TJSNotifyEvent;');
  11829. Add(' property OnClick: TJSNotifyEvent read FOnClick write FOnClick;');
  11830. Add(' procedure Click(Sender: TJSElement);');
  11831. Add(' end;');
  11832. Add('procedure TControl.Click(Sender: TJSElement);');
  11833. Add('begin');
  11834. Add(' OnClick(Self);');
  11835. Add('end;');
  11836. Add('var');
  11837. Add(' Ctrl: TControl;');
  11838. Add('begin');
  11839. Add(' Ctrl.OnClick:[email protected];');
  11840. Add(' Ctrl.OnClick(Ctrl);');
  11841. ConvertProgram;
  11842. CheckSource('TestExternalClass_PascalProperty',
  11843. LinesToStr([ // statements
  11844. 'rtl.createClassExt($mod, "TControl", ExtA, "", function () {',
  11845. ' this.$init = function () {',
  11846. ' this.FOnClick = null;',
  11847. ' };',
  11848. ' this.$final = function () {',
  11849. ' this.FOnClick = undefined;',
  11850. ' };',
  11851. ' this.Click = function (Sender) {',
  11852. ' this.FOnClick(this);',
  11853. ' };',
  11854. '});',
  11855. 'this.Ctrl = null;',
  11856. '']),
  11857. LinesToStr([ // $mod.$main
  11858. '$mod.Ctrl.FOnClick = rtl.createCallback($mod.Ctrl, "Click");',
  11859. '$mod.Ctrl.FOnClick($mod.Ctrl);',
  11860. '']));
  11861. end;
  11862. procedure TTestModule.TestExternalClass_TypeCastToRootClass;
  11863. begin
  11864. StartProgram(false);
  11865. Add([
  11866. '{$modeswitch externalclass}',
  11867. 'type',
  11868. ' IUnknown = interface end;',
  11869. ' TObject = class',
  11870. ' end;',
  11871. ' TChild = class',
  11872. ' end;',
  11873. ' TExtRootA = class external name ''ExtRootA''',
  11874. ' end;',
  11875. ' TExtChildA = class external name ''ExtChildA''(TExtRootA)',
  11876. ' end;',
  11877. ' TExtRootB = class external name ''ExtRootB''',
  11878. ' end;',
  11879. ' TExtChildB = class external name ''ExtChildB''(TExtRootB)',
  11880. ' end;',
  11881. 'var',
  11882. ' Obj: TObject;',
  11883. ' Child: TChild;',
  11884. ' RootA: TExtRootA;',
  11885. ' ChildA: TExtChildA;',
  11886. ' RootB: TExtRootB;',
  11887. ' ChildB: TExtChildB;',
  11888. ' i: IUnknown;',
  11889. 'begin',
  11890. ' obj:=tobject(roota);',
  11891. ' obj:=tobject(childa);',
  11892. ' child:=tchild(tobject(roota));',
  11893. ' roota:=textroota(obj);',
  11894. ' roota:=textroota(child);',
  11895. ' roota:=textroota(rootb);',
  11896. ' roota:=textroota(childb);',
  11897. ' childa:=textchilda(textroota(obj));',
  11898. ' roota:=TExtRootA(i)',
  11899. '']);
  11900. ConvertProgram;
  11901. CheckSource('TestExternalClass_TypeCastToRootClass',
  11902. LinesToStr([ // statements
  11903. 'rtl.createInterface($mod, "IUnknown", "{5D22E7CA-4E00-3000-8000-000000000000}", [], null);',
  11904. 'rtl.createClass($mod, "TObject", null, function () {',
  11905. ' this.$init = function () {',
  11906. ' };',
  11907. ' this.$final = function () {',
  11908. ' };',
  11909. '});',
  11910. 'rtl.createClass($mod, "TChild", $mod.TObject, function () {',
  11911. '});',
  11912. 'this.Obj = null;',
  11913. 'this.Child = null;',
  11914. 'this.RootA = null;',
  11915. 'this.ChildA = null;',
  11916. 'this.RootB = null;',
  11917. 'this.ChildB = null;',
  11918. 'this.i = null;',
  11919. '']),
  11920. LinesToStr([ // $mod.$main
  11921. '$mod.Obj = $mod.RootA;',
  11922. '$mod.Obj = $mod.ChildA;',
  11923. '$mod.Child = $mod.RootA;',
  11924. '$mod.RootA = $mod.Obj;',
  11925. '$mod.RootA = $mod.Child;',
  11926. '$mod.RootA = $mod.RootB;',
  11927. '$mod.RootA = $mod.ChildB;',
  11928. '$mod.ChildA = $mod.Obj;',
  11929. '$mod.RootA = $mod.i;',
  11930. '']));
  11931. end;
  11932. procedure TTestModule.TestExternalClass_TypeCastToJSObject;
  11933. begin
  11934. StartProgram(false);
  11935. Add([
  11936. '{$modeswitch externalclass}',
  11937. 'type',
  11938. ' IUnknown = interface end;',
  11939. ' IBird = interface(IUnknown) end;',
  11940. ' TClass = class of TObject;',
  11941. ' TObject = class',
  11942. ' end;',
  11943. ' TChild = class',
  11944. ' end;',
  11945. ' TJSObject = class external name ''Object''',
  11946. ' end;',
  11947. ' TRec = record end;',
  11948. 'var',
  11949. ' Obj: TObject;',
  11950. ' Child: TChild;',
  11951. ' i: IUnknown;',
  11952. ' Bird: IBird;',
  11953. ' j: TJSObject;',
  11954. ' r: TRec;',
  11955. ' c: TClass;',
  11956. 'begin',
  11957. ' j:=tjsobject(IUnknown);',
  11958. ' j:=tjsobject(IBird);',
  11959. ' j:=tjsobject(TObject);',
  11960. ' j:=tjsobject(TChild);',
  11961. ' j:=tjsobject(TRec);',
  11962. ' j:=tjsobject(Obj);',
  11963. ' j:=tjsobject(Child);',
  11964. ' j:=tjsobject(i);',
  11965. ' j:=tjsobject(Bird);',
  11966. ' j:=tjsobject(r);',
  11967. ' j:=tjsobject(c);',
  11968. '']);
  11969. ConvertProgram;
  11970. CheckSource('TestExternalClass_TypeCastToJSObject',
  11971. LinesToStr([ // statements
  11972. 'rtl.createInterface($mod, "IUnknown", "{5D22E7CA-4E00-3000-8000-000000000000}", [], null);',
  11973. 'rtl.createInterface($mod, "IBird", "{48E3FF4A-AF76-3465-A738-D462ECC63074}", [], $mod.IUnknown);',
  11974. 'rtl.createClass($mod, "TObject", null, function () {',
  11975. ' this.$init = function () {',
  11976. ' };',
  11977. ' this.$final = function () {',
  11978. ' };',
  11979. '});',
  11980. 'rtl.createClass($mod, "TChild", $mod.TObject, function () {',
  11981. '});',
  11982. 'this.TRec = function (s) {',
  11983. ' this.$equal = function (b) {',
  11984. ' return true;',
  11985. ' };',
  11986. '};',
  11987. 'this.Obj = null;',
  11988. 'this.Child = null;',
  11989. 'this.i = null;',
  11990. 'this.Bird = null;',
  11991. 'this.j = null;',
  11992. 'this.r = new $mod.TRec();',
  11993. 'this.c = null;',
  11994. '']),
  11995. LinesToStr([ // $mod.$main
  11996. '$mod.j = $mod.IUnknown;',
  11997. '$mod.j = $mod.IBird;',
  11998. '$mod.j = $mod.TObject;',
  11999. '$mod.j = $mod.TChild;',
  12000. '$mod.j = $mod.TRec;',
  12001. '$mod.j = $mod.Obj;',
  12002. '$mod.j = $mod.Child;',
  12003. '$mod.j = $mod.i;',
  12004. '$mod.j = $mod.Bird;',
  12005. '$mod.j = $mod.r;',
  12006. '$mod.j = $mod.c;',
  12007. '']));
  12008. end;
  12009. procedure TTestModule.TestExternalClass_TypeCastStringToExternalString;
  12010. begin
  12011. StartProgram(false);
  12012. Add('{$modeswitch externalclass}');
  12013. Add('type');
  12014. Add(' TJSString = class external name ''String''');
  12015. Add(' class function fromCharCode() : string; varargs;');
  12016. Add(' function anchor(const aName : string) : string;');
  12017. Add(' end;');
  12018. Add('var');
  12019. Add(' s: string;');
  12020. Add('begin');
  12021. Add(' s:=TJSString.fromCharCode(65,66);');
  12022. Add(' s:=TJSString(s).anchor(s);');
  12023. Add(' s:=TJSString(''foo'').anchor(s);');
  12024. ConvertProgram;
  12025. CheckSource('TestExternalClass_TypeCastStringToExternalString',
  12026. LinesToStr([ // statements
  12027. 'this.s = "";',
  12028. '']),
  12029. LinesToStr([ // $mod.$main
  12030. '$mod.s = String.fromCharCode(65, 66);',
  12031. '$mod.s = $mod.s.anchor($mod.s);',
  12032. '$mod.s = "foo".anchor($mod.s);',
  12033. '']));
  12034. end;
  12035. procedure TTestModule.TestExternalClass_CallClassFunctionOfInstanceFail;
  12036. begin
  12037. StartProgram(false);
  12038. Add('{$modeswitch externalclass}');
  12039. Add('type');
  12040. Add(' TJSString = class external name ''String''');
  12041. Add(' class function fromCharCode() : string; varargs;');
  12042. Add(' end;');
  12043. Add('var');
  12044. Add(' s: string;');
  12045. Add(' sObj: TJSString;');
  12046. Add('begin');
  12047. Add(' s:=sObj.fromCharCode(65,66);');
  12048. SetExpectedPasResolverError('External class instance cannot access static class function fromCharCode',
  12049. nExternalClassInstanceCannotAccessStaticX);
  12050. ConvertProgram;
  12051. end;
  12052. procedure TTestModule.TestExternalClass_BracketAccessor;
  12053. begin
  12054. StartProgram(false);
  12055. Add('{$modeswitch externalclass}');
  12056. Add('type');
  12057. Add(' TJSArray = class external name ''Array2''');
  12058. Add(' function GetItems(Index: longint): jsvalue; external name ''[]'';');
  12059. Add(' procedure SetItems(Index: longint; Value: jsvalue); external name ''[]'';');
  12060. Add(' property Items[Index: longint]: jsvalue read GetItems write SetItems; default;');
  12061. Add(' end;');
  12062. Add('procedure DoIt(vI: JSValue; const vJ: jsvalue; var vK: jsvalue; out vL: jsvalue);');
  12063. Add('begin end;');
  12064. Add('var');
  12065. Add(' Arr: tjsarray;');
  12066. Add(' s: string;');
  12067. Add(' i: longint;');
  12068. Add(' v: jsvalue;');
  12069. Add('begin');
  12070. Add(' v:=arr[0];');
  12071. Add(' v:=arr.items[1];');
  12072. Add(' arr[2]:=s;');
  12073. Add(' arr.items[3]:=s;');
  12074. Add(' arr[4]:=i;');
  12075. Add(' arr[5]:=arr[6];');
  12076. Add(' arr.items[7]:=arr.items[8];');
  12077. Add(' with arr do items[9]:=items[10];');
  12078. Add(' doit(arr[7],arr[8],arr[9],arr[10]);');
  12079. ConvertProgram;
  12080. CheckSource('TestExternalClass_BracketAccessor',
  12081. LinesToStr([ // statements
  12082. 'this.DoIt = function (vI, vJ, vK, vL) {',
  12083. '};',
  12084. 'this.Arr = null;',
  12085. 'this.s = "";',
  12086. 'this.i = 0;',
  12087. 'this.v = undefined;',
  12088. '']),
  12089. LinesToStr([ // $mod.$main
  12090. '$mod.v = $mod.Arr[0];',
  12091. '$mod.v = $mod.Arr[1];',
  12092. '$mod.Arr[2] = $mod.s;',
  12093. '$mod.Arr[3] = $mod.s;',
  12094. '$mod.Arr[4] = $mod.i;',
  12095. '$mod.Arr[5] = $mod.Arr[6];',
  12096. '$mod.Arr[7] = $mod.Arr[8];',
  12097. 'var $with1 = $mod.Arr;',
  12098. '$with1[9] = $with1[10];',
  12099. '$mod.DoIt($mod.Arr[7], $mod.Arr[8], {',
  12100. ' a: 9,',
  12101. ' p: $mod.Arr,',
  12102. ' get: function () {',
  12103. ' return this.p[this.a];',
  12104. ' },',
  12105. ' set: function (v) {',
  12106. ' this.p[this.a] = v;',
  12107. ' }',
  12108. '}, {',
  12109. ' a: 10,',
  12110. ' p: $mod.Arr,',
  12111. ' get: function () {',
  12112. ' return this.p[this.a];',
  12113. ' },',
  12114. ' set: function (v) {',
  12115. ' this.p[this.a] = v;',
  12116. ' }',
  12117. '});',
  12118. '']));
  12119. end;
  12120. procedure TTestModule.TestExternalClass_BracketAccessor_2ParamsFail;
  12121. begin
  12122. StartProgram(false);
  12123. Add('{$modeswitch externalclass}');
  12124. Add('type');
  12125. Add(' TJSArray = class external name ''Array2''');
  12126. Add(' function GetItems(Index1, Index2: longint): jsvalue; external name ''[]'';');
  12127. Add(' procedure SetItems(Index1, Index2: longint; Value: jsvalue); external name ''[]'';');
  12128. Add(' property Items[Index1, Index2: longint]: jsvalue read GetItems write SetItems; default;');
  12129. Add(' end;');
  12130. Add('begin');
  12131. SetExpectedPasResolverError(sBracketAccessorOfExternalClassMustHaveOneParameter,
  12132. nBracketAccessorOfExternalClassMustHaveOneParameter);
  12133. ConvertProgram;
  12134. end;
  12135. procedure TTestModule.TestExternalClass_BracketAccessor_ReadOnly;
  12136. begin
  12137. StartProgram(false);
  12138. Add('{$modeswitch externalclass}');
  12139. Add('type');
  12140. Add(' TJSArray = class external name ''Array2''');
  12141. Add(' function GetItems(Index: longint): jsvalue; external name ''[]'';');
  12142. Add(' property Items[Index: longint]: jsvalue read GetItems; default;');
  12143. Add(' end;');
  12144. Add('procedure DoIt(vI: JSValue; const vJ: jsvalue);');
  12145. Add('begin end;');
  12146. Add('var');
  12147. Add(' Arr: tjsarray;');
  12148. Add(' v: jsvalue;');
  12149. Add('begin');
  12150. Add(' v:=arr[0];');
  12151. Add(' v:=arr.items[1];');
  12152. Add(' with arr do v:=items[2];');
  12153. Add(' doit(arr[3],arr[4]);');
  12154. ConvertProgram;
  12155. CheckSource('TestExternalClass_BracketAccessor_ReadOnly',
  12156. LinesToStr([ // statements
  12157. 'this.DoIt = function (vI, vJ) {',
  12158. '};',
  12159. 'this.Arr = null;',
  12160. 'this.v = undefined;',
  12161. '']),
  12162. LinesToStr([ // $mod.$main
  12163. '$mod.v = $mod.Arr[0];',
  12164. '$mod.v = $mod.Arr[1];',
  12165. 'var $with1 = $mod.Arr;',
  12166. '$mod.v = $with1[2];',
  12167. '$mod.DoIt($mod.Arr[3], $mod.Arr[4]);',
  12168. '']));
  12169. end;
  12170. procedure TTestModule.TestExternalClass_BracketAccessor_WriteOnly;
  12171. begin
  12172. StartProgram(false);
  12173. Add('{$modeswitch externalclass}');
  12174. Add('type');
  12175. Add(' TJSArray = class external name ''Array2''');
  12176. Add(' procedure SetItems(Index: longint; Value: jsvalue); external name ''[]'';');
  12177. Add(' property Items[Index: longint]: jsvalue write SetItems; default;');
  12178. Add(' end;');
  12179. Add('var');
  12180. Add(' Arr: tjsarray;');
  12181. Add(' s: string;');
  12182. Add(' i: longint;');
  12183. Add(' v: jsvalue;');
  12184. Add('begin');
  12185. Add(' arr[2]:=s;');
  12186. Add(' arr.items[3]:=s;');
  12187. Add(' arr[4]:=i;');
  12188. Add(' with arr do items[5]:=i;');
  12189. ConvertProgram;
  12190. CheckSource('TestExternalClass_BracketAccessor_WriteOnly',
  12191. LinesToStr([ // statements
  12192. 'this.Arr = null;',
  12193. 'this.s = "";',
  12194. 'this.i = 0;',
  12195. 'this.v = undefined;',
  12196. '']),
  12197. LinesToStr([ // $mod.$main
  12198. '$mod.Arr[2] = $mod.s;',
  12199. '$mod.Arr[3] = $mod.s;',
  12200. '$mod.Arr[4] = $mod.i;',
  12201. 'var $with1 = $mod.Arr;',
  12202. '$with1[5] = $mod.i;',
  12203. '']));
  12204. end;
  12205. procedure TTestModule.TestExternalClass_BracketAccessor_MultiType;
  12206. begin
  12207. StartProgram(false);
  12208. Add('{$modeswitch externalclass}');
  12209. Add('type');
  12210. Add(' TJSArray = class external name ''Array2''');
  12211. Add(' procedure SetItems(Index: longint; Value: jsvalue); external name ''[]'';');
  12212. Add(' property Items[Index: longint]: jsvalue write SetItems; default;');
  12213. Add(' procedure SetNumbers(Index: longint; Value: longint); external name ''[]'';');
  12214. Add(' property Numbers[Index: longint]: longint write SetNumbers;');
  12215. Add(' end;');
  12216. Add('var');
  12217. Add(' Arr: tjsarray;');
  12218. Add(' s: string;');
  12219. Add(' i: longint;');
  12220. Add(' v: jsvalue;');
  12221. Add('begin');
  12222. Add(' arr[2]:=s;');
  12223. Add(' arr.items[3]:=s;');
  12224. Add(' arr.numbers[4]:=i;');
  12225. Add(' with arr do items[5]:=i;');
  12226. Add(' with arr do numbers[6]:=i;');
  12227. ConvertProgram;
  12228. CheckSource('TestExternalClass_BracketAccessor_MultiType',
  12229. LinesToStr([ // statements
  12230. 'this.Arr = null;',
  12231. 'this.s = "";',
  12232. 'this.i = 0;',
  12233. 'this.v = undefined;',
  12234. '']),
  12235. LinesToStr([ // $mod.$main
  12236. '$mod.Arr[2] = $mod.s;',
  12237. '$mod.Arr[3] = $mod.s;',
  12238. '$mod.Arr[4] = $mod.i;',
  12239. 'var $with1 = $mod.Arr;',
  12240. '$with1[5] = $mod.i;',
  12241. 'var $with2 = $mod.Arr;',
  12242. '$with2[6] = $mod.i;',
  12243. '']));
  12244. end;
  12245. procedure TTestModule.TestExternalClass_BracketAccessor_Index;
  12246. begin
  12247. StartProgram(false);
  12248. Add('{$modeswitch externalclass}');
  12249. Add('type');
  12250. Add(' TJSArray = class external name ''Array2''');
  12251. Add(' function GetItems(Index: longint): jsvalue; external name ''[]'';');
  12252. Add(' procedure SetItems(Index: longint; Value: jsvalue); external name ''[]'';');
  12253. Add(' property Items[Index: longint]: jsvalue read GetItems write SetItems; default;');
  12254. Add(' end;');
  12255. Add('var');
  12256. Add(' Arr: tjsarray;');
  12257. Add(' i: longint;');
  12258. Add(' IntArr: array of longint;');
  12259. Add(' v: jsvalue;');
  12260. Add('begin');
  12261. Add(' v:=arr.items[i];');
  12262. Add(' arr[longint(v)]:=arr.items[intarr[0]];');
  12263. Add(' arr.items[intarr[1]]:=arr[IntArr[2]];');
  12264. ConvertProgram;
  12265. CheckSource('TestExternalClass_BracketAccessor_Index',
  12266. LinesToStr([ // statements
  12267. 'this.Arr = null;',
  12268. 'this.i = 0;',
  12269. 'this.IntArr = [];',
  12270. 'this.v = undefined;',
  12271. '']),
  12272. LinesToStr([ // $mod.$main
  12273. '$mod.v = $mod.Arr[$mod.i];',
  12274. '$mod.Arr[Math.floor($mod.v)] = $mod.Arr[$mod.IntArr[0]];',
  12275. '$mod.Arr[$mod.IntArr[1]] = $mod.Arr[$mod.IntArr[2]];',
  12276. '']));
  12277. end;
  12278. procedure TTestModule.TestExternalClass_ForInJSObject;
  12279. begin
  12280. StartProgram(false);
  12281. Add([
  12282. '{$modeswitch externalclass}',
  12283. 'type',
  12284. ' TJSObject = class external name ''Object''',
  12285. ' end;',
  12286. 'var',
  12287. ' o: TJSObject;',
  12288. ' key: string;',
  12289. 'begin',
  12290. ' for key in o do',
  12291. ' if key=''abc'' then ;',
  12292. '']);
  12293. ConvertProgram;
  12294. CheckSource('TestExternalClass_ForInJSObject',
  12295. LinesToStr([ // statements
  12296. 'this.o = null;',
  12297. 'this.key = "";',
  12298. '']),
  12299. LinesToStr([ // $mod.$main
  12300. 'for ($mod.key in $mod.o) if ($mod.key === "abc") ;',
  12301. '']));
  12302. end;
  12303. procedure TTestModule.TestClassInterface_Corba;
  12304. begin
  12305. StartProgram(false);
  12306. Add([
  12307. '{$interfaces corba}',
  12308. 'type',
  12309. ' IUnknown = interface;',
  12310. ' IUnknown = interface',
  12311. ' [''{00000000-0000-0000-C000-000000000046}'']',
  12312. ' end;',
  12313. ' IInterface = IUnknown;',
  12314. ' IBird = interface(IInterface)',
  12315. ' function GetSize: longint;',
  12316. ' procedure SetSize(i: longint);',
  12317. ' property Size: longint read GetSize write SetSize;',
  12318. ' procedure DoIt(i: longint);',
  12319. ' end;',
  12320. ' TObject = class',
  12321. ' end;',
  12322. ' TBird = class(TObject,IBird)',
  12323. ' function GetSize: longint; virtual; abstract;',
  12324. ' procedure SetSize(i: longint); virtual; abstract;',
  12325. ' procedure DoIt(i: longint); virtual; abstract;',
  12326. ' end;',
  12327. 'var',
  12328. ' BirdIntf: IBird;',
  12329. 'begin',
  12330. ' BirdIntf.Size:=BirdIntf.Size;',
  12331. '']);
  12332. ConvertProgram;
  12333. CheckSource('TestClassInterface_Corba',
  12334. LinesToStr([ // statements
  12335. 'rtl.createInterface($mod, "IUnknown", "{00000000-0000-0000-C000-000000000046}", [], null);',
  12336. 'rtl.createInterface($mod, "IBird", "{B0AF836B-4E58-31BA-A735-D744B6DAA205}", ["GetSize", "SetSize", "DoIt"], $mod.IUnknown);',
  12337. 'rtl.createClass($mod, "TObject", null, function () {',
  12338. ' this.$init = function () {',
  12339. ' };',
  12340. ' this.$final = function () {',
  12341. ' };',
  12342. '});',
  12343. 'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
  12344. ' this.$intfmaps = {};',
  12345. ' rtl.addIntf(this, $mod.IBird);',
  12346. '});',
  12347. 'this.BirdIntf = null;',
  12348. '']),
  12349. LinesToStr([ // $mod.$main
  12350. ' $mod.BirdIntf.SetSize($mod.BirdIntf.GetSize());',
  12351. '']));
  12352. end;
  12353. procedure TTestModule.TestClassInterface_ProcExternalFail;
  12354. begin
  12355. StartProgram(false);
  12356. Add([
  12357. '{$interfaces corba}',
  12358. 'type',
  12359. ' IUnknown = interface',
  12360. ' procedure DoIt; external name ''foo'';',
  12361. ' end;',
  12362. 'begin']);
  12363. SetExpectedParserError(
  12364. 'Fields are not allowed in Interfaces at token "Identifier external" in file test1.pp at line 6 column 21',
  12365. nParserNoFieldsAllowed);
  12366. ConvertProgram;
  12367. end;
  12368. procedure TTestModule.TestClassInterface_Overloads;
  12369. begin
  12370. StartProgram(false);
  12371. Add([
  12372. '{$interfaces corba}',
  12373. 'type',
  12374. ' integer = longint;',
  12375. ' IUnknown = interface',
  12376. ' procedure DoIt(i: integer);',
  12377. ' procedure DoIt(s: string);',
  12378. ' end;',
  12379. ' IBird = interface(IUnknown)',
  12380. ' procedure DoIt(b: boolean); overload;',
  12381. ' end;',
  12382. ' TObject = class',
  12383. ' end;',
  12384. ' TBird = class(TObject,IBird)',
  12385. ' procedure DoIt(o: TObject);',
  12386. ' procedure DoIt(s: string);',
  12387. ' procedure DoIt(i: integer);',
  12388. ' procedure DoIt(b: boolean);',
  12389. ' end;',
  12390. 'procedure TBird.DoIt(o: TObject); begin end;',
  12391. 'procedure TBird.DoIt(s: string); begin end;',
  12392. 'procedure TBird.DoIt(i: integer); begin end;',
  12393. 'procedure TBird.DoIt(b: boolean); begin end;',
  12394. 'var',
  12395. ' BirdIntf: IBird;',
  12396. 'begin',
  12397. ' BirdIntf.DoIt(3);',
  12398. ' BirdIntf.DoIt(''abc'');',
  12399. ' BirdIntf.DoIt(true);',
  12400. '']);
  12401. ConvertProgram;
  12402. CheckSource('TestClassInterface_Overloads',
  12403. LinesToStr([ // statements
  12404. 'rtl.createInterface($mod, "IUnknown", "{5D22E7CA-4E71-32CA-B8EF-650000000000}", ["DoIt", "DoIt$1"], null);',
  12405. 'rtl.createInterface($mod, "IBird", "{D2E3FF4A-AF76-3468-AB38-EB26B77CE676}", ["DoIt$2"], $mod.IUnknown);',
  12406. 'rtl.createClass($mod, "TObject", null, function () {',
  12407. ' this.$init = function () {',
  12408. ' };',
  12409. ' this.$final = function () {',
  12410. ' };',
  12411. '});',
  12412. 'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
  12413. ' this.DoIt = function (o) {',
  12414. ' };',
  12415. ' this.DoIt$1 = function (s) {',
  12416. ' };',
  12417. ' this.DoIt$2 = function (i) {',
  12418. ' };',
  12419. ' this.DoIt$3 = function (b) {',
  12420. ' };',
  12421. ' this.$intfmaps = {};',
  12422. ' rtl.addIntf(this, $mod.IBird, {',
  12423. ' DoIt$2: "DoIt$3",',
  12424. ' DoIt: "DoIt$2"',
  12425. ' });',
  12426. '});',
  12427. 'this.BirdIntf = null;',
  12428. '']),
  12429. LinesToStr([ // $mod.$main
  12430. '$mod.BirdIntf.DoIt(3);',
  12431. '$mod.BirdIntf.DoIt$1("abc");',
  12432. '$mod.BirdIntf.DoIt$2(true);',
  12433. '']));
  12434. end;
  12435. procedure TTestModule.TestClassInterface_DuplicateGUIInIntfListFail;
  12436. begin
  12437. StartProgram(false);
  12438. Add([
  12439. '{$interfaces corba}',
  12440. 'type',
  12441. ' IBird = interface',
  12442. ' [''{4B3BA825-E0EC-4799-A19C-55F714A07959}'']',
  12443. ' end;',
  12444. ' IDog = interface',
  12445. ' [''{4B3BA825-E0EC-4799-A19C-55F714A07959}'']',
  12446. ' end;',
  12447. ' TObject = class(IBird,IDog)',
  12448. ' end;',
  12449. 'begin']);
  12450. SetExpectedPasResolverError('Duplicate GUID {4B3BA825-E0EC-4799-A19C-55F714A07959} in IDog and IBird',
  12451. nDuplicateGUIDXInYZ);
  12452. ConvertProgram;
  12453. end;
  12454. procedure TTestModule.TestClassInterface_DuplicateGUIInAncestorFail;
  12455. begin
  12456. StartProgram(false);
  12457. Add([
  12458. '{$interfaces corba}',
  12459. 'type',
  12460. ' IAnimal = interface',
  12461. ' [''{4B3BA825-E0EC-4799-A19C-55F714A07959}'']',
  12462. ' end;',
  12463. ' IBird = interface(IAnimal)',
  12464. ' end;',
  12465. ' IHawk = interface(IBird)',
  12466. ' [''{4B3BA825-E0EC-4799-A19C-55F714A07959}'']',
  12467. ' end;',
  12468. 'begin']);
  12469. SetExpectedPasResolverError('Duplicate GUID {4B3BA825-E0EC-4799-A19C-55F714A07959} in IHawk and IAnimal',
  12470. nDuplicateGUIDXInYZ);
  12471. ConvertProgram;
  12472. end;
  12473. procedure TTestModule.TestClassInterface_AncestorImpl;
  12474. begin
  12475. StartProgram(false);
  12476. Add([
  12477. '{$interfaces corba}',
  12478. 'type',
  12479. ' integer = longint;',
  12480. ' IUnknown = interface',
  12481. ' procedure DoIt(i: integer);',
  12482. ' end;',
  12483. ' IBird = interface',
  12484. ' procedure Fly(i: integer);',
  12485. ' end;',
  12486. ' TObject = class(IUnknown)',
  12487. ' procedure DoIt(i: integer);',
  12488. ' end;',
  12489. ' TBird = class(IBird)',
  12490. ' procedure Fly(i: integer);',
  12491. ' end;',
  12492. 'procedure TObject.DoIt(i: integer); begin end;',
  12493. 'procedure TBird.Fly(i: integer); begin end;',
  12494. 'begin',
  12495. '']);
  12496. ConvertProgram;
  12497. CheckSource('TestClassInterface_AncestorIntf',
  12498. LinesToStr([ // statements
  12499. 'rtl.createInterface($mod, "IUnknown", "{5D22E7CA-4E71-32CA-8000-000000000000}", ["DoIt"], null);',
  12500. 'rtl.createInterface($mod, "IBird", "{585952B8-2CC8-3000-8000-000000000000}", ["Fly"], null);',
  12501. 'rtl.createClass($mod, "TObject", null, function () {',
  12502. ' this.$init = function () {',
  12503. ' };',
  12504. ' this.$final = function () {',
  12505. ' };',
  12506. ' this.DoIt = function (i) {',
  12507. ' };',
  12508. ' this.$intfmaps = {};',
  12509. ' rtl.addIntf(this, $mod.IUnknown);',
  12510. '});',
  12511. 'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
  12512. ' this.Fly = function (i) {',
  12513. ' };',
  12514. ' this.$intfmaps = {};',
  12515. ' rtl.addIntf(this, $mod.IBird);',
  12516. ' rtl.addIntf(this, $mod.IUnknown);',
  12517. '});',
  12518. '']),
  12519. LinesToStr([ // $mod.$main
  12520. '']));
  12521. end;
  12522. procedure TTestModule.TestClassInterface_ImplReintroduce;
  12523. begin
  12524. StartProgram(false);
  12525. Add([
  12526. '{$interfaces corba}',
  12527. 'type',
  12528. ' integer = longint;',
  12529. ' IBird = interface',
  12530. ' procedure DoIt(i: integer);',
  12531. ' end;',
  12532. ' TObject = class',
  12533. ' procedure DoIt(i: integer);',
  12534. ' end;',
  12535. ' TBird = class(IBird)',
  12536. ' procedure DoIt(i: integer); virtual; reintroduce;',
  12537. ' end;',
  12538. 'procedure TObject.DoIt(i: integer); begin end;',
  12539. 'procedure TBird.DoIt(i: integer); begin end;',
  12540. 'begin',
  12541. '']);
  12542. ConvertProgram;
  12543. CheckSource('TestClassInterface_ImplReintroduce',
  12544. LinesToStr([ // statements
  12545. 'rtl.createInterface($mod, "IBird", "{585952B8-EF65-3000-8000-000000000000}", ["DoIt"], null);',
  12546. 'rtl.createClass($mod, "TObject", null, function () {',
  12547. ' this.$init = function () {',
  12548. ' };',
  12549. ' this.$final = function () {',
  12550. ' };',
  12551. ' this.DoIt = function (i) {',
  12552. ' };',
  12553. '});',
  12554. 'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
  12555. ' this.DoIt$1 = function (i) {',
  12556. ' };',
  12557. ' this.$intfmaps = {};',
  12558. ' rtl.addIntf(this, $mod.IBird, {',
  12559. ' DoIt: "DoIt$1"',
  12560. ' });',
  12561. '});',
  12562. '']),
  12563. LinesToStr([ // $mod.$main
  12564. '']));
  12565. end;
  12566. procedure TTestModule.TestClassInterface_MethodResolution;
  12567. begin
  12568. StartProgram(false);
  12569. Add([
  12570. '{$interfaces corba}',
  12571. 'type',
  12572. ' IUnknown = interface',
  12573. ' procedure Walk(i: longint);',
  12574. ' end;',
  12575. ' IBird = interface(IUnknown)',
  12576. ' procedure Walk(b: boolean); overload;',
  12577. ' procedure Fly(s: string);',
  12578. ' end;',
  12579. ' TObject = class',
  12580. ' end;',
  12581. ' TBird = class(TObject,IBird)',
  12582. ' procedure IBird.Fly = Move;',
  12583. ' procedure IBird.Walk = Hop;',
  12584. ' procedure Hop(i: longint);',
  12585. ' procedure Move(s: string);',
  12586. ' procedure Hop(b: boolean);',
  12587. ' end;',
  12588. 'procedure TBird.Move(s: string); begin end;',
  12589. 'procedure TBird.Hop(i: longint); begin end;',
  12590. 'procedure TBird.Hop(b: boolean); begin end;',
  12591. 'var',
  12592. ' BirdIntf: IBird;',
  12593. 'begin',
  12594. ' BirdIntf.Walk(3);',
  12595. ' BirdIntf.Walk(true);',
  12596. ' BirdIntf.Fly(''abc'');',
  12597. '']);
  12598. ConvertProgram;
  12599. CheckSource('TestClassInterface_MethodResolution',
  12600. LinesToStr([ // statements
  12601. 'rtl.createInterface($mod, "IUnknown", "{5D22E7CA-4E75-38F5-8000-000000000000}", ["Walk"], null);',
  12602. 'rtl.createInterface($mod, "IBird", "{F8E3FF4A-AF76-3468-BB38-1CCFAB120092}", ["Walk$1", "Fly"], $mod.IUnknown);',
  12603. 'rtl.createClass($mod, "TObject", null, function () {',
  12604. ' this.$init = function () {',
  12605. ' };',
  12606. ' this.$final = function () {',
  12607. ' };',
  12608. '});',
  12609. 'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
  12610. ' this.Hop = function (i) {',
  12611. ' };',
  12612. ' this.Move = function (s) {',
  12613. ' };',
  12614. ' this.Hop$1 = function (b) {',
  12615. ' };',
  12616. ' this.$intfmaps = {};',
  12617. ' rtl.addIntf(this, $mod.IBird, {',
  12618. ' Walk$1: "Hop$1",',
  12619. ' Fly: "Move",',
  12620. ' Walk: "Hop"',
  12621. ' });',
  12622. '});',
  12623. 'this.BirdIntf = null;',
  12624. '']),
  12625. LinesToStr([ // $mod.$main
  12626. '$mod.BirdIntf.Walk(3);',
  12627. '$mod.BirdIntf.Walk$1(true);',
  12628. '$mod.BirdIntf.Fly("abc");',
  12629. '']));
  12630. end;
  12631. procedure TTestModule.TestClassInterface_AncestorMoreInterfaces;
  12632. begin
  12633. StartProgram(false);
  12634. Add([
  12635. '{$interfaces com}',
  12636. 'type',
  12637. ' IUnknown = interface',
  12638. ' function _AddRef: longint;',
  12639. ' procedure Walk;',
  12640. ' end;',
  12641. ' IBird = interface end;',
  12642. ' IDog = interface end;',
  12643. ' TObject = class(IBird,IDog)',
  12644. ' function _AddRef: longint; virtual; abstract;',
  12645. ' procedure Walk; virtual; abstract;',
  12646. ' end;',
  12647. ' TBird = class(IUnknown)',
  12648. ' end;',
  12649. 'begin',
  12650. '']);
  12651. ConvertProgram;
  12652. CheckSource('TestClassInterface_COM_AncestorLess',
  12653. LinesToStr([ // statements
  12654. 'rtl.createInterface($mod, "IUnknown", "{5D22E7CA-4E77-3872-9406-7588F5800000}", ["_AddRef", "Walk"], null);',
  12655. 'rtl.createInterface($mod, "IBird", "{136757F2-AF76-3468-8338-1526EC563676}", [], $mod.IUnknown);',
  12656. 'rtl.createInterface($mod, "IDog", "{136757F2-AF76-3468-8565-8D26EC563676}", [], $mod.IUnknown);',
  12657. 'rtl.createClass($mod, "TObject", null, function () {',
  12658. ' this.$init = function () {',
  12659. ' };',
  12660. ' this.$final = function () {',
  12661. ' };',
  12662. ' this.$intfmaps = {};',
  12663. ' rtl.addIntf(this, $mod.IBird);',
  12664. ' rtl.addIntf(this, $mod.IDog);',
  12665. '});',
  12666. 'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
  12667. ' this.$intfmaps = {};',
  12668. ' rtl.addIntf(this, $mod.IUnknown);',
  12669. ' rtl.addIntf(this, $mod.IBird);',
  12670. ' rtl.addIntf(this, $mod.IDog);',
  12671. '});',
  12672. '']),
  12673. LinesToStr([ // $mod.$main
  12674. '']));
  12675. end;
  12676. procedure TTestModule.TestClassInterface_Corba_Delegation;
  12677. begin
  12678. StartProgram(false);
  12679. Add([
  12680. '{$interfaces corba}',
  12681. 'type',
  12682. ' IUnknown = interface',
  12683. ' end;',
  12684. ' IBird = interface(IUnknown)',
  12685. ' procedure Fly(s: string);',
  12686. ' end;',
  12687. ' IEagle = interface(IBird)',
  12688. ' end;',
  12689. ' IDove = interface(IBird)',
  12690. ' end;',
  12691. ' ISwallow = interface(IBird)',
  12692. ' end;',
  12693. ' TObject = class',
  12694. ' end;',
  12695. ' TBird = class(TObject,IBird,IEagle,IDove,ISwallow)',
  12696. ' procedure Fly(s: string); virtual; abstract;',
  12697. ' end;',
  12698. ' TBat = class(IBird,IEagle,IDove,ISwallow)',
  12699. ' FBirdIntf: IBird;',
  12700. ' property BirdIntf: IBird read FBirdIntf implements IBird;',
  12701. ' function GetEagleIntf: IEagle; virtual; abstract;',
  12702. ' property EagleIntf: IEagle read GetEagleIntf implements IEagle;',
  12703. ' FDoveObj: TBird;',
  12704. ' property DoveObj: TBird read FDoveObj implements IDove;',
  12705. ' function GetSwallowObj: TBird; virtual; abstract;',
  12706. ' property SwallowObj: TBird read GetSwallowObj implements ISwallow;',
  12707. ' end;',
  12708. 'begin',
  12709. '']);
  12710. ConvertProgram;
  12711. CheckSource('TestClassInterface_Delegation',
  12712. LinesToStr([ // statements
  12713. 'rtl.createInterface($mod, "IUnknown", "{5D22E7CA-4E00-3000-8000-000000000000}", [], null);',
  12714. 'rtl.createInterface($mod, "IBird", "{48E3FF4A-AF76-3465-A738-D745ABE63074}", ["Fly"], $mod.IUnknown);',
  12715. 'rtl.createInterface($mod, "IEagle", "{56CEF525-B037-3078-82F5-4C3CF0629879}", [], $mod.IBird);',
  12716. 'rtl.createInterface($mod, "IDove", "{56CEF525-B037-3078-8169-F7ECF0629879}", [], $mod.IBird);',
  12717. 'rtl.createInterface($mod, "ISwallow", "{56CEF525-B037-3078-90A3-CCE44C629879}", [], $mod.IBird);',
  12718. 'rtl.createClass($mod, "TObject", null, function () {',
  12719. ' this.$init = function () {',
  12720. ' };',
  12721. ' this.$final = function () {',
  12722. ' };',
  12723. '});',
  12724. 'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
  12725. ' this.$intfmaps = {};',
  12726. ' rtl.addIntf(this, $mod.IBird);',
  12727. ' rtl.addIntf(this, $mod.IEagle);',
  12728. ' rtl.addIntf(this, $mod.IDove);',
  12729. ' rtl.addIntf(this, $mod.ISwallow);',
  12730. '});',
  12731. 'rtl.createClass($mod, "TBat", $mod.TObject, function () {',
  12732. ' this.$init = function () {',
  12733. ' $mod.TObject.$init.call(this);',
  12734. ' this.FBirdIntf = null;',
  12735. ' this.FDoveObj = null;',
  12736. ' };',
  12737. ' this.$final = function () {',
  12738. ' this.FBirdIntf = undefined;',
  12739. ' this.FDoveObj = undefined;',
  12740. ' $mod.TObject.$final.call(this);',
  12741. ' };',
  12742. ' this.$intfmaps = {',
  12743. ' "{48E3FF4A-AF76-3465-A738-D745ABE63074}": function () {',
  12744. ' return this.FBirdIntf;',
  12745. ' },',
  12746. ' "{56CEF525-B037-3078-82F5-4C3CF0629879}": function () {',
  12747. ' return this.GetEagleIntf();',
  12748. ' },',
  12749. ' "{56CEF525-B037-3078-8169-F7ECF0629879}": function () {',
  12750. ' return rtl.getIntfT(this.FDoveObj, $mod.IDove);',
  12751. ' },',
  12752. ' "{56CEF525-B037-3078-90A3-CCE44C629879}": function () {',
  12753. ' return rtl.getIntfT(this.GetSwallowObj(), $mod.ISwallow);',
  12754. ' }',
  12755. ' };',
  12756. '});',
  12757. '']),
  12758. LinesToStr([ // $mod.$main
  12759. '']));
  12760. end;
  12761. procedure TTestModule.TestClassInterface_Corba_DelegationStatic;
  12762. begin
  12763. StartProgram(false);
  12764. Add([
  12765. '{$interfaces corba}',
  12766. 'type',
  12767. ' IUnknown = interface',
  12768. ' end;',
  12769. ' IBird = interface(IUnknown)',
  12770. ' procedure Fly(s: string);',
  12771. ' end;',
  12772. ' IEagle = interface(IBird)',
  12773. ' end;',
  12774. ' IDove = interface(IBird)',
  12775. ' end;',
  12776. ' ISwallow = interface(IBird)',
  12777. ' end;',
  12778. ' TObject = class',
  12779. ' end;',
  12780. ' TBird = class(TObject,IBird,IEagle,IDove,ISwallow)',
  12781. ' procedure Fly(s: string); virtual; abstract;',
  12782. ' end;',
  12783. ' TBat = class(IBird,IEagle,IDove,ISwallow)',
  12784. ' private',
  12785. ' class var FBirdIntf: IBird;',
  12786. ' class var FDoveObj: TBird;',
  12787. ' class function GetEagleIntf: IEagle; virtual; abstract;',
  12788. ' class function GetSwallowObj: TBird; virtual; abstract;',
  12789. ' protected',
  12790. ' class property BirdIntf: IBird read FBirdIntf implements IBird;',
  12791. ' class property EagleIntf: IEagle read GetEagleIntf implements IEagle;',
  12792. ' class property DoveObj: TBird read FDoveObj implements IDove;',
  12793. ' class property SwallowObj: TBird read GetSwallowObj implements ISwallow;',
  12794. ' end;',
  12795. 'begin',
  12796. '']);
  12797. ConvertProgram;
  12798. CheckSource('TestClassInterface_DelegationStatic',
  12799. LinesToStr([ // statements
  12800. 'rtl.createInterface($mod, "IUnknown", "{5D22E7CA-4E00-3000-8000-000000000000}", [], null);',
  12801. 'rtl.createInterface($mod, "IBird", "{48E3FF4A-AF76-3465-A738-D745ABE63074}", ["Fly"], $mod.IUnknown);',
  12802. 'rtl.createInterface($mod, "IEagle", "{56CEF525-B037-3078-82F5-4C3CF0629879}", [], $mod.IBird);',
  12803. 'rtl.createInterface($mod, "IDove", "{56CEF525-B037-3078-8169-F7ECF0629879}", [], $mod.IBird);',
  12804. 'rtl.createInterface($mod, "ISwallow", "{56CEF525-B037-3078-90A3-CCE44C629879}", [], $mod.IBird);',
  12805. 'rtl.createClass($mod, "TObject", null, function () {',
  12806. ' this.$init = function () {',
  12807. ' };',
  12808. ' this.$final = function () {',
  12809. ' };',
  12810. '});',
  12811. 'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
  12812. ' this.$intfmaps = {};',
  12813. ' rtl.addIntf(this, $mod.IBird);',
  12814. ' rtl.addIntf(this, $mod.IEagle);',
  12815. ' rtl.addIntf(this, $mod.IDove);',
  12816. ' rtl.addIntf(this, $mod.ISwallow);',
  12817. '});',
  12818. 'rtl.createClass($mod, "TBat", $mod.TObject, function () {',
  12819. ' this.FBirdIntf = null;',
  12820. ' this.FDoveObj = null;',
  12821. ' this.$intfmaps = {',
  12822. ' "{48E3FF4A-AF76-3465-A738-D745ABE63074}": function () {',
  12823. ' return this.FBirdIntf;',
  12824. ' },',
  12825. ' "{56CEF525-B037-3078-82F5-4C3CF0629879}": function () {',
  12826. ' return this.$class.GetEagleIntf();',
  12827. ' },',
  12828. ' "{56CEF525-B037-3078-8169-F7ECF0629879}": function () {',
  12829. ' return rtl.getIntfT(this.FDoveObj, $mod.IDove);',
  12830. ' },',
  12831. ' "{56CEF525-B037-3078-90A3-CCE44C629879}": function () {',
  12832. ' return rtl.getIntfT(this.$class.GetSwallowObj(), $mod.ISwallow);',
  12833. ' }',
  12834. ' };',
  12835. '});',
  12836. '']),
  12837. LinesToStr([ // $mod.$main
  12838. '']));
  12839. end;
  12840. procedure TTestModule.TestClassInterface_Corba_Operators;
  12841. begin
  12842. StartProgram(false);
  12843. Add([
  12844. '{$interfaces corba}',
  12845. 'type',
  12846. ' IUnknown = interface',
  12847. ' end;',
  12848. ' IBird = interface(IUnknown)',
  12849. ' function GetItems(Index: longint): longint;',
  12850. ' procedure SetItems(Index: longint; Value: longint);',
  12851. ' property Items[Index: longint]: longint read GetItems write SetItems; default;',
  12852. ' end;',
  12853. ' TObject = class',
  12854. ' end;',
  12855. ' TBird = class(TObject,IBird)',
  12856. ' function GetItems(Index: longint): longint; virtual; abstract;',
  12857. ' procedure SetItems(Index: longint; Value: longint); virtual; abstract;',
  12858. ' end;',
  12859. 'var',
  12860. ' IntfVar: IBird = nil;',
  12861. ' IntfVar2: IBird;',
  12862. ' ObjVar: TBird;',
  12863. ' v: JSValue;',
  12864. 'begin',
  12865. ' IntfVar:=nil;',
  12866. ' IntfVar[3]:=IntfVar[4];',
  12867. ' if Assigned(IntfVar) then ;',
  12868. ' IntfVar:=IntfVar2;',
  12869. ' IntfVar:=ObjVar;',
  12870. ' if IntfVar=IntfVar2 then ;',
  12871. ' if IntfVar<>IntfVar2 then ;',
  12872. ' if IntfVar is IBird then ;',
  12873. ' if IntfVar is TBird then ;',
  12874. ' if ObjVar is IBird then ;',
  12875. ' IntfVar:=IntfVar2 as IBird;',
  12876. ' ObjVar:=IntfVar2 as TBird;',
  12877. ' IntfVar:=ObjVar as IBird;',
  12878. ' IntfVar:=IBird(IntfVar2);',
  12879. ' ObjVar:=TBird(IntfVar);',
  12880. ' IntfVar:=IBird(ObjVar);',
  12881. ' v:=IntfVar;',
  12882. ' IntfVar:=IBird(v);',
  12883. ' if v is IBird then ;',
  12884. ' v:=JSValue(IntfVar);',
  12885. ' v:=IBird;',
  12886. '']);
  12887. ConvertProgram;
  12888. CheckSource('TestClassInterface_Corba_Operators',
  12889. LinesToStr([ // statements
  12890. 'rtl.createInterface($mod, "IUnknown", "{5D22E7CA-4E00-3000-8000-000000000000}", [], null);',
  12891. 'rtl.createInterface($mod, "IBird", "{8E3C13AF-8080-3465-A738-D7460F8FE995}", ["GetItems", "SetItems"], $mod.IUnknown);',
  12892. 'rtl.createClass($mod, "TObject", null, function () {',
  12893. ' this.$init = function () {',
  12894. ' };',
  12895. ' this.$final = function () {',
  12896. ' };',
  12897. '});',
  12898. 'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
  12899. ' this.$intfmaps = {};',
  12900. ' rtl.addIntf(this, $mod.IBird);',
  12901. '});',
  12902. 'this.IntfVar = null;',
  12903. 'this.IntfVar2 = null;',
  12904. 'this.ObjVar = null;',
  12905. 'this.v = undefined;',
  12906. '']),
  12907. LinesToStr([ // $mod.$main
  12908. '$mod.IntfVar = null;',
  12909. '$mod.IntfVar.SetItems(3, $mod.IntfVar.GetItems(4));',
  12910. 'if ($mod.IntfVar != null) ;',
  12911. '$mod.IntfVar = $mod.IntfVar2;',
  12912. '$mod.IntfVar = rtl.getIntfT($mod.ObjVar,$mod.IBird);',
  12913. 'if ($mod.IntfVar === $mod.IntfVar2) ;',
  12914. 'if ($mod.IntfVar !== $mod.IntfVar2) ;',
  12915. 'if ($mod.IBird.isPrototypeOf($mod.IntfVar)) ;',
  12916. 'if (rtl.intfIsClass($mod.IntfVar, $mod.TBird)) ;',
  12917. 'if (rtl.getIntfT($mod.ObjVar, $mod.IBird) !== null) ;',
  12918. '$mod.IntfVar = rtl.as($mod.IntfVar2, $mod.IBird);',
  12919. '$mod.ObjVar = rtl.intfAsClass($mod.IntfVar2, $mod.TBird);',
  12920. '$mod.IntfVar = rtl.getIntfT($mod.ObjVar, $mod.IBird);',
  12921. '$mod.IntfVar = $mod.IntfVar2;',
  12922. '$mod.ObjVar = rtl.intfToClass($mod.IntfVar, $mod.TBird);',
  12923. '$mod.IntfVar = rtl.getIntfT($mod.ObjVar, $mod.IBird);',
  12924. '$mod.v = $mod.IntfVar;',
  12925. '$mod.IntfVar = rtl.getObject($mod.v);',
  12926. 'if (rtl.isExt($mod.v, $mod.IBird, 1)) ;',
  12927. '$mod.v = rtl.getObject($mod.IntfVar);',
  12928. '$mod.v = $mod.IBird;',
  12929. '']));
  12930. end;
  12931. procedure TTestModule.TestClassInterface_Corba_Args;
  12932. begin
  12933. StartProgram(false);
  12934. Add([
  12935. '{$interfaces corba}',
  12936. 'type',
  12937. ' IUnknown = interface',
  12938. ' end;',
  12939. ' IBird = interface(IUnknown)',
  12940. ' end;',
  12941. ' TObject = class',
  12942. ' end;',
  12943. ' TBird = class(TObject,IBird)',
  12944. ' end;',
  12945. 'procedure DoIt(var u; i: IBird; const j: IBird);',
  12946. 'begin',
  12947. ' DoIt(i,i,i);',
  12948. 'end;',
  12949. 'procedure Change(var i: IBird; out j: IBird);',
  12950. 'begin',
  12951. ' DoIt(i,i,i);',
  12952. ' Change(i,i);',
  12953. 'end;',
  12954. 'var',
  12955. ' i: IBird;',
  12956. ' o: TBird;',
  12957. 'begin',
  12958. ' DoIt(i,i,i);',
  12959. ' Change(i,i);',
  12960. ' DoIt(o,o,o);',
  12961. '']);
  12962. ConvertProgram;
  12963. CheckSource('TestClassInterface_Corba_Args',
  12964. LinesToStr([ // statements
  12965. 'rtl.createInterface($mod, "IUnknown", "{5D22E7CA-4E00-3000-8000-000000000000}", [], null);',
  12966. 'rtl.createInterface($mod, "IBird", "{48E3FF4A-AF76-3465-A738-D462ECC63074}", [], $mod.IUnknown);',
  12967. 'rtl.createClass($mod, "TObject", null, function () {',
  12968. ' this.$init = function () {',
  12969. ' };',
  12970. ' this.$final = function () {',
  12971. ' };',
  12972. '});',
  12973. 'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
  12974. ' this.$intfmaps = {};',
  12975. ' rtl.addIntf(this, $mod.IBird);',
  12976. '});',
  12977. 'this.DoIt = function (u, i, j) {',
  12978. ' $mod.DoIt({',
  12979. ' get: function () {',
  12980. ' return i;',
  12981. ' },',
  12982. ' set: function (v) {',
  12983. ' i = v;',
  12984. ' }',
  12985. ' }, i, i);',
  12986. '};',
  12987. 'this.Change = function (i, j) {',
  12988. ' $mod.DoIt(i, i.get(), i.get());',
  12989. ' $mod.Change(i, i);',
  12990. '};',
  12991. 'this.i = null;',
  12992. 'this.o = null;',
  12993. '']),
  12994. LinesToStr([ // $mod.$main
  12995. '$mod.DoIt({',
  12996. ' p: $mod,',
  12997. ' get: function () {',
  12998. ' return this.p.i;',
  12999. ' },',
  13000. ' set: function (v) {',
  13001. ' this.p.i = v;',
  13002. ' }',
  13003. '}, $mod.i, $mod.i);',
  13004. '$mod.Change({',
  13005. ' p: $mod,',
  13006. ' get: function () {',
  13007. ' return this.p.i;',
  13008. ' },',
  13009. ' set: function (v) {',
  13010. ' this.p.i = v;',
  13011. ' }',
  13012. '}, {',
  13013. ' p: $mod,',
  13014. ' get: function () {',
  13015. ' return this.p.i;',
  13016. ' },',
  13017. ' set: function (v) {',
  13018. ' this.p.i = v;',
  13019. ' }',
  13020. '});',
  13021. '$mod.DoIt({',
  13022. ' p: $mod,',
  13023. ' get: function () {',
  13024. ' return this.p.o;',
  13025. ' },',
  13026. ' set: function (v) {',
  13027. ' this.p.o = v;',
  13028. ' }',
  13029. '}, rtl.getIntfT($mod.o, $mod.IBird), rtl.getIntfT($mod.o, $mod.IBird));',
  13030. '']));
  13031. end;
  13032. procedure TTestModule.TestClassInterface_Corba_ForIn;
  13033. begin
  13034. StartProgram(false);
  13035. Add([
  13036. '{$interfaces corba}',
  13037. 'type',
  13038. ' IUnknown = interface end;',
  13039. ' TObject = class',
  13040. ' Id: longint;',
  13041. ' end;',
  13042. ' IEnumerator = interface(IUnknown)',
  13043. ' function GetCurrent: TObject;',
  13044. ' function MoveNext: Boolean;',
  13045. ' property Current: TObject read GetCurrent;',
  13046. ' end;',
  13047. ' IEnumerable = interface(IUnknown)',
  13048. ' function GetEnumerator: IEnumerator;',
  13049. ' end;',
  13050. 'var',
  13051. ' o: TObject;',
  13052. ' i: IEnumerable;',
  13053. 'begin',
  13054. ' for o in i do o.Id:=3;',
  13055. '']);
  13056. ConvertProgram;
  13057. CheckSource('TestClassInterface_Corba_ForIn',
  13058. LinesToStr([ // statements
  13059. 'rtl.createInterface($mod, "IUnknown", "{5D22E7CA-4E00-3000-8000-000000000000}", [], null);',
  13060. 'rtl.createClass($mod, "TObject", null, function () {',
  13061. ' this.$init = function () {',
  13062. ' this.Id = 0;',
  13063. ' };',
  13064. ' this.$final = function () {',
  13065. ' };',
  13066. '});',
  13067. 'rtl.createInterface($mod, "IEnumerator", "{D2FE11F3-D2CC-36BB-A5B2-66EB7FB5CB08}", ["GetCurrent", "MoveNext"], $mod.IUnknown);',
  13068. 'rtl.createInterface($mod, "IEnumerable", "{D20534CB-D9C0-3EA5-AA60-ACEB7D726308}", ["GetEnumerator"], $mod.IUnknown);',
  13069. 'this.o = null;',
  13070. 'this.i = null;',
  13071. '']),
  13072. LinesToStr([ // $mod.$main
  13073. 'var $in1 = $mod.i.GetEnumerator();',
  13074. 'while ($in1.MoveNext()) {',
  13075. ' $mod.o = $in1.GetCurrent();',
  13076. ' $mod.o.Id = 3;',
  13077. '};',
  13078. '']));
  13079. end;
  13080. procedure TTestModule.TestClassInterface_COM_AssignVar;
  13081. begin
  13082. StartProgram(false);
  13083. Add([
  13084. '{$interfaces com}',
  13085. 'type',
  13086. ' IUnknown = interface',
  13087. ' function _AddRef: longint;',
  13088. ' function _Release: longint;',
  13089. ' end;',
  13090. ' TObject = class(IUnknown)',
  13091. ' function _AddRef: longint; virtual; abstract;',
  13092. ' function _Release: longint; virtual; abstract;',
  13093. ' end;',
  13094. 'var',
  13095. ' i: IUnknown;',
  13096. 'procedure DoGlobal(o: TObject);',
  13097. 'begin',
  13098. ' i:=nil;',
  13099. ' i:=o;',
  13100. ' i:=i;',
  13101. 'end;',
  13102. 'procedure DoLocal(o: TObject);',
  13103. 'const k: IUnknown = nil;',
  13104. 'var j: IUnknown;',
  13105. 'begin',
  13106. ' k:=o;',
  13107. ' k:=i;',
  13108. ' j:=o;',
  13109. ' j:=i;',
  13110. 'end;',
  13111. 'var o: TObject;',
  13112. 'begin',
  13113. ' i:=nil;',
  13114. ' i:=o;',
  13115. '']);
  13116. ConvertProgram;
  13117. CheckSource('TestClassInterface_COM_AssignVar',
  13118. LinesToStr([ // statements
  13119. 'rtl.createInterface($mod, "IUnknown", "{5D22E7CA-4E77-3872-9406-776A86A09328}", ["_AddRef", "_Release"], null);',
  13120. 'rtl.createClass($mod, "TObject", null, function () {',
  13121. ' this.$init = function () {',
  13122. ' };',
  13123. ' this.$final = function () {',
  13124. ' };',
  13125. ' this.$intfmaps = {};',
  13126. ' rtl.addIntf(this, $mod.IUnknown);',
  13127. '});',
  13128. 'this.i = null;',
  13129. 'this.DoGlobal = function (o) {',
  13130. ' rtl.setIntfP($mod, "i", null);',
  13131. ' rtl.setIntfP($mod, "i", rtl.queryIntfT(o, $mod.IUnknown), true);',
  13132. ' rtl.setIntfP($mod, "i", $mod.i);',
  13133. '};',
  13134. 'var k = null;',
  13135. 'this.DoLocal = function (o) {',
  13136. ' var j = null;',
  13137. ' try{',
  13138. ' k = rtl.setIntfL(k, rtl.queryIntfT(o, $mod.IUnknown), true);',
  13139. ' k = rtl.setIntfL(k, $mod.i);',
  13140. ' j = rtl.setIntfL(j, rtl.queryIntfT(o, $mod.IUnknown), true);',
  13141. ' j = rtl.setIntfL(j, $mod.i);',
  13142. ' }finally{',
  13143. ' rtl._Release(j);',
  13144. ' };',
  13145. '};',
  13146. 'this.o = null;',
  13147. '']),
  13148. LinesToStr([ // $mod.$main
  13149. 'rtl.setIntfP($mod, "i", null);',
  13150. 'rtl.setIntfP($mod, "i", rtl.queryIntfT($mod.o, $mod.IUnknown), true);',
  13151. '']));
  13152. end;
  13153. procedure TTestModule.TestClassInterface_COM_AssignArg;
  13154. begin
  13155. StartProgram(false);
  13156. Add([
  13157. '{$interfaces com}',
  13158. 'type',
  13159. ' IUnknown = interface',
  13160. ' function _AddRef: longint;',
  13161. ' function _Release: longint;',
  13162. ' end;',
  13163. ' TObject = class(IUnknown)',
  13164. ' function _AddRef: longint; virtual; abstract;',
  13165. ' function _Release: longint; virtual; abstract;',
  13166. ' end;',
  13167. 'procedure DoDefault(i, j: IUnknown);',
  13168. 'begin',
  13169. ' i:=nil;',
  13170. ' i:=j;',
  13171. 'end;',
  13172. 'begin',
  13173. '']);
  13174. ConvertProgram;
  13175. CheckSource('TestClassInterface_COM_AssignArg',
  13176. LinesToStr([ // statements
  13177. 'rtl.createInterface($mod, "IUnknown", "{5D22E7CA-4E77-3872-9406-776A86A09328}", ["_AddRef", "_Release"], null);',
  13178. 'rtl.createClass($mod, "TObject", null, function () {',
  13179. ' this.$init = function () {',
  13180. ' };',
  13181. ' this.$final = function () {',
  13182. ' };',
  13183. ' this.$intfmaps = {};',
  13184. ' rtl.addIntf(this, $mod.IUnknown);',
  13185. '});',
  13186. 'this.DoDefault = function (i, j) {',
  13187. ' rtl._AddRef(i);',
  13188. ' try {',
  13189. ' i = rtl.setIntfL(i, null);',
  13190. ' i = rtl.setIntfL(i, j);',
  13191. ' } finally {',
  13192. ' rtl._Release(i);',
  13193. ' };',
  13194. '};',
  13195. '']),
  13196. LinesToStr([ // $mod.$main
  13197. '']));
  13198. end;
  13199. procedure TTestModule.TestClassInterface_COM_FunctionResult;
  13200. begin
  13201. StartProgram(false);
  13202. Add([
  13203. '{$interfaces com}',
  13204. 'type',
  13205. ' IUnknown = interface',
  13206. ' function _AddRef: longint;',
  13207. ' function _Release: longint;',
  13208. ' end;',
  13209. ' TObject = class(IUnknown)',
  13210. ' function _AddRef: longint; virtual; abstract;',
  13211. ' function _Release: longint; virtual; abstract;',
  13212. ' end;',
  13213. 'function DoDefault(i: IUnknown): IUnknown;',
  13214. 'begin',
  13215. ' Result:=i;',
  13216. ' if Result<>nil then exit;',
  13217. 'end;',
  13218. 'begin',
  13219. '']);
  13220. ConvertProgram;
  13221. CheckSource('TestClassInterface_COM_FunctionResult',
  13222. LinesToStr([ // statements
  13223. 'rtl.createInterface($mod, "IUnknown", "{5D22E7CA-4E77-3872-9406-776A86A09328}", ["_AddRef", "_Release"], null);',
  13224. 'rtl.createClass($mod, "TObject", null, function () {',
  13225. ' this.$init = function () {',
  13226. ' };',
  13227. ' this.$final = function () {',
  13228. ' };',
  13229. ' this.$intfmaps = {};',
  13230. ' rtl.addIntf(this, $mod.IUnknown);',
  13231. '});',
  13232. 'this.DoDefault = function (i) {',
  13233. ' var Result = null;',
  13234. ' var $ok = false;',
  13235. ' try {',
  13236. ' Result = rtl.setIntfL(Result, i);',
  13237. ' if(Result !== null){',
  13238. ' $ok = true;',
  13239. ' return Result;',
  13240. ' };',
  13241. ' $ok = true;',
  13242. ' } finally {',
  13243. ' if(!$ok) rtl._Release(Result);',
  13244. ' };',
  13245. ' return Result;',
  13246. '};',
  13247. '']),
  13248. LinesToStr([ // $mod.$main
  13249. '']));
  13250. end;
  13251. procedure TTestModule.TestClassInterface_COM_InheritedFuncResult;
  13252. begin
  13253. StartProgram(false);
  13254. Add([
  13255. '{$interfaces com}',
  13256. 'type',
  13257. ' IUnknown = interface',
  13258. ' function _AddRef: longint;',
  13259. ' function _Release: longint;',
  13260. ' end;',
  13261. ' TObject = class(IUnknown)',
  13262. ' function _AddRef: longint; virtual; abstract;',
  13263. ' function _Release: longint; virtual; abstract;',
  13264. ' function GetIntf: IUnknown; virtual;',
  13265. ' end;',
  13266. ' TMouse = class',
  13267. ' function GetIntf: IUnknown; override;',
  13268. ' end;',
  13269. 'function TObject.GetIntf: IUnknown; begin end;',
  13270. 'function TMouse.GetIntf: IUnknown;',
  13271. 'var i: IUnknown;',
  13272. 'begin',
  13273. ' inherited;',
  13274. ' inherited GetIntf;',
  13275. ' inherited GetIntf();',
  13276. ' Result:=inherited GetIntf;',
  13277. ' Result:=inherited GetIntf();',
  13278. ' i:=inherited GetIntf;',
  13279. ' i:=inherited GetIntf();',
  13280. 'end;',
  13281. 'begin',
  13282. '']);
  13283. ConvertProgram;
  13284. CheckSource('TestClassInterface_COM_InheritedFuncResult',
  13285. LinesToStr([ // statements
  13286. 'rtl.createInterface($mod, "IUnknown", "{5D22E7CA-4E77-3872-9406-776A86A09328}", ["_AddRef", "_Release"], null);',
  13287. 'rtl.createClass($mod, "TObject", null, function () {',
  13288. ' this.$init = function () {',
  13289. ' };',
  13290. ' this.$final = function () {',
  13291. ' };',
  13292. ' this.GetIntf = function () {',
  13293. ' var Result = null;',
  13294. ' return Result;',
  13295. ' };',
  13296. ' this.$intfmaps = {};',
  13297. ' rtl.addIntf(this, $mod.IUnknown);',
  13298. '});',
  13299. 'rtl.createClass($mod, "TMouse", $mod.TObject, function () {',
  13300. ' this.GetIntf = function () {',
  13301. ' var Result = null;',
  13302. ' var i = null;',
  13303. ' var $ir = rtl.createIntfRefs();',
  13304. ' var $ok = false;',
  13305. ' try {',
  13306. ' $ir.ref(1, $mod.TObject.GetIntf.apply(this, arguments));',
  13307. ' $ir.ref(2, $mod.TObject.GetIntf.call(this));',
  13308. ' $ir.ref(3, $mod.TObject.GetIntf.call(this));',
  13309. ' Result = rtl.setIntfL(Result, $mod.TObject.GetIntf.call(this), true);',
  13310. ' Result = rtl.setIntfL(Result, $mod.TObject.GetIntf.call(this), true);',
  13311. ' i = rtl.setIntfL(i, $mod.TObject.GetIntf.call(this), true);',
  13312. ' i = rtl.setIntfL(i, $mod.TObject.GetIntf.call(this), true);',
  13313. ' $ok = true;',
  13314. ' } finally {',
  13315. ' $ir.free();',
  13316. ' rtl._Release(i);',
  13317. ' if (!$ok) rtl._Release(Result);',
  13318. ' };',
  13319. ' return Result;',
  13320. ' };',
  13321. '});',
  13322. '']),
  13323. LinesToStr([ // $mod.$main
  13324. '']));
  13325. end;
  13326. procedure TTestModule.TestClassInterface_COM_IsAsTypeCasts;
  13327. begin
  13328. StartProgram(false);
  13329. Add([
  13330. '{$interfaces com}',
  13331. 'type',
  13332. ' IUnknown = interface',
  13333. ' function _AddRef: longint;',
  13334. ' function _Release: longint;',
  13335. ' end;',
  13336. ' TObject = class(IUnknown)',
  13337. ' function _AddRef: longint; virtual; abstract;',
  13338. ' function _Release: longint; virtual; abstract;',
  13339. ' end;',
  13340. 'procedure DoDefault(i, j: IUnknown; o: TObject);',
  13341. 'begin',
  13342. ' if i is IUnknown then ;',
  13343. ' if o is IUnknown then ;',
  13344. ' if i is TObject then ;',
  13345. ' i:=j as IUnknown;',
  13346. ' i:=o as IUnknown;',
  13347. ' o:=j as TObject;',
  13348. ' i:=IUnknown(j);',
  13349. ' i:=IUnknown(o);',
  13350. ' o:=TObject(i);',
  13351. 'end;',
  13352. 'begin',
  13353. '']);
  13354. ConvertProgram;
  13355. CheckSource('TestClassInterface_COM_IsAsTypeCasts',
  13356. LinesToStr([ // statements
  13357. 'rtl.createInterface($mod, "IUnknown", "{5D22E7CA-4E77-3872-9406-776A86A09328}", ["_AddRef", "_Release"], null);',
  13358. 'rtl.createClass($mod, "TObject", null, function () {',
  13359. ' this.$init = function () {',
  13360. ' };',
  13361. ' this.$final = function () {',
  13362. ' };',
  13363. ' this.$intfmaps = {};',
  13364. ' rtl.addIntf(this, $mod.IUnknown);',
  13365. '});',
  13366. 'this.DoDefault = function (i, j, o) {',
  13367. ' rtl._AddRef(i);',
  13368. ' try {',
  13369. ' if ($mod.IUnknown.isPrototypeOf(i)) ;',
  13370. ' if (rtl.queryIntfIsT(o, $mod.IUnknown)) ;',
  13371. ' if (rtl.intfIsClass(i, $mod.TObject)) ;',
  13372. ' i = rtl.setIntfL(i, rtl.as(j, $mod.IUnknown));',
  13373. ' i = rtl.setIntfL(i, rtl.queryIntfT(o, $mod.IUnknown), true);',
  13374. ' o = rtl.intfAsClass(j, $mod.TObject);',
  13375. ' i = rtl.setIntfL(i, j);',
  13376. ' i = rtl.setIntfL(i, rtl.queryIntfT(o, $mod.IUnknown), true);',
  13377. ' o = rtl.intfToClass(i, $mod.TObject);',
  13378. ' } finally {',
  13379. ' rtl._Release(i);',
  13380. ' };',
  13381. '};',
  13382. '']),
  13383. LinesToStr([ // $mod.$main
  13384. '']));
  13385. end;
  13386. procedure TTestModule.TestClassInterface_COM_PassAsArg;
  13387. begin
  13388. StartProgram(false);
  13389. Add([
  13390. '{$interfaces com}',
  13391. 'type',
  13392. ' IUnknown = interface',
  13393. ' function _AddRef: longint;',
  13394. ' function _Release: longint;',
  13395. ' end;',
  13396. ' TObject = class(IUnknown)',
  13397. ' function _AddRef: longint; virtual; abstract;',
  13398. ' function _Release: longint; virtual; abstract;',
  13399. ' end;',
  13400. 'procedure DoIt(v: IUnknown; const j: IUnknown; var k: IUnknown; out l: IUnknown);',
  13401. 'var o: TObject;',
  13402. 'begin',
  13403. ' DoIt(v,v,v,v);',
  13404. ' DoIt(o,o,k,k);',
  13405. 'end;',
  13406. 'procedure DoSome;',
  13407. 'var v: IUnknown;',
  13408. 'begin',
  13409. ' DoIt(v,v,v,v);',
  13410. 'end;',
  13411. 'var i: IUnknown;',
  13412. 'begin',
  13413. ' DoIt(i,i,i,i);',
  13414. '']);
  13415. ConvertProgram;
  13416. CheckSource('TestClassInterface_COM_PassAsArg',
  13417. LinesToStr([ // statements
  13418. 'rtl.createInterface($mod, "IUnknown", "{5D22E7CA-4E77-3872-9406-776A86A09328}", ["_AddRef", "_Release"], null);',
  13419. 'rtl.createClass($mod, "TObject", null, function () {',
  13420. ' this.$init = function () {',
  13421. ' };',
  13422. ' this.$final = function () {',
  13423. ' };',
  13424. ' this.$intfmaps = {};',
  13425. ' rtl.addIntf(this, $mod.IUnknown);',
  13426. '});',
  13427. 'this.DoIt = function (v, j, k, l) {',
  13428. ' var o = null;',
  13429. ' var $ir = rtl.createIntfRefs();',
  13430. ' rtl._AddRef(v);',
  13431. ' try {',
  13432. ' $mod.DoIt(v, v, {',
  13433. ' get: function () {',
  13434. ' return v;',
  13435. ' },',
  13436. ' set: function (w) {',
  13437. ' v = rtl.setIntfL(v, w);',
  13438. ' }',
  13439. ' }, {',
  13440. ' get: function () {',
  13441. ' return v;',
  13442. ' },',
  13443. ' set: function (w) {',
  13444. ' v = rtl.setIntfL(v, w);',
  13445. ' }',
  13446. ' });',
  13447. ' $mod.DoIt($ir.ref(1, rtl.queryIntfT(o, $mod.IUnknown)), $ir.ref(2, rtl.queryIntfT(o, $mod.IUnknown)), k, k);',
  13448. ' } finally {',
  13449. ' $ir.free();',
  13450. ' rtl._Release(v);',
  13451. ' };',
  13452. '};',
  13453. 'this.DoSome = function () {',
  13454. ' var v = null;',
  13455. ' try {',
  13456. ' $mod.DoIt(v, v, {',
  13457. ' get: function () {',
  13458. ' return v;',
  13459. ' },',
  13460. ' set: function (w) {',
  13461. ' v = rtl.setIntfL(v, w);',
  13462. ' }',
  13463. ' }, {',
  13464. ' get: function () {',
  13465. ' return v;',
  13466. ' },',
  13467. ' set: function (w) {',
  13468. ' v = rtl.setIntfL(v, w);',
  13469. ' }',
  13470. ' });',
  13471. ' } finally {',
  13472. ' rtl._Release(v);',
  13473. ' };',
  13474. '};',
  13475. 'this.i = null;',
  13476. '']),
  13477. LinesToStr([ // $mod.$main
  13478. '$mod.DoIt($mod.i, $mod.i, {',
  13479. ' p: $mod,',
  13480. ' get: function () {',
  13481. ' return this.p.i;',
  13482. ' },',
  13483. ' set: function (v) {',
  13484. ' rtl.setIntfP(this.p, "i", v);',
  13485. ' }',
  13486. '}, {',
  13487. ' p: $mod,',
  13488. ' get: function () {',
  13489. ' return this.p.i;',
  13490. ' },',
  13491. ' set: function (v) {',
  13492. ' rtl.setIntfP(this.p, "i", v);',
  13493. ' }',
  13494. '});',
  13495. '']));
  13496. end;
  13497. procedure TTestModule.TestClassInterface_COM_PassToUntypedParam;
  13498. begin
  13499. StartProgram(false);
  13500. Add([
  13501. '{$interfaces com}',
  13502. 'type',
  13503. ' IUnknown = interface',
  13504. ' function _AddRef: longint;',
  13505. ' function _Release: longint;',
  13506. ' end;',
  13507. ' TObject = class(IUnknown)',
  13508. ' function _AddRef: longint; virtual; abstract;',
  13509. ' function _Release: longint; virtual; abstract;',
  13510. ' end;',
  13511. 'procedure DoIt(out i);',
  13512. 'begin end;',
  13513. 'procedure DoSome;',
  13514. 'var v: IUnknown;',
  13515. 'begin',
  13516. ' DoIt(v);',
  13517. 'end;',
  13518. 'function GetIt: IUnknown;',
  13519. 'begin',
  13520. ' DoIt(Result);',
  13521. 'end;',
  13522. 'var i: IUnknown;',
  13523. 'begin',
  13524. ' DoIt(i);',
  13525. '']);
  13526. ConvertProgram;
  13527. CheckSource('TestClassInterface_COM_PassToUntypedParam',
  13528. LinesToStr([ // statements
  13529. 'rtl.createInterface($mod, "IUnknown", "{5D22E7CA-4E77-3872-9406-776A86A09328}", ["_AddRef", "_Release"], null);',
  13530. 'rtl.createClass($mod, "TObject", null, function () {',
  13531. ' this.$init = function () {',
  13532. ' };',
  13533. ' this.$final = function () {',
  13534. ' };',
  13535. ' this.$intfmaps = {};',
  13536. ' rtl.addIntf(this, $mod.IUnknown);',
  13537. '});',
  13538. 'this.DoIt = function (i) {',
  13539. '};',
  13540. 'this.DoSome = function () {',
  13541. ' var v = null;',
  13542. ' try {',
  13543. ' $mod.DoIt({',
  13544. ' get: function () {',
  13545. ' return v;',
  13546. ' },',
  13547. ' set: function (w) {',
  13548. ' v = w;',
  13549. ' }',
  13550. ' });',
  13551. ' } finally {',
  13552. ' rtl._Release(v);',
  13553. ' };',
  13554. '};',
  13555. 'this.GetIt = function () {',
  13556. ' var Result = null;',
  13557. ' var $ok = false;',
  13558. ' try {',
  13559. ' $mod.DoIt({',
  13560. ' get: function () {',
  13561. ' return Result;',
  13562. ' },',
  13563. ' set: function (v) {',
  13564. ' Result = v;',
  13565. ' }',
  13566. ' });',
  13567. ' $ok = true;',
  13568. ' } finally {',
  13569. ' if (!$ok) rtl._Release(Result);',
  13570. ' };',
  13571. ' return Result;',
  13572. '};',
  13573. 'this.i = null;',
  13574. '']),
  13575. LinesToStr([ // $mod.$main
  13576. 'try {',
  13577. ' $mod.DoIt({',
  13578. ' p: $mod,',
  13579. ' get: function () {',
  13580. ' return this.p.i;',
  13581. ' },',
  13582. ' set: function (v) {',
  13583. ' this.p.i = v;',
  13584. ' }',
  13585. ' });',
  13586. '} finally {',
  13587. ' rtl._Release($mod.i);',
  13588. '};',
  13589. '']));
  13590. end;
  13591. procedure TTestModule.TestClassInterface_COM_FunctionInExpr;
  13592. begin
  13593. StartProgram(false);
  13594. Add([
  13595. '{$interfaces com}',
  13596. 'type',
  13597. ' IUnknown = interface',
  13598. ' function _AddRef: longint;',
  13599. ' function _Release: longint;',
  13600. ' end;',
  13601. ' TObject = class(IUnknown)',
  13602. ' function _AddRef: longint; virtual; abstract;',
  13603. ' function _Release: longint; virtual; abstract;',
  13604. ' end;',
  13605. 'function GetIt: IUnknown;',
  13606. 'begin',
  13607. 'end;',
  13608. 'procedure DoSome;',
  13609. 'var v: IUnknown;',
  13610. ' i: longint;',
  13611. 'begin',
  13612. ' v:=GetIt;',
  13613. ' v:=GetIt();',
  13614. ' GetIt()._AddRef;',
  13615. ' i:=GetIt()._AddRef;',
  13616. 'end;',
  13617. 'var v: IUnknown;',
  13618. ' i: longint;',
  13619. 'begin',
  13620. ' v:=GetIt;',
  13621. ' v:=GetIt();',
  13622. ' GetIt()._AddRef;',
  13623. ' i:=GetIt()._AddRef;',
  13624. '']);
  13625. ConvertProgram;
  13626. CheckSource('TestClassInterface_COM_FunctionInExpr',
  13627. LinesToStr([ // statements
  13628. 'rtl.createInterface($mod, "IUnknown", "{5D22E7CA-4E77-3872-9406-776A86A09328}", ["_AddRef", "_Release"], null);',
  13629. 'rtl.createClass($mod, "TObject", null, function () {',
  13630. ' this.$init = function () {',
  13631. ' };',
  13632. ' this.$final = function () {',
  13633. ' };',
  13634. ' this.$intfmaps = {};',
  13635. ' rtl.addIntf(this, $mod.IUnknown);',
  13636. '});',
  13637. 'this.GetIt = function () {',
  13638. ' var Result = null;',
  13639. ' return Result;',
  13640. '};',
  13641. 'this.DoSome = function () {',
  13642. ' var v = null;',
  13643. ' var i = 0;',
  13644. ' var $ir = rtl.createIntfRefs();',
  13645. ' try {',
  13646. ' v = rtl.setIntfL(v, $mod.GetIt(), true);',
  13647. ' v = rtl.setIntfL(v, $mod.GetIt(), true);',
  13648. ' $ir.ref(1, $mod.GetIt())._AddRef();',
  13649. ' i = $ir.ref(2, $mod.GetIt())._AddRef();',
  13650. ' } finally {',
  13651. ' $ir.free();',
  13652. ' rtl._Release(v);',
  13653. ' };',
  13654. '};',
  13655. 'this.v = null;',
  13656. 'this.i = 0;',
  13657. '']),
  13658. LinesToStr([ // $mod.$main
  13659. 'var $ir = rtl.createIntfRefs();',
  13660. 'try {',
  13661. ' rtl.setIntfP($mod, "v", $mod.GetIt(), true);',
  13662. ' rtl.setIntfP($mod, "v", $mod.GetIt(), true);',
  13663. ' $ir.ref(1, $mod.GetIt())._AddRef();',
  13664. ' $mod.i = $ir.ref(2, $mod.GetIt())._AddRef();',
  13665. '} finally {',
  13666. ' $ir.free();',
  13667. '};',
  13668. '']));
  13669. end;
  13670. procedure TTestModule.TestClassInterface_COM_Property;
  13671. begin
  13672. StartProgram(false);
  13673. Add([
  13674. '{$interfaces com}',
  13675. 'type',
  13676. ' IUnknown = interface',
  13677. ' function _AddRef: longint;',
  13678. ' function _Release: longint;',
  13679. ' end;',
  13680. ' TObject = class(IUnknown)',
  13681. ' FAnt: IUnknown;',
  13682. ' function _AddRef: longint; virtual; abstract;',
  13683. ' function _Release: longint; virtual; abstract;',
  13684. ' function GetBird: IUnknown; virtual; abstract;',
  13685. ' procedure SetBird(Value: IUnknown); virtual; abstract;',
  13686. ' function GetItems(Index: longint): IUnknown; virtual; abstract;',
  13687. ' procedure SetItems(Index: longint; Value: IUnknown); virtual; abstract;',
  13688. ' property Ant: IUnknown read FAnt write FAnt;',
  13689. ' property Bird: IUnknown read GetBird write SetBird;',
  13690. ' property Items[Index: longint]: IUnknown read GetItems write SetItems; default;',
  13691. ' end;',
  13692. 'procedure DoIt;',
  13693. 'var',
  13694. ' o: TObject;',
  13695. ' v: IUnknown;',
  13696. 'begin',
  13697. ' v:=o.Ant;',
  13698. ' o.Ant:=v;',
  13699. ' o.Ant:=o.Ant;',
  13700. ' v:=o.Bird;',
  13701. ' o.Bird:=v;',
  13702. ' o.Bird:=o.Bird;',
  13703. ' v:=o.Items[1];',
  13704. ' o.Items[2]:=v;',
  13705. ' o.Items[3]:=o.Items[4];',
  13706. ' v:=o[5];',
  13707. ' o[6]:=v;',
  13708. ' o[7]:=o[8];',
  13709. 'end;',
  13710. 'begin',
  13711. '']);
  13712. ConvertProgram;
  13713. CheckSource('TestClassInterface_COM_Property',
  13714. LinesToStr([ // statements
  13715. 'rtl.createInterface($mod, "IUnknown", "{5D22E7CA-4E77-3872-9406-776A86A09328}", ["_AddRef", "_Release"], null);',
  13716. 'rtl.createClass($mod, "TObject", null, function () {',
  13717. ' this.$init = function () {',
  13718. ' this.FAnt = null;',
  13719. ' };',
  13720. ' this.$final = function () {',
  13721. ' this.FAnt = undefined;',
  13722. ' };',
  13723. ' this.$intfmaps = {};',
  13724. ' rtl.addIntf(this, $mod.IUnknown);',
  13725. '});',
  13726. 'this.DoIt = function () {',
  13727. ' var o = null;',
  13728. ' var v = null;',
  13729. ' var $ir = rtl.createIntfRefs();',
  13730. ' try {',
  13731. ' v = rtl.setIntfL(v, o.FAnt);',
  13732. ' rtl.setIntfP(o, "FAnt", v);',
  13733. ' rtl.setIntfP(o, "FAnt", o.FAnt);',
  13734. ' v = rtl.setIntfL(v, o.GetBird(), true);',
  13735. ' o.SetBird(v);',
  13736. ' o.SetBird($ir.ref(1, o.GetBird()));',
  13737. ' v = rtl.setIntfL(v, o.GetItems(1), true);',
  13738. ' o.SetItems(2, v);',
  13739. ' o.SetItems(3, $ir.ref(2, o.GetItems(4)));',
  13740. ' v = rtl.setIntfL(v, o.GetItems(5), true);',
  13741. ' o.SetItems(6, v);',
  13742. ' o.SetItems(7, $ir.ref(3, o.GetItems(8)));',
  13743. ' } finally {',
  13744. ' $ir.free();',
  13745. ' rtl._Release(v);',
  13746. ' };',
  13747. '};',
  13748. '']),
  13749. LinesToStr([ // $mod.$main
  13750. '']));
  13751. end;
  13752. procedure TTestModule.TestClassInterface_COM_IntfProperty;
  13753. begin
  13754. StartProgram(false);
  13755. Add([
  13756. '{$interfaces com}',
  13757. 'type',
  13758. ' IUnknown = interface',
  13759. ' function _AddRef: longint;',
  13760. ' function _Release: longint;',
  13761. ' function GetBird: IUnknown;',
  13762. ' procedure SetBird(Value: IUnknown);',
  13763. ' function GetItems(Index: longint): IUnknown;',
  13764. ' procedure SetItems(Index: longint; Value: IUnknown);',
  13765. ' property Bird: IUnknown read GetBird write SetBird;',
  13766. ' property Items[Index: longint]: IUnknown read GetItems write SetItems; default;',
  13767. ' end;',
  13768. ' TObject = class(IUnknown)',
  13769. ' function _AddRef: longint; virtual; abstract;',
  13770. ' function _Release: longint; virtual; abstract;',
  13771. ' function GetBird: IUnknown; virtual; abstract;',
  13772. ' procedure SetBird(Value: IUnknown); virtual; abstract;',
  13773. ' function GetItems(Index: longint): IUnknown; virtual; abstract;',
  13774. ' procedure SetItems(Index: longint; Value: IUnknown); virtual; abstract;',
  13775. ' end;',
  13776. 'procedure DoIt;',
  13777. 'var',
  13778. ' o: TObject;',
  13779. ' v: IUnknown;',
  13780. 'begin',
  13781. ' v:=v.Items[1];',
  13782. ' v.Items[2]:=v;',
  13783. ' v.Items[3]:=v.Items[4];',
  13784. ' v:=v[5];',
  13785. ' v[6]:=v;',
  13786. ' v[7]:=v[8];',
  13787. ' v[9].Bird.Bird:=v;',
  13788. ' v:=v.Bird[10].Bird',
  13789. 'end;',
  13790. 'begin',
  13791. '']);
  13792. ConvertProgram;
  13793. CheckSource('TestClassInterface_COM_IntfProperty',
  13794. LinesToStr([ // statements
  13795. 'rtl.createInterface($mod, "IUnknown", "{5406909F-9F0B-32A4-B98B-94CDDE493C91}", [',
  13796. ' "_AddRef",',
  13797. ' "_Release",',
  13798. ' "GetBird",',
  13799. ' "SetBird",',
  13800. ' "GetItems",',
  13801. ' "SetItems"',
  13802. '], null);',
  13803. 'rtl.createClass($mod, "TObject", null, function () {',
  13804. ' this.$init = function () {',
  13805. ' };',
  13806. ' this.$final = function () {',
  13807. ' };',
  13808. ' this.$intfmaps = {};',
  13809. ' rtl.addIntf(this, $mod.IUnknown);',
  13810. '});',
  13811. 'this.DoIt = function () {',
  13812. ' var o = null;',
  13813. ' var v = null;',
  13814. ' var $ir = rtl.createIntfRefs();',
  13815. ' try {',
  13816. ' v = rtl.setIntfL(v, v.GetItems(1), true);',
  13817. ' v.SetItems(2, v);',
  13818. ' v.SetItems(3, $ir.ref(1, v.GetItems(4)));',
  13819. ' v = rtl.setIntfL(v, v.GetItems(5), true);',
  13820. ' v.SetItems(6, v);',
  13821. ' v.SetItems(7, $ir.ref(2, v.GetItems(8)));',
  13822. ' $ir.ref(4, $ir.ref(3, v.GetItems(9)).GetBird()).SetBird(v);',
  13823. ' v = rtl.setIntfL(v, $ir.ref(6, v.$ir.ref(5, GetBird()).GetItems(10)).GetBird(), true);',
  13824. ' } finally {',
  13825. ' $ir.free();',
  13826. ' rtl._Release(v);',
  13827. ' };',
  13828. '};',
  13829. '']),
  13830. LinesToStr([ // $mod.$main
  13831. '']));
  13832. end;
  13833. procedure TTestModule.TestClassInterface_COM_Delegation;
  13834. begin
  13835. StartProgram(false);
  13836. Add([
  13837. '{$interfaces com}',
  13838. 'type',
  13839. ' IUnknown = interface',
  13840. ' function _AddRef: longint;',
  13841. ' function _Release: longint;',
  13842. ' end;',
  13843. ' IBird = interface(IUnknown)',
  13844. ' procedure Fly(s: string);',
  13845. ' end;',
  13846. ' IEagle = interface(IBird) end;',
  13847. ' IDove = interface(IBird) end;',
  13848. ' ISwallow = interface(IBird) end;',
  13849. ' TObject = class',
  13850. ' end;',
  13851. ' TBird = class(TObject,IBird,IEagle,IDove,ISwallow)',
  13852. ' function _AddRef: longint; virtual; abstract;',
  13853. ' function _Release: longint; virtual; abstract;',
  13854. ' procedure Fly(s: string); virtual; abstract;',
  13855. ' end;',
  13856. ' TBat = class(IBird,IEagle,IDove,ISwallow)',
  13857. ' function _AddRef: longint; virtual; abstract;',
  13858. ' function _Release: longint; virtual; abstract;',
  13859. ' FBirdIntf: IBird;',
  13860. ' property BirdIntf: IBird read FBirdIntf implements IBird;',
  13861. ' function GetEagleIntf: IEagle; virtual; abstract;',
  13862. ' property EagleIntf: IEagle read GetEagleIntf implements IEagle;',
  13863. ' FDoveObj: TBird;',
  13864. ' property DoveObj: TBird read FDoveObj implements IDove;',
  13865. ' function GetSwallowObj: TBird; virtual; abstract;',
  13866. ' property SwallowObj: TBird read GetSwallowObj implements ISwallow;',
  13867. ' end;',
  13868. 'begin',
  13869. '']);
  13870. ConvertProgram;
  13871. CheckSource('TestClassInterface_COM_Delegation',
  13872. LinesToStr([ // statements
  13873. 'rtl.createInterface($mod, "IUnknown", "{5D22E7CA-4E77-3872-9406-776A86A09328}", ["_AddRef", "_Release"], null);',
  13874. 'rtl.createInterface($mod, "IBird", "{174B9F1B-B1BC-3868-8338-1709AB763676}", ["Fly"], $mod.IUnknown);',
  13875. 'rtl.createInterface($mod, "IEagle", "{95CDEE63-AD4B-322E-B6F5-6C42ECD29875}", [], $mod.IBird);',
  13876. 'rtl.createInterface($mod, "IDove", "{95CDEE63-AD4B-322E-B569-17F2ECD29875}", [], $mod.IBird);',
  13877. 'rtl.createInterface($mod, "ISwallow", "{95CDEE63-AD4B-322E-84A4-ECEA48D29875}", [], $mod.IBird);',
  13878. 'rtl.createClass($mod, "TObject", null, function () {',
  13879. ' this.$init = function () {',
  13880. ' };',
  13881. ' this.$final = function () {',
  13882. ' };',
  13883. '});',
  13884. 'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
  13885. ' this.$intfmaps = {};',
  13886. ' rtl.addIntf(this, $mod.IBird);',
  13887. ' rtl.addIntf(this, $mod.IEagle);',
  13888. ' rtl.addIntf(this, $mod.IDove);',
  13889. ' rtl.addIntf(this, $mod.ISwallow);',
  13890. '});',
  13891. 'rtl.createClass($mod, "TBat", $mod.TObject, function () {',
  13892. ' this.$init = function () {',
  13893. ' $mod.TObject.$init.call(this);',
  13894. ' this.FBirdIntf = null;',
  13895. ' this.FDoveObj = null;',
  13896. ' };',
  13897. ' this.$final = function () {',
  13898. ' this.FBirdIntf = undefined;',
  13899. ' this.FDoveObj = undefined;',
  13900. ' $mod.TObject.$final.call(this);',
  13901. ' };',
  13902. ' this.$intfmaps = {',
  13903. ' "{174B9F1B-B1BC-3868-8338-1709AB763676}": function () {',
  13904. ' return rtl._AddRef(this.FBirdIntf);',
  13905. ' },',
  13906. ' "{95CDEE63-AD4B-322E-B6F5-6C42ECD29875}": function () {',
  13907. ' return this.GetEagleIntf();',
  13908. ' },',
  13909. ' "{95CDEE63-AD4B-322E-B569-17F2ECD29875}": function () {',
  13910. ' return rtl.queryIntfT(this.FDoveObj, $mod.IDove);',
  13911. ' },',
  13912. ' "{95CDEE63-AD4B-322E-84A4-ECEA48D29875}": function () {',
  13913. ' return rtl.queryIntfT(this.GetSwallowObj(), $mod.ISwallow);',
  13914. ' }',
  13915. ' };',
  13916. '});',
  13917. '']),
  13918. LinesToStr([ // $mod.$main
  13919. '']));
  13920. end;
  13921. procedure TTestModule.TestClassInterface_COM_With;
  13922. begin
  13923. StartProgram(false);
  13924. Add([
  13925. '{$interfaces com}',
  13926. 'type',
  13927. ' IUnknown = interface',
  13928. ' function _AddRef: longint;',
  13929. ' function _Release: longint;',
  13930. ' function GetAnt: IUnknown;',
  13931. ' property Ant: IUnknown read GetAnt;',
  13932. ' end;',
  13933. ' TObject = class(IUnknown)',
  13934. ' function _AddRef: longint; virtual; abstract;',
  13935. ' function _Release: longint; virtual; abstract;',
  13936. ' function GetAnt: IUnknown; virtual; abstract;',
  13937. ' property Ant: IUnknown read GetAnt;',
  13938. ' end;',
  13939. 'procedure DoIt;',
  13940. 'var',
  13941. ' i: IUnknown;',
  13942. 'begin',
  13943. ' with i do ',
  13944. ' GetAnt;',
  13945. ' with i.Ant, Ant do ',
  13946. ' GetAnt;',
  13947. 'end;',
  13948. 'begin',
  13949. '']);
  13950. ConvertProgram;
  13951. CheckSource('TestClassInterface_COM_With',
  13952. LinesToStr([ // statements
  13953. 'rtl.createInterface($mod, "IUnknown", "{F1ACF9FE-4E77-3872-9406-776A86A09333}", ["_AddRef", "_Release", "GetAnt"], null);',
  13954. 'rtl.createClass($mod, "TObject", null, function () {',
  13955. ' this.$init = function () {',
  13956. ' };',
  13957. ' this.$final = function () {',
  13958. ' };',
  13959. ' this.$intfmaps = {};',
  13960. ' rtl.addIntf(this, $mod.IUnknown);',
  13961. '});',
  13962. 'this.DoIt = function () {',
  13963. ' var i = null;',
  13964. ' var $ir = rtl.createIntfRefs();',
  13965. ' try {',
  13966. ' $ir.ref(1, i.GetAnt());',
  13967. ' var $with1 = $ir.ref(2, i.GetAnt());',
  13968. ' var $with2 = $ir.ref(3, $with1.GetAnt());',
  13969. ' $ir.ref(4, $with2.GetAnt());',
  13970. ' } finally {',
  13971. ' $ir.free();',
  13972. ' };',
  13973. '};',
  13974. '']),
  13975. LinesToStr([ // $mod.$main
  13976. '']));
  13977. end;
  13978. procedure TTestModule.TestClassInterface_COM_ForIn;
  13979. begin
  13980. StartProgram(false);
  13981. Add([
  13982. '{$interfaces com}',
  13983. 'type',
  13984. ' IUnknown = interface end;',
  13985. ' TObject = class',
  13986. ' Id: longint;',
  13987. ' end;',
  13988. ' IEnumerator = interface(IUnknown)',
  13989. ' function GetCurrent: TObject;',
  13990. ' function MoveNext: Boolean;',
  13991. ' property Current: TObject read GetCurrent;',
  13992. ' end;',
  13993. ' IEnumerable = interface(IUnknown)',
  13994. ' function GetEnumerator: IEnumerator;',
  13995. ' end;',
  13996. 'var',
  13997. ' o: TObject;',
  13998. ' i: IEnumerable;',
  13999. 'begin',
  14000. ' for o in i do o.Id:=3;',
  14001. '']);
  14002. ConvertProgram;
  14003. CheckSource('TestClassInterface_COM_ForIn',
  14004. LinesToStr([ // statements
  14005. 'rtl.createInterface($mod, "IUnknown", "{5D22E7CA-4E00-3000-8000-000000000000}", [], null);',
  14006. 'rtl.createClass($mod, "TObject", null, function () {',
  14007. ' this.$init = function () {',
  14008. ' this.Id = 0;',
  14009. ' };',
  14010. ' this.$final = function () {',
  14011. ' };',
  14012. '});',
  14013. 'rtl.createInterface($mod, "IEnumerator", "{D2FE11F3-D2CC-36BB-A5B2-66EB7FB5CB08}", ["GetCurrent", "MoveNext"], $mod.IUnknown);',
  14014. 'rtl.createInterface($mod, "IEnumerable", "{D20534CB-D9C0-3EA5-AA60-ACEB7D726308}", ["GetEnumerator"], $mod.IUnknown);',
  14015. 'this.o = null;',
  14016. 'this.i = null;',
  14017. '']),
  14018. LinesToStr([ // $mod.$main
  14019. 'var $in1 = $mod.i.GetEnumerator();',
  14020. 'try {',
  14021. ' while ($in1.MoveNext()) {',
  14022. ' $mod.o = $in1.GetCurrent();',
  14023. ' $mod.o.Id = 3;',
  14024. ' }',
  14025. '} finally {',
  14026. ' rtl._Release($in1)',
  14027. '};',
  14028. '']));
  14029. end;
  14030. procedure TTestModule.TestClassInterface_COM_ArrayOfIntfFail;
  14031. begin
  14032. StartProgram(false);
  14033. Add([
  14034. '{$interfaces com}',
  14035. 'type',
  14036. ' IUnknown = interface',
  14037. ' function _AddRef: longint;',
  14038. ' function _Release: longint;',
  14039. ' end;',
  14040. ' TObject = class',
  14041. ' end;',
  14042. ' TArrOfIntf = array of IUnknown;',
  14043. 'begin',
  14044. '']);
  14045. SetExpectedPasResolverError('Not supported: array of COM-interface',nNotSupportedX);
  14046. ConvertProgram;
  14047. end;
  14048. procedure TTestModule.TestClassInterface_COM_RecordIntfFail;
  14049. begin
  14050. StartProgram(false);
  14051. Add([
  14052. '{$interfaces com}',
  14053. 'type',
  14054. ' IUnknown = interface',
  14055. ' function _AddRef: longint;',
  14056. ' function _Release: longint;',
  14057. ' end;',
  14058. ' TRec = record',
  14059. ' i: IUnknown;',
  14060. ' end;',
  14061. 'begin',
  14062. '']);
  14063. SetExpectedPasResolverError('Not supported: COM-interface as record member',nNotSupportedX);
  14064. ConvertProgram;
  14065. end;
  14066. procedure TTestModule.TestClassInterface_COM_UnitInitialization;
  14067. begin
  14068. StartUnit(false);
  14069. Add([
  14070. '{$interfaces com}',
  14071. 'interface',
  14072. 'implementation',
  14073. 'type',
  14074. ' IUnknown = interface',
  14075. ' function _AddRef: longint;',
  14076. ' end;',
  14077. ' TObject = class(IUnknown)',
  14078. ' function _AddRef: longint;',
  14079. ' end;',
  14080. 'function TObject._AddRef: longint; begin end;',
  14081. 'var i: IUnknown;',
  14082. ' o: TObject;',
  14083. 'initialization',
  14084. ' i:=nil;',
  14085. ' i:=i;',
  14086. ' i:=o;',
  14087. ' if (o as IUnknown)=nil then ;',
  14088. '']);
  14089. ConvertUnit;
  14090. CheckSource('TestClassInterface_COM_UnitInitialization',
  14091. LinesToStr([ // statements
  14092. 'var $impl = $mod.$impl;',
  14093. '']),
  14094. LinesToStr([ // this.$init
  14095. 'var $ir = rtl.createIntfRefs();',
  14096. 'try {',
  14097. ' rtl.setIntfP($impl, "i", null);',
  14098. ' rtl.setIntfP($impl, "i", $impl.i);',
  14099. ' rtl.setIntfP($impl, "i", rtl.queryIntfT($impl.o, $impl.IUnknown), true);',
  14100. ' if ($ir.ref(1, rtl.queryIntfT($impl.o, $impl.IUnknown)) === null) ;',
  14101. '} finally {',
  14102. ' $ir.free();',
  14103. '};',
  14104. '']),
  14105. LinesToStr([ // implementation
  14106. 'rtl.createInterface($impl, "IUnknown", "{5D22E7CA-4E77-3872-9406-000000000000}", ["_AddRef"], null);',
  14107. 'rtl.createClass($impl, "TObject", null, function () {',
  14108. ' this.$init = function () {',
  14109. ' };',
  14110. ' this.$final = function () {',
  14111. ' };',
  14112. ' this._AddRef = function () {',
  14113. ' var Result = 0;',
  14114. ' return Result;',
  14115. ' };',
  14116. ' this.$intfmaps = {};',
  14117. ' rtl.addIntf(this, $impl.IUnknown);',
  14118. '});',
  14119. '$impl.i = null;',
  14120. '$impl.o = null;',
  14121. ''])
  14122. );
  14123. end;
  14124. procedure TTestModule.TestClassInterface_GUID;
  14125. begin
  14126. StartProgram(false);
  14127. Add([
  14128. '{$interfaces corba}',
  14129. 'type',
  14130. ' IUnknown = interface',
  14131. ' [''{f31db68f-3010-D355-4EBA-CDD4EF4A737C}'']',
  14132. ' end;',
  14133. ' TObject = class end;',
  14134. ' TGUID = record D1, D2, D3, D4: word; end;',
  14135. ' TAliasGUID = TGUID;',
  14136. ' TGUIDString = string;',
  14137. ' TAliasGUIDString = TGUIDString;',
  14138. 'procedure DoConstGUIDIt(const g: TAliasGUID); overload;',
  14139. 'begin end;',
  14140. 'procedure DoDefGUID(g: TAliasGUID); overload;',
  14141. 'begin end;',
  14142. 'procedure DoStr(const s: TAliasGUIDString); overload;',
  14143. 'begin end;',
  14144. 'var',
  14145. ' i: IUnknown;',
  14146. ' g: TAliasGUID = ''{d91c9af4-3C93-420F-A303-BF5BA82BFD23}'';',
  14147. ' s: TAliasGUIDString;',
  14148. 'begin',
  14149. ' DoConstGUIDIt(IUnknown);',
  14150. ' DoDefGUID(IUnknown);',
  14151. ' DoStr(IUnknown);',
  14152. ' DoConstGUIDIt(i);',
  14153. ' DoDefGUID(i);',
  14154. ' DoStr(i);',
  14155. ' DoConstGUIDIt(''{D91C9AF4-3c93-420f-A303-BF5BA82BFD23}'');',
  14156. ' DoDefGUID(''{D91C9AF4-3c93-420f-A303-BF5BA82BFD23}'');',
  14157. ' DoStr(g);',
  14158. ' g:=i;',
  14159. ' g:=IUnknown;',
  14160. ' g:=''{D91C9AF4-3C93-420F-A303-bf5ba82bfd23}'';',
  14161. ' s:=i;',
  14162. ' s:=IUnknown;',
  14163. ' s:=g;',
  14164. ' if g=i then ;',
  14165. ' if i=g then ;',
  14166. ' if g=IUnknown then ;',
  14167. ' if IUnknown=g then ;',
  14168. ' if s=i then ;',
  14169. ' if i=s then ;',
  14170. ' if s=IUnknown then ;',
  14171. ' if IUnknown=s then ;',
  14172. ' if s=g then ;',
  14173. ' if g=s then ;',
  14174. '']);
  14175. ConvertProgram;
  14176. CheckSource('TestClassInterface_GUID',
  14177. LinesToStr([ // statements
  14178. 'rtl.createInterface($mod, "IUnknown", "{F31DB68F-3010-D355-4EBA-CDD4EF4A737C}", [], null);',
  14179. 'rtl.createClass($mod, "TObject", null, function () {',
  14180. ' this.$init = function () {',
  14181. ' };',
  14182. ' this.$final = function () {',
  14183. ' };',
  14184. '});',
  14185. 'this.TGUID = function (s) {',
  14186. ' if (s) {',
  14187. ' this.D1 = s.D1;',
  14188. ' this.D2 = s.D2;',
  14189. ' this.D3 = s.D3;',
  14190. ' this.D4 = s.D4;',
  14191. ' } else {',
  14192. ' this.D1 = 0;',
  14193. ' this.D2 = 0;',
  14194. ' this.D3 = 0;',
  14195. ' this.D4 = 0;',
  14196. ' };',
  14197. ' this.$equal = function (b) {',
  14198. ' return (this.D1 === b.D1) && ((this.D2 === b.D2) && ((this.D3 === b.D3) && (this.D4 === b.D4)));',
  14199. ' };',
  14200. '};',
  14201. 'this.DoConstGUIDIt = function (g) {',
  14202. '};',
  14203. 'this.DoDefGUID = function (g) {',
  14204. '};',
  14205. 'this.DoStr = function (s) {',
  14206. '};',
  14207. 'this.i = null;',
  14208. 'this.g = new $mod.TGUID({',
  14209. ' D1: 0xD91C9AF4,',
  14210. ' D2: 0x3C93,',
  14211. ' D3: 0x420F,',
  14212. ' D4: [',
  14213. ' 0xA3,',
  14214. ' 0x03,',
  14215. ' 0xBF,',
  14216. ' 0x5B,',
  14217. ' 0xA8,',
  14218. ' 0x2B,',
  14219. ' 0xFD,',
  14220. ' 0x23',
  14221. ' ]',
  14222. '});',
  14223. 'this.s = "";',
  14224. '']),
  14225. LinesToStr([ // $mod.$main
  14226. '$mod.DoConstGUIDIt(rtl.getIntfGUIDR($mod.IUnknown));',
  14227. '$mod.DoDefGUID(new $mod.TGUID(rtl.getIntfGUIDR($mod.IUnknown)));',
  14228. '$mod.DoStr($mod.IUnknown.$guid);',
  14229. '$mod.DoConstGUIDIt(rtl.getIntfGUIDR($mod.i));',
  14230. '$mod.DoDefGUID(new $mod.TGUID(rtl.getIntfGUIDR($mod.i)));',
  14231. '$mod.DoStr($mod.i.$guid);',
  14232. '$mod.DoConstGUIDIt(rtl.strToGUIDR("{D91C9AF4-3c93-420f-A303-BF5BA82BFD23}"));',
  14233. '$mod.DoDefGUID(rtl.strToGUIDR("{D91C9AF4-3c93-420f-A303-BF5BA82BFD23}"));',
  14234. '$mod.DoStr(rtl.guidrToStr($mod.g));',
  14235. '$mod.g = new $mod.TGUID(rtl.getIntfGUIDR($mod.i));',
  14236. '$mod.g = new $mod.TGUID(rtl.getIntfGUIDR($mod.IUnknown));',
  14237. '$mod.g = new $mod.TGUID({',
  14238. ' D1: 0xD91C9AF4,',
  14239. ' D2: 0x3C93,',
  14240. ' D3: 0x420F,',
  14241. ' D4: [',
  14242. ' 0xA3,',
  14243. ' 0x03,',
  14244. ' 0xBF,',
  14245. ' 0x5B,',
  14246. ' 0xA8,',
  14247. ' 0x2B,',
  14248. ' 0xFD,',
  14249. ' 0x23',
  14250. ' ]',
  14251. '});',
  14252. '$mod.s = $mod.i.$guid;',
  14253. '$mod.s = $mod.IUnknown.$guid;',
  14254. '$mod.s = rtl.guidrToStr($mod.g);',
  14255. 'if ($mod.g.$equal(rtl.getIntfGUIDR($mod.i))) ;',
  14256. 'if ($mod.g.$equal(rtl.getIntfGUIDR($mod.i))) ;',
  14257. 'if ($mod.g.$equal(rtl.getIntfGUIDR($mod.IUnknown))) ;',
  14258. 'if ($mod.g.$equal(rtl.getIntfGUIDR($mod.IUnknown))) ;',
  14259. 'if ($mod.s === $mod.i.$guid) ;',
  14260. 'if ($mod.i.$guid === $mod.s) ;',
  14261. 'if ($mod.s === $mod.IUnknown.$guid) ;',
  14262. 'if ($mod.IUnknown.$guid === $mod.s) ;',
  14263. 'if ($mod.g.$equal(rtl.createTGUID($mod.s))) ;',
  14264. 'if ($mod.g.$equal(rtl.createTGUID($mod.s))) ;',
  14265. '']));
  14266. end;
  14267. procedure TTestModule.TestClassInterface_GUIDProperty;
  14268. begin
  14269. StartProgram(false);
  14270. Add([
  14271. '{$interfaces corba}',
  14272. 'type',
  14273. ' IUnknown = interface',
  14274. ' [''{f31db68f-3010-D355-4EBA-CDD4EF4A737C}'']',
  14275. ' end;',
  14276. ' TGUID = record D1, D2, D3, D4: word; end;',
  14277. ' TAliasGUID = TGUID;',
  14278. ' TGUIDString = string;',
  14279. ' TAliasGUIDString = TGUIDString;',
  14280. ' TObject = class',
  14281. ' function GetG: TAliasGUID; virtual; abstract;',
  14282. ' procedure SetG(const Value: TAliasGUID); virtual; abstract;',
  14283. ' function GetS: TAliasGUIDString; virtual; abstract;',
  14284. ' procedure SetS(const Value: TAliasGUIDString); virtual; abstract;',
  14285. ' property g: TAliasGUID read GetG write SetG;',
  14286. ' property s: TAliasGUIDString read GetS write SetS;',
  14287. ' end;',
  14288. 'var o: TObject;',
  14289. 'begin',
  14290. ' o.g:=IUnknown;',
  14291. ' o.g:=''{D91C9AF4-3C93-420F-A303-bf5ba82bfd23}'';',
  14292. ' o.s:=IUnknown;',
  14293. ' o.s:=o.g;',
  14294. '']);
  14295. ConvertProgram;
  14296. CheckSource('TestClassInterface_GUIDProperty',
  14297. LinesToStr([ // statements
  14298. 'rtl.createInterface($mod, "IUnknown", "{F31DB68F-3010-D355-4EBA-CDD4EF4A737C}", [], null);',
  14299. 'this.TGUID = function (s) {',
  14300. ' if (s) {',
  14301. ' this.D1 = s.D1;',
  14302. ' this.D2 = s.D2;',
  14303. ' this.D3 = s.D3;',
  14304. ' this.D4 = s.D4;',
  14305. ' } else {',
  14306. ' this.D1 = 0;',
  14307. ' this.D2 = 0;',
  14308. ' this.D3 = 0;',
  14309. ' this.D4 = 0;',
  14310. ' };',
  14311. ' this.$equal = function (b) {',
  14312. ' return (this.D1 === b.D1) && ((this.D2 === b.D2) && ((this.D3 === b.D3) && (this.D4 === b.D4)));',
  14313. ' };',
  14314. '};',
  14315. 'rtl.createClass($mod, "TObject", null, function () {',
  14316. ' this.$init = function () {',
  14317. ' };',
  14318. ' this.$final = function () {',
  14319. ' };',
  14320. '});',
  14321. 'this.o = null;',
  14322. '']),
  14323. LinesToStr([ // $mod.$main
  14324. '$mod.o.SetG(new $mod.TGUID(rtl.getIntfGUIDR($mod.IUnknown)));',
  14325. '$mod.o.SetG(new $mod.TGUID({',
  14326. ' D1: 0xD91C9AF4,',
  14327. ' D2: 0x3C93,',
  14328. ' D3: 0x420F,',
  14329. ' D4: [',
  14330. ' 0xA3,',
  14331. ' 0x03,',
  14332. ' 0xBF,',
  14333. ' 0x5B,',
  14334. ' 0xA8,',
  14335. ' 0x2B,',
  14336. ' 0xFD,',
  14337. ' 0x23',
  14338. ' ]',
  14339. '}));',
  14340. '$mod.o.SetS($mod.IUnknown.$guid);',
  14341. '$mod.o.SetS(rtl.guidrToStr($mod.o.GetG()));',
  14342. '']));
  14343. end;
  14344. procedure TTestModule.TestProcType;
  14345. begin
  14346. StartProgram(false);
  14347. Add([
  14348. 'type',
  14349. ' TProcInt = procedure(vI: longint = 1);',
  14350. 'procedure DoIt(vJ: longint);',
  14351. 'begin end;',
  14352. 'var',
  14353. ' b: boolean;',
  14354. ' vP, vQ: tprocint;',
  14355. 'begin',
  14356. ' vp:=nil;',
  14357. ' vp:=vp;',
  14358. ' vp:=@doit;',
  14359. ' vp;',
  14360. ' vp();',
  14361. ' vp(2);',
  14362. ' b:=vp=nil;',
  14363. ' b:=nil=vp;',
  14364. ' b:=vp=vq;',
  14365. ' b:=vp=@doit;',
  14366. ' b:=@doit=vp;',
  14367. ' b:=vp<>nil;',
  14368. ' b:=nil<>vp;',
  14369. ' b:=vp<>vq;',
  14370. ' b:=vp<>@doit;',
  14371. ' b:=@doit<>vp;',
  14372. ' b:=Assigned(vp);',
  14373. ' if Assigned(vp) then ;']);
  14374. ConvertProgram;
  14375. CheckSource('TestProcType',
  14376. LinesToStr([ // statements
  14377. 'this.DoIt = function(vJ) {',
  14378. '};',
  14379. 'this.b = false;',
  14380. 'this.vP = null;',
  14381. 'this.vQ = null;'
  14382. ]),
  14383. LinesToStr([ // $mod.$main
  14384. '$mod.vP = null;',
  14385. '$mod.vP = $mod.vP;',
  14386. '$mod.vP = $mod.DoIt;',
  14387. '$mod.vP(1);',
  14388. '$mod.vP(1);',
  14389. '$mod.vP(2);',
  14390. '$mod.b = $mod.vP === null;',
  14391. '$mod.b = null === $mod.vP;',
  14392. '$mod.b = rtl.eqCallback($mod.vP,$mod.vQ);',
  14393. '$mod.b = rtl.eqCallback($mod.vP, $mod.DoIt);',
  14394. '$mod.b = rtl.eqCallback($mod.DoIt, $mod.vP);',
  14395. '$mod.b = $mod.vP !== null;',
  14396. '$mod.b = null !== $mod.vP;',
  14397. '$mod.b = !rtl.eqCallback($mod.vP,$mod.vQ);',
  14398. '$mod.b = !rtl.eqCallback($mod.vP, $mod.DoIt);',
  14399. '$mod.b = !rtl.eqCallback($mod.DoIt, $mod.vP);',
  14400. '$mod.b = $mod.vP != null;',
  14401. 'if ($mod.vP != null) ;',
  14402. '']));
  14403. end;
  14404. procedure TTestModule.TestProcType_Arg;
  14405. begin
  14406. StartProgram(false);
  14407. Add([
  14408. 'type',
  14409. ' TProcInt = procedure(vI: longint = 1);',
  14410. 'procedure DoIt(vJ: longint); begin end;',
  14411. 'procedure DoSome(vP, vQ: TProcInt);',
  14412. 'var',
  14413. ' b: boolean;',
  14414. 'begin',
  14415. ' vp:=nil;',
  14416. ' vp:=vp;',
  14417. ' vp:=@doit;',
  14418. ' vp;',
  14419. ' vp();',
  14420. ' vp(2);',
  14421. ' b:=vp=nil;',
  14422. ' b:=nil=vp;',
  14423. ' b:=vp=vq;',
  14424. ' b:=vp=@doit;',
  14425. ' b:=@doit=vp;',
  14426. ' b:=vp<>nil;',
  14427. ' b:=nil<>vp;',
  14428. ' b:=vp<>vq;',
  14429. ' b:=vp<>@doit;',
  14430. ' b:=@doit<>vp;',
  14431. ' b:=Assigned(vp);',
  14432. ' if Assigned(vp) then ;',
  14433. 'end;',
  14434. 'begin',
  14435. ' DoSome(@DoIt,nil);']);
  14436. ConvertProgram;
  14437. CheckSource('TestProcType_Arg',
  14438. LinesToStr([ // statements
  14439. 'this.DoIt = function(vJ) {',
  14440. '};',
  14441. 'this.DoSome = function(vP, vQ) {',
  14442. ' var b = false;',
  14443. ' vP = null;',
  14444. ' vP = vP;',
  14445. ' vP = $mod.DoIt;',
  14446. ' vP(1);',
  14447. ' vP(1);',
  14448. ' vP(2);',
  14449. ' b = vP === null;',
  14450. ' b = null === vP;',
  14451. ' b = rtl.eqCallback(vP,vQ);',
  14452. ' b = rtl.eqCallback(vP, $mod.DoIt);',
  14453. ' b = rtl.eqCallback($mod.DoIt, vP);',
  14454. ' b = vP !== null;',
  14455. ' b = null !== vP;',
  14456. ' b = !rtl.eqCallback(vP, vQ);',
  14457. ' b = !rtl.eqCallback(vP, $mod.DoIt);',
  14458. ' b = !rtl.eqCallback($mod.DoIt, vP);',
  14459. ' b = vP != null;',
  14460. ' if (vP != null) ;',
  14461. '};',
  14462. '']),
  14463. LinesToStr([ // $mod.$main
  14464. '$mod.DoSome($mod.DoIt,null);',
  14465. '']));
  14466. end;
  14467. procedure TTestModule.TestProcType_FunctionFPC;
  14468. begin
  14469. StartProgram(false);
  14470. Add('type');
  14471. Add(' TFuncInt = function(vA: longint = 1): longint;');
  14472. Add('function DoIt(vI: longint): longint;');
  14473. Add('begin end;');
  14474. Add('var');
  14475. Add(' b: boolean;');
  14476. Add(' vP, vQ: tfuncint;');
  14477. Add('begin');
  14478. Add(' vp:=nil;');
  14479. Add(' vp:=vp;');
  14480. Add(' vp:=@doit;'); // ok in fpc and delphi
  14481. //Add(' vp:=doit;'); // illegal in fpc, ok in delphi
  14482. Add(' vp;'); // ok in fpc and delphi
  14483. Add(' vp();');
  14484. Add(' vp(2);');
  14485. Add(' b:=vp=nil;'); // ok in fpc, illegal in delphi
  14486. Add(' b:=nil=vp;'); // ok in fpc, illegal in delphi
  14487. Add(' b:=vp=vq;'); // in fpc compare proctypes, in delphi compare results
  14488. Add(' b:=vp=@doit;'); // ok in fpc, illegal in delphi
  14489. Add(' b:=@doit=vp;'); // ok in fpc, illegal in delphi
  14490. //Add(' b:=vp=3;'); // illegal in fpc, ok in delphi
  14491. Add(' b:=4=vp;'); // illegal in fpc, ok in delphi
  14492. Add(' b:=vp<>nil;'); // ok in fpc, illegal in delphi
  14493. Add(' b:=nil<>vp;'); // ok in fpc, illegal in delphi
  14494. Add(' b:=vp<>vq;'); // in fpc compare proctypes, in delphi compare results
  14495. Add(' b:=vp<>@doit;'); // ok in fpc, illegal in delphi
  14496. Add(' b:=@doit<>vp;'); // ok in fpc, illegal in delphi
  14497. //Add(' b:=vp<>5;'); // illegal in fpc, ok in delphi
  14498. Add(' b:=6<>vp;'); // illegal in fpc, ok in delphi
  14499. Add(' b:=Assigned(vp);');
  14500. //Add(' doit(vp);'); // illegal in fpc, ok in delphi
  14501. Add(' doit(vp());'); // ok in fpc and delphi
  14502. Add(' doit(vp(2));'); // ok in fpc and delphi
  14503. ConvertProgram;
  14504. CheckSource('TestProcType_FunctionFPC',
  14505. LinesToStr([ // statements
  14506. 'this.DoIt = function(vI) {',
  14507. ' var Result = 0;',
  14508. ' return Result;',
  14509. '};',
  14510. 'this.b = false;',
  14511. 'this.vP = null;',
  14512. 'this.vQ = null;'
  14513. ]),
  14514. LinesToStr([ // $mod.$main
  14515. '$mod.vP = null;',
  14516. '$mod.vP = $mod.vP;',
  14517. '$mod.vP = $mod.DoIt;',
  14518. '$mod.vP(1);',
  14519. '$mod.vP(1);',
  14520. '$mod.vP(2);',
  14521. '$mod.b = $mod.vP === null;',
  14522. '$mod.b = null === $mod.vP;',
  14523. '$mod.b = rtl.eqCallback($mod.vP,$mod.vQ);',
  14524. '$mod.b = rtl.eqCallback($mod.vP, $mod.DoIt);',
  14525. '$mod.b = rtl.eqCallback($mod.DoIt, $mod.vP);',
  14526. '$mod.b = 4 === $mod.vP(1);',
  14527. '$mod.b = $mod.vP !== null;',
  14528. '$mod.b = null !== $mod.vP;',
  14529. '$mod.b = !rtl.eqCallback($mod.vP,$mod.vQ);',
  14530. '$mod.b = !rtl.eqCallback($mod.vP, $mod.DoIt);',
  14531. '$mod.b = !rtl.eqCallback($mod.DoIt, $mod.vP);',
  14532. '$mod.b = 6 !== $mod.vP(1);',
  14533. '$mod.b = $mod.vP != null;',
  14534. '$mod.DoIt($mod.vP(1));',
  14535. '$mod.DoIt($mod.vP(2));',
  14536. '']));
  14537. end;
  14538. procedure TTestModule.TestProcType_FunctionDelphi;
  14539. begin
  14540. StartProgram(false);
  14541. Add('{$mode Delphi}');
  14542. Add('type');
  14543. Add(' TFuncInt = function(vA: longint = 1): longint;');
  14544. Add('function DoIt(vI: longint): longint;');
  14545. Add('begin end;');
  14546. Add('var');
  14547. Add(' b: boolean;');
  14548. Add(' vP, vQ: tfuncint;');
  14549. Add('begin');
  14550. Add(' vp:=nil;');
  14551. Add(' vp:=vp;');
  14552. Add(' vp:=@doit;'); // ok in fpc and delphi
  14553. Add(' vp:=doit;'); // illegal in fpc, ok in delphi
  14554. Add(' vp;'); // ok in fpc and delphi
  14555. Add(' vp();');
  14556. Add(' vp(2);');
  14557. //Add(' b:=vp=nil;'); // ok in fpc, illegal in delphi
  14558. //Add(' b:=nil=vp;'); // ok in fpc, illegal in delphi
  14559. Add(' b:=vp=vq;'); // in fpc compare proctypes, in delphi compare results
  14560. //Add(' b:=vp=@doit;'); // ok in fpc, illegal in delphi
  14561. //Add(' b:=@doit=vp;'); // ok in fpc, illegal in delphi
  14562. Add(' b:=vp=3;'); // illegal in fpc, ok in delphi
  14563. Add(' b:=4=vp;'); // illegal in fpc, ok in delphi
  14564. //Add(' b:=vp<>nil;'); // ok in fpc, illegal in delphi
  14565. //Add(' b:=nil<>vp;'); // ok in fpc, illegal in delphi
  14566. Add(' b:=vp<>vq;'); // in fpc compare proctypes, in delphi compare results
  14567. //Add(' b:=vp<>@doit;'); // ok in fpc, illegal in delphi
  14568. //Add(' b:=@doit<>vp;'); // ok in fpc, illegal in delphi
  14569. Add(' b:=vp<>5;'); // illegal in fpc, ok in delphi
  14570. Add(' b:=6<>vp;'); // illegal in fpc, ok in delphi
  14571. Add(' b:=Assigned(vp);');
  14572. Add(' doit(vp);'); // illegal in fpc, ok in delphi
  14573. Add(' doit(vp());'); // ok in fpc and delphi
  14574. Add(' doit(vp(2));'); // ok in fpc and delphi *)
  14575. ConvertProgram;
  14576. CheckSource('TestProcType_FunctionDelphi',
  14577. LinesToStr([ // statements
  14578. 'this.DoIt = function(vI) {',
  14579. ' var Result = 0;',
  14580. ' return Result;',
  14581. '};',
  14582. 'this.b = false;',
  14583. 'this.vP = null;',
  14584. 'this.vQ = null;'
  14585. ]),
  14586. LinesToStr([ // $mod.$main
  14587. '$mod.vP = null;',
  14588. '$mod.vP = $mod.vP;',
  14589. '$mod.vP = $mod.DoIt;',
  14590. '$mod.vP = $mod.DoIt;',
  14591. '$mod.vP(1);',
  14592. '$mod.vP(1);',
  14593. '$mod.vP(2);',
  14594. '$mod.b = $mod.vP(1) === $mod.vQ(1);',
  14595. '$mod.b = $mod.vP(1) === 3;',
  14596. '$mod.b = 4 === $mod.vP(1);',
  14597. '$mod.b = $mod.vP(1) !== $mod.vQ(1);',
  14598. '$mod.b = $mod.vP(1) !== 5;',
  14599. '$mod.b = 6 !== $mod.vP(1);',
  14600. '$mod.b = $mod.vP != null;',
  14601. '$mod.DoIt($mod.vP(1));',
  14602. '$mod.DoIt($mod.vP(1));',
  14603. '$mod.DoIt($mod.vP(2));',
  14604. '']));
  14605. end;
  14606. procedure TTestModule.TestProcType_ProcedureDelphi;
  14607. begin
  14608. StartProgram(false);
  14609. Add('{$mode Delphi}');
  14610. Add('type');
  14611. Add(' TProc = procedure;');
  14612. Add('procedure DoIt;');
  14613. Add('begin end;');
  14614. Add('var');
  14615. Add(' b: boolean;');
  14616. Add(' vP, vQ: tproc;');
  14617. Add('begin');
  14618. Add(' vp:=nil;');
  14619. Add(' vp:=vp;');
  14620. Add(' vp:=vq;');
  14621. 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
  14622. Add(' vp:=doit;'); // illegal in fpc, ok in delphi
  14623. //Add(' vp:=@doit;'); // illegal in fpc, ok in delphi (because Delphi treats @F as Pointer), not supported by resolver
  14624. Add(' vp;'); // ok in fpc and delphi
  14625. Add(' vp();');
  14626. // equal
  14627. //Add(' b:=vp=nil;'); // ok in fpc, illegal in delphi
  14628. Add(' b:=@@vp=nil;'); // ok in fpc delphi mode, ok in delphi
  14629. //Add(' b:=nil=vp;'); // ok in fpc, illegal in delphi
  14630. Add(' b:=nil=@@vp;'); // ok in fpc delphi mode, ok in delphi
  14631. Add(' b:=@@vp=@@vq;'); // ok in fpc delphi mode, ok in Delphi
  14632. //Add(' b:=vp=vq;'); // in fpc compare proctypes, in delphi compare results
  14633. //Add(' b:=vp=@doit;'); // ok in fpc, illegal in delphi
  14634. Add(' b:=@@vp=@doit;'); // ok in fpc delphi mode, ok in delphi
  14635. //Add(' b:=@doit=vp;'); // ok in fpc, illegal in delphi
  14636. Add(' b:=@doit=@@vp;'); // ok in fpc delphi mode, ok in delphi
  14637. // unequal
  14638. //Add(' b:=vp<>nil;'); // ok in fpc, illegal in delphi
  14639. Add(' b:=@@vp<>nil;'); // ok in fpc mode delphi, ok in delphi
  14640. //Add(' b:=nil<>vp;'); // ok in fpc, illegal in delphi
  14641. Add(' b:=nil<>@@vp;'); // ok in fpc mode delphi, ok in delphi
  14642. //Add(' b:=vp<>vq;'); // in fpc compare proctypes, in delphi compare results
  14643. Add(' b:=@@vp<>@@vq;'); // ok in fpc mode delphi, ok in delphi
  14644. //Add(' b:=vp<>@doit;'); // ok in fpc, illegal in delphi
  14645. Add(' b:=@@vp<>@doit;'); // ok in fpc mode delphi, illegal in delphi
  14646. //Add(' b:=@doit<>vp;'); // ok in fpc, illegal in delphi
  14647. Add(' b:=@doit<>@@vp;'); // ok in fpc mode delphi, illegal in delphi
  14648. Add(' b:=Assigned(vp);');
  14649. ConvertProgram;
  14650. CheckSource('TestProcType_ProcedureDelphi',
  14651. LinesToStr([ // statements
  14652. 'this.DoIt = function() {',
  14653. '};',
  14654. 'this.b = false;',
  14655. 'this.vP = null;',
  14656. 'this.vQ = null;'
  14657. ]),
  14658. LinesToStr([ // $mod.$main
  14659. '$mod.vP = null;',
  14660. '$mod.vP = $mod.vP;',
  14661. '$mod.vP = $mod.vQ;',
  14662. '$mod.vP = $mod.DoIt;',
  14663. '$mod.vP = $mod.DoIt;',
  14664. '$mod.vP();',
  14665. '$mod.vP();',
  14666. '$mod.b = $mod.vP === null;',
  14667. '$mod.b = null === $mod.vP;',
  14668. '$mod.b = rtl.eqCallback($mod.vP, $mod.vQ);',
  14669. '$mod.b = rtl.eqCallback($mod.vP, $mod.DoIt);',
  14670. '$mod.b = rtl.eqCallback($mod.DoIt, $mod.vP);',
  14671. '$mod.b = $mod.vP !== null;',
  14672. '$mod.b = null !== $mod.vP;',
  14673. '$mod.b = !rtl.eqCallback($mod.vP, $mod.vQ);',
  14674. '$mod.b = !rtl.eqCallback($mod.vP, $mod.DoIt);',
  14675. '$mod.b = !rtl.eqCallback($mod.DoIt, $mod.vP);',
  14676. '$mod.b = $mod.vP != null;',
  14677. '']));
  14678. end;
  14679. procedure TTestModule.TestProcType_AsParam;
  14680. begin
  14681. StartProgram(false);
  14682. Add('type');
  14683. Add(' TFuncInt = function(vA: longint = 1): longint;');
  14684. Add('procedure DoIt(vG: tfuncint; const vH: tfuncint; var vI: tfuncint);');
  14685. Add('var vJ: tfuncint;');
  14686. Add('begin');
  14687. Add(' vg:=vg;');
  14688. Add(' vj:=vh;');
  14689. Add(' vi:=vi;');
  14690. Add(' doit(vg,vg,vg);');
  14691. Add(' doit(vh,vh,vj);');
  14692. Add(' doit(vi,vi,vi);');
  14693. Add(' doit(vj,vj,vj);');
  14694. Add('end;');
  14695. Add('var i: tfuncint;');
  14696. Add('begin');
  14697. Add(' doit(i,i,i);');
  14698. ConvertProgram;
  14699. CheckSource('TestProcType_AsParam',
  14700. LinesToStr([ // statements
  14701. 'this.DoIt = function (vG,vH,vI) {',
  14702. ' var vJ = null;',
  14703. ' vG = vG;',
  14704. ' vJ = vH;',
  14705. ' vI.set(vI.get());',
  14706. ' $mod.DoIt(vG, vG, {',
  14707. ' get: function () {',
  14708. ' return vG;',
  14709. ' },',
  14710. ' set: function (v) {',
  14711. ' vG = v;',
  14712. ' }',
  14713. ' });',
  14714. ' $mod.DoIt(vH, vH, {',
  14715. ' get: function () {',
  14716. ' return vJ;',
  14717. ' },',
  14718. ' set: function (v) {',
  14719. ' vJ = v;',
  14720. ' }',
  14721. ' });',
  14722. ' $mod.DoIt(vI.get(), vI.get(), vI);',
  14723. ' $mod.DoIt(vJ, vJ, {',
  14724. ' get: function () {',
  14725. ' return vJ;',
  14726. ' },',
  14727. ' set: function (v) {',
  14728. ' vJ = v;',
  14729. ' }',
  14730. ' });',
  14731. '};',
  14732. 'this.i = null;'
  14733. ]),
  14734. LinesToStr([
  14735. '$mod.DoIt($mod.i,$mod.i,{',
  14736. ' p: $mod,',
  14737. ' get: function () {',
  14738. ' return this.p.i;',
  14739. ' },',
  14740. ' set: function (v) {',
  14741. ' this.p.i = v;',
  14742. ' }',
  14743. '});'
  14744. ]));
  14745. end;
  14746. procedure TTestModule.TestProcType_MethodFPC;
  14747. begin
  14748. StartProgram(false);
  14749. Add('type');
  14750. Add(' TFuncInt = function(vA: longint = 1): longint of object;');
  14751. Add(' TObject = class');
  14752. Add(' function DoIt(vA: longint = 1): longint;');
  14753. Add(' end;');
  14754. Add('function TObject.DoIt(vA: longint = 1): longint;');
  14755. Add('begin');
  14756. Add('end;');
  14757. Add('var');
  14758. Add(' Obj: TObject;');
  14759. Add(' vP: tfuncint;');
  14760. Add(' b: boolean;');
  14761. Add('begin');
  14762. Add(' vp:[email protected];'); // ok in fpc and delphi
  14763. //Add(' vp:=obj.doit;'); // illegal in fpc, ok in delphi
  14764. Add(' vp;'); // ok in fpc and delphi
  14765. Add(' vp();');
  14766. Add(' vp(2);');
  14767. Add(' b:[email protected];'); // ok in fpc, illegal in delphi
  14768. Add(' b:[email protected]=vp;'); // ok in fpc, illegal in delphi
  14769. Add(' b:=vp<>@obj.doit;'); // ok in fpc, illegal in delphi
  14770. Add(' b:[email protected]<>vp;'); // ok in fpc, illegal in delphi
  14771. ConvertProgram;
  14772. CheckSource('TestProcType_MethodFPC',
  14773. LinesToStr([ // statements
  14774. 'rtl.createClass($mod, "TObject", null, function () {',
  14775. ' this.$init = function () {',
  14776. ' };',
  14777. ' this.$final = function () {',
  14778. ' };',
  14779. ' this.DoIt = function (vA) {',
  14780. ' var Result = 0;',
  14781. ' return Result;',
  14782. ' };',
  14783. '});',
  14784. 'this.Obj = null;',
  14785. 'this.vP = null;',
  14786. 'this.b = false;'
  14787. ]),
  14788. LinesToStr([
  14789. '$mod.vP = rtl.createCallback($mod.Obj, "DoIt");',
  14790. '$mod.vP(1);',
  14791. '$mod.vP(1);',
  14792. '$mod.vP(2);',
  14793. '$mod.b = rtl.eqCallback($mod.vP, rtl.createCallback($mod.Obj, "DoIt"));',
  14794. '$mod.b = rtl.eqCallback(rtl.createCallback($mod.Obj, "DoIt"), $mod.vP);',
  14795. '$mod.b = !rtl.eqCallback($mod.vP, rtl.createCallback($mod.Obj, "DoIt"));',
  14796. '$mod.b = !rtl.eqCallback(rtl.createCallback($mod.Obj, "DoIt"), $mod.vP);',
  14797. '']));
  14798. end;
  14799. procedure TTestModule.TestProcType_MethodDelphi;
  14800. begin
  14801. StartProgram(false);
  14802. Add('{$mode delphi}');
  14803. Add('type');
  14804. Add(' TFuncInt = function(vA: longint = 1): longint of object;');
  14805. Add(' TObject = class');
  14806. Add(' function DoIt(vA: longint = 1): longint;');
  14807. Add(' end;');
  14808. Add('function TObject.DoIt(vA: longint = 1): longint;');
  14809. Add('begin');
  14810. Add('end;');
  14811. Add('var');
  14812. Add(' Obj: TObject;');
  14813. Add(' vP: tfuncint;');
  14814. Add(' b: boolean;');
  14815. Add('begin');
  14816. Add(' vp:[email protected];'); // ok in fpc and delphi
  14817. Add(' vp:=obj.doit;'); // illegal in fpc, ok in delphi
  14818. Add(' vp;'); // ok in fpc and delphi
  14819. Add(' vp();');
  14820. Add(' vp(2);');
  14821. //Add(' b:[email protected];'); // ok in fpc, illegal in delphi
  14822. //Add(' b:[email protected]=vp;'); // ok in fpc, illegal in delphi
  14823. //Add(' b:=vp<>@obj.doit;'); // ok in fpc, illegal in delphi
  14824. //Add(' b:[email protected]<>vp;'); // ok in fpc, illegal in delphi
  14825. ConvertProgram;
  14826. CheckSource('TestProcType_MethodDelphi',
  14827. LinesToStr([ // statements
  14828. 'rtl.createClass($mod, "TObject", null, function () {',
  14829. ' this.$init = function () {',
  14830. ' };',
  14831. ' this.$final = function () {',
  14832. ' };',
  14833. ' this.DoIt = function (vA) {',
  14834. ' var Result = 0;',
  14835. ' return Result;',
  14836. ' };',
  14837. '});',
  14838. 'this.Obj = null;',
  14839. 'this.vP = null;',
  14840. 'this.b = false;'
  14841. ]),
  14842. LinesToStr([
  14843. '$mod.vP = rtl.createCallback($mod.Obj, "DoIt");',
  14844. '$mod.vP = rtl.createCallback($mod.Obj, "DoIt");',
  14845. '$mod.vP(1);',
  14846. '$mod.vP(1);',
  14847. '$mod.vP(2);',
  14848. '']));
  14849. end;
  14850. procedure TTestModule.TestProcType_PropertyFPC;
  14851. begin
  14852. StartProgram(false);
  14853. Add('type');
  14854. Add(' TFuncInt = function(vA: longint = 1): longint of object;');
  14855. Add(' TObject = class');
  14856. Add(' FOnFoo: TFuncInt;');
  14857. Add(' function DoIt(vA: longint = 1): longint;');
  14858. Add(' function GetFoo: TFuncInt;');
  14859. Add(' procedure SetFoo(const Value: TFuncInt);');
  14860. Add(' function GetEvents(Index: longint): TFuncInt;');
  14861. Add(' procedure SetEvents(Index: longint; const Value: TFuncInt);');
  14862. Add(' property OnFoo: TFuncInt read FOnFoo write FOnFoo;');
  14863. Add(' property OnBar: TFuncInt read GetFoo write SetFoo;');
  14864. Add(' property Events[Index: longint]: TFuncInt read GetEvents write SetEvents; default;');
  14865. Add(' end;');
  14866. Add('function tobject.doit(va: longint = 1): longint; begin end;');
  14867. Add('function tobject.getfoo: tfuncint; begin end;');
  14868. Add('procedure tobject.setfoo(const value: tfuncint); begin end;');
  14869. Add('function tobject.getevents(index: longint): tfuncint; begin end;');
  14870. Add('procedure tobject.setevents(index: longint; const value: tfuncint); begin end;');
  14871. Add('var');
  14872. Add(' Obj: TObject;');
  14873. Add(' vP: tfuncint;');
  14874. Add(' b: boolean;');
  14875. Add('begin');
  14876. Add(' obj.onfoo:=nil;');
  14877. Add(' obj.onbar:=nil;');
  14878. Add(' obj.events[1]:=nil;');
  14879. Add(' obj.onfoo:=obj.onfoo;');
  14880. Add(' obj.onbar:=obj.onbar;');
  14881. Add(' obj.events[2]:=obj.events[3];');
  14882. Add(' obj.onfoo:[email protected];');
  14883. Add(' obj.onbar:[email protected];');
  14884. Add(' obj.events[4]:[email protected];');
  14885. //Add(' obj.onfoo:=obj.doit;'); // delphi
  14886. //Add(' obj.onbar:=obj.doit;'); // delphi
  14887. //Add(' obj.events[4]:=obj.doit;'); // delphi
  14888. Add(' obj.onfoo;');
  14889. Add(' obj.onbar;');
  14890. //Add(' obj.events[5];'); ToDo in pasresolver
  14891. Add(' obj.onfoo();');
  14892. Add(' obj.onbar();');
  14893. Add(' obj.events[6]();');
  14894. Add(' b:=obj.onfoo=nil;');
  14895. Add(' b:=obj.onbar=nil;');
  14896. Add(' b:=obj.events[7]=nil;');
  14897. Add(' b:=obj.onfoo<>nil;');
  14898. Add(' b:=obj.onbar<>nil;');
  14899. Add(' b:=obj.events[8]<>nil;');
  14900. Add(' b:=obj.onfoo=vp;');
  14901. Add(' b:=obj.onbar=vp;');
  14902. Add(' b:=obj.events[9]=vp;');
  14903. Add(' b:=obj.onfoo=obj.onfoo;');
  14904. Add(' b:=obj.onbar=obj.onfoo;');
  14905. Add(' b:=obj.events[10]=obj.onfoo;');
  14906. Add(' b:=obj.onfoo<>obj.onfoo;');
  14907. Add(' b:=obj.onbar<>obj.onfoo;');
  14908. Add(' b:=obj.events[11]<>obj.onfoo;');
  14909. Add(' b:[email protected];');
  14910. Add(' b:[email protected];');
  14911. Add(' b:=obj.events[12][email protected];');
  14912. Add(' b:=obj.onfoo<>@obj.doit;');
  14913. Add(' b:=obj.onbar<>@obj.doit;');
  14914. Add(' b:=obj.events[12]<>@obj.doit;');
  14915. Add(' b:=Assigned(obj.onfoo);');
  14916. Add(' b:=Assigned(obj.onbar);');
  14917. Add(' b:=Assigned(obj.events[13]);');
  14918. ConvertProgram;
  14919. CheckSource('TestProcType_PropertyFPC',
  14920. LinesToStr([ // statements
  14921. 'rtl.createClass($mod, "TObject", null, function () {',
  14922. ' this.$init = function () {',
  14923. ' this.FOnFoo = null;',
  14924. ' };',
  14925. ' this.$final = function () {',
  14926. ' this.FOnFoo = undefined;',
  14927. ' };',
  14928. ' this.DoIt = function (vA) {',
  14929. ' var Result = 0;',
  14930. ' return Result;',
  14931. ' };',
  14932. 'this.GetFoo = function () {',
  14933. ' var Result = null;',
  14934. ' return Result;',
  14935. '};',
  14936. 'this.SetFoo = function (Value) {',
  14937. '};',
  14938. 'this.GetEvents = function (Index) {',
  14939. ' var Result = null;',
  14940. ' return Result;',
  14941. '};',
  14942. 'this.SetEvents = function (Index, Value) {',
  14943. '};',
  14944. '});',
  14945. 'this.Obj = null;',
  14946. 'this.vP = null;',
  14947. 'this.b = false;'
  14948. ]),
  14949. LinesToStr([
  14950. '$mod.Obj.FOnFoo = null;',
  14951. '$mod.Obj.SetFoo(null);',
  14952. '$mod.Obj.SetEvents(1, null);',
  14953. '$mod.Obj.FOnFoo = $mod.Obj.FOnFoo;',
  14954. '$mod.Obj.SetFoo($mod.Obj.GetFoo());',
  14955. '$mod.Obj.SetEvents(2, $mod.Obj.GetEvents(3));',
  14956. '$mod.Obj.FOnFoo = rtl.createCallback($mod.Obj, "DoIt");',
  14957. '$mod.Obj.SetFoo(rtl.createCallback($mod.Obj, "DoIt"));',
  14958. '$mod.Obj.SetEvents(4, rtl.createCallback($mod.Obj, "DoIt"));',
  14959. '$mod.Obj.FOnFoo(1);',
  14960. '$mod.Obj.GetFoo();',
  14961. '$mod.Obj.FOnFoo(1);',
  14962. '$mod.Obj.GetFoo()(1);',
  14963. '$mod.Obj.GetEvents(6)(1);',
  14964. '$mod.b = $mod.Obj.FOnFoo === null;',
  14965. '$mod.b = $mod.Obj.GetFoo() === null;',
  14966. '$mod.b = $mod.Obj.GetEvents(7) === null;',
  14967. '$mod.b = $mod.Obj.FOnFoo !== null;',
  14968. '$mod.b = $mod.Obj.GetFoo() !== null;',
  14969. '$mod.b = $mod.Obj.GetEvents(8) !== null;',
  14970. '$mod.b = rtl.eqCallback($mod.Obj.FOnFoo, $mod.vP);',
  14971. '$mod.b = rtl.eqCallback($mod.Obj.GetFoo(), $mod.vP);',
  14972. '$mod.b = rtl.eqCallback($mod.Obj.GetEvents(9), $mod.vP);',
  14973. '$mod.b = rtl.eqCallback($mod.Obj.FOnFoo, $mod.Obj.FOnFoo);',
  14974. '$mod.b = rtl.eqCallback($mod.Obj.GetFoo(), $mod.Obj.FOnFoo);',
  14975. '$mod.b = rtl.eqCallback($mod.Obj.GetEvents(10), $mod.Obj.FOnFoo);',
  14976. '$mod.b = !rtl.eqCallback($mod.Obj.FOnFoo, $mod.Obj.FOnFoo);',
  14977. '$mod.b = !rtl.eqCallback($mod.Obj.GetFoo(), $mod.Obj.FOnFoo);',
  14978. '$mod.b = !rtl.eqCallback($mod.Obj.GetEvents(11), $mod.Obj.FOnFoo);',
  14979. '$mod.b = rtl.eqCallback($mod.Obj.FOnFoo, rtl.createCallback($mod.Obj, "DoIt"));',
  14980. '$mod.b = rtl.eqCallback($mod.Obj.GetFoo(), rtl.createCallback($mod.Obj, "DoIt"));',
  14981. '$mod.b = rtl.eqCallback($mod.Obj.GetEvents(12), rtl.createCallback($mod.Obj, "DoIt"));',
  14982. '$mod.b = !rtl.eqCallback($mod.Obj.FOnFoo, rtl.createCallback($mod.Obj, "DoIt"));',
  14983. '$mod.b = !rtl.eqCallback($mod.Obj.GetFoo(), rtl.createCallback($mod.Obj, "DoIt"));',
  14984. '$mod.b = !rtl.eqCallback($mod.Obj.GetEvents(12), rtl.createCallback($mod.Obj, "DoIt"));',
  14985. '$mod.b = $mod.Obj.FOnFoo != null;',
  14986. '$mod.b = $mod.Obj.GetFoo() != null;',
  14987. '$mod.b = $mod.Obj.GetEvents(13) != null;',
  14988. '']));
  14989. end;
  14990. procedure TTestModule.TestProcType_PropertyDelphi;
  14991. begin
  14992. StartProgram(false);
  14993. Add('{$mode delphi}');
  14994. Add('type');
  14995. Add(' TFuncInt = function(vA: longint = 1): longint of object;');
  14996. Add(' TObject = class');
  14997. Add(' FOnFoo: TFuncInt;');
  14998. Add(' function DoIt(vA: longint = 1): longint;');
  14999. Add(' function GetFoo: TFuncInt;');
  15000. Add(' procedure SetFoo(const Value: TFuncInt);');
  15001. Add(' function GetEvents(Index: longint): TFuncInt;');
  15002. Add(' procedure SetEvents(Index: longint; const Value: TFuncInt);');
  15003. Add(' property OnFoo: TFuncInt read FOnFoo write FOnFoo;');
  15004. Add(' property OnBar: TFuncInt read GetFoo write SetFoo;');
  15005. Add(' property Events[Index: longint]: TFuncInt read GetEvents write SetEvents; default;');
  15006. Add(' end;');
  15007. Add('function tobject.doit(va: longint = 1): longint; begin end;');
  15008. Add('function tobject.getfoo: tfuncint; begin end;');
  15009. Add('procedure tobject.setfoo(const value: tfuncint); begin end;');
  15010. Add('function tobject.getevents(index: longint): tfuncint; begin end;');
  15011. Add('procedure tobject.setevents(index: longint; const value: tfuncint); begin end;');
  15012. Add('var');
  15013. Add(' Obj: TObject;');
  15014. Add(' vP: tfuncint;');
  15015. Add(' b: boolean;');
  15016. Add('begin');
  15017. Add(' obj.onfoo:=nil;');
  15018. Add(' obj.onbar:=nil;');
  15019. Add(' obj.events[1]:=nil;');
  15020. Add(' obj.onfoo:=obj.onfoo;');
  15021. Add(' obj.onbar:=obj.onbar;');
  15022. Add(' obj.events[2]:=obj.events[3];');
  15023. Add(' obj.onfoo:[email protected];');
  15024. Add(' obj.onbar:[email protected];');
  15025. Add(' obj.events[4]:[email protected];');
  15026. Add(' obj.onfoo:=obj.doit;'); // delphi
  15027. Add(' obj.onbar:=obj.doit;'); // delphi
  15028. Add(' obj.events[4]:=obj.doit;'); // delphi
  15029. Add(' obj.onfoo;');
  15030. Add(' obj.onbar;');
  15031. //Add(' obj.events[5];'); ToDo in pasresolver
  15032. Add(' obj.onfoo();');
  15033. Add(' obj.onbar();');
  15034. Add(' obj.events[6]();');
  15035. //Add(' b:=obj.onfoo=nil;'); // fpc
  15036. //Add(' b:=obj.onbar=nil;'); // fpc
  15037. //Add(' b:=obj.events[7]=nil;'); // fpc
  15038. //Add(' b:=obj.onfoo<>nil;'); // fpc
  15039. //Add(' b:=obj.onbar<>nil;'); // fpc
  15040. //Add(' b:=obj.events[8]<>nil;'); // fpc
  15041. Add(' b:=obj.onfoo=vp;');
  15042. Add(' b:=obj.onbar=vp;');
  15043. //Add(' b:=obj.events[9]=vp;'); ToDo in pasresolver
  15044. Add(' b:=obj.onfoo=obj.onfoo;');
  15045. Add(' b:=obj.onbar=obj.onfoo;');
  15046. //Add(' b:=obj.events[10]=obj.onfoo;'); // ToDo in pasresolver
  15047. Add(' b:=obj.onfoo<>obj.onfoo;');
  15048. Add(' b:=obj.onbar<>obj.onfoo;');
  15049. //Add(' b:=obj.events[11]<>obj.onfoo;'); // ToDo in pasresolver
  15050. //Add(' b:[email protected];'); // fpc
  15051. //Add(' b:[email protected];'); // fpc
  15052. //Add(' b:=obj.events[12][email protected];'); // fpc
  15053. //Add(' b:=obj.onfoo<>@obj.doit;'); // fpc
  15054. //Add(' b:=obj.onbar<>@obj.doit;'); // fpc
  15055. //Add(' b:=obj.events[12]<>@obj.doit;'); // fpc
  15056. Add(' b:=Assigned(obj.onfoo);');
  15057. Add(' b:=Assigned(obj.onbar);');
  15058. Add(' b:=Assigned(obj.events[13]);');
  15059. ConvertProgram;
  15060. CheckSource('TestProcType_PropertyDelphi',
  15061. LinesToStr([ // statements
  15062. 'rtl.createClass($mod, "TObject", null, function () {',
  15063. ' this.$init = function () {',
  15064. ' this.FOnFoo = null;',
  15065. ' };',
  15066. ' this.$final = function () {',
  15067. ' this.FOnFoo = undefined;',
  15068. ' };',
  15069. ' this.DoIt = function (vA) {',
  15070. ' var Result = 0;',
  15071. ' return Result;',
  15072. ' };',
  15073. 'this.GetFoo = function () {',
  15074. ' var Result = null;',
  15075. ' return Result;',
  15076. '};',
  15077. 'this.SetFoo = function (Value) {',
  15078. '};',
  15079. 'this.GetEvents = function (Index) {',
  15080. ' var Result = null;',
  15081. ' return Result;',
  15082. '};',
  15083. 'this.SetEvents = function (Index, Value) {',
  15084. '};',
  15085. '});',
  15086. 'this.Obj = null;',
  15087. 'this.vP = null;',
  15088. 'this.b = false;'
  15089. ]),
  15090. LinesToStr([
  15091. '$mod.Obj.FOnFoo = null;',
  15092. '$mod.Obj.SetFoo(null);',
  15093. '$mod.Obj.SetEvents(1, null);',
  15094. '$mod.Obj.FOnFoo = $mod.Obj.FOnFoo;',
  15095. '$mod.Obj.SetFoo($mod.Obj.GetFoo());',
  15096. '$mod.Obj.SetEvents(2, $mod.Obj.GetEvents(3));',
  15097. '$mod.Obj.FOnFoo = rtl.createCallback($mod.Obj, "DoIt");',
  15098. '$mod.Obj.SetFoo(rtl.createCallback($mod.Obj, "DoIt"));',
  15099. '$mod.Obj.SetEvents(4, rtl.createCallback($mod.Obj, "DoIt"));',
  15100. '$mod.Obj.FOnFoo = rtl.createCallback($mod.Obj, "DoIt");',
  15101. '$mod.Obj.SetFoo(rtl.createCallback($mod.Obj, "DoIt"));',
  15102. '$mod.Obj.SetEvents(4, rtl.createCallback($mod.Obj, "DoIt"));',
  15103. '$mod.Obj.FOnFoo(1);',
  15104. '$mod.Obj.GetFoo();',
  15105. '$mod.Obj.FOnFoo(1);',
  15106. '$mod.Obj.GetFoo()(1);',
  15107. '$mod.Obj.GetEvents(6)(1);',
  15108. '$mod.b = $mod.Obj.FOnFoo(1) === $mod.vP(1);',
  15109. '$mod.b = $mod.Obj.GetFoo() === $mod.vP(1);',
  15110. '$mod.b = $mod.Obj.FOnFoo(1) === $mod.Obj.FOnFoo(1);',
  15111. '$mod.b = $mod.Obj.GetFoo() === $mod.Obj.FOnFoo(1);',
  15112. '$mod.b = $mod.Obj.FOnFoo(1) !== $mod.Obj.FOnFoo(1);',
  15113. '$mod.b = $mod.Obj.GetFoo() !== $mod.Obj.FOnFoo(1);',
  15114. '$mod.b = $mod.Obj.FOnFoo != null;',
  15115. '$mod.b = $mod.Obj.GetFoo() != null;',
  15116. '$mod.b = $mod.Obj.GetEvents(13) != null;',
  15117. '']));
  15118. end;
  15119. procedure TTestModule.TestProcType_WithClassInstDoPropertyFPC;
  15120. begin
  15121. StartProgram(false);
  15122. Add('type');
  15123. Add(' TFuncInt = function(vA: longint = 1): longint of object;');
  15124. Add(' TObject = class');
  15125. Add(' FOnFoo: TFuncInt;');
  15126. Add(' function DoIt(vA: longint = 1): longint;');
  15127. Add(' function GetFoo: TFuncInt;');
  15128. Add(' procedure SetFoo(const Value: TFuncInt);');
  15129. Add(' property OnFoo: TFuncInt read FOnFoo write FOnFoo;');
  15130. Add(' property OnBar: TFuncInt read GetFoo write SetFoo;');
  15131. Add(' end;');
  15132. Add('function tobject.doit(va: longint = 1): longint; begin end;');
  15133. Add('function tobject.getfoo: tfuncint; begin end;');
  15134. Add('procedure tobject.setfoo(const value: tfuncint); begin end;');
  15135. Add('var');
  15136. Add(' Obj: TObject;');
  15137. Add(' vP: tfuncint;');
  15138. Add(' b: boolean;');
  15139. Add('begin');
  15140. Add('with obj do begin');
  15141. Add(' fonfoo:=nil;');
  15142. Add(' onfoo:=nil;');
  15143. Add(' onbar:=nil;');
  15144. Add(' fonfoo:=fonfoo;');
  15145. Add(' onfoo:=onfoo;');
  15146. Add(' onbar:=onbar;');
  15147. Add(' fonfoo:=@doit;');
  15148. Add(' onfoo:=@doit;');
  15149. Add(' onbar:=@doit;');
  15150. //Add(' fonfoo:=doit;'); // delphi
  15151. //Add(' onfoo:=doit;'); // delphi
  15152. //Add(' onbar:=doit;'); // delphi
  15153. Add(' fonfoo;');
  15154. Add(' onfoo;');
  15155. Add(' onbar;');
  15156. Add(' fonfoo();');
  15157. Add(' onfoo();');
  15158. Add(' onbar();');
  15159. Add(' b:=fonfoo=nil;');
  15160. Add(' b:=onfoo=nil;');
  15161. Add(' b:=onbar=nil;');
  15162. Add(' b:=fonfoo<>nil;');
  15163. Add(' b:=onfoo<>nil;');
  15164. Add(' b:=onbar<>nil;');
  15165. Add(' b:=fonfoo=vp;');
  15166. Add(' b:=onfoo=vp;');
  15167. Add(' b:=onbar=vp;');
  15168. Add(' b:=fonfoo=fonfoo;');
  15169. Add(' b:=onfoo=onfoo;');
  15170. Add(' b:=onbar=onfoo;');
  15171. Add(' b:=fonfoo<>fonfoo;');
  15172. Add(' b:=onfoo<>onfoo;');
  15173. Add(' b:=onbar<>onfoo;');
  15174. Add(' b:=fonfoo=@doit;');
  15175. Add(' b:=onfoo=@doit;');
  15176. Add(' b:=onbar=@doit;');
  15177. Add(' b:=fonfoo<>@doit;');
  15178. Add(' b:=onfoo<>@doit;');
  15179. Add(' b:=onbar<>@doit;');
  15180. Add(' b:=Assigned(fonfoo);');
  15181. Add(' b:=Assigned(onfoo);');
  15182. Add(' b:=Assigned(onbar);');
  15183. Add('end;');
  15184. ConvertProgram;
  15185. CheckSource('TestProcType_WithClassInstDoPropertyFPC',
  15186. LinesToStr([ // statements
  15187. 'rtl.createClass($mod, "TObject", null, function () {',
  15188. ' this.$init = function () {',
  15189. ' this.FOnFoo = null;',
  15190. ' };',
  15191. ' this.$final = function () {',
  15192. ' this.FOnFoo = undefined;',
  15193. ' };',
  15194. ' this.DoIt = function (vA) {',
  15195. ' var Result = 0;',
  15196. ' return Result;',
  15197. ' };',
  15198. ' this.GetFoo = function () {',
  15199. ' var Result = null;',
  15200. ' return Result;',
  15201. ' };',
  15202. ' this.SetFoo = function (Value) {',
  15203. ' };',
  15204. '});',
  15205. 'this.Obj = null;',
  15206. 'this.vP = null;',
  15207. 'this.b = false;'
  15208. ]),
  15209. LinesToStr([
  15210. 'var $with1 = $mod.Obj;',
  15211. '$with1.FOnFoo = null;',
  15212. '$with1.FOnFoo = null;',
  15213. '$with1.SetFoo(null);',
  15214. '$with1.FOnFoo = $with1.FOnFoo;',
  15215. '$with1.FOnFoo = $with1.FOnFoo;',
  15216. '$with1.SetFoo($with1.GetFoo());',
  15217. '$with1.FOnFoo = rtl.createCallback($with1, "DoIt");',
  15218. '$with1.FOnFoo = rtl.createCallback($with1, "DoIt");',
  15219. '$with1.SetFoo(rtl.createCallback($with1, "DoIt"));',
  15220. '$with1.FOnFoo(1);',
  15221. '$with1.FOnFoo(1);',
  15222. '$with1.GetFoo();',
  15223. '$with1.FOnFoo(1);',
  15224. '$with1.FOnFoo(1);',
  15225. '$with1.GetFoo()(1);',
  15226. '$mod.b = $with1.FOnFoo === null;',
  15227. '$mod.b = $with1.FOnFoo === null;',
  15228. '$mod.b = $with1.GetFoo() === null;',
  15229. '$mod.b = $with1.FOnFoo !== null;',
  15230. '$mod.b = $with1.FOnFoo !== null;',
  15231. '$mod.b = $with1.GetFoo() !== null;',
  15232. '$mod.b = rtl.eqCallback($with1.FOnFoo, $mod.vP);',
  15233. '$mod.b = rtl.eqCallback($with1.FOnFoo, $mod.vP);',
  15234. '$mod.b = rtl.eqCallback($with1.GetFoo(), $mod.vP);',
  15235. '$mod.b = rtl.eqCallback($with1.FOnFoo, $with1.FOnFoo);',
  15236. '$mod.b = rtl.eqCallback($with1.FOnFoo, $with1.FOnFoo);',
  15237. '$mod.b = rtl.eqCallback($with1.GetFoo(), $with1.FOnFoo);',
  15238. '$mod.b = !rtl.eqCallback($with1.FOnFoo, $with1.FOnFoo);',
  15239. '$mod.b = !rtl.eqCallback($with1.FOnFoo, $with1.FOnFoo);',
  15240. '$mod.b = !rtl.eqCallback($with1.GetFoo(), $with1.FOnFoo);',
  15241. '$mod.b = rtl.eqCallback($with1.FOnFoo, rtl.createCallback($with1, "DoIt"));',
  15242. '$mod.b = rtl.eqCallback($with1.FOnFoo, rtl.createCallback($with1, "DoIt"));',
  15243. '$mod.b = rtl.eqCallback($with1.GetFoo(), rtl.createCallback($with1, "DoIt"));',
  15244. '$mod.b = !rtl.eqCallback($with1.FOnFoo, rtl.createCallback($with1, "DoIt"));',
  15245. '$mod.b = !rtl.eqCallback($with1.FOnFoo, rtl.createCallback($with1, "DoIt"));',
  15246. '$mod.b = !rtl.eqCallback($with1.GetFoo(), rtl.createCallback($with1, "DoIt"));',
  15247. '$mod.b = $with1.FOnFoo != null;',
  15248. '$mod.b = $with1.FOnFoo != null;',
  15249. '$mod.b = $with1.GetFoo() != null;',
  15250. '']));
  15251. end;
  15252. procedure TTestModule.TestProcType_Nested;
  15253. begin
  15254. StartProgram(false);
  15255. Add([
  15256. 'type',
  15257. ' TProcInt = procedure(vI: longint = 1);',
  15258. 'procedure DoIt(vJ: longint);',
  15259. 'var aProc: TProcInt;',
  15260. ' b: boolean;',
  15261. ' procedure Sub(vK: longint);',
  15262. ' var aSub: TProcInt;',
  15263. ' procedure SubSub(vK: longint);',
  15264. ' var aSubSub: TProcInt;',
  15265. ' begin;',
  15266. ' aProc:=@DoIt;',
  15267. ' aSub:=@DoIt;',
  15268. ' aSubSub:=@DoIt;',
  15269. ' aProc:=@Sub;',
  15270. ' aSub:=@Sub;',
  15271. ' aSubSub:=@Sub;',
  15272. ' aProc:=@SubSub;',
  15273. ' aSub:=@SubSub;',
  15274. ' aSubSub:=@SubSub;',
  15275. ' end;',
  15276. ' begin;',
  15277. ' end;',
  15278. 'begin;',
  15279. ' aProc:=@Sub;',
  15280. ' b:=aProc=@Sub;',
  15281. ' b:=@Sub=aProc;',
  15282. 'end;',
  15283. 'begin',
  15284. '']);
  15285. ConvertProgram;
  15286. CheckSource('TestProcType_Nested',
  15287. LinesToStr([ // statements
  15288. 'this.DoIt = function (vJ) {',
  15289. ' var aProc = null;',
  15290. ' var b = false;',
  15291. ' function Sub(vK) {',
  15292. ' var aSub = null;',
  15293. ' function SubSub(vK) {',
  15294. ' var aSubSub = null;',
  15295. ' aProc = $mod.DoIt;',
  15296. ' aSub = $mod.DoIt;',
  15297. ' aSubSub = $mod.DoIt;',
  15298. ' aProc = Sub;',
  15299. ' aSub = Sub;',
  15300. ' aSubSub = Sub;',
  15301. ' aProc = SubSub;',
  15302. ' aSub = SubSub;',
  15303. ' aSubSub = SubSub;',
  15304. ' };',
  15305. ' };',
  15306. ' aProc = Sub;',
  15307. ' b = rtl.eqCallback(aProc, Sub);',
  15308. ' b = rtl.eqCallback(Sub, aProc);',
  15309. '};',
  15310. '']),
  15311. LinesToStr([ // $mod.$main
  15312. '']));
  15313. end;
  15314. procedure TTestModule.TestProcType_NestedOfObject;
  15315. begin
  15316. StartProgram(false);
  15317. Add([
  15318. 'type',
  15319. ' TProcInt = procedure(vI: longint = 1) of object;',
  15320. ' TObject = class',
  15321. ' procedure DoIt(vJ: longint);',
  15322. ' end;',
  15323. 'procedure TObject.DoIt(vJ: longint);',
  15324. 'var aProc: TProcInt;',
  15325. ' b: boolean;',
  15326. ' procedure Sub(vK: longint);',
  15327. ' var aSub: TProcInt;',
  15328. ' procedure SubSub(vK: longint);',
  15329. ' var aSubSub: TProcInt;',
  15330. ' begin;',
  15331. ' aProc:=@DoIt;',
  15332. ' aSub:=@DoIt;',
  15333. ' aSubSub:=@DoIt;',
  15334. ' aProc:=@Sub;',
  15335. ' aSub:=@Sub;',
  15336. ' aSubSub:=@Sub;',
  15337. ' aProc:=@SubSub;',
  15338. ' aSub:=@SubSub;',
  15339. ' aSubSub:=@SubSub;',
  15340. ' end;',
  15341. ' begin;',
  15342. ' end;',
  15343. 'begin;',
  15344. ' aProc:=@Sub;',
  15345. ' b:=aProc=@Sub;',
  15346. ' b:=@Sub=aProc;',
  15347. 'end;',
  15348. 'begin',
  15349. '']);
  15350. ConvertProgram;
  15351. CheckSource('TestProcType_Nested',
  15352. LinesToStr([ // statements
  15353. 'rtl.createClass($mod, "TObject", null, function () {',
  15354. ' this.$init = function () {',
  15355. ' };',
  15356. ' this.$final = function () {',
  15357. ' };',
  15358. ' this.DoIt = function (vJ) {',
  15359. ' var Self = this;',
  15360. ' var aProc = null;',
  15361. ' var b = false;',
  15362. ' function Sub(vK) {',
  15363. ' var aSub = null;',
  15364. ' function SubSub(vK) {',
  15365. ' var aSubSub = null;',
  15366. ' aProc = rtl.createCallback(Self, "DoIt");',
  15367. ' aSub = rtl.createCallback(Self, "DoIt");',
  15368. ' aSubSub = rtl.createCallback(Self, "DoIt");',
  15369. ' aProc = Sub;',
  15370. ' aSub = Sub;',
  15371. ' aSubSub = Sub;',
  15372. ' aProc = SubSub;',
  15373. ' aSub = SubSub;',
  15374. ' aSubSub = SubSub;',
  15375. ' };',
  15376. ' };',
  15377. ' aProc = Sub;',
  15378. ' b = rtl.eqCallback(aProc, Sub);',
  15379. ' b = rtl.eqCallback(Sub, aProc);',
  15380. ' };',
  15381. '});',
  15382. '']),
  15383. LinesToStr([ // $mod.$main
  15384. '']));
  15385. end;
  15386. procedure TTestModule.TestProcType_ReferenceToProc;
  15387. begin
  15388. StartProgram(false);
  15389. Add([
  15390. 'type',
  15391. ' TProcRef = reference to procedure(i: longint = 0);',
  15392. ' TFuncRef = reference to function(i: longint = 0): longint;',
  15393. 'var',
  15394. ' p: TProcRef;',
  15395. ' f: TFuncRef;',
  15396. 'procedure DoIt(i: longint);',
  15397. 'begin',
  15398. 'end;',
  15399. 'function GetIt(i: longint): longint;',
  15400. 'begin',
  15401. ' p:=@DoIt;',
  15402. ' f:=@GetIt;',
  15403. ' f;',
  15404. ' f();',
  15405. ' f(1);',
  15406. 'end;',
  15407. 'begin',
  15408. ' p:=@DoIt;',
  15409. ' f:=@GetIt;',
  15410. ' f;',
  15411. ' f();',
  15412. ' f(1);',
  15413. ' p:=TProcRef(f);',
  15414. '']);
  15415. ConvertProgram;
  15416. CheckSource('TestProcType_ReferenceToProc',
  15417. LinesToStr([ // statements
  15418. 'this.p = null;',
  15419. 'this.f = null;',
  15420. 'this.DoIt = function (i) {',
  15421. '};',
  15422. 'this.GetIt = function (i) {',
  15423. ' var Result = 0;',
  15424. ' $mod.p = $mod.DoIt;',
  15425. ' $mod.f = $mod.GetIt;',
  15426. ' $mod.f(0);',
  15427. ' $mod.f(0);',
  15428. ' $mod.f(1);',
  15429. ' return Result;',
  15430. '};',
  15431. '']),
  15432. LinesToStr([ // $mod.$main
  15433. '$mod.p = $mod.DoIt;',
  15434. '$mod.f = $mod.GetIt;',
  15435. '$mod.f(0);',
  15436. '$mod.f(0);',
  15437. '$mod.f(1);',
  15438. '$mod.p = $mod.f;',
  15439. '']));
  15440. end;
  15441. procedure TTestModule.TestProcType_ReferenceToMethod;
  15442. begin
  15443. StartProgram(false);
  15444. Add([
  15445. 'type',
  15446. ' TFuncRef = reference to function(i: longint = 5): longint;',
  15447. ' TObject = class',
  15448. ' function Grow(s: longint): longint;',
  15449. ' end;',
  15450. 'var',
  15451. ' f: tfuncref;',
  15452. 'function tobject.grow(s: longint): longint;',
  15453. ' function GrowSub(i: longint): longint;',
  15454. ' begin',
  15455. ' f:=@grow;',
  15456. ' f:=@growsub;',
  15457. ' end;',
  15458. 'begin',
  15459. ' f:=@grow;',
  15460. ' f:=@growsub;',
  15461. 'end;',
  15462. 'begin',
  15463. '']);
  15464. ConvertProgram;
  15465. CheckSource('TestProcType_ReferenceToMethod',
  15466. LinesToStr([ // statements
  15467. 'rtl.createClass($mod, "TObject", null, function () {',
  15468. ' this.$init = function () {',
  15469. ' };',
  15470. ' this.$final = function () {',
  15471. ' };',
  15472. ' this.Grow = function (s) {',
  15473. ' var Self = this;',
  15474. ' var Result = 0;',
  15475. ' function GrowSub(i) {',
  15476. ' var Result = 0;',
  15477. ' $mod.f = rtl.createCallback(Self, "Grow");',
  15478. ' $mod.f = GrowSub;',
  15479. ' return Result;',
  15480. ' };',
  15481. ' $mod.f = rtl.createCallback(Self, "Grow");',
  15482. ' $mod.f = GrowSub;',
  15483. ' return Result;',
  15484. ' };',
  15485. '});',
  15486. 'this.f = null;',
  15487. '']),
  15488. LinesToStr([ // $mod.$main
  15489. '']));
  15490. end;
  15491. procedure TTestModule.TestProcType_Typecast;
  15492. begin
  15493. StartProgram(false);
  15494. Add([
  15495. 'type',
  15496. ' TNotifyEvent = procedure(Sender: Pointer) of object;',
  15497. ' TEvent = procedure of object;',
  15498. ' TGetter = function:longint of object;',
  15499. ' TProcA = procedure(i: longint);',
  15500. ' TFuncB = function(i, j: longint): longint;',
  15501. 'procedure DoIt(); varargs; begin end;',
  15502. 'var',
  15503. ' Notify: tnotifyevent;',
  15504. ' Event: tevent;',
  15505. ' Getter: tgetter;',
  15506. ' ProcA: tproca;',
  15507. ' FuncB: tfuncb;',
  15508. ' p: pointer;',
  15509. 'begin',
  15510. ' notify:=tnotifyevent(event);',
  15511. ' event:=tevent(event);',
  15512. ' event:=tevent(notify);',
  15513. ' event:=tevent(getter);',
  15514. ' event:=tevent(proca);',
  15515. ' proca:=tproca(funcb);',
  15516. ' funcb:=tfuncb(funcb);',
  15517. ' funcb:=tfuncb(proca);',
  15518. ' funcb:=tfuncb(getter);',
  15519. ' proca:=tproca(p);',
  15520. ' funcb:=tfuncb(p);',
  15521. ' getter:=tgetter(p);',
  15522. ' p:=pointer(notify);',
  15523. ' p:=notify;',
  15524. ' p:=pointer(proca);',
  15525. ' p:=proca;',
  15526. ' p:=pointer(funcb);',
  15527. ' p:=funcb;',
  15528. ' doit(Pointer(notify),pointer(event),pointer(proca));',
  15529. '']);
  15530. ConvertProgram;
  15531. CheckSource('TestProcType_Typecast',
  15532. LinesToStr([ // statements
  15533. 'this.DoIt = function () {',
  15534. '};',
  15535. 'this.Notify = null;',
  15536. 'this.Event = null;',
  15537. 'this.Getter = null;',
  15538. 'this.ProcA = null;',
  15539. 'this.FuncB = null;',
  15540. 'this.p = null;',
  15541. '']),
  15542. LinesToStr([ // $mod.$main
  15543. '$mod.Notify = $mod.Event;',
  15544. '$mod.Event = $mod.Event;',
  15545. '$mod.Event = $mod.Notify;',
  15546. '$mod.Event = $mod.Getter;',
  15547. '$mod.Event = $mod.ProcA;',
  15548. '$mod.ProcA = $mod.FuncB;',
  15549. '$mod.FuncB = $mod.FuncB;',
  15550. '$mod.FuncB = $mod.ProcA;',
  15551. '$mod.FuncB = $mod.Getter;',
  15552. '$mod.ProcA = $mod.p;',
  15553. '$mod.FuncB = $mod.p;',
  15554. '$mod.Getter = $mod.p;',
  15555. '$mod.p = $mod.Notify;',
  15556. '$mod.p = $mod.Notify;',
  15557. '$mod.p = $mod.ProcA;',
  15558. '$mod.p = $mod.ProcA;',
  15559. '$mod.p = $mod.FuncB;',
  15560. '$mod.p = $mod.FuncB;',
  15561. '$mod.DoIt($mod.Notify, $mod.Event, $mod.ProcA);',
  15562. '']));
  15563. end;
  15564. procedure TTestModule.TestProcType_PassProcToUntyped;
  15565. begin
  15566. StartProgram(false);
  15567. Add([
  15568. 'type',
  15569. ' TEvent = procedure of object;',
  15570. ' TFunc = function: longint;',
  15571. 'procedure DoIt(); varargs; begin end;',
  15572. 'procedure DoSome(const a; var b; p: pointer); begin end;',
  15573. 'var',
  15574. ' Event: tevent;',
  15575. ' Func: TFunc;',
  15576. 'begin',
  15577. ' doit(event,func);',
  15578. ' dosome(event,event,event);',
  15579. ' dosome(func,func,func);',
  15580. '']);
  15581. ConvertProgram;
  15582. CheckSource('TestProcType_PassProcToUntyped',
  15583. LinesToStr([ // statements
  15584. 'this.DoIt = function () {',
  15585. '};',
  15586. 'this.DoSome = function (a, b, p) {',
  15587. '};',
  15588. 'this.Event = null;',
  15589. 'this.Func = null;',
  15590. '']),
  15591. LinesToStr([ // $mod.$main
  15592. '$mod.DoIt($mod.Event, $mod.Func);',
  15593. '$mod.DoSome($mod.Event, {',
  15594. ' p: $mod,',
  15595. ' get: function () {',
  15596. ' return this.p.Event;',
  15597. ' },',
  15598. ' set: function (v) {',
  15599. ' this.p.Event = v;',
  15600. ' }',
  15601. '}, $mod.Event);',
  15602. '$mod.DoSome($mod.Func, {',
  15603. ' p: $mod,',
  15604. ' get: function () {',
  15605. ' return this.p.Func;',
  15606. ' },',
  15607. ' set: function (v) {',
  15608. ' this.p.Func = v;',
  15609. ' }',
  15610. '}, $mod.Func);',
  15611. '']));
  15612. end;
  15613. procedure TTestModule.TestProcType_PassProcToArray;
  15614. begin
  15615. StartProgram(false);
  15616. Add([
  15617. 'type',
  15618. ' TFunc = function: longint;',
  15619. ' TArrFunc = array of TFunc;',
  15620. 'procedure DoIt(Arr: TArrFunc); begin end;',
  15621. 'function GetIt: longint; begin end;',
  15622. 'var',
  15623. ' Func: tfunc;',
  15624. 'begin',
  15625. ' doit([]);',
  15626. ' doit([@GetIt]);',
  15627. ' doit([Func]);',
  15628. '']);
  15629. ConvertProgram;
  15630. CheckSource('TestProcType_PassProcToArray',
  15631. LinesToStr([ // statements
  15632. 'this.DoIt = function (Arr) {',
  15633. '};',
  15634. 'this.GetIt = function () {',
  15635. ' var Result = 0;',
  15636. ' return Result;',
  15637. '};',
  15638. 'this.Func = null;',
  15639. '']),
  15640. LinesToStr([ // $mod.$main
  15641. '$mod.DoIt([]);',
  15642. '$mod.DoIt([$mod.GetIt]);',
  15643. '$mod.DoIt([$mod.Func]);',
  15644. '']));
  15645. end;
  15646. procedure TTestModule.TestPointer;
  15647. begin
  15648. StartProgram(false);
  15649. Add(['type',
  15650. ' TObject = class end;',
  15651. ' TClass = class of TObject;',
  15652. ' TArrInt = array of longint;',
  15653. 'const',
  15654. ' n = nil;',
  15655. 'var',
  15656. ' v: jsvalue;',
  15657. ' Obj: tobject;',
  15658. ' C: tclass;',
  15659. ' a: tarrint;',
  15660. ' p: Pointer = nil;',
  15661. 'begin',
  15662. ' p:=p;',
  15663. ' p:=nil;',
  15664. ' if p=nil then;',
  15665. ' if nil=p then;',
  15666. ' if Assigned(p) then;',
  15667. ' p:=Pointer(v);',
  15668. ' p:=obj;',
  15669. ' p:=c;',
  15670. ' p:=a;',
  15671. ' p:=tobject;',
  15672. ' obj:=TObject(p);',
  15673. ' c:=TClass(p);',
  15674. ' a:=TArrInt(p);',
  15675. ' p:=n;']);
  15676. ConvertProgram;
  15677. CheckSource('TestPointer',
  15678. LinesToStr([ // statements
  15679. 'rtl.createClass($mod, "TObject", null, function () {',
  15680. ' this.$init = function () {',
  15681. ' };',
  15682. ' this.$final = function () {',
  15683. ' };',
  15684. '});',
  15685. 'this.n = null;',
  15686. 'this.v = undefined;',
  15687. 'this.Obj = null;',
  15688. 'this.C = null;',
  15689. 'this.a = [];',
  15690. 'this.p = null;',
  15691. '']),
  15692. LinesToStr([ // $mod.$main
  15693. '$mod.p = $mod.p;',
  15694. '$mod.p = null;',
  15695. 'if ($mod.p === null) ;',
  15696. 'if (null === $mod.p) ;',
  15697. 'if ($mod.p != null) ;',
  15698. '$mod.p = $mod.v;',
  15699. '$mod.p = $mod.Obj;',
  15700. '$mod.p = $mod.C;',
  15701. '$mod.p = $mod.a;',
  15702. '$mod.p = $mod.TObject;',
  15703. '$mod.Obj = $mod.p;',
  15704. '$mod.C = $mod.p;',
  15705. '$mod.a = $mod.p;',
  15706. '$mod.p = null;',
  15707. '']));
  15708. end;
  15709. procedure TTestModule.TestPointer_Proc;
  15710. begin
  15711. StartProgram(false);
  15712. Add('type');
  15713. Add(' TObject = class');
  15714. Add(' procedure DoIt; virtual; abstract;');
  15715. Add(' end;');
  15716. Add('procedure DoSome; begin end;');
  15717. Add('var');
  15718. Add(' o: TObject;');
  15719. Add(' p: Pointer;');
  15720. Add('begin');
  15721. Add(' p:=@DoSome;');
  15722. Add(' p:[email protected];');
  15723. ConvertProgram;
  15724. CheckSource('TestPointer_Proc',
  15725. LinesToStr([ // statements
  15726. 'rtl.createClass($mod, "TObject", null, function () {',
  15727. ' this.$init = function () {',
  15728. ' };',
  15729. ' this.$final = function () {',
  15730. ' };',
  15731. '});',
  15732. 'this.DoSome = function () {',
  15733. '};',
  15734. 'this.o = null;',
  15735. 'this.p = null;',
  15736. '']),
  15737. LinesToStr([ // $mod.$main
  15738. '$mod.p = $mod.DoSome;',
  15739. '$mod.p = rtl.createCallback($mod.o, "DoIt");',
  15740. '']));
  15741. end;
  15742. procedure TTestModule.TestPointer_AssignRecordFail;
  15743. begin
  15744. StartProgram(false);
  15745. Add('type');
  15746. Add(' TRec = record end;');
  15747. Add('var');
  15748. Add(' p: Pointer;');
  15749. Add(' r: TRec;');
  15750. Add('begin');
  15751. Add(' p:=r;');
  15752. SetExpectedPasResolverError('Incompatible types: got "TRec" expected "Pointer"',
  15753. nIncompatibleTypesGotExpected);
  15754. ConvertProgram;
  15755. end;
  15756. procedure TTestModule.TestPointer_AssignStaticArrayFail;
  15757. begin
  15758. StartProgram(false);
  15759. Add('type');
  15760. Add(' TArr = array[boolean] of longint;');
  15761. Add('var');
  15762. Add(' p: Pointer;');
  15763. Add(' a: TArr;');
  15764. Add('begin');
  15765. Add(' p:=a;');
  15766. SetExpectedPasResolverError('Incompatible types: got "TArr" expected "Pointer"',
  15767. nIncompatibleTypesGotExpected);
  15768. ConvertProgram;
  15769. end;
  15770. procedure TTestModule.TestPointer_TypeCastJSValueToPointer;
  15771. begin
  15772. StartProgram(false);
  15773. Add([
  15774. 'procedure DoIt(args: array of jsvalue); begin end;',
  15775. 'procedure DoAll; varargs; begin end;',
  15776. 'var',
  15777. ' v: jsvalue;',
  15778. 'begin',
  15779. ' DoIt([pointer(v)]);',
  15780. ' DoAll(pointer(v));',
  15781. '']);
  15782. ConvertProgram;
  15783. CheckSource('TestPointer_TypeCastJSValueToPointer',
  15784. LinesToStr([ // statements
  15785. 'this.DoIt = function (args) {',
  15786. '};',
  15787. 'this.DoAll = function () {',
  15788. '};',
  15789. 'this.v = undefined;',
  15790. '']),
  15791. LinesToStr([ // $mod.$main
  15792. '$mod.DoIt([$mod.v]);',
  15793. '$mod.DoAll($mod.v);',
  15794. '']));
  15795. end;
  15796. procedure TTestModule.TestPointer_NonRecordFail;
  15797. begin
  15798. StartProgram(false);
  15799. Add([
  15800. 'type',
  15801. ' p = ^longint;',
  15802. 'begin',
  15803. '']);
  15804. SetExpectedPasResolverError('Not supported: pointer of Longint',nNotSupportedX);
  15805. ConvertProgram;
  15806. end;
  15807. procedure TTestModule.TestPointer_AnonymousArgTypeFail;
  15808. begin
  15809. StartProgram(false);
  15810. Add([
  15811. 'procedure DoIt(p: ^longint); begin end;',
  15812. 'begin',
  15813. '']);
  15814. SetExpectedPasResolverError('Not supported: pointer',nNotSupportedX);
  15815. ConvertProgram;
  15816. end;
  15817. procedure TTestModule.TestPointer_AnonymousVarTypeFail;
  15818. begin
  15819. StartProgram(false);
  15820. Add([
  15821. 'var p: ^longint;',
  15822. 'begin',
  15823. '']);
  15824. SetExpectedPasResolverError('Not supported: pointer',nNotSupportedX);
  15825. ConvertProgram;
  15826. end;
  15827. procedure TTestModule.TestPointer_AnonymousResultTypeFail;
  15828. begin
  15829. StartProgram(false);
  15830. Add([
  15831. 'function DoIt: ^longint; begin end;',
  15832. 'begin',
  15833. '']);
  15834. SetExpectedPasResolverError('Not supported: pointer',nNotSupportedX);
  15835. ConvertProgram;
  15836. end;
  15837. procedure TTestModule.TestPointer_AddrOperatorFail;
  15838. begin
  15839. StartProgram(false);
  15840. Add([
  15841. 'var i: longint;',
  15842. 'begin',
  15843. ' if @i=nil then ;',
  15844. '']);
  15845. SetExpectedConverterError('illegal qualifier "@" in front of "i:Longint"',nIllegalQualifierInFrontOf);
  15846. ConvertProgram;
  15847. end;
  15848. procedure TTestModule.TestPointer_ArrayParamsFail;
  15849. begin
  15850. StartProgram(false);
  15851. Add([
  15852. 'var',
  15853. ' p: Pointer;',
  15854. 'begin',
  15855. ' p:=p[1];',
  15856. '']);
  15857. SetExpectedPasResolverError('illegal qualifier "[" after "Pointer"',nIllegalQualifierAfter);
  15858. ConvertProgram;
  15859. end;
  15860. procedure TTestModule.TestPointer_PointerAddFail;
  15861. begin
  15862. StartProgram(false);
  15863. Add([
  15864. 'var',
  15865. ' p: Pointer;',
  15866. 'begin',
  15867. ' p:=p+1;',
  15868. '']);
  15869. SetExpectedPasResolverError('Operator is not overloaded: "Pointer" + "Longint"',nOperatorIsNotOverloadedAOpB);
  15870. ConvertProgram;
  15871. end;
  15872. procedure TTestModule.TestPointer_IncPointerFail;
  15873. begin
  15874. StartProgram(false);
  15875. Add([
  15876. 'var',
  15877. ' p: Pointer;',
  15878. 'begin',
  15879. ' inc(p,1);',
  15880. '']);
  15881. SetExpectedPasResolverError('Incompatible type arg no. 1: Got "Pointer", expected "integer"',
  15882. nIncompatibleTypeArgNo);
  15883. ConvertProgram;
  15884. end;
  15885. procedure TTestModule.TestPointer_Record;
  15886. begin
  15887. StartProgram(false);
  15888. Add([
  15889. 'type',
  15890. ' TRec = record x: longint; end;',
  15891. ' PRec = ^TRec;',
  15892. 'var',
  15893. ' r: TRec;',
  15894. ' p: PRec;',
  15895. 'begin',
  15896. ' p:=@r;',
  15897. ' r:=p^;',
  15898. ' r.x:=p^.x;',
  15899. ' p^.x:=r.x;',
  15900. ' if p^.x=3 then ;',
  15901. ' if 4=p^.x then ;',
  15902. '']);
  15903. ConvertProgram;
  15904. CheckSource('TestPointer_Record',
  15905. LinesToStr([ // statements
  15906. 'this.TRec = function (s) {',
  15907. ' if (s) {',
  15908. ' this.x = s.x;',
  15909. ' } else {',
  15910. ' this.x = 0;',
  15911. ' };',
  15912. ' this.$equal = function (b) {',
  15913. ' return this.x === b.x;',
  15914. ' };',
  15915. '};',
  15916. 'this.r = new $mod.TRec();',
  15917. 'this.p = null;',
  15918. '']),
  15919. LinesToStr([ // $mod.$main
  15920. '$mod.p = $mod.r;',
  15921. '$mod.r = new $mod.TRec($mod.p);',
  15922. '$mod.r.x = $mod.p.x;',
  15923. '$mod.p.x = $mod.r.x;',
  15924. 'if ($mod.p.x === 3) ;',
  15925. 'if (4 === $mod.p.x) ;',
  15926. '']));
  15927. end;
  15928. procedure TTestModule.TestPointer_RecordArg;
  15929. begin
  15930. StartProgram(false);
  15931. Add([
  15932. '{$modeswitch autoderef}',
  15933. 'type',
  15934. ' TRec = record x: longint; end;',
  15935. ' PRec = ^TRec;',
  15936. 'function DoIt(const a: PRec; var b: PRec; out c: PRec): TRec;',
  15937. 'begin',
  15938. ' a.x:=a.x;',
  15939. ' a^.x:=a^.x;',
  15940. ' with a^ do',
  15941. ' x:=x;',
  15942. 'end;',
  15943. 'function GetIt(p: PRec): PRec;',
  15944. 'begin',
  15945. ' p.x:=p.x;',
  15946. ' p^.x:=p^.x;',
  15947. ' with p^ do',
  15948. ' x:=x;',
  15949. 'end;',
  15950. 'var',
  15951. ' r: TRec;',
  15952. ' p: PRec;',
  15953. 'begin',
  15954. ' p:=GetIt(p);',
  15955. ' p^:=GetIt(@r)^;',
  15956. ' DoIt(p,p,p);',
  15957. ' DoIt(@r,p,p);',
  15958. '']);
  15959. ConvertProgram;
  15960. CheckSource('TestPointer_Record',
  15961. LinesToStr([ // statements
  15962. 'this.TRec = function (s) {',
  15963. ' if (s) {',
  15964. ' this.x = s.x;',
  15965. ' } else {',
  15966. ' this.x = 0;',
  15967. ' };',
  15968. ' this.$equal = function (b) {',
  15969. ' return this.x === b.x;',
  15970. ' };',
  15971. '};',
  15972. 'this.DoIt = function (a, b, c) {',
  15973. ' var Result = new $mod.TRec();',
  15974. ' a.x = a.x;',
  15975. ' a.x = a.x;',
  15976. ' a.x = a.x;',
  15977. ' return Result;',
  15978. '};',
  15979. 'this.GetIt = function (p) {',
  15980. ' var Result = null;',
  15981. ' p.x = p.x;',
  15982. ' p.x = p.x;',
  15983. ' p.x = p.x;',
  15984. ' return Result;',
  15985. '};',
  15986. 'this.r = new $mod.TRec();',
  15987. 'this.p = null;',
  15988. '']),
  15989. LinesToStr([ // $mod.$main
  15990. '$mod.p = $mod.GetIt($mod.p);',
  15991. '$mod.p = new $mod.TRec($mod.GetIt($mod.r));',
  15992. '$mod.DoIt($mod.p, {',
  15993. ' p: $mod,',
  15994. ' get: function () {',
  15995. ' return this.p.p;',
  15996. ' },',
  15997. ' set: function (v) {',
  15998. ' this.p.p = v;',
  15999. ' }',
  16000. '}, {',
  16001. ' p: $mod,',
  16002. ' get: function () {',
  16003. ' return this.p.p;',
  16004. ' },',
  16005. ' set: function (v) {',
  16006. ' this.p.p = v;',
  16007. ' }',
  16008. '});',
  16009. '$mod.DoIt($mod.r, {',
  16010. ' p: $mod,',
  16011. ' get: function () {',
  16012. ' return this.p.p;',
  16013. ' },',
  16014. ' set: function (v) {',
  16015. ' this.p.p = v;',
  16016. ' }',
  16017. '}, {',
  16018. ' p: $mod,',
  16019. ' get: function () {',
  16020. ' return this.p.p;',
  16021. ' },',
  16022. ' set: function (v) {',
  16023. ' this.p.p = v;',
  16024. ' }',
  16025. '});',
  16026. '']));
  16027. end;
  16028. procedure TTestModule.TestJSValue_AssignToJSValue;
  16029. begin
  16030. StartProgram(false);
  16031. Add('var');
  16032. Add(' v: jsvalue;');
  16033. Add(' i: longint;');
  16034. Add(' s: string;');
  16035. Add(' b: boolean;');
  16036. Add(' d: double;');
  16037. Add(' p: pointer;');
  16038. Add('begin');
  16039. Add(' v:=v;');
  16040. Add(' v:=1;');
  16041. Add(' v:=i;');
  16042. Add(' v:='''';');
  16043. Add(' v:=''c'';');
  16044. Add(' v:=''foo'';');
  16045. Add(' v:=s;');
  16046. Add(' v:=false;');
  16047. Add(' v:=true;');
  16048. Add(' v:=b;');
  16049. Add(' v:=0.1;');
  16050. Add(' v:=d;');
  16051. Add(' v:=nil;');
  16052. Add(' v:=p;');
  16053. ConvertProgram;
  16054. CheckSource('TestJSValue_AssignToJSValue',
  16055. LinesToStr([ // statements
  16056. 'this.v = undefined;',
  16057. 'this.i = 0;',
  16058. 'this.s = "";',
  16059. 'this.b = false;',
  16060. 'this.d = 0.0;',
  16061. 'this.p = null;',
  16062. '']),
  16063. LinesToStr([ // $mod.$main
  16064. '$mod.v = $mod.v;',
  16065. '$mod.v = 1;',
  16066. '$mod.v = $mod.i;',
  16067. '$mod.v = "";',
  16068. '$mod.v = "c";',
  16069. '$mod.v = "foo";',
  16070. '$mod.v = $mod.s;',
  16071. '$mod.v = false;',
  16072. '$mod.v = true;',
  16073. '$mod.v = $mod.b;',
  16074. '$mod.v = 0.1;',
  16075. '$mod.v = $mod.d;',
  16076. '$mod.v = null;',
  16077. '$mod.v = $mod.p;',
  16078. '']));
  16079. end;
  16080. procedure TTestModule.TestJSValue_TypeCastToBaseType;
  16081. begin
  16082. StartProgram(false);
  16083. Add('type');
  16084. Add(' integer = longint;');
  16085. Add(' TYesNo = boolean;');
  16086. Add(' TFloat = double;');
  16087. Add(' TCaption = string;');
  16088. Add(' TChar = char;');
  16089. Add('var');
  16090. Add(' v: jsvalue;');
  16091. Add(' i: integer;');
  16092. Add(' s: TCaption;');
  16093. Add(' b: TYesNo;');
  16094. Add(' d: TFloat;');
  16095. Add(' c: char;');
  16096. Add('begin');
  16097. Add(' i:=longint(v);');
  16098. Add(' i:=integer(v);');
  16099. Add(' s:=string(v);');
  16100. Add(' s:=TCaption(v);');
  16101. Add(' b:=boolean(v);');
  16102. Add(' b:=TYesNo(v);');
  16103. Add(' d:=double(v);');
  16104. Add(' d:=TFloat(v);');
  16105. Add(' c:=char(v);');
  16106. Add(' c:=TChar(v);');
  16107. ConvertProgram;
  16108. CheckSource('TestJSValue_TypeCastToBaseType',
  16109. LinesToStr([ // statements
  16110. 'this.v = undefined;',
  16111. 'this.i = 0;',
  16112. 'this.s = "";',
  16113. 'this.b = false;',
  16114. 'this.d = 0.0;',
  16115. 'this.c = "";',
  16116. '']),
  16117. LinesToStr([ // $mod.$main
  16118. '$mod.i = Math.floor($mod.v);',
  16119. '$mod.i = Math.floor($mod.v);',
  16120. '$mod.s = "" + $mod.v;',
  16121. '$mod.s = "" + $mod.v;',
  16122. '$mod.b = !($mod.v == false);',
  16123. '$mod.b = !($mod.v == false);',
  16124. '$mod.d = rtl.getNumber($mod.v);',
  16125. '$mod.d = rtl.getNumber($mod.v);',
  16126. '$mod.c = rtl.getChar($mod.v);',
  16127. '$mod.c = rtl.getChar($mod.v);',
  16128. '']));
  16129. end;
  16130. procedure TTestModule.TestJSValue_Equal;
  16131. begin
  16132. StartProgram(false);
  16133. Add('type');
  16134. Add(' integer = longint;');
  16135. Add(' TYesNo = boolean;');
  16136. Add(' TFloat = double;');
  16137. Add(' TCaption = string;');
  16138. Add(' TChar = char;');
  16139. Add(' TMulti = JSValue;');
  16140. Add('var');
  16141. Add(' v: jsvalue;');
  16142. Add(' i: integer;');
  16143. Add(' s: TCaption;');
  16144. Add(' b: TYesNo;');
  16145. Add(' d: TFloat;');
  16146. Add(' c: char;');
  16147. Add(' m: TMulti;');
  16148. Add('begin');
  16149. Add(' b:=v=v;');
  16150. Add(' b:=v<>v;');
  16151. Add(' b:=v=1;');
  16152. Add(' b:=v<>1;');
  16153. Add(' b:=2=v;');
  16154. Add(' b:=2<>v;');
  16155. Add(' b:=v=i;');
  16156. Add(' b:=i=v;');
  16157. Add(' b:=v=nil;');
  16158. Add(' b:=nil=v;');
  16159. Add(' b:=v=false;');
  16160. Add(' b:=true=v;');
  16161. Add(' b:=v=b;');
  16162. Add(' b:=b=v;');
  16163. Add(' b:=v=s;');
  16164. Add(' b:=s=v;');
  16165. Add(' b:=v=''foo'';');
  16166. Add(' b:=''''=v;');
  16167. Add(' b:=v=d;');
  16168. Add(' b:=d=v;');
  16169. Add(' b:=v=3.4;');
  16170. Add(' b:=5.6=v;');
  16171. Add(' b:=v=c;');
  16172. Add(' b:=c=v;');
  16173. Add(' b:=m=m;');
  16174. Add(' b:=v=m;');
  16175. Add(' b:=m=v;');
  16176. ConvertProgram;
  16177. CheckSource('TestJSValue_Equal',
  16178. LinesToStr([ // statements
  16179. 'this.v = undefined;',
  16180. 'this.i = 0;',
  16181. 'this.s = "";',
  16182. 'this.b = false;',
  16183. 'this.d = 0.0;',
  16184. 'this.c = "";',
  16185. 'this.m = undefined;',
  16186. '']),
  16187. LinesToStr([ // $mod.$main
  16188. '$mod.b = $mod.v == $mod.v;',
  16189. '$mod.b = $mod.v != $mod.v;',
  16190. '$mod.b = $mod.v == 1;',
  16191. '$mod.b = $mod.v != 1;',
  16192. '$mod.b = 2 == $mod.v;',
  16193. '$mod.b = 2 != $mod.v;',
  16194. '$mod.b = $mod.v == $mod.i;',
  16195. '$mod.b = $mod.i == $mod.v;',
  16196. '$mod.b = $mod.v == null;',
  16197. '$mod.b = null == $mod.v;',
  16198. '$mod.b = $mod.v == false;',
  16199. '$mod.b = true == $mod.v;',
  16200. '$mod.b = $mod.v == $mod.b;',
  16201. '$mod.b = $mod.b == $mod.v;',
  16202. '$mod.b = $mod.v == $mod.s;',
  16203. '$mod.b = $mod.s == $mod.v;',
  16204. '$mod.b = $mod.v == "foo";',
  16205. '$mod.b = "" == $mod.v;',
  16206. '$mod.b = $mod.v == $mod.d;',
  16207. '$mod.b = $mod.d == $mod.v;',
  16208. '$mod.b = $mod.v == 3.4;',
  16209. '$mod.b = 5.6 == $mod.v;',
  16210. '$mod.b = $mod.v == $mod.c;',
  16211. '$mod.b = $mod.c == $mod.v;',
  16212. '$mod.b = $mod.m == $mod.m;',
  16213. '$mod.b = $mod.v == $mod.m;',
  16214. '$mod.b = $mod.m == $mod.v;',
  16215. '']));
  16216. end;
  16217. procedure TTestModule.TestJSValue_If;
  16218. begin
  16219. StartProgram(false);
  16220. Add([
  16221. 'var',
  16222. ' v: jsvalue;',
  16223. 'begin',
  16224. ' if v then ;',
  16225. ' while v do ;',
  16226. ' repeat until v;',
  16227. '']);
  16228. ConvertProgram;
  16229. CheckSource('TestJSValue_If',
  16230. LinesToStr([ // statements
  16231. 'this.v = undefined;',
  16232. '']),
  16233. LinesToStr([ // $mod.$main
  16234. 'if ($mod.v) ;',
  16235. 'while($mod.v){',
  16236. '};',
  16237. 'do{',
  16238. '} while(!$mod.v);',
  16239. '']));
  16240. end;
  16241. procedure TTestModule.TestJSValue_Not;
  16242. begin
  16243. StartProgram(false);
  16244. Add([
  16245. 'var',
  16246. ' v: jsvalue;',
  16247. ' b: boolean;',
  16248. 'begin',
  16249. ' b:=not v;',
  16250. ' if not v then ;',
  16251. ' while not v do ;',
  16252. ' repeat until not v;',
  16253. '']);
  16254. ConvertProgram;
  16255. CheckSource('TestJSValue_If',
  16256. LinesToStr([ // statements
  16257. 'this.v = undefined;',
  16258. 'this.b = false;',
  16259. '']),
  16260. LinesToStr([ // $mod.$main
  16261. '$mod.b=!$mod.v;',
  16262. 'if (!$mod.v) ;',
  16263. 'while(!$mod.v){',
  16264. '};',
  16265. 'do{',
  16266. '} while($mod.v);',
  16267. '']));
  16268. end;
  16269. procedure TTestModule.TestJSValue_Enum;
  16270. begin
  16271. StartProgram(false);
  16272. Add('type');
  16273. Add(' TColor = (red, blue);');
  16274. Add(' TRedBlue = TColor;');
  16275. Add('var');
  16276. Add(' v: jsvalue;');
  16277. Add(' e: TColor;');
  16278. Add('begin');
  16279. Add(' v:=e;');
  16280. Add(' v:=TColor(e);');
  16281. Add(' v:=TRedBlue(e);');
  16282. Add(' e:=TColor(v);');
  16283. Add(' e:=TRedBlue(v);');
  16284. ConvertProgram;
  16285. CheckSource('TestJSValue_Enum',
  16286. LinesToStr([ // statements
  16287. 'this.TColor = {',
  16288. ' "0": "red",',
  16289. ' red: 0,',
  16290. ' "1": "blue",',
  16291. ' blue: 1',
  16292. '};',
  16293. 'this.v = undefined;',
  16294. 'this.e = 0;',
  16295. '']),
  16296. LinesToStr([ // $mod.$main
  16297. '$mod.v = $mod.e;',
  16298. '$mod.v = $mod.e;',
  16299. '$mod.v = $mod.e;',
  16300. '$mod.e = $mod.v;',
  16301. '$mod.e = $mod.v;',
  16302. '']));
  16303. end;
  16304. procedure TTestModule.TestJSValue_ClassInstance;
  16305. begin
  16306. StartProgram(false);
  16307. Add([
  16308. 'type',
  16309. ' TObject = class',
  16310. ' end;',
  16311. ' TBirdObject = TObject;',
  16312. 'var',
  16313. ' v: jsvalue;',
  16314. ' o: TObject;',
  16315. 'begin',
  16316. ' v:=o;',
  16317. ' v:=TObject(o);',
  16318. ' v:=TBirdObject(o);',
  16319. ' o:=TObject(v);',
  16320. ' o:=TBirdObject(v);',
  16321. ' if v is TObject then ;',
  16322. '']);
  16323. ConvertProgram;
  16324. CheckSource('TestJSValue_ClassInstance',
  16325. LinesToStr([ // statements
  16326. 'rtl.createClass($mod, "TObject", null, function () {',
  16327. ' this.$init = function () {',
  16328. ' };',
  16329. ' this.$final = function () {',
  16330. ' };',
  16331. '});',
  16332. 'this.v = undefined;',
  16333. 'this.o = null;',
  16334. '']),
  16335. LinesToStr([ // $mod.$main
  16336. '$mod.v = $mod.o;',
  16337. '$mod.v = $mod.o;',
  16338. '$mod.v = $mod.o;',
  16339. '$mod.o = rtl.getObject($mod.v);',
  16340. '$mod.o = rtl.getObject($mod.v);',
  16341. 'if (rtl.isExt($mod.v, $mod.TObject, 1)) ;',
  16342. '']));
  16343. end;
  16344. procedure TTestModule.TestJSValue_ClassOf;
  16345. begin
  16346. StartProgram(false);
  16347. Add([
  16348. 'type',
  16349. ' TClass = class of TObject;',
  16350. ' TObject = class',
  16351. ' end;',
  16352. ' TBirds = class of TBird;',
  16353. ' TBird = class(TObject) end;',
  16354. 'var',
  16355. ' v: jsvalue;',
  16356. ' c: TClass;',
  16357. 'begin',
  16358. ' v:=c;',
  16359. ' v:=TObject;',
  16360. ' v:=TClass(c);',
  16361. ' v:=TBirds(c);',
  16362. ' c:=TClass(v);',
  16363. ' c:=TBirds(v);',
  16364. ' if v is TClass then ;',
  16365. '']);
  16366. ConvertProgram;
  16367. CheckSource('TestJSValue_ClassOf',
  16368. LinesToStr([ // statements
  16369. 'rtl.createClass($mod, "TObject", null, function () {',
  16370. ' this.$init = function () {',
  16371. ' };',
  16372. ' this.$final = function () {',
  16373. ' };',
  16374. '});',
  16375. 'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
  16376. '});',
  16377. 'this.v = undefined;',
  16378. 'this.c = null;',
  16379. '']),
  16380. LinesToStr([ // $mod.$main
  16381. '$mod.v = $mod.c;',
  16382. '$mod.v = $mod.TObject;',
  16383. '$mod.v = $mod.c;',
  16384. '$mod.v = $mod.c;',
  16385. '$mod.c = rtl.getObject($mod.v);',
  16386. '$mod.c = rtl.getObject($mod.v);',
  16387. 'if (rtl.isExt($mod.v, $mod.TObject, 2)) ;',
  16388. '']));
  16389. end;
  16390. procedure TTestModule.TestJSValue_ArrayOfJSValue;
  16391. begin
  16392. StartProgram(false);
  16393. Add([
  16394. 'type',
  16395. ' integer = longint;',
  16396. ' TArray = array of JSValue;',
  16397. ' TArrgh = tarray;',
  16398. ' TArrInt = array of integer;',
  16399. 'var',
  16400. ' v: jsvalue;',
  16401. ' TheArray: tarray = (1,''2'');',
  16402. ' Arr: tarrgh;',
  16403. ' i: integer;',
  16404. ' ArrInt: tarrint;',
  16405. 'begin',
  16406. ' arr:=thearray;',
  16407. ' thearray:=arr;',
  16408. ' setlength(arr,2);',
  16409. ' setlength(thearray,3);',
  16410. ' arr[4]:=v;',
  16411. ' arr[5]:=length(thearray);',
  16412. ' arr[6]:=nil;',
  16413. ' arr[7]:=thearray[8];',
  16414. ' arr[low(arr)]:=high(thearray);',
  16415. ' arr:=arrint;',
  16416. ' arrInt:=tarrint(arr);',
  16417. ' if TheArray = nil then ;',
  16418. ' if nil = TheArray then ;',
  16419. ' if TheArray <> nil then ;',
  16420. ' if nil <> TheArray then ;',
  16421. '']);
  16422. ConvertProgram;
  16423. CheckSource('TestJSValue_ArrayOfJSValue',
  16424. LinesToStr([ // statements
  16425. 'this.v = undefined;',
  16426. 'this.TheArray = [1, "2"];',
  16427. 'this.Arr = [];',
  16428. 'this.i = 0;',
  16429. 'this.ArrInt = [];',
  16430. '']),
  16431. LinesToStr([ // $mod.$main
  16432. '$mod.Arr = $mod.TheArray;',
  16433. '$mod.TheArray = $mod.Arr;',
  16434. '$mod.Arr = rtl.arraySetLength($mod.Arr,undefined,2);',
  16435. '$mod.TheArray = rtl.arraySetLength($mod.TheArray,undefined,3);',
  16436. '$mod.Arr[4] = $mod.v;',
  16437. '$mod.Arr[5] = rtl.length($mod.TheArray);',
  16438. '$mod.Arr[6] = null;',
  16439. '$mod.Arr[7] = $mod.TheArray[8];',
  16440. '$mod.Arr[0] = rtl.length($mod.TheArray) - 1;',
  16441. '$mod.Arr = $mod.ArrInt;',
  16442. '$mod.ArrInt = $mod.Arr;',
  16443. 'if (rtl.length($mod.TheArray) === 0) ;',
  16444. 'if (rtl.length($mod.TheArray) === 0) ;',
  16445. 'if (rtl.length($mod.TheArray) > 0) ;',
  16446. 'if (rtl.length($mod.TheArray) > 0) ;',
  16447. '']));
  16448. end;
  16449. procedure TTestModule.TestJSValue_Params;
  16450. begin
  16451. StartProgram(false);
  16452. Add('type');
  16453. Add(' integer = longint;');
  16454. Add(' TYesNo = boolean;');
  16455. Add(' TFloat = double;');
  16456. Add(' TCaption = string;');
  16457. Add(' TChar = char;');
  16458. Add('function DoIt(a: jsvalue; const b: jsvalue; var c: jsvalue; out d: jsvalue): jsvalue;');
  16459. Add('var');
  16460. Add(' l: jsvalue;');
  16461. Add('begin');
  16462. Add(' a:=a;');
  16463. Add(' l:=b;');
  16464. Add(' c:=c;');
  16465. Add(' d:=d;');
  16466. Add(' Result:=l;');
  16467. Add('end;');
  16468. Add('function DoSome(a: jsvalue; const b: jsvalue): jsvalue; begin end;');
  16469. Add('var');
  16470. Add(' v: jsvalue;');
  16471. Add(' i: integer;');
  16472. Add(' b: TYesNo;');
  16473. Add(' d: TFloat;');
  16474. Add(' s: TCaption;');
  16475. Add(' c: TChar;');
  16476. Add('begin');
  16477. Add(' v:=doit(v,v,v,v);');
  16478. Add(' i:=integer(dosome(i,i));');
  16479. Add(' b:=TYesNo(dosome(b,b));');
  16480. Add(' d:=TFloat(dosome(d,d));');
  16481. Add(' s:=TCaption(dosome(s,s));');
  16482. Add(' c:=TChar(dosome(c,c));');
  16483. ConvertProgram;
  16484. CheckSource('TestJSValue_Params',
  16485. LinesToStr([ // statements
  16486. 'this.DoIt = function (a, b, c, d) {',
  16487. ' var Result = undefined;',
  16488. ' var l = undefined;',
  16489. ' a = a;',
  16490. ' l = b;',
  16491. ' c.set(c.get());',
  16492. ' d.set(d.get());',
  16493. ' Result = l;',
  16494. ' return Result;',
  16495. '};',
  16496. 'this.DoSome = function (a, b) {',
  16497. ' var Result = undefined;',
  16498. ' return Result;',
  16499. '};',
  16500. 'this.v = undefined;',
  16501. 'this.i = 0;',
  16502. 'this.b = false;',
  16503. 'this.d = 0.0;',
  16504. 'this.s = "";',
  16505. 'this.c = "";',
  16506. '']),
  16507. LinesToStr([ // $mod.$main
  16508. '$mod.v = $mod.DoIt($mod.v, $mod.v, {',
  16509. ' p: $mod,',
  16510. ' get: function () {',
  16511. ' return this.p.v;',
  16512. ' },',
  16513. ' set: function (v) {',
  16514. ' this.p.v = v;',
  16515. ' }',
  16516. '}, {',
  16517. ' p: $mod,',
  16518. ' get: function () {',
  16519. ' return this.p.v;',
  16520. ' },',
  16521. ' set: function (v) {',
  16522. ' this.p.v = v;',
  16523. ' }',
  16524. '});',
  16525. '$mod.i = Math.floor($mod.DoSome($mod.i, $mod.i));',
  16526. '$mod.b = !($mod.DoSome($mod.b, $mod.b) == false);',
  16527. '$mod.d = rtl.getNumber($mod.DoSome($mod.d, $mod.d));',
  16528. '$mod.s = "" + $mod.DoSome($mod.s, $mod.s);',
  16529. '$mod.c = rtl.getChar($mod.DoSome($mod.c, $mod.c));',
  16530. '']));
  16531. end;
  16532. procedure TTestModule.TestJSValue_UntypedParam;
  16533. begin
  16534. StartProgram(false);
  16535. Add('function DoIt(const a; var b; out c): jsvalue;');
  16536. Add('begin');
  16537. Add(' Result:=a;');
  16538. Add(' Result:=b;');
  16539. Add(' Result:=c;');
  16540. Add(' b:=Result;');
  16541. Add(' c:=Result;');
  16542. Add('end;');
  16543. Add('var i: longint;');
  16544. Add('begin');
  16545. Add(' doit(i,i,i);');
  16546. ConvertProgram;
  16547. CheckSource('TestJSValue_UntypedParam',
  16548. LinesToStr([ // statements
  16549. 'this.DoIt = function (a, b, c) {',
  16550. ' var Result = undefined;',
  16551. ' Result = a;',
  16552. ' Result = b.get();',
  16553. ' Result = c.get();',
  16554. ' b.set(Result);',
  16555. ' c.set(Result);',
  16556. ' return Result;',
  16557. '};',
  16558. 'this.i = 0;',
  16559. '']),
  16560. LinesToStr([ // $mod.$main
  16561. '$mod.DoIt($mod.i, {',
  16562. ' p: $mod,',
  16563. ' get: function () {',
  16564. ' return this.p.i;',
  16565. ' },',
  16566. ' set: function (v) {',
  16567. ' this.p.i = v;',
  16568. ' }',
  16569. '}, {',
  16570. ' p: $mod,',
  16571. ' get: function () {',
  16572. ' return this.p.i;',
  16573. ' },',
  16574. ' set: function (v) {',
  16575. ' this.p.i = v;',
  16576. ' }',
  16577. '});',
  16578. '']));
  16579. end;
  16580. procedure TTestModule.TestJSValue_FuncResultType;
  16581. begin
  16582. StartProgram(false);
  16583. Add('type');
  16584. Add(' integer = longint;');
  16585. Add(' TJSValueArray = array of JSValue;');
  16586. Add(' TListSortCompare = function(Item1, Item2: JSValue): Integer;');
  16587. Add('procedure Sort(P: JSValue; aList: TJSValueArray; const Compare: TListSortCompare);');
  16588. Add('begin');
  16589. Add(' while Compare(P,aList[0])>0 do ;');
  16590. Add('end;');
  16591. Add('var');
  16592. Add(' Compare: TListSortCompare;');
  16593. Add(' V: JSValue;');
  16594. Add(' i: integer;');
  16595. Add('begin');
  16596. Add(' if Compare(V,V)>0 then ;');
  16597. Add(' if Compare(i,i)>1 then ;');
  16598. Add(' if Compare(nil,false)>2 then ;');
  16599. Add(' if Compare(1,true)>3 then ;');
  16600. ConvertProgram;
  16601. CheckSource('TestJSValue_UntypedParam',
  16602. LinesToStr([ // statements
  16603. 'this.Sort = function (P, aList, Compare) {',
  16604. ' while (Compare(P, aList[0]) > 0) {',
  16605. ' };',
  16606. '};',
  16607. 'this.Compare = null;',
  16608. 'this.V = undefined;',
  16609. 'this.i = 0;',
  16610. '']),
  16611. LinesToStr([ // $mod.$main
  16612. 'if ($mod.Compare($mod.V, $mod.V) > 0) ;',
  16613. 'if ($mod.Compare($mod.i, $mod.i) > 1) ;',
  16614. 'if ($mod.Compare(null, false) > 2) ;',
  16615. 'if ($mod.Compare(1, true) > 3) ;',
  16616. '']));
  16617. end;
  16618. procedure TTestModule.TestJSValue_ProcType_Assign;
  16619. begin
  16620. StartProgram(false);
  16621. Add('type');
  16622. Add(' integer = longint;');
  16623. Add(' TObject = class');
  16624. Add(' class function GetGlob: integer;');
  16625. Add(' function Getter: integer;');
  16626. Add(' end;');
  16627. Add('class function TObject.GetGlob: integer;');
  16628. Add('var v1: jsvalue;');
  16629. Add('begin');
  16630. Add(' v1:=@GetGlob;');
  16631. Add(' v1:[email protected];');
  16632. Add('end;');
  16633. Add('function TObject.Getter: integer;');
  16634. Add('var v2: jsvalue;');
  16635. Add('begin');
  16636. Add(' v2:=@Getter;');
  16637. Add(' v2:[email protected];');
  16638. Add(' v2:=@GetGlob;');
  16639. Add(' v2:[email protected];');
  16640. Add('end;');
  16641. Add('function GetIt(i: integer): integer;');
  16642. Add('var v3: jsvalue;');
  16643. Add('begin');
  16644. Add(' v3:=@GetIt;');
  16645. Add('end;');
  16646. Add('var');
  16647. Add(' V: JSValue;');
  16648. Add(' o: TObject;');
  16649. Add('begin');
  16650. Add(' v:=@GetIt;');
  16651. Add(' v:[email protected];');
  16652. Add(' v:[email protected];');
  16653. ConvertProgram;
  16654. CheckSource('TestJSValue_ProcType_Assign',
  16655. LinesToStr([ // statements
  16656. 'rtl.createClass($mod, "TObject", null, function () {',
  16657. ' this.$init = function () {',
  16658. ' };',
  16659. ' this.$final = function () {',
  16660. ' };',
  16661. ' this.GetGlob = function () {',
  16662. ' var Result = 0;',
  16663. ' var v1 = undefined;',
  16664. ' v1 = rtl.createCallback(this, "GetGlob");',
  16665. ' v1 = rtl.createCallback(this, "GetGlob");',
  16666. ' return Result;',
  16667. ' };',
  16668. ' this.Getter = function () {',
  16669. ' var Result = 0;',
  16670. ' var v2 = undefined;',
  16671. ' v2 = rtl.createCallback(this, "Getter");',
  16672. ' v2 = rtl.createCallback(this, "Getter");',
  16673. ' v2 = rtl.createCallback(this.$class, "GetGlob");',
  16674. ' v2 = rtl.createCallback(this.$class, "GetGlob");',
  16675. ' return Result;',
  16676. ' };',
  16677. '});',
  16678. 'this.GetIt = function (i) {',
  16679. ' var Result = 0;',
  16680. ' var v3 = undefined;',
  16681. ' v3 = $mod.GetIt;',
  16682. ' return Result;',
  16683. '};',
  16684. 'this.V = undefined;',
  16685. 'this.o = null;',
  16686. '']),
  16687. LinesToStr([ // $mod.$main
  16688. '$mod.V = $mod.GetIt;',
  16689. '$mod.V = rtl.createCallback($mod.o, "Getter");',
  16690. '$mod.V = rtl.createCallback($mod.o.$class, "GetGlob");',
  16691. '']));
  16692. end;
  16693. procedure TTestModule.TestJSValue_ProcType_Equal;
  16694. begin
  16695. StartProgram(false);
  16696. Add('type');
  16697. Add(' integer = longint;');
  16698. Add(' TObject = class');
  16699. Add(' class function GetGlob: integer;');
  16700. Add(' function Getter: integer;');
  16701. Add(' end;');
  16702. Add('class function TObject.GetGlob: integer;');
  16703. Add('var v1: jsvalue;');
  16704. Add('begin');
  16705. Add(' if v1=@GetGlob then;');
  16706. Add(' if [email protected] then ;');
  16707. Add('end;');
  16708. Add('function TObject.Getter: integer;');
  16709. Add('var v2: jsvalue;');
  16710. Add('begin');
  16711. Add(' if v2=@Getter then;');
  16712. Add(' if [email protected] then ;');
  16713. Add(' if v2=@GetGlob then;');
  16714. Add(' if [email protected] then;');
  16715. Add('end;');
  16716. Add('function GetIt(i: integer): integer;');
  16717. Add('var v3: jsvalue;');
  16718. Add('begin');
  16719. Add(' if v3=@GetIt then;');
  16720. Add('end;');
  16721. Add('var');
  16722. Add(' V: JSValue;');
  16723. Add(' o: TObject;');
  16724. Add('begin');
  16725. Add(' if v=@GetIt then;');
  16726. Add(' if [email protected] then;');
  16727. Add(' if [email protected] then;');
  16728. Add(' if @GetIt=v then;');
  16729. Add(' if @o.Getter=v then;');
  16730. Add(' if @o.GetGlob=v then;');
  16731. ConvertProgram;
  16732. CheckSource('TestJSValue_ProcType_Equal',
  16733. LinesToStr([ // statements
  16734. 'rtl.createClass($mod, "TObject", null, function () {',
  16735. ' this.$init = function () {',
  16736. ' };',
  16737. ' this.$final = function () {',
  16738. ' };',
  16739. ' this.GetGlob = function () {',
  16740. ' var Result = 0;',
  16741. ' var v1 = undefined;',
  16742. ' if (rtl.eqCallback(v1, rtl.createCallback(this, "GetGlob"))) ;',
  16743. ' if (rtl.eqCallback(v1, rtl.createCallback(this, "GetGlob"))) ;',
  16744. ' return Result;',
  16745. ' };',
  16746. ' this.Getter = function () {',
  16747. ' var Result = 0;',
  16748. ' var v2 = undefined;',
  16749. ' if (rtl.eqCallback(v2, rtl.createCallback(this, "Getter"))) ;',
  16750. ' if (rtl.eqCallback(v2, rtl.createCallback(this, "Getter"))) ;',
  16751. ' if (rtl.eqCallback(v2, rtl.createCallback(this.$class, "GetGlob"))) ;',
  16752. ' if (rtl.eqCallback(v2, rtl.createCallback(this.$class, "GetGlob"))) ;',
  16753. ' return Result;',
  16754. ' };',
  16755. '});',
  16756. 'this.GetIt = function (i) {',
  16757. ' var Result = 0;',
  16758. ' var v3 = undefined;',
  16759. ' if (rtl.eqCallback(v3, $mod.GetIt)) ;',
  16760. ' return Result;',
  16761. '};',
  16762. 'this.V = undefined;',
  16763. 'this.o = null;',
  16764. '']),
  16765. LinesToStr([ // $mod.$main
  16766. 'if (rtl.eqCallback($mod.V, $mod.GetIt)) ;',
  16767. 'if (rtl.eqCallback($mod.V, rtl.createCallback($mod.o, "Getter"))) ;',
  16768. 'if (rtl.eqCallback($mod.V, rtl.createCallback($mod.o.$class, "GetGlob"))) ;',
  16769. 'if (rtl.eqCallback($mod.GetIt, $mod.V)) ;',
  16770. 'if (rtl.eqCallback(rtl.createCallback($mod.o, "Getter"), $mod.V)) ;',
  16771. 'if (rtl.eqCallback(rtl.createCallback($mod.o.$class, "GetGlob"), $mod.V)) ;',
  16772. '']));
  16773. end;
  16774. procedure TTestModule.TestJSValue_ProcType_Param;
  16775. begin
  16776. StartProgram(false);
  16777. Add([
  16778. 'type',
  16779. ' variant = jsvalue;',
  16780. ' TArrVariant = array of variant;',
  16781. ' TArrVar2 = TArrVariant;',
  16782. ' TFuncInt = function: longint;',
  16783. 'function GetIt: longint;',
  16784. 'begin',
  16785. 'end;',
  16786. 'procedure DoIt(p: jsvalue; Arr: TArrVar2);',
  16787. 'var v: variant;',
  16788. 'begin',
  16789. ' v:=arr[1];',
  16790. 'end;',
  16791. 'var s: string;',
  16792. 'begin',
  16793. ' DoIt(GetIt,[]);',
  16794. ' DoIt(@GetIt,[]);',
  16795. ' DoIt(1,[s,GetIt]);',
  16796. ' DoIt(1,[s,@GetIt]);',
  16797. '']);
  16798. ConvertProgram;
  16799. CheckSource('TestJSValue_ProcType_Param',
  16800. LinesToStr([ // statements
  16801. 'this.GetIt = function () {',
  16802. ' var Result = 0;',
  16803. ' return Result;',
  16804. '};',
  16805. 'this.DoIt = function (p, Arr) {',
  16806. ' var v = undefined;',
  16807. ' v = Arr[1];',
  16808. '};',
  16809. 'this.s = "";',
  16810. '']),
  16811. LinesToStr([ // $mod.$main
  16812. '$mod.DoIt($mod.GetIt(), []);',
  16813. '$mod.DoIt($mod.GetIt, []);',
  16814. '$mod.DoIt(1, [$mod.s, $mod.GetIt()]);',
  16815. '$mod.DoIt(1, [$mod.s, $mod.GetIt]);',
  16816. '']));
  16817. end;
  16818. procedure TTestModule.TestJSValue_AssignToPointerFail;
  16819. begin
  16820. StartProgram(false);
  16821. Add([
  16822. 'var',
  16823. ' v: JSValue;',
  16824. ' p: Pointer;',
  16825. 'begin',
  16826. ' p:=v;',
  16827. '']);
  16828. SetExpectedPasResolverError('Incompatible types: got "JSValue" expected "Pointer"',
  16829. nIncompatibleTypesGotExpected);
  16830. ConvertProgram;
  16831. end;
  16832. procedure TTestModule.TestJSValue_OverloadDouble;
  16833. begin
  16834. StartProgram(false);
  16835. Add([
  16836. 'type',
  16837. ' integer = longint;',
  16838. ' tdatetime = double;',
  16839. 'procedure DoIt(d: double); begin end;',
  16840. 'procedure DoIt(v: jsvalue); begin end;',
  16841. 'var',
  16842. ' d: double;',
  16843. ' dt: tdatetime;',
  16844. ' i: integer;',
  16845. ' b: byte;',
  16846. ' shi: shortint;',
  16847. ' w: word;',
  16848. ' smi: smallint;',
  16849. ' lw: longword;',
  16850. ' li: longint;',
  16851. ' ni: nativeint;',
  16852. ' nu: nativeuint;',
  16853. 'begin',
  16854. ' DoIt(d);',
  16855. ' DoIt(dt);',
  16856. ' DoIt(i);',
  16857. ' DoIt(b);',
  16858. ' DoIt(shi);',
  16859. ' DoIt(w);',
  16860. ' DoIt(smi);',
  16861. ' DoIt(lw);',
  16862. ' DoIt(li);',
  16863. ' DoIt(ni);',
  16864. ' DoIt(nu);',
  16865. '']);
  16866. ConvertProgram;
  16867. CheckSource('TestJSValue_OverloadDouble',
  16868. LinesToStr([ // statements
  16869. 'this.DoIt = function (d) {',
  16870. '};',
  16871. 'this.DoIt$1 = function (v) {',
  16872. '};',
  16873. 'this.d = 0.0;',
  16874. 'this.dt = 0.0;',
  16875. 'this.i = 0;',
  16876. 'this.b = 0;',
  16877. 'this.shi = 0;',
  16878. 'this.w = 0;',
  16879. 'this.smi = 0;',
  16880. 'this.lw = 0;',
  16881. 'this.li = 0;',
  16882. 'this.ni = 0;',
  16883. 'this.nu = 0;',
  16884. '']),
  16885. LinesToStr([ // $mod.$main
  16886. '$mod.DoIt($mod.d);',
  16887. '$mod.DoIt($mod.dt);',
  16888. '$mod.DoIt($mod.i);',
  16889. '$mod.DoIt($mod.b);',
  16890. '$mod.DoIt($mod.shi);',
  16891. '$mod.DoIt($mod.w);',
  16892. '$mod.DoIt($mod.smi);',
  16893. '$mod.DoIt($mod.lw);',
  16894. '$mod.DoIt($mod.li);',
  16895. '$mod.DoIt($mod.ni);',
  16896. '$mod.DoIt($mod.nu);',
  16897. '']));
  16898. end;
  16899. procedure TTestModule.TestJSValue_OverloadNativeInt;
  16900. begin
  16901. StartProgram(false);
  16902. Add([
  16903. 'type',
  16904. ' integer = longint;',
  16905. ' int53 = nativeint;',
  16906. ' tdatetime = double;',
  16907. 'procedure DoIt(n: nativeint); begin end;',
  16908. 'procedure DoIt(v: jsvalue); begin end;',
  16909. 'var',
  16910. ' d: double;',
  16911. ' dt: tdatetime;',
  16912. ' i: integer;',
  16913. ' b: byte;',
  16914. ' shi: shortint;',
  16915. ' w: word;',
  16916. ' smi: smallint;',
  16917. ' lw: longword;',
  16918. ' li: longint;',
  16919. ' ni: nativeint;',
  16920. ' nu: nativeuint;',
  16921. 'begin',
  16922. ' DoIt(d);',
  16923. ' DoIt(dt);',
  16924. ' DoIt(i);',
  16925. ' DoIt(b);',
  16926. ' DoIt(shi);',
  16927. ' DoIt(w);',
  16928. ' DoIt(smi);',
  16929. ' DoIt(lw);',
  16930. ' DoIt(li);',
  16931. ' DoIt(ni);',
  16932. ' DoIt(nu);',
  16933. '']);
  16934. ConvertProgram;
  16935. CheckSource('TestJSValue_OverloadNativeInt',
  16936. LinesToStr([ // statements
  16937. 'this.DoIt = function (n) {',
  16938. '};',
  16939. 'this.DoIt$1 = function (v) {',
  16940. '};',
  16941. 'this.d = 0.0;',
  16942. 'this.dt = 0.0;',
  16943. 'this.i = 0;',
  16944. 'this.b = 0;',
  16945. 'this.shi = 0;',
  16946. 'this.w = 0;',
  16947. 'this.smi = 0;',
  16948. 'this.lw = 0;',
  16949. 'this.li = 0;',
  16950. 'this.ni = 0;',
  16951. 'this.nu = 0;',
  16952. '']),
  16953. LinesToStr([ // $mod.$main
  16954. '$mod.DoIt$1($mod.d);',
  16955. '$mod.DoIt$1($mod.dt);',
  16956. '$mod.DoIt($mod.i);',
  16957. '$mod.DoIt($mod.b);',
  16958. '$mod.DoIt($mod.shi);',
  16959. '$mod.DoIt($mod.w);',
  16960. '$mod.DoIt($mod.smi);',
  16961. '$mod.DoIt($mod.lw);',
  16962. '$mod.DoIt($mod.li);',
  16963. '$mod.DoIt($mod.ni);',
  16964. '$mod.DoIt($mod.nu);',
  16965. '']));
  16966. end;
  16967. procedure TTestModule.TestJSValue_OverloadWord;
  16968. begin
  16969. StartProgram(false);
  16970. Add([
  16971. 'type',
  16972. ' integer = longint;',
  16973. ' int53 = nativeint;',
  16974. ' tdatetime = double;',
  16975. 'procedure DoIt(w: word); begin end;',
  16976. 'procedure DoIt(v: jsvalue); begin end;',
  16977. 'var',
  16978. ' d: double;',
  16979. ' dt: tdatetime;',
  16980. ' i: integer;',
  16981. ' b: byte;',
  16982. ' shi: shortint;',
  16983. ' w: word;',
  16984. ' smi: smallint;',
  16985. ' lw: longword;',
  16986. ' li: longint;',
  16987. ' ni: nativeint;',
  16988. ' nu: nativeuint;',
  16989. 'begin',
  16990. ' DoIt(d);',
  16991. ' DoIt(dt);',
  16992. ' DoIt(i);',
  16993. ' DoIt(b);',
  16994. ' DoIt(shi);',
  16995. ' DoIt(w);',
  16996. ' DoIt(smi);',
  16997. ' DoIt(lw);',
  16998. ' DoIt(li);',
  16999. ' DoIt(ni);',
  17000. ' DoIt(nu);',
  17001. '']);
  17002. ConvertProgram;
  17003. CheckSource('TestJSValue_OverloadWord',
  17004. LinesToStr([ // statements
  17005. 'this.DoIt = function (w) {',
  17006. '};',
  17007. 'this.DoIt$1 = function (v) {',
  17008. '};',
  17009. 'this.d = 0.0;',
  17010. 'this.dt = 0.0;',
  17011. 'this.i = 0;',
  17012. 'this.b = 0;',
  17013. 'this.shi = 0;',
  17014. 'this.w = 0;',
  17015. 'this.smi = 0;',
  17016. 'this.lw = 0;',
  17017. 'this.li = 0;',
  17018. 'this.ni = 0;',
  17019. 'this.nu = 0;',
  17020. '']),
  17021. LinesToStr([ // $mod.$main
  17022. '$mod.DoIt$1($mod.d);',
  17023. '$mod.DoIt$1($mod.dt);',
  17024. '$mod.DoIt$1($mod.i);',
  17025. '$mod.DoIt($mod.b);',
  17026. '$mod.DoIt($mod.shi);',
  17027. '$mod.DoIt($mod.w);',
  17028. '$mod.DoIt$1($mod.smi);',
  17029. '$mod.DoIt$1($mod.lw);',
  17030. '$mod.DoIt$1($mod.li);',
  17031. '$mod.DoIt$1($mod.ni);',
  17032. '$mod.DoIt$1($mod.nu);',
  17033. '']));
  17034. end;
  17035. procedure TTestModule.TestJSValue_OverloadString;
  17036. begin
  17037. StartProgram(false);
  17038. Add([
  17039. 'type',
  17040. ' uni = string;',
  17041. ' WChar = char;',
  17042. 'procedure DoIt(s: string); begin end;',
  17043. 'procedure DoIt(v: jsvalue); begin end;',
  17044. 'var',
  17045. ' s: string;',
  17046. ' c: char;',
  17047. ' u: uni;',
  17048. 'begin',
  17049. ' DoIt(s);',
  17050. ' DoIt(c);',
  17051. ' DoIt(u);',
  17052. '']);
  17053. ConvertProgram;
  17054. CheckSource('TestJSValue_OverloadString',
  17055. LinesToStr([ // statements
  17056. 'this.DoIt = function (s) {',
  17057. '};',
  17058. 'this.DoIt$1 = function (v) {',
  17059. '};',
  17060. 'this.s = "";',
  17061. 'this.c = "";',
  17062. 'this.u = "";',
  17063. '']),
  17064. LinesToStr([ // $mod.$main
  17065. '$mod.DoIt($mod.s);',
  17066. '$mod.DoIt($mod.c);',
  17067. '$mod.DoIt($mod.u);',
  17068. '']));
  17069. end;
  17070. procedure TTestModule.TestJSValue_OverloadChar;
  17071. begin
  17072. StartProgram(false);
  17073. Add([
  17074. 'type',
  17075. ' uni = string;',
  17076. ' WChar = char;',
  17077. 'procedure DoIt(c: char); begin end;',
  17078. 'procedure DoIt(v: jsvalue); begin end;',
  17079. 'var',
  17080. ' s: string;',
  17081. ' c: char;',
  17082. ' u: uni;',
  17083. 'begin',
  17084. ' DoIt(s);',
  17085. ' DoIt(c);',
  17086. ' DoIt(u);',
  17087. '']);
  17088. ConvertProgram;
  17089. CheckSource('TestJSValue_OverloadChar',
  17090. LinesToStr([ // statements
  17091. 'this.DoIt = function (c) {',
  17092. '};',
  17093. 'this.DoIt$1 = function (v) {',
  17094. '};',
  17095. 'this.s = "";',
  17096. 'this.c = "";',
  17097. 'this.u = "";',
  17098. '']),
  17099. LinesToStr([ // $mod.$main
  17100. '$mod.DoIt$1($mod.s);',
  17101. '$mod.DoIt($mod.c);',
  17102. '$mod.DoIt$1($mod.u);',
  17103. '']));
  17104. end;
  17105. procedure TTestModule.TestJSValue_OverloadPointer;
  17106. begin
  17107. StartProgram(false);
  17108. Add([
  17109. 'type',
  17110. ' TObject = class end;',
  17111. 'procedure DoIt(p: pointer); begin end;',
  17112. 'procedure DoIt(v: jsvalue); begin end;',
  17113. 'var',
  17114. ' o: TObject;',
  17115. 'begin',
  17116. ' DoIt(o);',
  17117. '']);
  17118. ConvertProgram;
  17119. CheckSource('TestJSValue_OverloadPointer',
  17120. LinesToStr([ // statements
  17121. 'rtl.createClass($mod, "TObject", null, function () {',
  17122. ' this.$init = function () {',
  17123. ' };',
  17124. ' this.$final = function () {',
  17125. ' };',
  17126. '});',
  17127. 'this.DoIt = function (p) {',
  17128. '};',
  17129. 'this.DoIt$1 = function (v) {',
  17130. '};',
  17131. 'this.o = null;',
  17132. '']),
  17133. LinesToStr([ // $mod.$main
  17134. '$mod.DoIt($mod.o);',
  17135. '']));
  17136. end;
  17137. procedure TTestModule.TestJSValue_ForIn;
  17138. begin
  17139. StartProgram(false);
  17140. Add([
  17141. 'var',
  17142. ' v: JSValue;',
  17143. ' key: string;',
  17144. 'begin',
  17145. ' for key in v do begin',
  17146. ' if key=''abc'' then ;',
  17147. ' end;',
  17148. '']);
  17149. ConvertProgram;
  17150. CheckSource('TestJSValue_ForIn',
  17151. LinesToStr([ // statements
  17152. 'this.v = undefined;',
  17153. 'this.key = "";',
  17154. '']),
  17155. LinesToStr([ // $mod.$main
  17156. 'for ($mod.key in $mod.v) {',
  17157. ' if ($mod.key === "abc") ;',
  17158. '};',
  17159. '']));
  17160. end;
  17161. procedure TTestModule.TestRTTI_ProcType;
  17162. begin
  17163. Converter.Options:=Converter.Options-[coNoTypeInfo];
  17164. StartProgram(false);
  17165. Add('type');
  17166. Add(' TProcA = procedure;');
  17167. Add(' TMethodB = procedure of object;');
  17168. Add(' TProcC = procedure; varargs;');
  17169. Add(' TProcD = procedure(i: longint; const j: string; var c: char; out d: double);');
  17170. Add(' TProcE = function: nativeint;');
  17171. Add(' TProcF = function(const p: TProcA): nativeuint;');
  17172. Add('var p: pointer;');
  17173. Add('begin');
  17174. Add(' p:=typeinfo(tproca);');
  17175. ConvertProgram;
  17176. CheckSource('TestRTTI_ProcType',
  17177. LinesToStr([ // statements
  17178. '$mod.$rtti.$ProcVar("TProcA", {',
  17179. ' procsig: rtl.newTIProcSig(null)',
  17180. '});',
  17181. '$mod.$rtti.$MethodVar("TMethodB", {',
  17182. ' procsig: rtl.newTIProcSig(null),',
  17183. ' methodkind: 0',
  17184. '});',
  17185. '$mod.$rtti.$ProcVar("TProcC", {',
  17186. ' procsig: rtl.newTIProcSig(null, 2)',
  17187. '});',
  17188. '$mod.$rtti.$ProcVar("TProcD", {',
  17189. ' procsig: rtl.newTIProcSig([["i", rtl.longint], ["j", rtl.string, 2], ["c", rtl.char, 1], ["d", rtl.double, 4]])',
  17190. '});',
  17191. '$mod.$rtti.$ProcVar("TProcE", {',
  17192. ' procsig: rtl.newTIProcSig(null, rtl.nativeint)',
  17193. '});',
  17194. '$mod.$rtti.$ProcVar("TProcF", {',
  17195. ' procsig: rtl.newTIProcSig([["p", $mod.$rtti["TProcA"], 2]], rtl.nativeuint)',
  17196. '});',
  17197. 'this.p = null;',
  17198. '']),
  17199. LinesToStr([ // $mod.$main
  17200. '$mod.p = $mod.$rtti["TProcA"];',
  17201. '']));
  17202. end;
  17203. procedure TTestModule.TestRTTI_ProcType_ArgFromOtherUnit;
  17204. begin
  17205. Converter.Options:=Converter.Options-[coNoTypeInfo];
  17206. AddModuleWithIntfImplSrc('unit2.pas',
  17207. LinesToStr([
  17208. 'type',
  17209. ' TObject = class end;'
  17210. ]),
  17211. '');
  17212. StartUnit(true);
  17213. Add('interface');
  17214. Add('uses unit2;');
  17215. Add('type');
  17216. Add(' TProcA = function(o: tobject): tobject;');
  17217. Add('implementation');
  17218. Add('type');
  17219. Add(' TProcB = function(o: tobject): tobject;');
  17220. Add('var p: Pointer;');
  17221. Add('initialization');
  17222. Add(' p:=typeinfo(tproca);');
  17223. Add(' p:=typeinfo(tprocb);');
  17224. ConvertUnit;
  17225. CheckSource('TestRTTI_ProcType_ArgFromOtherUnit',
  17226. LinesToStr([ // statements
  17227. 'var $impl = $mod.$impl;',
  17228. '$mod.$rtti.$ProcVar("TProcA", {',
  17229. ' procsig: rtl.newTIProcSig([["o", pas.unit2.$rtti["TObject"]]], pas.unit2.$rtti["TObject"])',
  17230. '});',
  17231. '']),
  17232. LinesToStr([ // this.$init
  17233. '$impl.p = $mod.$rtti["TProcA"];',
  17234. '$impl.p = $mod.$rtti["TProcB"];',
  17235. '']),
  17236. LinesToStr([ // implementation
  17237. '$mod.$rtti.$ProcVar("TProcB", {',
  17238. ' procsig: rtl.newTIProcSig([["o", pas.unit2.$rtti["TObject"]]], pas.unit2.$rtti["TObject"])',
  17239. '});',
  17240. '$impl.p = null;',
  17241. '']) );
  17242. end;
  17243. procedure TTestModule.TestRTTI_EnumAndSetType;
  17244. begin
  17245. Converter.Options:=Converter.Options-[coNoTypeInfo];
  17246. StartProgram(false);
  17247. Add('type');
  17248. Add(' TFlag = (light,dark);');
  17249. Add(' TFlags = set of TFlag;');
  17250. Add(' TProc = function(f: TFlags): TFlag;');
  17251. Add('var p: pointer;');
  17252. Add('begin');
  17253. Add(' p:=typeinfo(tflag);');
  17254. Add(' p:=typeinfo(tflags);');
  17255. ConvertProgram;
  17256. CheckSource('TestRTTI_EnumAndType',
  17257. LinesToStr([ // statements
  17258. 'this.TFlag = {',
  17259. ' "0": "light",',
  17260. ' light: 0,',
  17261. ' "1": "dark",',
  17262. ' dark: 1',
  17263. '};',
  17264. '$mod.$rtti.$Enum("TFlag", {',
  17265. ' minvalue: 0,',
  17266. ' maxvalue: 1,',
  17267. ' ordtype: 1,',
  17268. ' enumtype: this.TFlag',
  17269. '});',
  17270. '$mod.$rtti.$Set("TFlags", {',
  17271. ' comptype: $mod.$rtti["TFlag"]',
  17272. '});',
  17273. '$mod.$rtti.$ProcVar("TProc", {',
  17274. ' procsig: rtl.newTIProcSig([["f", $mod.$rtti["TFlags"]]], $mod.$rtti["TFlag"])',
  17275. '});',
  17276. 'this.p = null;',
  17277. '']),
  17278. LinesToStr([ // $mod.$main
  17279. '$mod.p = $mod.$rtti["TFlag"];',
  17280. '$mod.p = $mod.$rtti["TFlags"];',
  17281. '']));
  17282. end;
  17283. procedure TTestModule.TestRTTI_EnumRange;
  17284. begin
  17285. Converter.Options:=Converter.Options-[coNoTypeInfo];
  17286. StartProgram(false);
  17287. Add([
  17288. 'type',
  17289. ' TCol = (red,green,blue);',
  17290. ' TColRg = green..blue;',
  17291. ' TSetOfColRg = set of TColRg;',
  17292. 'var p: pointer;',
  17293. 'begin',
  17294. ' p:=typeinfo(tcolrg);',
  17295. ' p:=typeinfo(tsetofcolrg);',
  17296. '']);
  17297. ConvertProgram;
  17298. end;
  17299. procedure TTestModule.TestRTTI_AnonymousEnumType;
  17300. begin
  17301. Converter.Options:=Converter.Options-[coNoTypeInfo];
  17302. StartProgram(false);
  17303. Add('type');
  17304. Add(' TFlags = set of (red, green);');
  17305. Add('var');
  17306. Add(' f: TFlags;');
  17307. Add('begin');
  17308. Add(' Include(f,red);');
  17309. ConvertProgram;
  17310. CheckSource('TestRTTI_AnonymousEnumType',
  17311. LinesToStr([ // statements
  17312. 'this.TFlags$a = {',
  17313. ' "0": "red",',
  17314. ' red: 0,',
  17315. ' "1": "green",',
  17316. ' green: 1',
  17317. '};',
  17318. '$mod.$rtti.$Enum("TFlags$a", {',
  17319. ' minvalue: 0,',
  17320. ' maxvalue: 1,',
  17321. ' ordtype: 1,',
  17322. ' enumtype: this.TFlags$a',
  17323. '});',
  17324. '$mod.$rtti.$Set("TFlags", {',
  17325. ' comptype: $mod.$rtti["TFlags$a"]',
  17326. '});',
  17327. 'this.f = {};',
  17328. '']),
  17329. LinesToStr([
  17330. '$mod.f = rtl.includeSet($mod.f, $mod.TFlags$a.red);',
  17331. '']));
  17332. end;
  17333. procedure TTestModule.TestRTTI_StaticArray;
  17334. begin
  17335. Converter.Options:=Converter.Options-[coNoTypeInfo];
  17336. StartProgram(false);
  17337. Add('type');
  17338. Add(' TFlag = (light,dark);');
  17339. Add(' TFlagNames = array[TFlag] of string;');
  17340. Add(' TBoolNames = array[boolean] of string;');
  17341. Add(' TByteArray = array[1..32768] of byte;');
  17342. Add(' TProc = function(f: TBoolNames): TFlagNames;');
  17343. Add('var p: pointer;');
  17344. Add('begin');
  17345. Add(' p:=typeinfo(TFlagNames);');
  17346. Add(' p:=typeinfo(TBoolNames);');
  17347. ConvertProgram;
  17348. CheckSource('TestRTTI_StaticArray',
  17349. LinesToStr([ // statements
  17350. 'this.TFlag = {',
  17351. ' "0": "light",',
  17352. ' light: 0,',
  17353. ' "1": "dark",',
  17354. ' dark: 1',
  17355. '};',
  17356. '$mod.$rtti.$Enum("TFlag", {',
  17357. ' minvalue: 0,',
  17358. ' maxvalue: 1,',
  17359. ' ordtype: 1,',
  17360. ' enumtype: this.TFlag',
  17361. '});',
  17362. '$mod.$rtti.$StaticArray("TFlagNames", {',
  17363. ' dims: [2],',
  17364. ' eltype: rtl.string',
  17365. '});',
  17366. '$mod.$rtti.$StaticArray("TBoolNames", {',
  17367. ' dims: [2],',
  17368. ' eltype: rtl.string',
  17369. '});',
  17370. '$mod.$rtti.$StaticArray("TByteArray", {',
  17371. ' dims: [32768],',
  17372. ' eltype: rtl.byte',
  17373. '});',
  17374. '$mod.$rtti.$ProcVar("TProc", {',
  17375. ' procsig: rtl.newTIProcSig([["f", $mod.$rtti["TBoolNames"]]], $mod.$rtti["TFlagNames"])',
  17376. '});',
  17377. 'this.p = null;',
  17378. '']),
  17379. LinesToStr([ // $mod.$main
  17380. '$mod.p = $mod.$rtti["TFlagNames"];',
  17381. '$mod.p = $mod.$rtti["TBoolNames"];',
  17382. '']));
  17383. end;
  17384. procedure TTestModule.TestRTTI_DynArray;
  17385. begin
  17386. Converter.Options:=Converter.Options-[coNoTypeInfo];
  17387. StartProgram(false);
  17388. Add('type');
  17389. Add(' TArrStr = array of string;');
  17390. Add(' TArr2Dim = array of tarrstr;');
  17391. Add(' TProc = function(f: TArrStr): TArr2Dim;');
  17392. Add('var p: pointer;');
  17393. Add('begin');
  17394. Add(' p:=typeinfo(tarrstr);');
  17395. Add(' p:=typeinfo(tarr2dim);');
  17396. ConvertProgram;
  17397. CheckSource('TestRTTI_DynArray',
  17398. LinesToStr([ // statements
  17399. '$mod.$rtti.$DynArray("TArrStr", {',
  17400. ' eltype: rtl.string',
  17401. '});',
  17402. '$mod.$rtti.$DynArray("TArr2Dim", {',
  17403. ' eltype: $mod.$rtti["TArrStr"]',
  17404. '});',
  17405. '$mod.$rtti.$ProcVar("TProc", {',
  17406. ' procsig: rtl.newTIProcSig([["f", $mod.$rtti["TArrStr"]]], $mod.$rtti["TArr2Dim"])',
  17407. '});',
  17408. 'this.p = null;',
  17409. '']),
  17410. LinesToStr([ // $mod.$main
  17411. '$mod.p = $mod.$rtti["TArrStr"];',
  17412. '$mod.p = $mod.$rtti["TArr2Dim"];',
  17413. '']));
  17414. end;
  17415. procedure TTestModule.TestRTTI_ArrayNestedAnonymous;
  17416. begin
  17417. Converter.Options:=Converter.Options-[coNoTypeInfo];
  17418. StartProgram(false);
  17419. Add('type');
  17420. Add(' TArr = array of array of longint;');
  17421. Add('var a: TArr;');
  17422. Add('begin');
  17423. ConvertProgram;
  17424. CheckSource('TestRTTI_ArrayNestedAnonymous',
  17425. LinesToStr([ // statements
  17426. '$mod.$rtti.$DynArray("TArr$a", {',
  17427. ' eltype: rtl.longint',
  17428. '});',
  17429. '$mod.$rtti.$DynArray("TArr", {',
  17430. ' eltype: $mod.$rtti["TArr$a"]',
  17431. '});',
  17432. 'this.a = [];',
  17433. '']),
  17434. LinesToStr([ // $mod.$main
  17435. ]));
  17436. end;
  17437. procedure TTestModule.TestRTTI_PublishedMethodOverloadFail;
  17438. begin
  17439. Converter.Options:=Converter.Options-[coNoTypeInfo];
  17440. StartProgram(false);
  17441. Add('type');
  17442. Add(' TObject = class');
  17443. Add(' published');
  17444. Add(' procedure Proc; virtual; abstract;');
  17445. Add(' procedure Proc(Sender: tobject); virtual; abstract;');
  17446. Add(' end;');
  17447. Add('begin');
  17448. SetExpectedPasResolverError('Duplicate identifier "Proc" at test1.pp(6,19)',
  17449. nDuplicateIdentifier);
  17450. ConvertProgram;
  17451. end;
  17452. procedure TTestModule.TestRTTI_PublishedMethodExternalFail;
  17453. begin
  17454. Converter.Options:=Converter.Options-[coNoTypeInfo];
  17455. StartProgram(false);
  17456. Add('type');
  17457. Add(' TObject = class');
  17458. Add(' published');
  17459. Add(' procedure Proc; external name ''foo'';');
  17460. Add(' end;');
  17461. Add('begin');
  17462. SetExpectedPasResolverError(sPublishedNameMustMatchExternal,
  17463. nPublishedNameMustMatchExternal);
  17464. ConvertProgram;
  17465. end;
  17466. procedure TTestModule.TestRTTI_PublishedClassPropertyFail;
  17467. begin
  17468. Converter.Options:=Converter.Options-[coNoTypeInfo];
  17469. StartProgram(false);
  17470. Add('type');
  17471. Add(' TObject = class');
  17472. Add(' class var FA: longint;');
  17473. Add(' published');
  17474. Add(' class property A: longint read FA;');
  17475. Add(' end;');
  17476. Add('begin');
  17477. SetExpectedPasResolverError('Invalid published property modifier "class"',
  17478. nInvalidXModifierY);
  17479. ConvertProgram;
  17480. end;
  17481. procedure TTestModule.TestRTTI_PublishedClassFieldFail;
  17482. begin
  17483. Converter.Options:=Converter.Options-[coNoTypeInfo];
  17484. StartProgram(false);
  17485. Add('type');
  17486. Add(' TObject = class');
  17487. Add(' published');
  17488. Add(' class var FA: longint;');
  17489. Add(' end;');
  17490. Add('begin');
  17491. SetExpectedPasResolverError(sSymbolCannotBePublished,
  17492. nSymbolCannotBePublished);
  17493. ConvertProgram;
  17494. end;
  17495. procedure TTestModule.TestRTTI_PublishedFieldExternalFail;
  17496. begin
  17497. Converter.Options:=Converter.Options-[coNoTypeInfo];
  17498. StartProgram(false);
  17499. Add('{$modeswitch externalclass}');
  17500. Add('type');
  17501. Add(' TObject = class');
  17502. Add(' published');
  17503. Add(' V: longint; external name ''foo'';');
  17504. Add(' end;');
  17505. Add('begin');
  17506. SetExpectedPasResolverError(sPublishedNameMustMatchExternal,
  17507. nPublishedNameMustMatchExternal);
  17508. ConvertProgram;
  17509. end;
  17510. procedure TTestModule.TestRTTI_IndexModifier;
  17511. begin
  17512. Converter.Options:=Converter.Options-[coNoTypeInfo];
  17513. StartProgram(false);
  17514. Add([
  17515. 'type',
  17516. ' TEnum = (red, blue);',
  17517. ' TObject = class',
  17518. ' FB: boolean;',
  17519. ' procedure SetIntBool(Index: longint; b: boolean); virtual; abstract;',
  17520. ' function GetBoolBool(Index: boolean): boolean; virtual; abstract;',
  17521. ' procedure SetBoolBool(Index: boolean; b: boolean); virtual; abstract;',
  17522. ' function GetEnumBool(Index: TEnum): boolean; virtual; abstract;',
  17523. ' function GetStrIntBool(A: String; I: longint): boolean; virtual; abstract;',
  17524. ' procedure SetStrIntBool(A: String; I: longint; b: boolean); virtual; abstract;',
  17525. ' published',
  17526. ' property B1: boolean index 1 read FB write SetIntBool;',
  17527. ' property B2: boolean index TEnum.blue read GetEnumBool write FB;',
  17528. ' property I1[A: String]: boolean index 2 read GetStrIntBool write SetStrIntBool;',
  17529. ' end;',
  17530. 'begin']);
  17531. ConvertProgram;
  17532. CheckSource('TestRTTI_IndexModifier',
  17533. LinesToStr([ // statements
  17534. 'this.TEnum = {',
  17535. ' "0": "red",',
  17536. ' red: 0,',
  17537. ' "1": "blue",',
  17538. ' blue: 1',
  17539. '};',
  17540. '$mod.$rtti.$Enum("TEnum", {',
  17541. ' minvalue: 0,',
  17542. ' maxvalue: 1,',
  17543. ' ordtype: 1,',
  17544. ' enumtype: this.TEnum',
  17545. '});',
  17546. 'rtl.createClass($mod, "TObject", null, function () {',
  17547. ' this.$init = function () {',
  17548. ' this.FB = false;',
  17549. ' };',
  17550. ' this.$final = function () {',
  17551. ' };',
  17552. ' var $r = this.$rtti;',
  17553. ' $r.addProperty(',
  17554. ' "B1",',
  17555. ' 18,',
  17556. ' rtl.boolean,',
  17557. ' "FB",',
  17558. ' "SetIntBool",',
  17559. ' {',
  17560. ' index: 1',
  17561. ' }',
  17562. ' );',
  17563. ' $r.addProperty(',
  17564. ' "B2",',
  17565. ' 17,',
  17566. ' rtl.boolean,',
  17567. ' "GetEnumBool",',
  17568. ' "FB",',
  17569. ' {',
  17570. ' index: $mod.TEnum.blue',
  17571. ' }',
  17572. ' );',
  17573. ' $r.addProperty(',
  17574. ' "I1",',
  17575. ' 19,',
  17576. ' rtl.boolean,',
  17577. ' "GetStrIntBool",',
  17578. ' "SetStrIntBool",',
  17579. ' {',
  17580. ' index: 2',
  17581. ' }',
  17582. ' );',
  17583. '});',
  17584. '']),
  17585. LinesToStr([ // $mod.$main
  17586. '']));
  17587. end;
  17588. procedure TTestModule.TestRTTI_StoredModifier;
  17589. begin
  17590. Converter.Options:=Converter.Options-[coNoTypeInfo];
  17591. StartProgram(false);
  17592. Add([
  17593. 'const',
  17594. ' ConstB = true;',
  17595. 'type',
  17596. ' TObject = class',
  17597. ' private',
  17598. ' FB: boolean;',
  17599. ' function IsBStored: boolean; virtual; abstract;',
  17600. ' published',
  17601. ' property BoolA: boolean read FB stored true;',
  17602. ' property BoolB: boolean read FB stored false;',
  17603. ' property BoolC: boolean read FB stored FB;',
  17604. ' property BoolD: boolean read FB stored ConstB;',
  17605. ' property BoolE: boolean read FB stored IsBStored;',
  17606. ' end;',
  17607. 'begin']);
  17608. ConvertProgram;
  17609. CheckSource('TestRTTI_StoredModifier',
  17610. LinesToStr([ // statements
  17611. 'this.ConstB = true;',
  17612. 'rtl.createClass($mod, "TObject", null, function () {',
  17613. ' this.$init = function () {',
  17614. ' this.FB = false;',
  17615. ' };',
  17616. ' this.$final = function () {',
  17617. ' };',
  17618. ' var $r = this.$rtti;',
  17619. ' $r.addProperty("BoolA", 0, rtl.boolean, "FB", "");',
  17620. ' $r.addProperty("BoolB", 4, rtl.boolean, "FB", "");',
  17621. ' $r.addProperty(',
  17622. ' "BoolC",',
  17623. ' 8,',
  17624. ' rtl.boolean,',
  17625. ' "FB",',
  17626. ' "",',
  17627. ' {',
  17628. ' stored: "FB"',
  17629. ' }',
  17630. ' );',
  17631. ' $r.addProperty("BoolD", 0, rtl.boolean, "FB", "");',
  17632. ' $r.addProperty(',
  17633. ' "BoolE",',
  17634. ' 12,',
  17635. ' rtl.boolean,',
  17636. ' "FB",',
  17637. ' "",',
  17638. ' {',
  17639. ' stored: "IsBStored"',
  17640. ' }',
  17641. ' );',
  17642. '});',
  17643. '']),
  17644. LinesToStr([ // $mod.$main
  17645. '']));
  17646. end;
  17647. procedure TTestModule.TestRTTI_DefaultValue;
  17648. begin
  17649. Converter.Options:=Converter.Options-[coNoTypeInfo];
  17650. StartProgram(false);
  17651. Add([
  17652. 'type',
  17653. ' TEnum = (red, blue);',
  17654. 'const',
  17655. ' CB = true or false;',
  17656. ' CI = 1+2;',
  17657. 'type',
  17658. ' TObject = class',
  17659. ' FB: boolean;',
  17660. ' FI: longint;',
  17661. ' FE: TEnum;',
  17662. ' published',
  17663. ' property B1: boolean read FB default true;',
  17664. ' property B2: boolean read FB default CB;',
  17665. ' property B3: boolean read FB default test1.cb;',
  17666. ' property I1: longint read FI default 2;',
  17667. ' property I2: longint read FI default CI;',
  17668. ' property E1: TEnum read FE default red;',
  17669. ' property E2: TEnum read FE default TEnum.blue;',
  17670. ' end;',
  17671. 'begin']);
  17672. ConvertProgram;
  17673. CheckSource('TestRTTI_DefaultValue',
  17674. LinesToStr([ // statements
  17675. 'this.TEnum = {',
  17676. ' "0": "red",',
  17677. ' red: 0,',
  17678. ' "1": "blue",',
  17679. ' blue: 1',
  17680. '};',
  17681. '$mod.$rtti.$Enum("TEnum", {',
  17682. ' minvalue: 0,',
  17683. ' maxvalue: 1,',
  17684. ' ordtype: 1,',
  17685. ' enumtype: this.TEnum',
  17686. '});',
  17687. 'this.CB = true || false;',
  17688. 'this.CI = 1 + 2;',
  17689. 'rtl.createClass($mod, "TObject", null, function () {',
  17690. ' this.$init = function () {',
  17691. ' this.FB = false;',
  17692. ' this.FI = 0;',
  17693. ' this.FE = 0;',
  17694. ' };',
  17695. ' this.$final = function () {',
  17696. ' };',
  17697. ' var $r = this.$rtti;',
  17698. ' $r.addProperty(',
  17699. ' "B1",',
  17700. ' 0,',
  17701. ' rtl.boolean,',
  17702. ' "FB",',
  17703. ' "",',
  17704. ' {',
  17705. ' Default: true',
  17706. ' }',
  17707. ' );',
  17708. ' $r.addProperty(',
  17709. ' "B2",',
  17710. ' 0,',
  17711. ' rtl.boolean,',
  17712. ' "FB",',
  17713. ' "",',
  17714. ' {',
  17715. ' Default: true',
  17716. ' }',
  17717. ' );',
  17718. ' $r.addProperty(',
  17719. ' "B3",',
  17720. ' 0,',
  17721. ' rtl.boolean,',
  17722. ' "FB",',
  17723. ' "",',
  17724. ' {',
  17725. ' Default: true',
  17726. ' }',
  17727. ' );',
  17728. ' $r.addProperty(',
  17729. ' "I1",',
  17730. ' 0,',
  17731. ' rtl.longint,',
  17732. ' "FI",',
  17733. ' "",',
  17734. ' {',
  17735. ' Default: 2',
  17736. ' }',
  17737. ' );',
  17738. ' $r.addProperty(',
  17739. ' "I2",',
  17740. ' 0,',
  17741. ' rtl.longint,',
  17742. ' "FI",',
  17743. ' "",',
  17744. ' {',
  17745. ' Default: 3',
  17746. ' }',
  17747. ' );',
  17748. ' $r.addProperty(',
  17749. ' "E1",',
  17750. ' 0,',
  17751. ' $mod.$rtti["TEnum"],',
  17752. ' "FE",',
  17753. ' "",',
  17754. ' {',
  17755. ' Default: $mod.TEnum.red',
  17756. ' }',
  17757. ' );',
  17758. ' $r.addProperty(',
  17759. ' "E2",',
  17760. ' 0,',
  17761. ' $mod.$rtti["TEnum"],',
  17762. ' "FE",',
  17763. ' "",',
  17764. ' {',
  17765. ' Default: $mod.TEnum.blue',
  17766. ' }',
  17767. ' );',
  17768. '});',
  17769. '']),
  17770. LinesToStr([ // $mod.$main
  17771. '']));
  17772. end;
  17773. procedure TTestModule.TestRTTI_DefaultValueSet;
  17774. begin
  17775. Converter.Options:=Converter.Options-[coNoTypeInfo];
  17776. StartProgram(false);
  17777. Add([
  17778. 'type',
  17779. ' TEnum = (red, blue);',
  17780. ' TSet = set of TEnum;',
  17781. 'const',
  17782. ' CSet = [red,blue];',
  17783. 'type',
  17784. ' TObject = class',
  17785. ' FSet: TSet;',
  17786. ' published',
  17787. ' property Set1: TSet read FSet default [];',
  17788. ' property Set2: TSet read FSet default [red];',
  17789. ' property Set3: TSet read FSet default [red,blue];',
  17790. ' property Set4: TSet read FSet default CSet;',
  17791. ' end;',
  17792. 'begin']);
  17793. ConvertProgram;
  17794. CheckSource('TestRTTI_DefaultValueSet',
  17795. LinesToStr([ // statements
  17796. 'this.TEnum = {',
  17797. ' "0": "red",',
  17798. ' red: 0,',
  17799. ' "1": "blue",',
  17800. ' blue: 1',
  17801. '};',
  17802. '$mod.$rtti.$Enum("TEnum", {',
  17803. ' minvalue: 0,',
  17804. ' maxvalue: 1,',
  17805. ' ordtype: 1,',
  17806. ' enumtype: this.TEnum',
  17807. '});',
  17808. '$mod.$rtti.$Set("TSet", {',
  17809. ' comptype: $mod.$rtti["TEnum"]',
  17810. '});',
  17811. 'this.CSet = rtl.createSet($mod.TEnum.red, $mod.TEnum.blue);',
  17812. 'rtl.createClass($mod, "TObject", null, function () {',
  17813. ' this.$init = function () {',
  17814. ' this.FSet = {};',
  17815. ' };',
  17816. ' this.$final = function () {',
  17817. ' this.FSet = undefined;',
  17818. ' };',
  17819. ' var $r = this.$rtti;',
  17820. ' $r.addProperty(',
  17821. ' "Set1",',
  17822. ' 0,',
  17823. ' $mod.$rtti["TSet"],',
  17824. ' "FSet",',
  17825. ' "",',
  17826. ' {',
  17827. ' Default: {}',
  17828. ' }',
  17829. ' );',
  17830. ' $r.addProperty(',
  17831. ' "Set2",',
  17832. ' 0,',
  17833. ' $mod.$rtti["TSet"],',
  17834. ' "FSet",',
  17835. ' "",',
  17836. ' {',
  17837. ' Default: rtl.createSet($mod.TEnum.red)',
  17838. ' }',
  17839. ' );',
  17840. ' $r.addProperty(',
  17841. ' "Set3",',
  17842. ' 0,',
  17843. ' $mod.$rtti["TSet"],',
  17844. ' "FSet",',
  17845. ' "",',
  17846. ' {',
  17847. ' Default: rtl.createSet($mod.TEnum.red, $mod.TEnum.blue)',
  17848. ' }',
  17849. ' );',
  17850. ' $r.addProperty(',
  17851. ' "Set4",',
  17852. ' 0,',
  17853. ' $mod.$rtti["TSet"],',
  17854. ' "FSet",',
  17855. ' "",',
  17856. ' {',
  17857. ' Default: $mod.CSet',
  17858. ' }',
  17859. ' );',
  17860. '});',
  17861. '']),
  17862. LinesToStr([ // $mod.$main
  17863. '']));
  17864. end;
  17865. procedure TTestModule.TestRTTI_DefaultValueRangeType;
  17866. begin
  17867. Converter.Options:=Converter.Options-[coNoTypeInfo];
  17868. StartProgram(false);
  17869. Add([
  17870. 'type',
  17871. ' TRg = -1..1;',
  17872. 'const',
  17873. ' l = low(TRg);',
  17874. ' h = high(TRg);',
  17875. 'type',
  17876. ' TObject = class',
  17877. ' FV: TRg;',
  17878. ' published',
  17879. ' property V1: TRg read FV default -1;',
  17880. ' end;',
  17881. 'begin']);
  17882. ConvertProgram;
  17883. CheckSource('TestRTTI_DefaultValueRangeType',
  17884. LinesToStr([ // statements
  17885. '$mod.$rtti.$Int("TRg", {',
  17886. ' minvalue: -1,',
  17887. ' maxvalue: 1,',
  17888. ' ordtype: 0',
  17889. '});',
  17890. 'this.l = -1;',
  17891. 'this.h = 1;',
  17892. 'rtl.createClass($mod, "TObject", null, function () {',
  17893. ' this.$init = function () {',
  17894. ' this.FV = -1;',
  17895. ' };',
  17896. ' this.$final = function () {',
  17897. ' };',
  17898. ' var $r = this.$rtti;',
  17899. ' $r.addProperty(',
  17900. ' "V1",',
  17901. ' 0,',
  17902. ' $mod.$rtti["TRg"],',
  17903. ' "FV",',
  17904. ' "",',
  17905. ' {',
  17906. ' Default: -1',
  17907. ' }',
  17908. ' );',
  17909. '});',
  17910. '']),
  17911. LinesToStr([ // $mod.$main
  17912. '']));
  17913. end;
  17914. procedure TTestModule.TestRTTI_Class_Field;
  17915. begin
  17916. Converter.Options:=Converter.Options-[coNoTypeInfo];
  17917. StartProgram(false);
  17918. Add('{$modeswitch externalclass}');
  17919. Add('type');
  17920. Add(' TObject = class');
  17921. Add(' private');
  17922. Add(' FPropA: string;');
  17923. Add(' published');
  17924. Add(' VarLI: longint;');
  17925. Add(' VarC: char;');
  17926. Add(' VarS: string;');
  17927. Add(' VarD: double;');
  17928. Add(' VarB: boolean;');
  17929. Add(' VarLW: longword;');
  17930. Add(' VarSmI: smallint;');
  17931. Add(' VarW: word;');
  17932. Add(' VarShI: shortint;');
  17933. Add(' VarBy: byte;');
  17934. Add(' VarExt: longint external name ''VarExt'';');
  17935. Add(' end;');
  17936. Add('var p: pointer;');
  17937. Add(' Obj: tobject;');
  17938. Add('begin');
  17939. Add(' p:=typeinfo(tobject);');
  17940. Add(' p:=typeinfo(p);');
  17941. Add(' p:=typeinfo(obj);');
  17942. ConvertProgram;
  17943. CheckSource('TestRTTI_Class_Field',
  17944. LinesToStr([ // statements
  17945. 'rtl.createClass($mod, "TObject", null, function () {',
  17946. ' this.$init = function () {',
  17947. ' this.FPropA = "";',
  17948. ' this.VarLI = 0;',
  17949. ' this.VarC = "";',
  17950. ' this.VarS = "";',
  17951. ' this.VarD = 0.0;',
  17952. ' this.VarB = false;',
  17953. ' this.VarLW = 0;',
  17954. ' this.VarSmI = 0;',
  17955. ' this.VarW = 0;',
  17956. ' this.VarShI = 0;',
  17957. ' this.VarBy = 0;',
  17958. ' };',
  17959. ' this.$final = function () {',
  17960. ' };',
  17961. ' var $r = this.$rtti;',
  17962. ' $r.addField("VarLI", rtl.longint);',
  17963. ' $r.addField("VarC", rtl.char);',
  17964. ' $r.addField("VarS", rtl.string);',
  17965. ' $r.addField("VarD", rtl.double);',
  17966. ' $r.addField("VarB", rtl.boolean);',
  17967. ' $r.addField("VarLW", rtl.longword);',
  17968. ' $r.addField("VarSmI", rtl.smallint);',
  17969. ' $r.addField("VarW", rtl.word);',
  17970. ' $r.addField("VarShI", rtl.shortint);',
  17971. ' $r.addField("VarBy", rtl.byte);',
  17972. ' $r.addField("VarExt", rtl.longint);',
  17973. '});',
  17974. 'this.p = null;',
  17975. 'this.Obj = null;',
  17976. '']),
  17977. LinesToStr([ // $mod.$main
  17978. '$mod.p = $mod.$rtti["TObject"];',
  17979. '$mod.p = rtl.pointer;',
  17980. '$mod.p = $mod.Obj.$rtti;',
  17981. '']));
  17982. end;
  17983. procedure TTestModule.TestRTTI_Class_Method;
  17984. begin
  17985. Converter.Options:=Converter.Options-[coNoTypeInfo];
  17986. StartProgram(false);
  17987. Add('type');
  17988. Add(' TObject = class');
  17989. Add(' private');
  17990. Add(' procedure Internal; external name ''$intern'';');
  17991. Add(' published');
  17992. Add(' procedure Click; virtual; abstract;');
  17993. Add(' procedure Notify(Sender: TObject); virtual; abstract;');
  17994. Add(' function GetNotify: boolean; external name ''GetNotify'';');
  17995. Add(' procedure Println(a,b: longint); varargs; virtual; abstract;');
  17996. Add(' end;');
  17997. Add('begin');
  17998. ConvertProgram;
  17999. CheckSource('TestRTTI_Class_Method',
  18000. LinesToStr([ // statements
  18001. 'rtl.createClass($mod, "TObject", null, function () {',
  18002. ' this.$init = function () {',
  18003. ' };',
  18004. ' this.$final = function () {',
  18005. ' };',
  18006. ' var $r = this.$rtti;',
  18007. ' $r.addMethod("Click", 0, null);',
  18008. ' $r.addMethod("Notify", 0, [["Sender", $r]]);',
  18009. ' $r.addMethod("GetNotify", 1, null, rtl.boolean,{flags: 4});',
  18010. ' $r.addMethod("Println", 0, [["a", rtl.longint], ["b", rtl.longint]], null, {',
  18011. ' flags: 2',
  18012. ' });',
  18013. '});',
  18014. '']),
  18015. LinesToStr([ // $mod.$main
  18016. '']));
  18017. end;
  18018. procedure TTestModule.TestRTTI_Class_MethodArgFlags;
  18019. begin
  18020. Converter.Options:=Converter.Options-[coNoTypeInfo];
  18021. StartProgram(false);
  18022. Add('type');
  18023. Add(' TObject = class');
  18024. Add(' published');
  18025. Add(' procedure OpenArray(const Args: array of string); virtual; abstract;');
  18026. Add(' procedure ByRef(var Value: longint; out Item: longint); virtual; abstract;');
  18027. Add(' procedure Untyped(var Value; out Item); virtual; abstract;');
  18028. Add(' end;');
  18029. Add('begin');
  18030. ConvertProgram;
  18031. CheckSource('TestRTTI_Class_MethodOpenArray',
  18032. LinesToStr([ // statements
  18033. 'rtl.createClass($mod, "TObject", null, function () {',
  18034. ' this.$init = function () {',
  18035. ' };',
  18036. ' this.$final = function () {',
  18037. ' };',
  18038. ' var $r = this.$rtti;',
  18039. '$r.addMethod("OpenArray", 0, [["Args", rtl.string, 10]]);',
  18040. '$r.addMethod("ByRef", 0, [["Value", rtl.longint, 1], ["Item", rtl.longint, 4]]);',
  18041. '$r.addMethod("Untyped", 0, [["Value", null, 1], ["Item", null, 4]]);',
  18042. '});',
  18043. '']),
  18044. LinesToStr([ // $mod.$main
  18045. '']));
  18046. end;
  18047. procedure TTestModule.TestRTTI_Class_Property;
  18048. begin
  18049. Converter.Options:=Converter.Options-[coNoTypeInfo];
  18050. StartProgram(false);
  18051. Add('{$modeswitch externalclass}');
  18052. Add('type');
  18053. Add(' TObject = class');
  18054. Add(' private');
  18055. Add(' FColor: longint;');
  18056. Add(' FColorStored: boolean;');
  18057. Add(' procedure SetColor(Value: longint); virtual; abstract;');
  18058. Add(' function GetColor: longint; virtual; abstract;');
  18059. Add(' function GetColorStored: boolean; virtual; abstract;');
  18060. Add(' FExtSize: longint external name ''$extSize'';');
  18061. Add(' FExtSizeStored: boolean external name ''$extSizeStored'';');
  18062. Add(' procedure SetExtSize(Value: longint); external name ''$setSize'';');
  18063. Add(' function GetExtSize: longint; external name ''$getSize'';');
  18064. Add(' function GetExtSizeStored: boolean; external name ''$getExtSizeStored'';');
  18065. Add(' published');
  18066. Add(' property ColorA: longint read FColor;');
  18067. Add(' property ColorB: longint write FColor;');
  18068. Add(' property ColorC: longint read GetColor write SetColor;');
  18069. Add(' property ColorD: longint read FColor write FColor stored FColorStored;');
  18070. Add(' property ExtSizeA: longint read FExtSize write FExtSize;');
  18071. Add(' property ExtSizeB: longint read GetExtSize write SetExtSize stored FExtSizeStored;');
  18072. Add(' property ExtSizeC: longint read FExtSize write FExtSize stored GetExtSizeStored;');
  18073. Add(' end;');
  18074. Add('begin');
  18075. ConvertProgram;
  18076. CheckSource('TestRTTI_Class_Property',
  18077. LinesToStr([ // statements
  18078. 'rtl.createClass($mod, "TObject", null, function () {',
  18079. ' this.$init = function () {',
  18080. ' this.FColor = 0;',
  18081. ' this.FColorStored = false;',
  18082. ' };',
  18083. ' this.$final = function () {',
  18084. ' };',
  18085. ' var $r = this.$rtti;',
  18086. ' $r.addProperty("ColorA", 0, rtl.longint, "FColor", "");',
  18087. ' $r.addProperty("ColorB", 0, rtl.longint, "", "FColor");',
  18088. ' $r.addProperty("ColorC", 3, rtl.longint, "GetColor", "SetColor");',
  18089. ' $r.addProperty(',
  18090. ' "ColorD",',
  18091. ' 8,',
  18092. ' rtl.longint,',
  18093. ' "FColor",',
  18094. ' "FColor",',
  18095. ' {',
  18096. ' stored: "FColorStored"',
  18097. ' }',
  18098. ' );',
  18099. ' $r.addProperty("ExtSizeA", 0, rtl.longint, "$extSize", "$extSize");',
  18100. ' $r.addProperty(',
  18101. ' "ExtSizeB",',
  18102. ' 11,',
  18103. ' rtl.longint,',
  18104. ' "$getSize",',
  18105. ' "$setSize",',
  18106. ' {',
  18107. ' stored: "$extSizeStored"',
  18108. ' }',
  18109. ' );',
  18110. ' $r.addProperty(',
  18111. ' "ExtSizeC",',
  18112. ' 12,',
  18113. ' rtl.longint,',
  18114. ' "$extSize",',
  18115. ' "$extSize",',
  18116. ' {',
  18117. ' stored: "$getExtSizeStored"',
  18118. ' }',
  18119. ' );',
  18120. '});',
  18121. '']),
  18122. LinesToStr([ // $mod.$main
  18123. '']));
  18124. end;
  18125. procedure TTestModule.TestRTTI_Class_PropertyParams;
  18126. begin
  18127. Converter.Options:=Converter.Options-[coNoTypeInfo];
  18128. StartProgram(false);
  18129. Add('{$modeswitch externalclass}');
  18130. Add('type');
  18131. Add(' integer = longint;');
  18132. Add(' TObject = class');
  18133. Add(' private');
  18134. Add(' function GetItems(i: integer): tobject; virtual; abstract;');
  18135. Add(' procedure SetItems(i: integer; value: tobject); virtual; abstract;');
  18136. Add(' function GetValues(const i: integer; var b: boolean): char; virtual; abstract;');
  18137. Add(' procedure SetValues(const i: integer; var b: boolean; value: char); virtual; abstract;');
  18138. Add(' published');
  18139. Add(' property Items[Index: integer]: tobject read getitems write setitems;');
  18140. Add(' property Values[const keya: integer; var keyb: boolean]: char read getvalues write setvalues;');
  18141. Add(' end;');
  18142. Add('begin');
  18143. ConvertProgram;
  18144. CheckSource('TestRTTI_Class_PropertyParams',
  18145. LinesToStr([ // statements
  18146. 'rtl.createClass($mod, "TObject", null, function () {',
  18147. ' this.$init = function () {',
  18148. ' };',
  18149. ' this.$final = function () {',
  18150. ' };',
  18151. ' var $r = this.$rtti;',
  18152. ' $r.addProperty("Items", 3, $r, "GetItems", "SetItems");',
  18153. ' $r.addProperty("Values", 3, rtl.char, "GetValues", "SetValues");',
  18154. '});',
  18155. '']),
  18156. LinesToStr([ // $mod.$main
  18157. '']));
  18158. end;
  18159. procedure TTestModule.TestRTTI_OverrideMethod;
  18160. begin
  18161. Converter.Options:=Converter.Options-[coNoTypeInfo];
  18162. StartProgram(false);
  18163. Add('type');
  18164. Add(' TObject = class');
  18165. Add(' published');
  18166. Add(' procedure DoIt; virtual; abstract;');
  18167. Add(' end;');
  18168. Add(' TSky = class');
  18169. Add(' published');
  18170. Add(' procedure DoIt; override;');
  18171. Add(' end;');
  18172. Add('procedure TSky.DoIt; begin end;');
  18173. Add('begin');
  18174. ConvertProgram;
  18175. CheckSource('TestRTTI_OverrideMethod',
  18176. LinesToStr([ // statements
  18177. 'rtl.createClass($mod, "TObject", null, function () {',
  18178. ' this.$init = function () {',
  18179. ' };',
  18180. ' this.$final = function () {',
  18181. ' };',
  18182. ' var $r = this.$rtti;',
  18183. ' $r.addMethod("DoIt", 0, null);',
  18184. '});',
  18185. 'rtl.createClass($mod, "TSky", $mod.TObject, function () {',
  18186. ' this.DoIt = function () {',
  18187. ' };',
  18188. '});',
  18189. '']),
  18190. LinesToStr([ // $mod.$main
  18191. '']));
  18192. end;
  18193. procedure TTestModule.TestRTTI_OverloadProperty;
  18194. begin
  18195. Converter.Options:=Converter.Options-[coNoTypeInfo];
  18196. StartProgram(false);
  18197. Add('type');
  18198. Add(' TObject = class');
  18199. Add(' protected');
  18200. Add(' FFlag: longint;');
  18201. Add(' published');
  18202. Add(' property Flag: longint read fflag;');
  18203. Add(' end;');
  18204. Add(' TSky = class');
  18205. Add(' published');
  18206. Add(' property FLAG: longint write fflag;');
  18207. Add(' end;');
  18208. Add('begin');
  18209. ConvertProgram;
  18210. CheckSource('TestRTTI_OverrideMethod',
  18211. LinesToStr([ // statements
  18212. 'rtl.createClass($mod, "TObject", null, function () {',
  18213. ' this.$init = function () {',
  18214. ' this.FFlag = 0;',
  18215. ' };',
  18216. ' this.$final = function () {',
  18217. ' };',
  18218. ' var $r = this.$rtti;',
  18219. ' $r.addProperty("Flag", 0, rtl.longint, "FFlag", "");',
  18220. '});',
  18221. 'rtl.createClass($mod, "TSky", $mod.TObject, function () {',
  18222. ' var $r = this.$rtti;',
  18223. ' $r.addProperty("Flag", 0, rtl.longint, "", "FFlag");',
  18224. '});',
  18225. '']),
  18226. LinesToStr([ // $mod.$main
  18227. '']));
  18228. end;
  18229. procedure TTestModule.TestRTTI_ClassForward;
  18230. begin
  18231. Converter.Options:=Converter.Options-[coNoTypeInfo];
  18232. StartProgram(false);
  18233. Add('type');
  18234. Add(' TObject = class end;');
  18235. Add(' tbridge = class;');
  18236. Add(' TProc = function: tbridge;');
  18237. Add(' TOger = class');
  18238. Add(' published');
  18239. Add(' FBridge: tbridge;');
  18240. Add(' procedure SetBridge(Value: tbridge); virtual; abstract;');
  18241. Add(' property Bridge: tbridge read fbridge write setbridge;');
  18242. Add(' end;');
  18243. Add(' TBridge = class');
  18244. Add(' FOger: toger;');
  18245. Add(' end;');
  18246. Add('var p: Pointer;');
  18247. Add(' b: tbridge;');
  18248. Add('begin');
  18249. Add(' p:=typeinfo(tbridge);');
  18250. Add(' p:=typeinfo(b);');
  18251. ConvertProgram;
  18252. CheckSource('TestRTTI_ClassForward',
  18253. LinesToStr([ // statements
  18254. 'rtl.createClass($mod, "TObject", null, function () {',
  18255. ' this.$init = function () {',
  18256. ' };',
  18257. ' this.$final = function () {',
  18258. ' };',
  18259. '});',
  18260. '$mod.$rtti.$Class("TBridge");',
  18261. '$mod.$rtti.$ProcVar("TProc", {',
  18262. ' procsig: rtl.newTIProcSig(null, $mod.$rtti["TBridge"])',
  18263. '});',
  18264. 'rtl.createClass($mod, "TOger", $mod.TObject, function () {',
  18265. ' this.$init = function () {',
  18266. ' $mod.TObject.$init.call(this);',
  18267. ' this.FBridge = null;',
  18268. ' };',
  18269. ' this.$final = function () {',
  18270. ' this.FBridge = undefined;',
  18271. ' $mod.TObject.$final.call(this);',
  18272. ' };',
  18273. ' var $r = this.$rtti;',
  18274. ' $r.addField("FBridge", $mod.$rtti["TBridge"]);',
  18275. ' $r.addMethod("SetBridge", 0, [["Value", $mod.$rtti["TBridge"]]]);',
  18276. ' $r.addProperty("Bridge", 2, $mod.$rtti["TBridge"], "FBridge", "SetBridge");',
  18277. '});',
  18278. 'rtl.createClass($mod, "TBridge", $mod.TObject, function () {',
  18279. ' this.$init = function () {',
  18280. ' $mod.TObject.$init.call(this);',
  18281. ' this.FOger = null;',
  18282. ' };',
  18283. ' this.$final = function () {',
  18284. ' this.FOger = undefined;',
  18285. ' $mod.TObject.$final.call(this);',
  18286. ' };',
  18287. '});',
  18288. 'this.p = null;',
  18289. 'this.b = null;',
  18290. '']),
  18291. LinesToStr([ // $mod.$main
  18292. '$mod.p = $mod.$rtti["TBridge"];',
  18293. '$mod.p = $mod.b.$rtti;',
  18294. '']));
  18295. end;
  18296. procedure TTestModule.TestRTTI_ClassOf;
  18297. begin
  18298. Converter.Options:=Converter.Options-[coNoTypeInfo];
  18299. StartProgram(false);
  18300. Add('type');
  18301. Add(' TClass = class of tobject;');
  18302. Add(' TProcA = function: TClass;');
  18303. Add(' TObject = class');
  18304. Add(' published');
  18305. Add(' C: tclass;');
  18306. Add(' end;');
  18307. Add(' tfox = class;');
  18308. Add(' TBird = class end;');
  18309. Add(' TBirds = class of tbird;');
  18310. Add(' TFox = class end;');
  18311. Add(' TFoxes = class of tfox;');
  18312. Add(' TCows = class of TCow;');
  18313. Add(' TCow = class;');
  18314. Add(' TCow = class end;');
  18315. Add('begin');
  18316. ConvertProgram;
  18317. CheckSource('TestRTTI_ClassOf',
  18318. LinesToStr([ // statements
  18319. '$mod.$rtti.$Class("TObject");',
  18320. '$mod.$rtti.$ClassRef("TClass", {',
  18321. ' instancetype: $mod.$rtti["TObject"]',
  18322. '});',
  18323. '$mod.$rtti.$ProcVar("TProcA", {',
  18324. ' procsig: rtl.newTIProcSig(null, $mod.$rtti["TClass"])',
  18325. '});',
  18326. 'rtl.createClass($mod, "TObject", null, function () {',
  18327. ' this.$init = function () {',
  18328. ' this.C = null;',
  18329. ' };',
  18330. ' this.$final = function () {',
  18331. ' this.C = undefined;',
  18332. ' };',
  18333. ' var $r = this.$rtti;',
  18334. ' $r.addField("C", $mod.$rtti["TClass"]);',
  18335. '});',
  18336. '$mod.$rtti.$Class("TFox");',
  18337. 'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
  18338. '});',
  18339. '$mod.$rtti.$ClassRef("TBirds", {',
  18340. ' instancetype: $mod.$rtti["TBird"]',
  18341. '});',
  18342. 'rtl.createClass($mod, "TFox", $mod.TObject, function () {',
  18343. '});',
  18344. '$mod.$rtti.$ClassRef("TFoxes", {',
  18345. ' instancetype: $mod.$rtti["TFox"]',
  18346. '});',
  18347. '$mod.$rtti.$Class("TCow");',
  18348. '$mod.$rtti.$ClassRef("TCows", {',
  18349. ' instancetype: $mod.$rtti["TCow"]',
  18350. '});',
  18351. 'rtl.createClass($mod, "TCow", $mod.TObject, function () {',
  18352. '});',
  18353. '']),
  18354. LinesToStr([ // $mod.$main
  18355. '']));
  18356. end;
  18357. procedure TTestModule.TestRTTI_Record;
  18358. begin
  18359. Converter.Options:=Converter.Options-[coNoTypeInfo];
  18360. StartProgram(false);
  18361. Add('type');
  18362. Add(' integer = longint;');
  18363. Add(' TPoint = record');
  18364. Add(' x,y: integer;');
  18365. Add(' end;');
  18366. Add('var p: pointer;');
  18367. Add(' r: tpoint;');
  18368. Add('begin');
  18369. Add(' p:=typeinfo(tpoint);');
  18370. Add(' p:=typeinfo(r);');
  18371. Add(' p:=typeinfo(r.x);');
  18372. ConvertProgram;
  18373. CheckSource('TestRTTI_Record',
  18374. LinesToStr([ // statements
  18375. 'this.TPoint = function (s) {',
  18376. ' if (s) {',
  18377. ' this.x = s.x;',
  18378. ' this.y = s.y;',
  18379. ' } else {',
  18380. ' this.x = 0;',
  18381. ' this.y = 0;',
  18382. ' };',
  18383. ' this.$equal = function (b) {',
  18384. ' return (this.x === b.x) && (this.y === b.y);',
  18385. ' };',
  18386. '};',
  18387. '$mod.$rtti.$Record("TPoint", {}).addFields("x", rtl.longint, "y", rtl.longint);',
  18388. 'this.p = null;',
  18389. 'this.r = new $mod.TPoint();',
  18390. '']),
  18391. LinesToStr([ // $mod.$main
  18392. '$mod.p = $mod.$rtti["TPoint"];',
  18393. '$mod.p = $mod.$rtti["TPoint"];',
  18394. '$mod.p = rtl.longint;',
  18395. '']));
  18396. end;
  18397. procedure TTestModule.TestRTTI_RecordAnonymousArray;
  18398. begin
  18399. Converter.Options:=Converter.Options-[coNoTypeInfo];
  18400. StartProgram(false);
  18401. Add('type');
  18402. Add(' TFloatRec = record');
  18403. Add(' d: array of char;');
  18404. // Add(' i: array of array of longint;');
  18405. Add(' end;');
  18406. Add('var p: pointer;');
  18407. Add(' r: tfloatrec;');
  18408. Add('begin');
  18409. Add(' p:=typeinfo(tfloatrec);');
  18410. Add(' p:=typeinfo(r);');
  18411. Add(' p:=typeinfo(r.d);');
  18412. ConvertProgram;
  18413. CheckSource('TestRTTI_Record',
  18414. LinesToStr([ // statements
  18415. 'this.TFloatRec = function (s) {',
  18416. ' if (s) {',
  18417. ' this.d = s.d;',
  18418. ' } else {',
  18419. ' this.d = [];',
  18420. ' };',
  18421. ' this.$equal = function (b) {',
  18422. ' return this.d === b.d;',
  18423. ' };',
  18424. '};',
  18425. '$mod.$rtti.$DynArray("TFloatRec.d$a", {',
  18426. ' eltype: rtl.char',
  18427. '});',
  18428. '$mod.$rtti.$Record("TFloatRec", {}).addFields("d", $mod.$rtti["TFloatRec.d$a"]);',
  18429. 'this.p = null;',
  18430. 'this.r = new $mod.TFloatRec();',
  18431. '']),
  18432. LinesToStr([ // $mod.$main
  18433. '$mod.p = $mod.$rtti["TFloatRec"];',
  18434. '$mod.p = $mod.$rtti["TFloatRec"];',
  18435. '$mod.p = $mod.$rtti["TFloatRec.d$a"];',
  18436. '']));
  18437. end;
  18438. procedure TTestModule.TestRTTI_LocalTypes;
  18439. begin
  18440. Converter.Options:=Converter.Options-[coNoTypeInfo];
  18441. StartProgram(false);
  18442. Add('procedure DoIt;');
  18443. Add('type');
  18444. Add(' integer = longint;');
  18445. Add(' TPoint = record');
  18446. Add(' x,y: integer;');
  18447. Add(' end;');
  18448. Add('begin');
  18449. Add('end;');
  18450. Add('begin');
  18451. ConvertProgram;
  18452. CheckSource('TestRTTI_LocalTypes',
  18453. LinesToStr([ // statements
  18454. 'this.DoIt = function () {',
  18455. ' this.TPoint = function (s) {',
  18456. ' if (s) {',
  18457. ' this.x = s.x;',
  18458. ' this.y = s.y;',
  18459. ' } else {',
  18460. ' this.x = 0;',
  18461. ' this.y = 0;',
  18462. ' };',
  18463. ' this.$equal = function (b) {',
  18464. ' return (this.x === b.x) && (this.y === b.y);',
  18465. ' };',
  18466. ' };',
  18467. '};',
  18468. '']),
  18469. LinesToStr([ // $mod.$main
  18470. '']));
  18471. end;
  18472. procedure TTestModule.TestRTTI_TypeInfo_BaseTypes;
  18473. begin
  18474. Converter.Options:=Converter.Options-[coNoTypeInfo];
  18475. StartProgram(false);
  18476. Add('type');
  18477. Add(' TCaption = string;');
  18478. Add(' TYesNo = boolean;');
  18479. Add(' TLetter = char;');
  18480. Add(' TFloat = double;');
  18481. Add(' TPtr = pointer;');
  18482. Add(' TShortInt = shortint;');
  18483. Add(' TByte = byte;');
  18484. Add(' TSmallInt = smallint;');
  18485. Add(' TWord = word;');
  18486. Add(' TInt32 = longint;');
  18487. Add(' TDWord = longword;');
  18488. Add(' TValue = jsvalue;');
  18489. Add('var p: TPtr;');
  18490. Add('begin');
  18491. Add(' p:=typeinfo(string);');
  18492. Add(' p:=typeinfo(tcaption);');
  18493. Add(' p:=typeinfo(boolean);');
  18494. Add(' p:=typeinfo(tyesno);');
  18495. Add(' p:=typeinfo(char);');
  18496. Add(' p:=typeinfo(tletter);');
  18497. Add(' p:=typeinfo(double);');
  18498. Add(' p:=typeinfo(tfloat);');
  18499. Add(' p:=typeinfo(pointer);');
  18500. Add(' p:=typeinfo(tptr);');
  18501. Add(' p:=typeinfo(shortint);');
  18502. Add(' p:=typeinfo(tshortint);');
  18503. Add(' p:=typeinfo(byte);');
  18504. Add(' p:=typeinfo(tbyte);');
  18505. Add(' p:=typeinfo(smallint);');
  18506. Add(' p:=typeinfo(tsmallint);');
  18507. Add(' p:=typeinfo(word);');
  18508. Add(' p:=typeinfo(tword);');
  18509. Add(' p:=typeinfo(longword);');
  18510. Add(' p:=typeinfo(tdword);');
  18511. Add(' p:=typeinfo(jsvalue);');
  18512. Add(' p:=typeinfo(tvalue);');
  18513. ConvertProgram;
  18514. CheckSource('TestRTTI_TypeInfo_BaseTypes',
  18515. LinesToStr([ // statements
  18516. 'this.p = null;',
  18517. '']),
  18518. LinesToStr([ // $mod.$main
  18519. '$mod.p = rtl.string;',
  18520. '$mod.p = rtl.string;',
  18521. '$mod.p = rtl.boolean;',
  18522. '$mod.p = rtl.boolean;',
  18523. '$mod.p = rtl.char;',
  18524. '$mod.p = rtl.char;',
  18525. '$mod.p = rtl.double;',
  18526. '$mod.p = rtl.double;',
  18527. '$mod.p = rtl.pointer;',
  18528. '$mod.p = rtl.pointer;',
  18529. '$mod.p = rtl.shortint;',
  18530. '$mod.p = rtl.shortint;',
  18531. '$mod.p = rtl.byte;',
  18532. '$mod.p = rtl.byte;',
  18533. '$mod.p = rtl.smallint;',
  18534. '$mod.p = rtl.smallint;',
  18535. '$mod.p = rtl.word;',
  18536. '$mod.p = rtl.word;',
  18537. '$mod.p = rtl.longword;',
  18538. '$mod.p = rtl.longword;',
  18539. '$mod.p = rtl.jsvalue;',
  18540. '$mod.p = rtl.jsvalue;',
  18541. '']));
  18542. end;
  18543. procedure TTestModule.TestRTTI_TypeInfo_LocalFail;
  18544. begin
  18545. Converter.Options:=Converter.Options-[coNoTypeInfo];
  18546. StartProgram(false);
  18547. Add('procedure DoIt;');
  18548. Add('type');
  18549. Add(' integer = longint;');
  18550. Add(' TPoint = record');
  18551. Add(' x,y: integer;');
  18552. Add(' end;');
  18553. Add('var p: pointer;');
  18554. Add('begin');
  18555. Add(' p:=typeinfo(tpoint);');
  18556. Add('end;');
  18557. Add('begin');
  18558. SetExpectedPasResolverError(sSymbolCannotBePublished,nSymbolCannotBePublished);
  18559. ConvertProgram;
  18560. end;
  18561. procedure TTestModule.TestRTTI_TypeInfo_ExtTypeInfoClasses1;
  18562. begin
  18563. Converter.Options:=Converter.Options-[coNoTypeInfo];
  18564. StartProgram(false);
  18565. Add('{$modeswitch externalclass}');
  18566. Add('type');
  18567. Add(' TTypeInfo = class external name ''rtl.tTypeInfo'' end;');
  18568. Add(' TTypeInfoInteger = class external name ''rtl.tTypeInfoInteger''(TTypeInfo) end;');
  18569. Add(' TFlag = (up,down);');
  18570. Add(' TTypeInfoEnum = class external name ''rtl.tTypeInfoEnum''(TTypeInfoInteger) end;');
  18571. Add(' TFlags = set of TFlag;');
  18572. Add(' TTypeInfoSet = class external name ''rtl.tTypeInfoSet''(TTypeInfo) end;');
  18573. Add('var');
  18574. Add(' ti: TTypeInfo;');
  18575. Add(' tiInt: TTypeInfoInteger;');
  18576. Add(' tiEnum: TTypeInfoEnum;');
  18577. Add(' tiSet: TTypeInfoSet;');
  18578. Add('begin');
  18579. Add(' ti:=typeinfo(string);');
  18580. Add(' ti:=typeinfo(boolean);');
  18581. Add(' ti:=typeinfo(char);');
  18582. Add(' ti:=typeinfo(double);');
  18583. Add(' tiInt:=typeinfo(shortint);');
  18584. Add(' tiInt:=typeinfo(byte);');
  18585. Add(' tiInt:=typeinfo(smallint);');
  18586. Add(' tiInt:=typeinfo(word);');
  18587. Add(' tiInt:=typeinfo(longint);');
  18588. Add(' tiInt:=typeinfo(longword);');
  18589. Add(' ti:=typeinfo(jsvalue);');
  18590. Add(' tiEnum:=typeinfo(tflag);');
  18591. Add(' tiSet:=typeinfo(tflags);');
  18592. ConvertProgram;
  18593. CheckSource('TestRTTI_TypeInfo_ExtTypeInfoClasses1',
  18594. LinesToStr([ // statements
  18595. 'this.TFlag = {',
  18596. ' "0": "up",',
  18597. ' up: 0,',
  18598. ' "1": "down",',
  18599. ' down: 1',
  18600. '};',
  18601. '$mod.$rtti.$Enum("TFlag", {',
  18602. ' minvalue: 0,',
  18603. ' maxvalue: 1,',
  18604. ' ordtype: 1,',
  18605. ' enumtype: this.TFlag',
  18606. '});',
  18607. '$mod.$rtti.$Set("TFlags", {',
  18608. ' comptype: $mod.$rtti["TFlag"]',
  18609. '});',
  18610. 'this.ti = null;',
  18611. 'this.tiInt = null;',
  18612. 'this.tiEnum = null;',
  18613. 'this.tiSet = null;',
  18614. '']),
  18615. LinesToStr([ // $mod.$main
  18616. '$mod.ti = rtl.string;',
  18617. '$mod.ti = rtl.boolean;',
  18618. '$mod.ti = rtl.char;',
  18619. '$mod.ti = rtl.double;',
  18620. '$mod.tiInt = rtl.shortint;',
  18621. '$mod.tiInt = rtl.byte;',
  18622. '$mod.tiInt = rtl.smallint;',
  18623. '$mod.tiInt = rtl.word;',
  18624. '$mod.tiInt = rtl.longint;',
  18625. '$mod.tiInt = rtl.longword;',
  18626. '$mod.ti = rtl.jsvalue;',
  18627. '$mod.tiEnum = $mod.$rtti["TFlag"];',
  18628. '$mod.tiSet = $mod.$rtti["TFlags"];',
  18629. '']));
  18630. end;
  18631. procedure TTestModule.TestRTTI_TypeInfo_ExtTypeInfoClasses2;
  18632. begin
  18633. Converter.Options:=Converter.Options-[coNoTypeInfo];
  18634. StartProgram(false);
  18635. Add('{$modeswitch externalclass}');
  18636. Add('type');
  18637. Add(' TTypeInfo = class external name ''rtl.tTypeInfo'' end;');
  18638. Add(' TStaticArr = array[boolean] of string;');
  18639. Add(' TTypeInfoStaticArray = class external name ''rtl.tTypeInfoStaticArray''(TTypeInfo) end;');
  18640. Add(' TDynArr = array of string;');
  18641. Add(' TTypeInfoDynArray = class external name ''rtl.tTypeInfoDynArray''(TTypeInfo) end;');
  18642. Add(' TProc = procedure;');
  18643. Add(' TTypeInfoProcVar = class external name ''rtl.tTypeInfoProcVar''(TTypeInfo) end;');
  18644. Add(' TMethod = procedure of object;');
  18645. Add(' TTypeInfoMethodVar = class external name ''rtl.tTypeInfoMethodVar''(TTypeInfoProcVar) end;');
  18646. Add('var');
  18647. Add(' StaticArray: TStaticArr;');
  18648. Add(' tiStaticArray: TTypeInfoStaticArray;');
  18649. Add(' DynArray: TDynArr;');
  18650. Add(' tiDynArray: TTypeInfoDynArray;');
  18651. Add(' ProcVar: TProc;');
  18652. Add(' tiProcVar: TTypeInfoProcVar;');
  18653. Add(' MethodVar: TMethod;');
  18654. Add(' tiMethodVar: TTypeInfoMethodVar;');
  18655. Add('begin');
  18656. Add(' tiStaticArray:=typeinfo(StaticArray);');
  18657. Add(' tiStaticArray:=typeinfo(TStaticArr);');
  18658. Add(' tiDynArray:=typeinfo(DynArray);');
  18659. Add(' tiDynArray:=typeinfo(TDynArr);');
  18660. Add(' tiProcVar:=typeinfo(ProcVar);');
  18661. Add(' tiProcVar:=typeinfo(TProc);');
  18662. Add(' tiMethodVar:=typeinfo(MethodVar);');
  18663. Add(' tiMethodVar:=typeinfo(TMethod);');
  18664. ConvertProgram;
  18665. CheckSource('TestRTTI_TypeInfo_ExtTypeInfoClasses2',
  18666. LinesToStr([ // statements
  18667. ' $mod.$rtti.$StaticArray("TStaticArr", {',
  18668. ' dims: [2],',
  18669. ' eltype: rtl.string',
  18670. '});',
  18671. '$mod.$rtti.$DynArray("TDynArr", {',
  18672. ' eltype: rtl.string',
  18673. '});',
  18674. '$mod.$rtti.$ProcVar("TProc", {',
  18675. ' procsig: rtl.newTIProcSig(null)',
  18676. '});',
  18677. '$mod.$rtti.$MethodVar("TMethod", {',
  18678. ' procsig: rtl.newTIProcSig(null),',
  18679. ' methodkind: 0',
  18680. '});',
  18681. 'this.StaticArray = rtl.arraySetLength(null,"",2);',
  18682. 'this.tiStaticArray = null;',
  18683. 'this.DynArray = [];',
  18684. 'this.tiDynArray = null;',
  18685. 'this.ProcVar = null;',
  18686. 'this.tiProcVar = null;',
  18687. 'this.MethodVar = null;',
  18688. 'this.tiMethodVar = null;',
  18689. '']),
  18690. LinesToStr([ // $mod.$main
  18691. '$mod.tiStaticArray = $mod.$rtti["TStaticArr"];',
  18692. '$mod.tiStaticArray = $mod.$rtti["TStaticArr"];',
  18693. '$mod.tiDynArray = $mod.$rtti["TDynArr"];',
  18694. '$mod.tiDynArray = $mod.$rtti["TDynArr"];',
  18695. '$mod.tiProcVar = $mod.$rtti["TProc"];',
  18696. '$mod.tiProcVar = $mod.$rtti["TProc"];',
  18697. '$mod.tiMethodVar = $mod.$rtti["TMethod"];',
  18698. '$mod.tiMethodVar = $mod.$rtti["TMethod"];',
  18699. '']));
  18700. end;
  18701. procedure TTestModule.TestRTTI_TypeInfo_ExtTypeInfoClasses3;
  18702. begin
  18703. Converter.Options:=Converter.Options-[coNoTypeInfo];
  18704. StartProgram(false);
  18705. Add('{$modeswitch externalclass}');
  18706. Add('type');
  18707. Add(' TTypeInfo = class external name ''rtl.tTypeInfo'' end;');
  18708. Add(' TRec = record end;');
  18709. Add(' TTypeInfoRecord = class external name ''rtl.tTypeInfoRecord''(TTypeInfo) end;');
  18710. // ToDo: ^PRec
  18711. Add(' TObject = class end;');
  18712. Add(' TTypeInfoClass = class external name ''rtl.tTypeInfoClass''(TTypeInfo) end;');
  18713. Add(' TClass = class of tobject;');
  18714. Add(' TTypeInfoClassRef = class external name ''rtl.tTypeInfoClassRef''(TTypeInfo) end;');
  18715. Add(' TTypeInfoPointer = class external name ''rtl.tTypeInfoPointer''(TTypeInfo) end;');
  18716. Add('var');
  18717. Add(' Rec: trec;');
  18718. Add(' tiRecord: ttypeinforecord;');
  18719. Add(' Obj: tobject;');
  18720. Add(' tiClass: ttypeinfoclass;');
  18721. Add(' aClass: tclass;');
  18722. Add(' tiClassRef: ttypeinfoclassref;');
  18723. // ToDo: ^PRec
  18724. Add(' tiPointer: ttypeinfopointer;');
  18725. Add('begin');
  18726. Add(' tirecord:=typeinfo(trec);');
  18727. Add(' tirecord:=typeinfo(trec);');
  18728. Add(' ticlass:=typeinfo(obj);');
  18729. Add(' ticlass:=typeinfo(tobject);');
  18730. Add(' ticlass:=typeinfo(aclass);');
  18731. Add(' ticlassref:=typeinfo(tclass);');
  18732. ConvertProgram;
  18733. CheckSource('TestRTTI_TypeInfo_ExtTypeInfoClasses3',
  18734. LinesToStr([ // statements
  18735. 'this.TRec = function (s) {',
  18736. ' this.$equal = function (b) {',
  18737. ' return true;',
  18738. ' };',
  18739. '};',
  18740. '$mod.$rtti.$Record("TRec", {});',
  18741. 'rtl.createClass($mod, "TObject", null, function () {',
  18742. ' this.$init = function () {',
  18743. ' };',
  18744. ' this.$final = function () {',
  18745. ' };',
  18746. '});',
  18747. '$mod.$rtti.$ClassRef("TClass", {',
  18748. ' instancetype: $mod.$rtti["TObject"]',
  18749. '});',
  18750. 'this.Rec = new $mod.TRec();',
  18751. 'this.tiRecord = null;',
  18752. 'this.Obj = null;',
  18753. 'this.tiClass = null;',
  18754. 'this.aClass = null;',
  18755. 'this.tiClassRef = null;',
  18756. 'this.tiPointer = null;',
  18757. '']),
  18758. LinesToStr([ // $mod.$main
  18759. '$mod.tiRecord = $mod.$rtti["TRec"];',
  18760. '$mod.tiRecord = $mod.$rtti["TRec"];',
  18761. '$mod.tiClass = $mod.Obj.$rtti;',
  18762. '$mod.tiClass = $mod.$rtti["TObject"];',
  18763. '$mod.tiClass = $mod.aClass.$rtti;',
  18764. '$mod.tiClassRef = $mod.$rtti["TClass"];',
  18765. '']));
  18766. end;
  18767. procedure TTestModule.TestRTTI_TypeInfo_FunctionClassType;
  18768. begin
  18769. Converter.Options:=Converter.Options-[coNoTypeInfo];
  18770. StartProgram(false);
  18771. Add([
  18772. '{$modeswitch externalclass}',
  18773. 'type',
  18774. ' TClass = class of tobject;',
  18775. ' TObject = class',
  18776. ' function MyClass: TClass;',
  18777. ' class function ClassType: TClass;',
  18778. ' end;',
  18779. ' TTypeInfo = class external name ''rtl.tTypeInfo'' end;',
  18780. ' TTypeInfoClass = class external name ''rtl.tTypeInfoClass''(TTypeInfo) end;',
  18781. 'function TObject.MyClass: TClass;',
  18782. 'var t: TTypeInfoClass;',
  18783. 'begin',
  18784. ' t:=TypeInfo(Self);',
  18785. ' t:=TypeInfo(Result);',
  18786. ' t:=TypeInfo(TObject);',
  18787. 'end;',
  18788. 'class function TObject.ClassType: TClass;',
  18789. 'var t: TTypeInfoClass;',
  18790. 'begin',
  18791. ' t:=TypeInfo(Self);',
  18792. ' t:=TypeInfo(Result);',
  18793. 'end;',
  18794. 'var',
  18795. ' Obj: TObject;',
  18796. ' t: TTypeInfoClass;',
  18797. 'begin',
  18798. ' t:=TypeInfo(TObject.ClassType);',
  18799. ' t:=TypeInfo(Obj.ClassType);',
  18800. ' t:=TypeInfo(Obj.MyClass);',
  18801. '']);
  18802. ConvertProgram;
  18803. CheckSource('TestRTTI_TypeInfo_FunctionClassType',
  18804. LinesToStr([ // statements
  18805. '$mod.$rtti.$Class("TObject");',
  18806. '$mod.$rtti.$ClassRef("TClass", {',
  18807. ' instancetype: $mod.$rtti["TObject"]',
  18808. '});',
  18809. 'rtl.createClass($mod, "TObject", null, function () {',
  18810. ' this.$init = function () {',
  18811. ' };',
  18812. ' this.$final = function () {',
  18813. ' };',
  18814. ' this.MyClass = function () {',
  18815. ' var Result = null;',
  18816. ' var t = null;',
  18817. ' t = this.$rtti;',
  18818. ' t = Result.$rtti;',
  18819. ' t = $mod.$rtti["TObject"];',
  18820. ' return Result;',
  18821. ' };',
  18822. ' this.ClassType = function () {',
  18823. ' var Result = null;',
  18824. ' var t = null;',
  18825. ' t = this.$rtti;',
  18826. ' t = Result.$rtti;',
  18827. ' return Result;',
  18828. ' };',
  18829. '});',
  18830. 'this.Obj = null;',
  18831. 'this.t = null;',
  18832. '']),
  18833. LinesToStr([ // $mod.$main
  18834. '$mod.t = $mod.TObject.ClassType().$rtti;',
  18835. '$mod.t = $mod.Obj.$class.ClassType().$rtti;',
  18836. '$mod.t = $mod.Obj.MyClass().$rtti;',
  18837. '']));
  18838. end;
  18839. procedure TTestModule.TestRTTI_Interface_Corba;
  18840. begin
  18841. Converter.Options:=Converter.Options-[coNoTypeInfo];
  18842. StartProgram(false);
  18843. Add([
  18844. '{$interfaces corba}',
  18845. '{$modeswitch externalclass}',
  18846. 'type',
  18847. ' IUnknown = interface',
  18848. ' end;',
  18849. ' IBird = interface',
  18850. ' function GetItem: longint;',
  18851. ' procedure SetItem(Value: longint);',
  18852. ' property Item: longint read GetItem write SetItem;',
  18853. ' end;',
  18854. ' TTypeInfo = class external name ''rtl.tTypeInfo'' end;',
  18855. ' TTypeInfoInterface = class external name ''rtl.tTypeInfoInterface''(TTypeInfo) end;',
  18856. 'procedure DoIt(t: TTypeInfoInterface); begin end;',
  18857. 'var',
  18858. ' i: IBird;',
  18859. ' t: TTypeInfoInterface;',
  18860. 'begin',
  18861. ' t:=TypeInfo(IBird);',
  18862. ' t:=TypeInfo(i);',
  18863. ' DoIt(t);',
  18864. ' DoIt(TypeInfo(IBird));',
  18865. '']);
  18866. ConvertProgram;
  18867. CheckSource('TestRTTI_Interface_Corba',
  18868. LinesToStr([ // statements
  18869. 'rtl.createInterface(',
  18870. ' $mod,',
  18871. ' "IUnknown",',
  18872. ' "{5D22E7CA-4E00-3000-8000-000000000000}",',
  18873. ' [],',
  18874. ' null,',
  18875. ' function () {',
  18876. ' }',
  18877. ');',
  18878. 'rtl.createInterface(',
  18879. ' $mod,',
  18880. ' "IBird",',
  18881. ' "{585952B8-45B2-3E86-BAC5-B22E86800000}",',
  18882. ' ["GetItem", "SetItem"],',
  18883. ' null,',
  18884. ' function () {',
  18885. ' var $r = this.$rtti;',
  18886. ' $r.addMethod("GetItem", 1, null, rtl.longint);',
  18887. ' $r.addMethod("SetItem", 0, [["Value", rtl.longint]]);',
  18888. ' $r.addProperty("Item", 3, rtl.longint, "GetItem", "SetItem");',
  18889. ' }',
  18890. ');',
  18891. 'this.DoIt = function (t) {',
  18892. '}; ',
  18893. 'this.i = null;',
  18894. 'this.t = null;',
  18895. '']),
  18896. LinesToStr([ // $mod.$main
  18897. '$mod.t = $mod.$rtti["IBird"];',
  18898. '$mod.t = $mod.i.$rtti;',
  18899. '$mod.DoIt($mod.t);',
  18900. '$mod.DoIt($mod.$rtti["IBird"]);',
  18901. '']));
  18902. end;
  18903. procedure TTestModule.TestRTTI_Interface_COM;
  18904. begin
  18905. Converter.Options:=Converter.Options-[coNoTypeInfo];
  18906. StartProgram(false);
  18907. Add([
  18908. '{$interfaces com}',
  18909. '{$modeswitch externalclass}',
  18910. 'type',
  18911. ' TGuid = record end;',
  18912. ' integer = longint;',
  18913. ' IUnknown = interface',
  18914. ' function QueryInterface(const iid: TGuid; out obj): Integer;',
  18915. ' function _AddRef: Integer;',
  18916. ' function _Release: Integer;',
  18917. ' end;',
  18918. ' IBird = interface',
  18919. ' function GetItem: longint;',
  18920. ' procedure SetItem(Value: longint);',
  18921. ' property Item: longint read GetItem write SetItem;',
  18922. ' end;',
  18923. ' TTypeInfo = class external name ''rtl.tTypeInfo'' end;',
  18924. ' TTypeInfoInterface = class external name ''rtl.tTypeInfoInterface''(TTypeInfo) end;',
  18925. 'var',
  18926. ' i: IBird;',
  18927. ' t: TTypeInfoInterface;',
  18928. 'begin',
  18929. ' t:=TypeInfo(IBird);',
  18930. ' t:=TypeInfo(i);',
  18931. '']);
  18932. ConvertProgram;
  18933. CheckSource('TestRTTI_Interface_COM',
  18934. LinesToStr([ // statements
  18935. 'this.TGuid = function (s) {',
  18936. ' this.$equal = function (b) {',
  18937. ' return true;',
  18938. ' };',
  18939. '};',
  18940. '$mod.$rtti.$Record("TGuid", {});',
  18941. 'rtl.createInterface(',
  18942. ' $mod,',
  18943. ' "IUnknown",',
  18944. ' "{06A53E33-DB48-3B02-9906-776A86A09333}",',
  18945. ' ["QueryInterface", "_AddRef", "_Release"],',
  18946. ' null,',
  18947. ' function () {',
  18948. ' this.$kind = "com";',
  18949. ' var $r = this.$rtti;',
  18950. ' $r.addMethod("QueryInterface", 1, [["iid", $mod.$rtti["TGuid"], 2], ["obj", null, 4]], rtl.longint);',
  18951. ' $r.addMethod("_AddRef", 1, null, rtl.longint);',
  18952. ' $r.addMethod("_Release", 1, null, rtl.longint);',
  18953. ' }',
  18954. ');',
  18955. 'rtl.createInterface(',
  18956. ' $mod,',
  18957. ' "IBird",',
  18958. ' "{FF135A0E-7B4C-35B8-8737-674A0E33EF92}",',
  18959. ' ["GetItem", "SetItem"],',
  18960. ' $mod.IUnknown,',
  18961. ' function () {',
  18962. ' var $r = this.$rtti;',
  18963. ' $r.addMethod("GetItem", 1, null, rtl.longint);',
  18964. ' $r.addMethod("SetItem", 0, [["Value", rtl.longint]]);',
  18965. ' $r.addProperty("Item", 3, rtl.longint, "GetItem", "SetItem");',
  18966. ' }',
  18967. ');',
  18968. 'this.i = null;',
  18969. 'this.t = null;',
  18970. '']),
  18971. LinesToStr([ // $mod.$main
  18972. '$mod.t = $mod.$rtti["IBird"];',
  18973. '$mod.t = $mod.i.$rtti;',
  18974. '']));
  18975. end;
  18976. procedure TTestModule.TestResourcestringProgram;
  18977. begin
  18978. StartProgram(false);
  18979. Add([
  18980. 'const Bar = ''bar'';',
  18981. 'resourcestring',
  18982. ' Red = ''red'';',
  18983. ' Foobar = ''fOo''+bar;',
  18984. 'var s: string;',
  18985. ' c: char;',
  18986. 'begin',
  18987. ' s:=red;',
  18988. ' s:=test1.red;',
  18989. ' c:=red[1];',
  18990. ' c:=test1.red[2];',
  18991. ' if red=foobar then ;',
  18992. ' if red[3]=red[4] then ;']);
  18993. ConvertProgram;
  18994. CheckSource('TestResourcestringProgram',
  18995. LinesToStr([ // statements
  18996. 'this.Bar = "bar";',
  18997. 'this.s = "";',
  18998. 'this.c = "";',
  18999. '$mod.$resourcestrings = {',
  19000. ' Red: {',
  19001. ' org: "red"',
  19002. ' },',
  19003. ' Foobar: {',
  19004. ' org: "fOobar"',
  19005. ' }',
  19006. '};',
  19007. '']),
  19008. LinesToStr([ // $mod.$main
  19009. '$mod.s = rtl.getResStr(pas.program, "Red");',
  19010. '$mod.s = rtl.getResStr(pas.program, "Red");',
  19011. '$mod.c = rtl.getResStr(pas.program, "Red").charAt(0);',
  19012. '$mod.c = rtl.getResStr(pas.program, "Red").charAt(1);',
  19013. 'if (rtl.getResStr(pas.program, "Red") === rtl.getResStr(pas.program, "Foobar")) ;',
  19014. 'if (rtl.getResStr(pas.program, "Red").charAt(2) === rtl.getResStr(pas.program, "Red").charAt(3)) ;',
  19015. '']));
  19016. end;
  19017. procedure TTestModule.TestResourcestringUnit;
  19018. begin
  19019. StartUnit(false);
  19020. Add([
  19021. 'interface',
  19022. 'const Red = ''rEd'';',
  19023. 'resourcestring',
  19024. ' Blue = ''blue'';',
  19025. ' NotRed = ''not''+Red;',
  19026. 'var s: string;',
  19027. 'implementation',
  19028. 'resourcestring',
  19029. ' ImplGreen = ''green'';',
  19030. 'initialization',
  19031. ' s:=blue+ImplGreen;',
  19032. ' s:=test1.blue+test1.implgreen;',
  19033. ' s:=blue[1]+implgreen[2];']);
  19034. ConvertUnit;
  19035. CheckSource('TestResourcestringUnit',
  19036. LinesToStr([ // statements
  19037. 'this.Red = "rEd";',
  19038. 'this.s = "";',
  19039. '$mod.$resourcestrings = {',
  19040. ' Blue: {',
  19041. ' org: "blue"',
  19042. ' },',
  19043. ' NotRed: {',
  19044. ' org: "notrEd"',
  19045. ' },',
  19046. ' ImplGreen: {',
  19047. ' org: "green"',
  19048. ' }',
  19049. '};',
  19050. '']),
  19051. LinesToStr([ // $mod.$main
  19052. '$mod.s = rtl.getResStr(pas.Test1, "Blue") + rtl.getResStr(pas.Test1, "ImplGreen");',
  19053. '$mod.s = rtl.getResStr(pas.Test1, "Blue") + rtl.getResStr(pas.Test1, "ImplGreen");',
  19054. '$mod.s = rtl.getResStr(pas.Test1, "Blue").charAt(0) + rtl.getResStr(pas.Test1, "ImplGreen").charAt(1);',
  19055. '']));
  19056. end;
  19057. procedure TTestModule.TestResourcestringImplementation;
  19058. begin
  19059. StartUnit(false);
  19060. Add([
  19061. 'interface',
  19062. 'implementation',
  19063. 'resourcestring',
  19064. ' ImplRed = ''red'';']);
  19065. ConvertUnit;
  19066. CheckSource('TestResourcestringImplementation',
  19067. LinesToStr([ // intf statements
  19068. 'var $impl = $mod.$impl;']),
  19069. LinesToStr([ // $mod.$init
  19070. '']),
  19071. LinesToStr([ // impl statements
  19072. '$mod.$resourcestrings = {',
  19073. ' ImplRed: {',
  19074. ' org: "red"',
  19075. ' }',
  19076. '};',
  19077. '']));
  19078. end;
  19079. procedure TTestModule.TestAtributes_Ignore;
  19080. begin
  19081. StartProgram(false);
  19082. Add([
  19083. '{$modeswitch ignoreattributes}',
  19084. 'type',
  19085. ' [custom1, custom2(1+3,''foo'')] [mod1.custom3]',
  19086. ' TObject = class',
  19087. ' [custom5()] FS: string;',
  19088. ' [customProp] property S: string read FS;',
  19089. ' end;',
  19090. 'var',
  19091. ' [custom6]',
  19092. ' o: TObject;',
  19093. 'begin',
  19094. '']);
  19095. ConvertProgram;
  19096. CheckSource('TestAtributes_Ignore',
  19097. LinesToStr([ // statements
  19098. 'rtl.createClass($mod, "TObject", null, function () {',
  19099. ' this.$init = function () {',
  19100. ' this.FS = "";',
  19101. ' };',
  19102. ' this.$final = function () {',
  19103. ' };',
  19104. '});',
  19105. 'this.o = null;',
  19106. '']),
  19107. LinesToStr([ // $mod.$main
  19108. '']));
  19109. end;
  19110. procedure TTestModule.TestAssert;
  19111. begin
  19112. StartProgram(false);
  19113. Add([
  19114. 'procedure DoIt;',
  19115. 'var',
  19116. ' b: boolean;',
  19117. ' s: string;',
  19118. 'begin',
  19119. ' {$Assertions on}',
  19120. ' Assert(b);',
  19121. 'end;',
  19122. 'begin',
  19123. ' DoIt;',
  19124. '']);
  19125. ConvertProgram;
  19126. CheckSource('TestAssert',
  19127. LinesToStr([ // statements
  19128. 'this.DoIt = function () {',
  19129. ' var b = false;',
  19130. ' var s = "";',
  19131. ' if (b) throw "assert failed";',
  19132. '};',
  19133. '']),
  19134. LinesToStr([ // $mod.$main
  19135. '$mod.DoIt();',
  19136. '']));
  19137. end;
  19138. procedure TTestModule.TestAssert_SysUtils;
  19139. begin
  19140. AddModuleWithIntfImplSrc('SysUtils.pas',
  19141. LinesToStr([
  19142. 'type',
  19143. ' TObject = class',
  19144. ' constructor Create;',
  19145. ' end;',
  19146. ' EAssertionFailed = class',
  19147. ' constructor Create(s: string);',
  19148. ' end;',
  19149. '']),
  19150. LinesToStr([
  19151. 'constructor TObject.Create;',
  19152. 'begin end;',
  19153. 'constructor EAssertionFailed.Create(s: string);',
  19154. 'begin end;',
  19155. '']) );
  19156. StartProgram(true);
  19157. Add([
  19158. 'uses sysutils;',
  19159. 'procedure DoIt;',
  19160. 'var',
  19161. ' b: boolean;',
  19162. ' s: string;',
  19163. 'begin',
  19164. ' {$Assertions on}',
  19165. ' Assert(b);',
  19166. ' Assert(b,''msg'');',
  19167. 'end;',
  19168. 'begin',
  19169. ' DoIt;',
  19170. '']);
  19171. ConvertProgram;
  19172. CheckSource('TestAssert_SysUtils',
  19173. LinesToStr([ // statements
  19174. 'this.DoIt = function () {',
  19175. ' var b = false;',
  19176. ' var s = "";',
  19177. ' if (b) throw pas.SysUtils.EAssertionFailed.$create("Create");',
  19178. ' if (b) throw pas.SysUtils.EAssertionFailed.$create("Create$1", ["msg"]);',
  19179. '};',
  19180. '']),
  19181. LinesToStr([ // $mod.$main
  19182. '$mod.DoIt();',
  19183. '']));
  19184. end;
  19185. procedure TTestModule.TestObjectChecks;
  19186. begin
  19187. Scanner.CurrentBoolSwitches:=Scanner.CurrentBoolSwitches+[bsObjectChecks];
  19188. StartProgram(false);
  19189. Add([
  19190. 'type',
  19191. ' TObject = class',
  19192. ' procedure DoIt;',
  19193. ' end;',
  19194. ' TClass = class of tobject;',
  19195. ' TBird = class',
  19196. ' end;',
  19197. ' TBirdClass = class of TBird;',
  19198. 'var',
  19199. ' o : TObject;',
  19200. ' c: TClass;',
  19201. ' b: TBird;',
  19202. ' bc: TBirdClass;',
  19203. 'procedure TObject.DoIt;',
  19204. 'begin',
  19205. ' b:=TBird(o);',
  19206. 'end;',
  19207. 'begin',
  19208. ' o.DoIt;',
  19209. ' b:=TBird(o);',
  19210. ' bc:=TBirdClass(c);',
  19211. '']);
  19212. ConvertProgram;
  19213. CheckSource('TestCheckMethodCall',
  19214. LinesToStr([ // statements
  19215. 'rtl.createClass($mod, "TObject", null, function () {',
  19216. ' this.$init = function () {',
  19217. ' };',
  19218. ' this.$final = function () {',
  19219. ' };',
  19220. ' this.DoIt = function () {',
  19221. ' rtl.checkMethodCall(this,$mod.TObject);',
  19222. ' $mod.b = rtl.asExt($mod.o, $mod.TBird, 1);',
  19223. ' };',
  19224. '});',
  19225. 'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
  19226. '});',
  19227. 'this.o = null;',
  19228. 'this.c = null;',
  19229. 'this.b = null;',
  19230. 'this.bc = null;',
  19231. '']),
  19232. LinesToStr([ // $mod.$main
  19233. '$mod.o.DoIt();',
  19234. '$mod.b = rtl.asExt($mod.o,$mod.TBird, 1);',
  19235. '$mod.bc = rtl.asExt($mod.c, $mod.TBird, 2);',
  19236. '']));
  19237. end;
  19238. procedure TTestModule.TestRangeChecks_AssignInt;
  19239. begin
  19240. Scanner.Options:=Scanner.Options+[po_CAssignments];
  19241. StartProgram(false);
  19242. Add([
  19243. '{$R+}',
  19244. 'var',
  19245. ' b: byte = 2;',
  19246. ' w: word = 3;',
  19247. 'procedure DoIt(p: byte);',
  19248. 'begin',
  19249. ' b:=w;',
  19250. ' b+=w;',
  19251. ' b:=1;',
  19252. 'end;',
  19253. '{$R-}',
  19254. 'begin',
  19255. ' DoIt(w);',
  19256. ' b:=w;',
  19257. ' b:=2;',
  19258. '{$R+}',
  19259. '']);
  19260. ConvertProgram;
  19261. CheckSource('TestRangeChecks_AssignInt',
  19262. LinesToStr([ // statements
  19263. 'this.b = 2;',
  19264. 'this.w = 3;',
  19265. 'this.DoIt = function (p) {',
  19266. ' rtl.rc(p, 0, 255);',
  19267. ' $mod.b = rtl.rc($mod.w,0,255);',
  19268. ' rtl.rc($mod.b += $mod.w, 0, 255);',
  19269. ' $mod.b = 1;',
  19270. '};',
  19271. '']),
  19272. LinesToStr([ // $mod.$main
  19273. '$mod.DoIt($mod.w);',
  19274. '$mod.b = rtl.rc($mod.w,0,255);',
  19275. '$mod.b = 2;',
  19276. '']));
  19277. end;
  19278. procedure TTestModule.TestRangeChecks_AssignIntRange;
  19279. begin
  19280. Scanner.Options:=Scanner.Options+[po_CAssignments];
  19281. StartProgram(false);
  19282. Add([
  19283. '{$R+}',
  19284. 'type Ten = 1..10;',
  19285. 'var',
  19286. ' b: Ten = 2;',
  19287. ' w: Ten = 3;',
  19288. 'procedure DoIt(p: Ten);',
  19289. 'begin',
  19290. ' b:=w;',
  19291. ' b+=w;',
  19292. ' b:=1;',
  19293. 'end;',
  19294. '{$R-}',
  19295. 'begin',
  19296. ' DoIt(w);',
  19297. ' b:=w;',
  19298. ' b:=2;',
  19299. '{$R+}',
  19300. '']);
  19301. ConvertProgram;
  19302. CheckSource('TestRangeChecks_AssignIntRange',
  19303. LinesToStr([ // statements
  19304. 'this.b = 2;',
  19305. 'this.w = 3;',
  19306. 'this.DoIt = function (p) {',
  19307. ' rtl.rc(p, 1, 10);',
  19308. ' $mod.b = rtl.rc($mod.w, 1, 10);',
  19309. ' rtl.rc($mod.b += $mod.w, 1, 10);',
  19310. ' $mod.b = 1;',
  19311. '};',
  19312. '']),
  19313. LinesToStr([ // $mod.$main
  19314. '$mod.DoIt($mod.w);',
  19315. '$mod.b = rtl.rc($mod.w, 1, 10);',
  19316. '$mod.b = 2;',
  19317. '']));
  19318. end;
  19319. procedure TTestModule.TestRangeChecks_AssignEnum;
  19320. begin
  19321. StartProgram(false);
  19322. Add([
  19323. '{$R+}',
  19324. 'type TEnum = (red,green);',
  19325. 'var',
  19326. ' e: TEnum = red;',
  19327. 'procedure DoIt(p: TEnum);',
  19328. 'begin',
  19329. ' e:=p;',
  19330. ' p:=TEnum(0);',
  19331. ' p:=succ(e);',
  19332. 'end;',
  19333. '{$R-}',
  19334. 'begin',
  19335. ' DoIt(e);',
  19336. ' e:=TEnum(1);',
  19337. ' e:=pred(e);',
  19338. '{$R+}',
  19339. '']);
  19340. ConvertProgram;
  19341. CheckSource('TestRangeChecks_AssignEnum',
  19342. LinesToStr([ // statements
  19343. 'this.TEnum = {',
  19344. ' "0": "red",',
  19345. ' red: 0,',
  19346. ' "1": "green",',
  19347. ' green: 1',
  19348. '};',
  19349. 'this.e = $mod.TEnum.red;',
  19350. 'this.DoIt = function (p) {',
  19351. ' rtl.rc(p, 0, 1);',
  19352. ' $mod.e = rtl.rc(p, 0, 1);',
  19353. ' p = 0;',
  19354. ' p = rtl.rc($mod.e + 1, 0, 1);',
  19355. '};',
  19356. '']),
  19357. LinesToStr([ // $mod.$main
  19358. '$mod.DoIt($mod.e);',
  19359. '$mod.e = 1;',
  19360. '$mod.e = rtl.rc($mod.e-1, 0, 1);',
  19361. '']));
  19362. end;
  19363. procedure TTestModule.TestRangeChecks_AssignEnumRange;
  19364. begin
  19365. StartProgram(false);
  19366. Add([
  19367. '{$R+}',
  19368. 'type',
  19369. ' TEnum = (red,green);',
  19370. ' TEnumRg = red..green;',
  19371. 'var',
  19372. ' e: TEnumRg = red;',
  19373. 'procedure DoIt(p: TEnumRg);',
  19374. 'begin',
  19375. ' e:=p;',
  19376. ' p:=TEnumRg(0);',
  19377. ' p:=succ(e);',
  19378. 'end;',
  19379. '{$R-}',
  19380. 'begin',
  19381. ' DoIt(e);',
  19382. ' e:=TEnumRg(1);',
  19383. ' e:=pred(e);',
  19384. '{$R+}',
  19385. '']);
  19386. ConvertProgram;
  19387. CheckSource('TestRangeChecks_AssignEnumRange',
  19388. LinesToStr([ // statements
  19389. 'this.TEnum = {',
  19390. ' "0": "red",',
  19391. ' red: 0,',
  19392. ' "1": "green",',
  19393. ' green: 1',
  19394. '};',
  19395. 'this.e = $mod.TEnum.red;',
  19396. 'this.DoIt = function (p) {',
  19397. ' rtl.rc(p, 0, 1);',
  19398. ' $mod.e = rtl.rc(p, 0, 1);',
  19399. ' p = 0;',
  19400. ' p = rtl.rc($mod.e + 1, 0, 1);',
  19401. '};',
  19402. '']),
  19403. LinesToStr([ // $mod.$main
  19404. '$mod.DoIt($mod.e);',
  19405. '$mod.e = 1;',
  19406. '$mod.e = rtl.rc($mod.e-1, 0, 1);',
  19407. '']));
  19408. end;
  19409. procedure TTestModule.TestRangeChecks_AssignChar;
  19410. begin
  19411. StartProgram(false);
  19412. Add([
  19413. '{$R+}',
  19414. 'type TLetter = char;',
  19415. 'var',
  19416. ' b: TLetter = ''2'';',
  19417. ' w: TLetter = ''3'';',
  19418. 'procedure DoIt(p: TLetter);',
  19419. 'begin',
  19420. ' b:=w;',
  19421. ' b:=''1'';',
  19422. 'end;',
  19423. '{$R-}',
  19424. 'begin',
  19425. ' DoIt(w);',
  19426. ' b:=w;',
  19427. ' b:=''2'';',
  19428. '{$R+}',
  19429. '']);
  19430. ConvertProgram;
  19431. CheckSource('TestRangeChecks_AssignChar',
  19432. LinesToStr([ // statements
  19433. 'this.b = "2";',
  19434. 'this.w = "3";',
  19435. 'this.DoIt = function (p) {',
  19436. ' rtl.rcc(p, 0, 65535);',
  19437. ' $mod.b = rtl.rcc($mod.w, 0, 65535);',
  19438. ' $mod.b = "1";',
  19439. '};',
  19440. '']),
  19441. LinesToStr([ // $mod.$main
  19442. '$mod.DoIt($mod.w);',
  19443. '$mod.b = rtl.rcc($mod.w, 0, 65535);',
  19444. '$mod.b = "2";',
  19445. '']));
  19446. end;
  19447. procedure TTestModule.TestRangeChecks_AssignCharRange;
  19448. begin
  19449. StartProgram(false);
  19450. Add([
  19451. '{$R+}',
  19452. 'type TDigit = ''0''..''9'';',
  19453. 'var',
  19454. ' b: TDigit = ''2'';',
  19455. ' w: TDigit = ''3'';',
  19456. 'procedure DoIt(p: TDigit);',
  19457. 'begin',
  19458. ' b:=w;',
  19459. ' b:=''1'';',
  19460. 'end;',
  19461. '{$R-}',
  19462. 'begin',
  19463. ' DoIt(w);',
  19464. ' b:=w;',
  19465. ' b:=''2'';',
  19466. '{$R+}',
  19467. '']);
  19468. ConvertProgram;
  19469. CheckSource('TestRangeChecks_AssignCharRange',
  19470. LinesToStr([ // statements
  19471. 'this.b = "2";',
  19472. 'this.w = "3";',
  19473. 'this.DoIt = function (p) {',
  19474. ' rtl.rcc(p, 48, 57);',
  19475. ' $mod.b = rtl.rcc($mod.w, 48, 57);',
  19476. ' $mod.b = "1";',
  19477. '};',
  19478. '']),
  19479. LinesToStr([ // $mod.$main
  19480. '$mod.DoIt($mod.w);',
  19481. '$mod.b = rtl.rcc($mod.w, 48, 57);',
  19482. '$mod.b = "2";',
  19483. '']));
  19484. end;
  19485. procedure TTestModule.TestRangeChecks_ArrayIndex;
  19486. begin
  19487. StartProgram(false);
  19488. Add([
  19489. '{$R+}',
  19490. 'type',
  19491. ' Ten = 1..10;',
  19492. ' TArr = array of Ten;',
  19493. ' TArrArr = array of TArr;',
  19494. ' TArrByte = array[byte] of Ten;',
  19495. ' TArrChar = array[''0''..''9''] of Ten;',
  19496. ' TArrByteChar = array[byte,''0''..''9''] of Ten;',
  19497. 'procedure DoIt;',
  19498. 'var',
  19499. ' Arr: TArr;',
  19500. ' ArrArr: TArrArr;',
  19501. ' ArrByte: TArrByte;',
  19502. ' ArrChar: TArrChar;',
  19503. ' ArrByteChar: TArrByteChar;',
  19504. ' i: Ten;',
  19505. ' c: char;',
  19506. 'begin',
  19507. ' i:=Arr[1];',
  19508. ' i:=ArrByteChar[1,''2''];',
  19509. ' Arr[1]:=Arr[1];',
  19510. ' Arr[i]:=Arr[i];',
  19511. ' ArrByte[3]:=ArrByte[3];',
  19512. ' ArrByte[i]:=ArrByte[i];',
  19513. ' ArrChar[''5'']:=ArrChar[''5''];',
  19514. ' ArrChar[c]:=ArrChar[c];',
  19515. ' ArrByteChar[7,''7'']:=ArrByteChar[7,''7''];',
  19516. ' ArrByteChar[i,c]:=ArrByteChar[i,c];',
  19517. 'end;',
  19518. 'begin',
  19519. '']);
  19520. ConvertProgram;
  19521. CheckSource('TestRangeChecks_AssignChar',
  19522. LinesToStr([ // statements
  19523. 'this.DoIt = function () {',
  19524. ' var Arr = [];',
  19525. ' var ArrArr = [];',
  19526. ' var ArrByte = rtl.arraySetLength(null, 1, 256);',
  19527. ' var ArrChar = rtl.arraySetLength(null, 1, 10);',
  19528. ' var ArrByteChar = rtl.arraySetLength(null, 1, 256, 10);',
  19529. ' var i = 1;',
  19530. ' var c = "";',
  19531. ' i = rtl.rc(Arr[1], 1, 10);',
  19532. ' i = rtl.rc(ArrByteChar[1][2], 1, 10);',
  19533. ' Arr[1] = rtl.rc(Arr[1], 1, 10);',
  19534. ' rtl.rcArrW(Arr, i, rtl.rcArrR(Arr, i));',
  19535. ' ArrByte[3] = rtl.rc(ArrByte[3], 1, 10);',
  19536. ' rtl.rcArrW(ArrByte, i, rtl.rcArrR(ArrByte, i));',
  19537. ' ArrChar[5] = rtl.rc(ArrChar[5], 1, 10);',
  19538. ' rtl.rcArrW(ArrChar, c.charCodeAt() - 48, rtl.rcArrR(ArrChar, c.charCodeAt() - 48));',
  19539. ' ArrByteChar[7][7] = rtl.rc(ArrByteChar[7][7], 1, 10);',
  19540. ' rtl.rcArrW(ArrByteChar, i, c.charCodeAt() - 48, rtl.rcArrR(ArrByteChar, i, c.charCodeAt() - 48));',
  19541. '};',
  19542. '']),
  19543. LinesToStr([ // $mod.$main
  19544. '']));
  19545. end;
  19546. Initialization
  19547. RegisterTests([TTestModule]);
  19548. end.