tcmodules.pas 415 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542354335443545354635473548354935503551355235533554355535563557355835593560356135623563356435653566356735683569357035713572357335743575357635773578357935803581358235833584358535863587358835893590359135923593359435953596359735983599360036013602360336043605360636073608360936103611361236133614361536163617361836193620362136223623362436253626362736283629363036313632363336343635363636373638363936403641364236433644364536463647364836493650365136523653365436553656365736583659366036613662366336643665366636673668366936703671367236733674367536763677367836793680368136823683368436853686368736883689369036913692369336943695369636973698369937003701370237033704370537063707370837093710371137123713371437153716371737183719372037213722372337243725372637273728372937303731373237333734373537363737373837393740374137423743374437453746374737483749375037513752375337543755375637573758375937603761376237633764376537663767376837693770377137723773377437753776377737783779378037813782378337843785378637873788378937903791379237933794379537963797379837993800380138023803380438053806380738083809381038113812381338143815381638173818381938203821382238233824382538263827382838293830383138323833383438353836383738383839384038413842384338443845384638473848384938503851385238533854385538563857385838593860386138623863386438653866386738683869387038713872387338743875387638773878387938803881388238833884388538863887388838893890389138923893389438953896389738983899390039013902390339043905390639073908390939103911391239133914391539163917391839193920392139223923392439253926392739283929393039313932393339343935393639373938393939403941394239433944394539463947394839493950395139523953395439553956395739583959396039613962396339643965396639673968396939703971397239733974397539763977397839793980398139823983398439853986398739883989399039913992399339943995399639973998399940004001400240034004400540064007400840094010401140124013401440154016401740184019402040214022402340244025402640274028402940304031403240334034403540364037403840394040404140424043404440454046404740484049405040514052405340544055405640574058405940604061406240634064406540664067406840694070407140724073407440754076407740784079408040814082408340844085408640874088408940904091409240934094409540964097409840994100410141024103410441054106410741084109411041114112411341144115411641174118411941204121412241234124412541264127412841294130413141324133413441354136413741384139414041414142414341444145414641474148414941504151415241534154415541564157415841594160416141624163416441654166416741684169417041714172417341744175417641774178417941804181418241834184418541864187418841894190419141924193419441954196419741984199420042014202420342044205420642074208420942104211421242134214421542164217421842194220422142224223422442254226422742284229423042314232423342344235423642374238423942404241424242434244424542464247424842494250425142524253425442554256425742584259426042614262426342644265426642674268426942704271427242734274427542764277427842794280428142824283428442854286428742884289429042914292429342944295429642974298429943004301430243034304430543064307430843094310431143124313431443154316431743184319432043214322432343244325432643274328432943304331433243334334433543364337433843394340434143424343434443454346434743484349435043514352435343544355435643574358435943604361436243634364436543664367436843694370437143724373437443754376437743784379438043814382438343844385438643874388438943904391439243934394439543964397439843994400440144024403440444054406440744084409441044114412441344144415441644174418441944204421442244234424442544264427442844294430443144324433443444354436443744384439444044414442444344444445444644474448444944504451445244534454445544564457445844594460446144624463446444654466446744684469447044714472447344744475447644774478447944804481448244834484448544864487448844894490449144924493449444954496449744984499450045014502450345044505450645074508450945104511451245134514451545164517451845194520452145224523452445254526452745284529453045314532453345344535453645374538453945404541454245434544454545464547454845494550455145524553455445554556455745584559456045614562456345644565456645674568456945704571457245734574457545764577457845794580458145824583458445854586458745884589459045914592459345944595459645974598459946004601460246034604460546064607460846094610461146124613461446154616461746184619462046214622462346244625462646274628462946304631463246334634463546364637463846394640464146424643464446454646464746484649465046514652465346544655465646574658465946604661466246634664466546664667466846694670467146724673467446754676467746784679468046814682468346844685468646874688468946904691469246934694469546964697469846994700470147024703470447054706470747084709471047114712471347144715471647174718471947204721472247234724472547264727472847294730473147324733473447354736473747384739474047414742474347444745474647474748474947504751475247534754475547564757475847594760476147624763476447654766476747684769477047714772477347744775477647774778477947804781478247834784478547864787478847894790479147924793479447954796479747984799480048014802480348044805480648074808480948104811481248134814481548164817481848194820482148224823482448254826482748284829483048314832483348344835483648374838483948404841484248434844484548464847484848494850485148524853485448554856485748584859486048614862486348644865486648674868486948704871487248734874487548764877487848794880488148824883488448854886488748884889489048914892489348944895489648974898489949004901490249034904490549064907490849094910491149124913491449154916491749184919492049214922492349244925492649274928492949304931493249334934493549364937493849394940494149424943494449454946494749484949495049514952495349544955495649574958495949604961496249634964496549664967496849694970497149724973497449754976497749784979498049814982498349844985498649874988498949904991499249934994499549964997499849995000500150025003500450055006500750085009501050115012501350145015501650175018501950205021502250235024502550265027502850295030503150325033503450355036503750385039504050415042504350445045504650475048504950505051505250535054505550565057505850595060506150625063506450655066506750685069507050715072507350745075507650775078507950805081508250835084508550865087508850895090509150925093509450955096509750985099510051015102510351045105510651075108510951105111511251135114511551165117511851195120512151225123512451255126512751285129513051315132513351345135513651375138513951405141514251435144514551465147514851495150515151525153515451555156515751585159516051615162516351645165516651675168516951705171517251735174517551765177517851795180518151825183518451855186518751885189519051915192519351945195519651975198519952005201520252035204520552065207520852095210521152125213521452155216521752185219522052215222522352245225522652275228522952305231523252335234523552365237523852395240524152425243524452455246524752485249525052515252525352545255525652575258525952605261526252635264526552665267526852695270527152725273527452755276527752785279528052815282528352845285528652875288528952905291529252935294529552965297529852995300530153025303530453055306530753085309531053115312531353145315531653175318531953205321532253235324532553265327532853295330533153325333533453355336533753385339534053415342534353445345534653475348534953505351535253535354535553565357535853595360536153625363536453655366536753685369537053715372537353745375537653775378537953805381538253835384538553865387538853895390539153925393539453955396539753985399540054015402540354045405540654075408540954105411541254135414541554165417541854195420542154225423542454255426542754285429543054315432543354345435543654375438543954405441544254435444544554465447544854495450545154525453545454555456545754585459546054615462546354645465546654675468546954705471547254735474547554765477547854795480548154825483548454855486548754885489549054915492549354945495549654975498549955005501550255035504550555065507550855095510551155125513551455155516551755185519552055215522552355245525552655275528552955305531553255335534553555365537553855395540554155425543554455455546554755485549555055515552555355545555555655575558555955605561556255635564556555665567556855695570557155725573557455755576557755785579558055815582558355845585558655875588558955905591559255935594559555965597559855995600560156025603560456055606560756085609561056115612561356145615561656175618561956205621562256235624562556265627562856295630563156325633563456355636563756385639564056415642564356445645564656475648564956505651565256535654565556565657565856595660566156625663566456655666566756685669567056715672567356745675567656775678567956805681568256835684568556865687568856895690569156925693569456955696569756985699570057015702570357045705570657075708570957105711571257135714571557165717571857195720572157225723572457255726572757285729573057315732573357345735573657375738573957405741574257435744574557465747574857495750575157525753575457555756575757585759576057615762576357645765576657675768576957705771577257735774577557765777577857795780578157825783578457855786578757885789579057915792579357945795579657975798579958005801580258035804580558065807580858095810581158125813581458155816581758185819582058215822582358245825582658275828582958305831583258335834583558365837583858395840584158425843584458455846584758485849585058515852585358545855585658575858585958605861586258635864586558665867586858695870587158725873587458755876587758785879588058815882588358845885588658875888588958905891589258935894589558965897589858995900590159025903590459055906590759085909591059115912591359145915591659175918591959205921592259235924592559265927592859295930593159325933593459355936593759385939594059415942594359445945594659475948594959505951595259535954595559565957595859595960596159625963596459655966596759685969597059715972597359745975597659775978597959805981598259835984598559865987598859895990599159925993599459955996599759985999600060016002600360046005600660076008600960106011601260136014601560166017601860196020602160226023602460256026602760286029603060316032603360346035603660376038603960406041604260436044604560466047604860496050605160526053605460556056605760586059606060616062606360646065606660676068606960706071607260736074607560766077607860796080608160826083608460856086608760886089609060916092609360946095609660976098609961006101610261036104610561066107610861096110611161126113611461156116611761186119612061216122612361246125612661276128612961306131613261336134613561366137613861396140614161426143614461456146614761486149615061516152615361546155615661576158615961606161616261636164616561666167616861696170617161726173617461756176617761786179618061816182618361846185618661876188618961906191619261936194619561966197619861996200620162026203620462056206620762086209621062116212621362146215621662176218621962206221622262236224622562266227622862296230623162326233623462356236623762386239624062416242624362446245624662476248624962506251625262536254625562566257625862596260626162626263626462656266626762686269627062716272627362746275627662776278627962806281628262836284628562866287628862896290629162926293629462956296629762986299630063016302630363046305630663076308630963106311631263136314631563166317631863196320632163226323632463256326632763286329633063316332633363346335633663376338633963406341634263436344634563466347634863496350635163526353635463556356635763586359636063616362636363646365636663676368636963706371637263736374637563766377637863796380638163826383638463856386638763886389639063916392639363946395639663976398639964006401640264036404640564066407640864096410641164126413641464156416641764186419642064216422642364246425642664276428642964306431643264336434643564366437643864396440644164426443644464456446644764486449645064516452645364546455645664576458645964606461646264636464646564666467646864696470647164726473647464756476647764786479648064816482648364846485648664876488648964906491649264936494649564966497649864996500650165026503650465056506650765086509651065116512651365146515651665176518651965206521652265236524652565266527652865296530653165326533653465356536653765386539654065416542654365446545654665476548654965506551655265536554655565566557655865596560656165626563656465656566656765686569657065716572657365746575657665776578657965806581658265836584658565866587658865896590659165926593659465956596659765986599660066016602660366046605660666076608660966106611661266136614661566166617661866196620662166226623662466256626662766286629663066316632663366346635663666376638663966406641664266436644664566466647664866496650665166526653665466556656665766586659666066616662666366646665666666676668666966706671667266736674667566766677667866796680668166826683668466856686668766886689669066916692669366946695669666976698669967006701670267036704670567066707670867096710671167126713671467156716671767186719672067216722672367246725672667276728672967306731673267336734673567366737673867396740674167426743674467456746674767486749675067516752675367546755675667576758675967606761676267636764676567666767676867696770677167726773677467756776677767786779678067816782678367846785678667876788678967906791679267936794679567966797679867996800680168026803680468056806680768086809681068116812681368146815681668176818681968206821682268236824682568266827682868296830683168326833683468356836683768386839684068416842684368446845684668476848684968506851685268536854685568566857685868596860686168626863686468656866686768686869687068716872687368746875687668776878687968806881688268836884688568866887688868896890689168926893689468956896689768986899690069016902690369046905690669076908690969106911691269136914691569166917691869196920692169226923692469256926692769286929693069316932693369346935693669376938693969406941694269436944694569466947694869496950695169526953695469556956695769586959696069616962696369646965696669676968696969706971697269736974697569766977697869796980698169826983698469856986698769886989699069916992699369946995699669976998699970007001700270037004700570067007700870097010701170127013701470157016701770187019702070217022702370247025702670277028702970307031703270337034703570367037703870397040704170427043704470457046704770487049705070517052705370547055705670577058705970607061706270637064706570667067706870697070707170727073707470757076707770787079708070817082708370847085708670877088708970907091709270937094709570967097709870997100710171027103710471057106710771087109711071117112711371147115711671177118711971207121712271237124712571267127712871297130713171327133713471357136713771387139714071417142714371447145714671477148714971507151715271537154715571567157715871597160716171627163716471657166716771687169717071717172717371747175717671777178717971807181718271837184718571867187718871897190719171927193719471957196719771987199720072017202720372047205720672077208720972107211721272137214721572167217721872197220722172227223722472257226722772287229723072317232723372347235723672377238723972407241724272437244724572467247724872497250725172527253725472557256725772587259726072617262726372647265726672677268726972707271727272737274727572767277727872797280728172827283728472857286728772887289729072917292729372947295729672977298729973007301730273037304730573067307730873097310731173127313731473157316731773187319732073217322732373247325732673277328732973307331733273337334733573367337733873397340734173427343734473457346734773487349735073517352735373547355735673577358735973607361736273637364736573667367736873697370737173727373737473757376737773787379738073817382738373847385738673877388738973907391739273937394739573967397739873997400740174027403740474057406740774087409741074117412741374147415741674177418741974207421742274237424742574267427742874297430743174327433743474357436743774387439744074417442744374447445744674477448744974507451745274537454745574567457745874597460746174627463746474657466746774687469747074717472747374747475747674777478747974807481748274837484748574867487748874897490749174927493749474957496749774987499750075017502750375047505750675077508750975107511751275137514751575167517751875197520752175227523752475257526752775287529753075317532753375347535753675377538753975407541754275437544754575467547754875497550755175527553755475557556755775587559756075617562756375647565756675677568756975707571757275737574757575767577757875797580758175827583758475857586758775887589759075917592759375947595759675977598759976007601760276037604760576067607760876097610761176127613761476157616761776187619762076217622762376247625762676277628762976307631763276337634763576367637763876397640764176427643764476457646764776487649765076517652765376547655765676577658765976607661766276637664766576667667766876697670767176727673767476757676767776787679768076817682768376847685768676877688768976907691769276937694769576967697769876997700770177027703770477057706770777087709771077117712771377147715771677177718771977207721772277237724772577267727772877297730773177327733773477357736773777387739774077417742774377447745774677477748774977507751775277537754775577567757775877597760776177627763776477657766776777687769777077717772777377747775777677777778777977807781778277837784778577867787778877897790779177927793779477957796779777987799780078017802780378047805780678077808780978107811781278137814781578167817781878197820782178227823782478257826782778287829783078317832783378347835783678377838783978407841784278437844784578467847784878497850785178527853785478557856785778587859786078617862786378647865786678677868786978707871787278737874787578767877787878797880788178827883788478857886788778887889789078917892789378947895789678977898789979007901790279037904790579067907790879097910791179127913791479157916791779187919792079217922792379247925792679277928792979307931793279337934793579367937793879397940794179427943794479457946794779487949795079517952795379547955795679577958795979607961796279637964796579667967796879697970797179727973797479757976797779787979798079817982798379847985798679877988798979907991799279937994799579967997799879998000800180028003800480058006800780088009801080118012801380148015801680178018801980208021802280238024802580268027802880298030803180328033803480358036803780388039804080418042804380448045804680478048804980508051805280538054805580568057805880598060806180628063806480658066806780688069807080718072807380748075807680778078807980808081808280838084808580868087808880898090809180928093809480958096809780988099810081018102810381048105810681078108810981108111811281138114811581168117811881198120812181228123812481258126812781288129813081318132813381348135813681378138813981408141814281438144814581468147814881498150815181528153815481558156815781588159816081618162816381648165816681678168816981708171817281738174817581768177817881798180818181828183818481858186818781888189819081918192819381948195819681978198819982008201820282038204820582068207820882098210821182128213821482158216821782188219822082218222822382248225822682278228822982308231823282338234823582368237823882398240824182428243824482458246824782488249825082518252825382548255825682578258825982608261826282638264826582668267826882698270827182728273827482758276827782788279828082818282828382848285828682878288828982908291829282938294829582968297829882998300830183028303830483058306830783088309831083118312831383148315831683178318831983208321832283238324832583268327832883298330833183328333833483358336833783388339834083418342834383448345834683478348834983508351835283538354835583568357835883598360836183628363836483658366836783688369837083718372837383748375837683778378837983808381838283838384838583868387838883898390839183928393839483958396839783988399840084018402840384048405840684078408840984108411841284138414841584168417841884198420842184228423842484258426842784288429843084318432843384348435843684378438843984408441844284438444844584468447844884498450845184528453845484558456845784588459846084618462846384648465846684678468846984708471847284738474847584768477847884798480848184828483848484858486848784888489849084918492849384948495849684978498849985008501850285038504850585068507850885098510851185128513851485158516851785188519852085218522852385248525852685278528852985308531853285338534853585368537853885398540854185428543854485458546854785488549855085518552855385548555855685578558855985608561856285638564856585668567856885698570857185728573857485758576857785788579858085818582858385848585858685878588858985908591859285938594859585968597859885998600860186028603860486058606860786088609861086118612861386148615861686178618861986208621862286238624862586268627862886298630863186328633863486358636863786388639864086418642864386448645864686478648864986508651865286538654865586568657865886598660866186628663866486658666866786688669867086718672867386748675867686778678867986808681868286838684868586868687868886898690869186928693869486958696869786988699870087018702870387048705870687078708870987108711871287138714871587168717871887198720872187228723872487258726872787288729873087318732873387348735873687378738873987408741874287438744874587468747874887498750875187528753875487558756875787588759876087618762876387648765876687678768876987708771877287738774877587768777877887798780878187828783878487858786878787888789879087918792879387948795879687978798879988008801880288038804880588068807880888098810881188128813881488158816881788188819882088218822882388248825882688278828882988308831883288338834883588368837883888398840884188428843884488458846884788488849885088518852885388548855885688578858885988608861886288638864886588668867886888698870887188728873887488758876887788788879888088818882888388848885888688878888888988908891889288938894889588968897889888998900890189028903890489058906890789088909891089118912891389148915891689178918891989208921892289238924892589268927892889298930893189328933893489358936893789388939894089418942894389448945894689478948894989508951895289538954895589568957895889598960896189628963896489658966896789688969897089718972897389748975897689778978897989808981898289838984898589868987898889898990899189928993899489958996899789988999900090019002900390049005900690079008900990109011901290139014901590169017901890199020902190229023902490259026902790289029903090319032903390349035903690379038903990409041904290439044904590469047904890499050905190529053905490559056905790589059906090619062906390649065906690679068906990709071907290739074907590769077907890799080908190829083908490859086908790889089909090919092909390949095909690979098909991009101910291039104910591069107910891099110911191129113911491159116911791189119912091219122912391249125912691279128912991309131913291339134913591369137913891399140914191429143914491459146914791489149915091519152915391549155915691579158915991609161916291639164916591669167916891699170917191729173917491759176917791789179918091819182918391849185918691879188918991909191919291939194919591969197919891999200920192029203920492059206920792089209921092119212921392149215921692179218921992209221922292239224922592269227922892299230923192329233923492359236923792389239924092419242924392449245924692479248924992509251925292539254925592569257925892599260926192629263926492659266926792689269927092719272927392749275927692779278927992809281928292839284928592869287928892899290929192929293929492959296929792989299930093019302930393049305930693079308930993109311931293139314931593169317931893199320932193229323932493259326932793289329933093319332933393349335933693379338933993409341934293439344934593469347934893499350935193529353935493559356935793589359936093619362936393649365936693679368936993709371937293739374937593769377937893799380938193829383938493859386938793889389939093919392939393949395939693979398939994009401940294039404940594069407940894099410941194129413941494159416941794189419942094219422942394249425942694279428942994309431943294339434943594369437943894399440944194429443944494459446944794489449945094519452945394549455945694579458945994609461946294639464946594669467946894699470947194729473947494759476947794789479948094819482948394849485948694879488948994909491949294939494949594969497949894999500950195029503950495059506950795089509951095119512951395149515951695179518951995209521952295239524952595269527952895299530953195329533953495359536953795389539954095419542954395449545954695479548954995509551955295539554955595569557955895599560956195629563956495659566956795689569957095719572957395749575957695779578957995809581958295839584958595869587958895899590959195929593959495959596959795989599960096019602960396049605960696079608960996109611961296139614961596169617961896199620962196229623962496259626962796289629963096319632963396349635963696379638963996409641964296439644964596469647964896499650965196529653965496559656965796589659966096619662966396649665966696679668966996709671967296739674967596769677967896799680968196829683968496859686968796889689969096919692969396949695969696979698969997009701970297039704970597069707970897099710971197129713971497159716971797189719972097219722972397249725972697279728972997309731973297339734973597369737973897399740974197429743974497459746974797489749975097519752975397549755975697579758975997609761976297639764976597669767976897699770977197729773977497759776977797789779978097819782978397849785978697879788978997909791979297939794979597969797979897999800980198029803980498059806980798089809981098119812981398149815981698179818981998209821982298239824982598269827982898299830983198329833983498359836983798389839984098419842984398449845984698479848984998509851985298539854985598569857985898599860986198629863986498659866986798689869987098719872987398749875987698779878987998809881988298839884988598869887988898899890989198929893989498959896989798989899990099019902990399049905990699079908990999109911991299139914991599169917991899199920992199229923992499259926992799289929993099319932993399349935993699379938993999409941994299439944994599469947994899499950995199529953995499559956995799589959996099619962996399649965996699679968996999709971997299739974997599769977997899799980998199829983998499859986998799889989999099919992999399949995999699979998999910000100011000210003100041000510006100071000810009100101001110012100131001410015100161001710018100191002010021100221002310024100251002610027100281002910030100311003210033100341003510036100371003810039100401004110042100431004410045100461004710048100491005010051100521005310054100551005610057100581005910060100611006210063100641006510066100671006810069100701007110072100731007410075100761007710078100791008010081100821008310084100851008610087100881008910090100911009210093100941009510096100971009810099101001010110102101031010410105101061010710108101091011010111101121011310114101151011610117101181011910120101211012210123101241012510126101271012810129101301013110132101331013410135101361013710138101391014010141101421014310144101451014610147101481014910150101511015210153101541015510156101571015810159101601016110162101631016410165101661016710168101691017010171101721017310174101751017610177101781017910180101811018210183101841018510186101871018810189101901019110192101931019410195101961019710198101991020010201102021020310204102051020610207102081020910210102111021210213102141021510216102171021810219102201022110222102231022410225102261022710228102291023010231102321023310234102351023610237102381023910240102411024210243102441024510246102471024810249102501025110252102531025410255102561025710258102591026010261102621026310264102651026610267102681026910270102711027210273102741027510276102771027810279102801028110282102831028410285102861028710288102891029010291102921029310294102951029610297102981029910300103011030210303103041030510306103071030810309103101031110312103131031410315103161031710318103191032010321103221032310324103251032610327103281032910330103311033210333103341033510336103371033810339103401034110342103431034410345103461034710348103491035010351103521035310354103551035610357103581035910360103611036210363103641036510366103671036810369103701037110372103731037410375103761037710378103791038010381103821038310384103851038610387103881038910390103911039210393103941039510396103971039810399104001040110402104031040410405104061040710408104091041010411104121041310414104151041610417104181041910420104211042210423104241042510426104271042810429104301043110432104331043410435104361043710438104391044010441104421044310444104451044610447104481044910450104511045210453104541045510456104571045810459104601046110462104631046410465104661046710468104691047010471104721047310474104751047610477104781047910480104811048210483104841048510486104871048810489104901049110492104931049410495104961049710498104991050010501105021050310504105051050610507105081050910510105111051210513105141051510516105171051810519105201052110522105231052410525105261052710528105291053010531105321053310534105351053610537105381053910540105411054210543105441054510546105471054810549105501055110552105531055410555105561055710558105591056010561105621056310564105651056610567105681056910570105711057210573105741057510576105771057810579105801058110582105831058410585105861058710588105891059010591105921059310594105951059610597105981059910600106011060210603106041060510606106071060810609106101061110612106131061410615106161061710618106191062010621106221062310624106251062610627106281062910630106311063210633106341063510636106371063810639106401064110642106431064410645106461064710648106491065010651106521065310654106551065610657106581065910660106611066210663106641066510666106671066810669106701067110672106731067410675106761067710678106791068010681106821068310684106851068610687106881068910690106911069210693106941069510696106971069810699107001070110702107031070410705107061070710708107091071010711107121071310714107151071610717107181071910720107211072210723107241072510726107271072810729107301073110732107331073410735107361073710738107391074010741107421074310744107451074610747107481074910750107511075210753107541075510756107571075810759107601076110762107631076410765107661076710768107691077010771107721077310774107751077610777107781077910780107811078210783107841078510786107871078810789107901079110792107931079410795107961079710798107991080010801108021080310804108051080610807108081080910810108111081210813108141081510816108171081810819108201082110822108231082410825108261082710828108291083010831108321083310834108351083610837108381083910840108411084210843108441084510846108471084810849108501085110852108531085410855108561085710858108591086010861108621086310864108651086610867108681086910870108711087210873108741087510876108771087810879108801088110882108831088410885108861088710888108891089010891108921089310894108951089610897108981089910900109011090210903109041090510906109071090810909109101091110912109131091410915109161091710918109191092010921109221092310924109251092610927109281092910930109311093210933109341093510936109371093810939109401094110942109431094410945109461094710948109491095010951109521095310954109551095610957109581095910960109611096210963109641096510966109671096810969109701097110972109731097410975109761097710978109791098010981109821098310984109851098610987109881098910990109911099210993109941099510996109971099810999110001100111002110031100411005110061100711008110091101011011110121101311014110151101611017110181101911020110211102211023110241102511026110271102811029110301103111032110331103411035110361103711038110391104011041110421104311044110451104611047110481104911050110511105211053110541105511056110571105811059110601106111062110631106411065110661106711068110691107011071110721107311074110751107611077110781107911080110811108211083110841108511086110871108811089110901109111092110931109411095110961109711098110991110011101111021110311104111051110611107111081110911110111111111211113111141111511116111171111811119111201112111122111231112411125111261112711128111291113011131111321113311134111351113611137111381113911140111411114211143111441114511146111471114811149111501115111152111531115411155111561115711158111591116011161111621116311164111651116611167111681116911170111711117211173111741117511176111771117811179111801118111182111831118411185111861118711188111891119011191111921119311194111951119611197111981119911200112011120211203112041120511206112071120811209112101121111212112131121411215112161121711218112191122011221112221122311224112251122611227112281122911230112311123211233112341123511236112371123811239112401124111242112431124411245112461124711248112491125011251112521125311254112551125611257112581125911260112611126211263112641126511266112671126811269112701127111272112731127411275112761127711278112791128011281112821128311284112851128611287112881128911290112911129211293112941129511296112971129811299113001130111302113031130411305113061130711308113091131011311113121131311314113151131611317113181131911320113211132211323113241132511326113271132811329113301133111332113331133411335113361133711338113391134011341113421134311344113451134611347113481134911350113511135211353113541135511356113571135811359113601136111362113631136411365113661136711368113691137011371113721137311374113751137611377113781137911380113811138211383113841138511386113871138811389113901139111392113931139411395113961139711398113991140011401114021140311404114051140611407114081140911410114111141211413114141141511416114171141811419114201142111422114231142411425114261142711428114291143011431114321143311434114351143611437114381143911440114411144211443114441144511446114471144811449114501145111452114531145411455114561145711458114591146011461114621146311464114651146611467114681146911470114711147211473114741147511476114771147811479114801148111482114831148411485114861148711488114891149011491114921149311494114951149611497114981149911500115011150211503115041150511506115071150811509115101151111512115131151411515115161151711518115191152011521115221152311524115251152611527115281152911530115311153211533115341153511536115371153811539115401154111542115431154411545115461154711548115491155011551115521155311554115551155611557115581155911560115611156211563115641156511566115671156811569115701157111572115731157411575115761157711578115791158011581115821158311584115851158611587115881158911590115911159211593115941159511596115971159811599116001160111602116031160411605116061160711608116091161011611116121161311614116151161611617116181161911620116211162211623116241162511626116271162811629116301163111632116331163411635116361163711638116391164011641116421164311644116451164611647116481164911650116511165211653116541165511656116571165811659116601166111662116631166411665116661166711668116691167011671116721167311674116751167611677116781167911680116811168211683116841168511686116871168811689116901169111692116931169411695116961169711698116991170011701117021170311704117051170611707117081170911710117111171211713117141171511716117171171811719117201172111722117231172411725117261172711728117291173011731117321173311734117351173611737117381173911740117411174211743117441174511746117471174811749117501175111752117531175411755117561175711758117591176011761117621176311764117651176611767117681176911770117711177211773117741177511776117771177811779117801178111782117831178411785117861178711788117891179011791117921179311794117951179611797117981179911800118011180211803118041180511806118071180811809118101181111812118131181411815118161181711818118191182011821118221182311824118251182611827118281182911830118311183211833118341183511836118371183811839118401184111842118431184411845118461184711848118491185011851118521185311854118551185611857118581185911860118611186211863118641186511866118671186811869118701187111872118731187411875118761187711878118791188011881118821188311884118851188611887118881188911890118911189211893118941189511896118971189811899119001190111902119031190411905119061190711908119091191011911119121191311914119151191611917119181191911920119211192211923119241192511926119271192811929119301193111932119331193411935119361193711938119391194011941119421194311944119451194611947119481194911950119511195211953119541195511956119571195811959119601196111962119631196411965119661196711968119691197011971119721197311974119751197611977119781197911980119811198211983119841198511986119871198811989119901199111992119931199411995119961199711998119991200012001120021200312004120051200612007120081200912010120111201212013120141201512016120171201812019120201202112022120231202412025120261202712028120291203012031120321203312034120351203612037120381203912040120411204212043120441204512046120471204812049120501205112052120531205412055120561205712058120591206012061120621206312064120651206612067120681206912070120711207212073120741207512076120771207812079120801208112082120831208412085120861208712088120891209012091120921209312094120951209612097120981209912100121011210212103121041210512106121071210812109121101211112112121131211412115121161211712118121191212012121121221212312124121251212612127121281212912130121311213212133121341213512136121371213812139121401214112142121431214412145121461214712148121491215012151121521215312154121551215612157121581215912160121611216212163121641216512166121671216812169121701217112172121731217412175121761217712178121791218012181121821218312184121851218612187121881218912190121911219212193121941219512196121971219812199122001220112202122031220412205122061220712208122091221012211122121221312214122151221612217122181221912220122211222212223122241222512226122271222812229122301223112232122331223412235122361223712238122391224012241122421224312244122451224612247122481224912250122511225212253122541225512256122571225812259122601226112262122631226412265122661226712268122691227012271122721227312274122751227612277122781227912280122811228212283122841228512286122871228812289122901229112292122931229412295122961229712298122991230012301123021230312304123051230612307123081230912310123111231212313123141231512316123171231812319123201232112322123231232412325123261232712328123291233012331123321233312334123351233612337123381233912340123411234212343123441234512346123471234812349123501235112352123531235412355123561235712358123591236012361123621236312364123651236612367123681236912370123711237212373123741237512376123771237812379123801238112382123831238412385123861238712388123891239012391123921239312394123951239612397123981239912400124011240212403124041240512406124071240812409124101241112412124131241412415124161241712418124191242012421124221242312424124251242612427124281242912430124311243212433124341243512436124371243812439124401244112442124431244412445124461244712448124491245012451124521245312454124551245612457124581245912460124611246212463124641246512466124671246812469124701247112472124731247412475124761247712478124791248012481124821248312484124851248612487124881248912490124911249212493124941249512496124971249812499125001250112502125031250412505125061250712508125091251012511125121251312514125151251612517125181251912520125211252212523125241252512526125271252812529125301253112532125331253412535125361253712538125391254012541125421254312544125451254612547125481254912550125511255212553125541255512556125571255812559125601256112562125631256412565125661256712568125691257012571125721257312574125751257612577125781257912580125811258212583125841258512586125871258812589125901259112592125931259412595125961259712598125991260012601126021260312604126051260612607126081260912610126111261212613126141261512616126171261812619126201262112622126231262412625126261262712628126291263012631126321263312634126351263612637126381263912640126411264212643126441264512646126471264812649126501265112652126531265412655126561265712658126591266012661126621266312664126651266612667126681266912670126711267212673126741267512676126771267812679126801268112682126831268412685126861268712688126891269012691126921269312694126951269612697126981269912700127011270212703127041270512706127071270812709127101271112712127131271412715127161271712718127191272012721127221272312724127251272612727127281272912730127311273212733127341273512736127371273812739127401274112742127431274412745127461274712748127491275012751127521275312754127551275612757127581275912760127611276212763127641276512766127671276812769127701277112772127731277412775127761277712778127791278012781127821278312784127851278612787127881278912790127911279212793127941279512796127971279812799128001280112802128031280412805128061280712808128091281012811128121281312814128151281612817128181281912820128211282212823128241282512826128271282812829128301283112832128331283412835128361283712838128391284012841128421284312844128451284612847128481284912850128511285212853128541285512856128571285812859128601286112862128631286412865128661286712868128691287012871128721287312874128751287612877128781287912880128811288212883128841288512886128871288812889128901289112892128931289412895128961289712898128991290012901129021290312904129051290612907129081290912910129111291212913129141291512916129171291812919129201292112922129231292412925129261292712928129291293012931129321293312934129351293612937129381293912940129411294212943129441294512946129471294812949129501295112952129531295412955129561295712958129591296012961129621296312964129651296612967129681296912970129711297212973129741297512976129771297812979129801298112982129831298412985129861298712988129891299012991129921299312994129951299612997129981299913000130011300213003130041300513006130071300813009130101301113012130131301413015130161301713018130191302013021130221302313024130251302613027130281302913030130311303213033130341303513036130371303813039130401304113042130431304413045130461304713048130491305013051130521305313054130551305613057130581305913060130611306213063130641306513066130671306813069130701307113072130731307413075130761307713078130791308013081130821308313084130851308613087130881308913090130911309213093130941309513096130971309813099131001310113102131031310413105131061310713108131091311013111131121311313114131151311613117131181311913120131211312213123131241312513126131271312813129131301313113132131331313413135131361313713138131391314013141131421314313144131451314613147131481314913150131511315213153131541315513156131571315813159131601316113162131631316413165131661316713168131691317013171131721317313174131751317613177131781317913180131811318213183131841318513186131871318813189131901319113192131931319413195131961319713198131991320013201132021320313204132051320613207132081320913210132111321213213132141321513216132171321813219132201322113222132231322413225132261322713228132291323013231132321323313234132351323613237132381323913240132411324213243132441324513246132471324813249132501325113252132531325413255132561325713258132591326013261132621326313264132651326613267132681326913270132711327213273132741327513276132771327813279132801328113282132831328413285132861328713288132891329013291132921329313294132951329613297132981329913300133011330213303133041330513306133071330813309133101331113312133131331413315133161331713318133191332013321133221332313324133251332613327133281332913330133311333213333133341333513336133371333813339133401334113342133431334413345133461334713348133491335013351133521335313354133551335613357133581335913360133611336213363133641336513366133671336813369133701337113372133731337413375133761337713378133791338013381133821338313384133851338613387133881338913390133911339213393133941339513396133971339813399134001340113402134031340413405134061340713408134091341013411134121341313414134151341613417134181341913420134211342213423134241342513426134271342813429134301343113432134331343413435134361343713438134391344013441134421344313444134451344613447134481344913450134511345213453134541345513456134571345813459134601346113462134631346413465134661346713468134691347013471134721347313474134751347613477134781347913480134811348213483134841348513486134871348813489134901349113492134931349413495134961349713498134991350013501135021350313504135051350613507135081350913510135111351213513135141351513516135171351813519135201352113522135231352413525135261352713528135291353013531135321353313534135351353613537135381353913540135411354213543135441354513546135471354813549135501355113552135531355413555135561355713558135591356013561135621356313564135651356613567135681356913570135711357213573135741357513576135771357813579135801358113582135831358413585135861358713588135891359013591135921359313594135951359613597135981359913600136011360213603136041360513606136071360813609136101361113612136131361413615136161361713618136191362013621136221362313624136251362613627136281362913630136311363213633136341363513636136371363813639136401364113642136431364413645136461364713648136491365013651136521365313654136551365613657136581365913660136611366213663136641366513666136671366813669136701367113672136731367413675136761367713678136791368013681136821368313684136851368613687136881368913690136911369213693136941369513696136971369813699137001370113702137031370413705137061370713708137091371013711137121371313714137151371613717137181371913720137211372213723137241372513726137271372813729137301373113732137331373413735137361373713738137391374013741137421374313744137451374613747137481374913750137511375213753137541375513756137571375813759137601376113762137631376413765137661376713768137691377013771137721377313774137751377613777137781377913780137811378213783137841378513786137871378813789137901379113792137931379413795137961379713798137991380013801138021380313804138051380613807138081380913810138111381213813138141381513816138171381813819138201382113822138231382413825138261382713828138291383013831138321383313834138351383613837138381383913840138411384213843138441384513846138471384813849138501385113852138531385413855138561385713858138591386013861138621386313864138651386613867138681386913870138711387213873138741387513876138771387813879138801388113882138831388413885138861388713888138891389013891138921389313894138951389613897138981389913900139011390213903139041390513906139071390813909139101391113912139131391413915139161391713918139191392013921139221392313924139251392613927139281392913930139311393213933139341393513936139371393813939139401394113942139431394413945139461394713948139491395013951139521395313954139551395613957139581395913960139611396213963139641396513966139671396813969139701397113972139731397413975139761397713978139791398013981139821398313984139851398613987139881398913990139911399213993139941399513996139971399813999140001400114002140031400414005140061400714008140091401014011140121401314014140151401614017140181401914020140211402214023140241402514026140271402814029140301403114032140331403414035140361403714038140391404014041140421404314044140451404614047140481404914050140511405214053140541405514056140571405814059140601406114062140631406414065140661406714068140691407014071140721407314074140751407614077140781407914080140811408214083140841408514086140871408814089140901409114092140931409414095140961409714098140991410014101141021410314104141051410614107141081410914110141111411214113141141411514116141171411814119141201412114122141231412414125141261412714128141291413014131141321413314134141351413614137141381413914140141411414214143141441414514146141471414814149141501415114152141531415414155141561415714158141591416014161141621416314164141651416614167141681416914170141711417214173141741417514176141771417814179141801418114182141831418414185141861418714188141891419014191141921419314194141951419614197141981419914200142011420214203142041420514206142071420814209142101421114212142131421414215142161421714218142191422014221142221422314224142251422614227142281422914230142311423214233142341423514236142371423814239142401424114242142431424414245142461424714248142491425014251142521425314254142551425614257142581425914260142611426214263142641426514266142671426814269142701427114272142731427414275142761427714278142791428014281142821428314284142851428614287142881428914290142911429214293142941429514296142971429814299143001430114302143031430414305143061430714308143091431014311143121431314314143151431614317143181431914320143211432214323143241432514326143271432814329143301433114332143331433414335143361433714338143391434014341143421434314344143451434614347143481434914350143511435214353143541435514356143571435814359143601436114362143631436414365143661436714368143691437014371143721437314374143751437614377143781437914380143811438214383143841438514386143871438814389143901439114392143931439414395143961439714398143991440014401144021440314404144051440614407144081440914410144111441214413144141441514416144171441814419144201442114422144231442414425144261442714428144291443014431144321443314434144351443614437144381443914440144411444214443144441444514446144471444814449144501445114452144531445414455144561445714458144591446014461144621446314464144651446614467144681446914470144711447214473144741447514476144771447814479144801448114482144831448414485144861448714488144891449014491144921449314494144951449614497144981449914500145011450214503145041450514506145071450814509145101451114512145131451414515145161451714518145191452014521145221452314524145251452614527145281452914530145311453214533145341453514536145371453814539145401454114542145431454414545145461454714548145491455014551145521455314554145551455614557145581455914560145611456214563145641456514566145671456814569145701457114572145731457414575145761457714578145791458014581145821458314584145851458614587145881458914590145911459214593145941459514596145971459814599146001460114602146031460414605146061460714608146091461014611146121461314614146151461614617146181461914620146211462214623146241462514626146271462814629146301463114632146331463414635146361463714638146391464014641146421464314644146451464614647146481464914650146511465214653146541465514656146571465814659146601466114662146631466414665146661466714668146691467014671146721467314674146751467614677146781467914680146811468214683146841468514686146871468814689146901469114692146931469414695146961469714698146991470014701147021470314704147051470614707147081470914710147111471214713147141471514716147171471814719147201472114722147231472414725147261472714728147291473014731147321473314734147351473614737147381473914740147411474214743147441474514746147471474814749147501475114752147531475414755147561475714758147591476014761147621476314764147651476614767147681476914770147711477214773147741477514776147771477814779147801478114782147831478414785147861478714788147891479014791147921479314794147951479614797147981479914800148011480214803148041480514806148071480814809148101481114812148131481414815148161481714818148191482014821148221482314824148251482614827148281482914830148311483214833148341483514836148371483814839148401484114842148431484414845148461484714848148491485014851148521485314854148551485614857148581485914860148611486214863148641486514866148671486814869148701487114872148731487414875148761487714878148791488014881148821488314884148851488614887148881488914890148911489214893148941489514896148971489814899149001490114902149031490414905149061490714908149091491014911149121491314914149151491614917149181491914920149211492214923149241492514926149271492814929149301493114932149331493414935149361493714938149391494014941149421494314944149451494614947149481494914950149511495214953149541495514956149571495814959149601496114962149631496414965149661496714968149691497014971149721497314974149751497614977149781497914980149811498214983149841498514986149871498814989149901499114992149931499414995149961499714998149991500015001150021500315004150051500615007150081500915010150111501215013150141501515016150171501815019150201502115022150231502415025150261502715028150291503015031150321503315034150351503615037150381503915040150411504215043150441504515046150471504815049150501505115052150531505415055150561505715058150591506015061150621506315064150651506615067150681506915070150711507215073150741507515076150771507815079150801508115082150831508415085150861508715088150891509015091150921509315094150951509615097150981509915100151011510215103151041510515106151071510815109151101511115112151131511415115151161511715118151191512015121151221512315124151251512615127151281512915130151311513215133151341513515136151371513815139151401514115142151431514415145151461514715148151491515015151151521515315154151551515615157151581515915160151611516215163151641516515166151671516815169151701517115172151731517415175151761517715178151791518015181151821518315184151851518615187151881518915190151911519215193151941519515196151971519815199152001520115202152031520415205152061520715208152091521015211152121521315214152151521615217152181521915220152211522215223152241522515226152271522815229152301523115232152331523415235152361523715238152391524015241152421524315244152451524615247152481524915250152511525215253152541525515256152571525815259152601526115262152631526415265152661526715268152691527015271152721527315274152751527615277152781527915280152811528215283152841528515286152871528815289152901529115292152931529415295152961529715298152991530015301153021530315304153051530615307153081530915310153111531215313153141531515316153171531815319153201532115322153231532415325153261532715328153291533015331153321533315334153351533615337153381533915340153411534215343153441534515346153471534815349153501535115352153531535415355153561535715358153591536015361153621536315364153651536615367153681536915370153711537215373153741537515376153771537815379153801538115382153831538415385153861538715388153891539015391153921539315394153951539615397153981539915400154011540215403154041540515406154071540815409154101541115412154131541415415154161541715418154191542015421154221542315424154251542615427154281542915430154311543215433154341543515436154371543815439154401544115442154431544415445154461544715448154491545015451154521545315454154551545615457154581545915460154611546215463
  1. {
  2. This file is part of the Free Component Library (FCL)
  3. Copyright (c) 2014 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_pas2js = [po_asmwhole,po_resolvestandardtypes];
  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. FResolver: TStreamResolver;
  40. FScanner: TPascalScanner;
  41. FSource: string;
  42. procedure SetModule(AValue: TPasModule);
  43. public
  44. destructor Destroy; override;
  45. function FindModule(const AName: String): TPasModule; override;
  46. property OnFindUnit: TOnFindUnit read FOnFindUnit write FOnFindUnit;
  47. property Filename: string read FFilename write FFilename;
  48. property Resolver: TStreamResolver read FResolver write FResolver;
  49. property Scanner: TPascalScanner read FScanner write FScanner;
  50. property Parser: TTestPasParser read FParser write FParser;
  51. property Source: string read FSource write FSource;
  52. property Module: TPasModule read FModule write SetModule;
  53. end;
  54. { TCustomTestModule }
  55. TCustomTestModule = Class(TTestCase)
  56. private
  57. FConverter: TPasToJSConverter;
  58. FEngine: TTestEnginePasResolver;
  59. FExpectedErrorClass: ExceptClass;
  60. FExpectedErrorMsg: string;
  61. FExpectedErrorNumber: integer;
  62. FFilename: string;
  63. FFileResolver: TStreamResolver;
  64. FJSImplementationSrc: TJSSourceElements;
  65. FJSImplementationUses: TJSArrayLiteral;
  66. FJSInitBody: TJSFunctionBody;
  67. FJSImplentationUses: TJSArrayLiteral;
  68. FJSInterfaceUses: TJSArrayLiteral;
  69. FJSModule: TJSSourceElements;
  70. FJSModuleSrc: TJSSourceElements;
  71. FJSSource: TStringList;
  72. FModule: TPasModule;
  73. FJSModuleCallArgs: TJSArguments;
  74. FModules: TObjectList;// list of TTestEnginePasResolver
  75. FParser: TTestPasParser;
  76. FPasProgram: TPasProgram;
  77. FJSRegModuleCall: TJSCallExpression;
  78. FScanner: TPascalScanner;
  79. FSkipTests: boolean;
  80. FSource: TStringList;
  81. FFirstPasStatement: TPasImplBlock;
  82. function GetResolverCount: integer;
  83. function GetResolvers(Index: integer): TTestEnginePasResolver;
  84. function OnPasResolverFindUnit(const aUnitName: String): TPasModule;
  85. function FindUnit(const aUnitName: String): TPasModule;
  86. protected
  87. procedure SetUp; override;
  88. function CreateConverter: TPasToJSConverter; virtual;
  89. procedure TearDown; override;
  90. Procedure Add(Line: string); virtual;
  91. Procedure Add(const Lines: array of string);
  92. Procedure StartParsing; virtual;
  93. procedure ParseModule; virtual;
  94. procedure ParseProgram; virtual;
  95. procedure ParseUnit; virtual;
  96. protected
  97. function FindModuleWithFilename(aFilename: string): TTestEnginePasResolver; virtual;
  98. function AddModule(aFilename: string): TTestEnginePasResolver; virtual;
  99. function AddModuleWithSrc(aFilename, Src: string): TTestEnginePasResolver; virtual;
  100. function AddModuleWithIntfImplSrc(aFilename, InterfaceSrc,
  101. ImplementationSrc: string): TTestEnginePasResolver; virtual;
  102. procedure AddSystemUnit; virtual;
  103. procedure StartProgram(NeedSystemUnit: boolean); virtual;
  104. procedure StartUnit(NeedSystemUnit: boolean); virtual;
  105. procedure ConvertModule; virtual;
  106. procedure ConvertProgram; virtual;
  107. procedure ConvertUnit; virtual;
  108. function ConvertJSModuleToString(El: TJSElement): string; virtual;
  109. procedure CheckDottedIdentifier(Msg: string; El: TJSElement; DottedName: string);
  110. function GetDottedIdentifier(El: TJSElement): string;
  111. procedure CheckSource(Msg,Statements: String; InitStatements: string = '';
  112. ImplStatements: string = ''); virtual;
  113. procedure CheckDiff(Msg, Expected, Actual: string); virtual;
  114. procedure CheckUnit(Filename, ExpectedSrc: string); virtual;
  115. procedure SetExpectedScannerError(Msg: string; MsgNumber: integer);
  116. procedure SetExpectedParserError(Msg: string; MsgNumber: integer);
  117. procedure SetExpectedPasResolverError(Msg: string; MsgNumber: integer);
  118. procedure SetExpectedConverterError(Msg: string; MsgNumber: integer);
  119. function IsErrorExpected(E: Exception): boolean;
  120. procedure HandleScannerError(E: EScannerError);
  121. procedure HandleParserError(E: EParserError);
  122. procedure HandlePasResolveError(E: EPasResolve);
  123. procedure HandlePas2JSError(E: EPas2JS);
  124. procedure HandleException(E: Exception);
  125. procedure RaiseException(E: Exception);
  126. procedure WriteSources(const aFilename: string; aRow, aCol: integer);
  127. function IndexOfResolver(const Filename: string): integer;
  128. function GetResolver(const Filename: string): TTestEnginePasResolver;
  129. function GetDefaultNamespace: string;
  130. property PasProgram: TPasProgram Read FPasProgram;
  131. property Resolvers[Index: integer]: TTestEnginePasResolver read GetResolvers;
  132. property ResolverCount: integer read GetResolverCount;
  133. property Engine: TTestEnginePasResolver read FEngine;
  134. property Filename: string read FFilename;
  135. Property Module: TPasModule Read FModule;
  136. property FirstPasStatement: TPasImplBlock read FFirstPasStatement;
  137. property Converter: TPasToJSConverter read FConverter;
  138. property JSSource: TStringList read FJSSource;
  139. property JSModule: TJSSourceElements read FJSModule;
  140. property JSRegModuleCall: TJSCallExpression read FJSRegModuleCall;
  141. property JSModuleCallArgs: TJSArguments read FJSModuleCallArgs;
  142. property JSImplementationUses: TJSArrayLiteral read FJSImplementationUses;
  143. property JSInterfaceUses: TJSArrayLiteral read FJSInterfaceUses;
  144. property JSModuleSrc: TJSSourceElements read FJSModuleSrc;
  145. property JSInitBody: TJSFunctionBody read FJSInitBody;
  146. property JSImplementationSrc: TJSSourceElements read FJSImplementationSrc;
  147. property ExpectedErrorClass: ExceptClass read FExpectedErrorClass write FExpectedErrorClass;
  148. property ExpectedErrorMsg: string read FExpectedErrorMsg write FExpectedErrorMsg;
  149. property ExpectedErrorNumber: integer read FExpectedErrorNumber write FExpectedErrorNumber;
  150. property SkipTests: boolean read FSkipTests write FSkipTests;
  151. public
  152. property Source: TStringList read FSource;
  153. property FileResolver: TStreamResolver read FFileResolver;
  154. property Scanner: TPascalScanner read FScanner;
  155. property Parser: TTestPasParser read FParser;
  156. end;
  157. { TTestModule }
  158. TTestModule = class(TCustomTestModule)
  159. Published
  160. // program/units
  161. Procedure TestEmptyProgram;
  162. Procedure TestEmptyProgramUseStrict;
  163. Procedure TestEmptyUnit;
  164. Procedure TestEmptyUnitUseStrict;
  165. Procedure TestDottedUnitNames;
  166. Procedure TestDottedUnitNameImpl;
  167. Procedure TestDottedUnitExpr;
  168. Procedure Test_ModeFPCFail;
  169. Procedure Test_ModeSwitchCBlocksFail;
  170. Procedure TestUnit_Intf1Impl2Intf1;
  171. // vars/const
  172. Procedure TestVarInt;
  173. Procedure TestVarBaseTypes;
  174. Procedure TestBaseTypeSingleFail;
  175. Procedure TestBaseTypeExtendedFail;
  176. Procedure TestConstBaseTypes;
  177. Procedure TestUnitImplVars;
  178. Procedure TestUnitImplConsts;
  179. Procedure TestUnitImplRecord;
  180. Procedure TestRenameJSNameConflict;
  181. Procedure TestLocalConst;
  182. Procedure TestVarExternal;
  183. Procedure TestVarExternalOtherUnit;
  184. Procedure TestVarAbsoluteFail;
  185. // numbers
  186. Procedure TestDouble;
  187. Procedure TestIntegerRange;
  188. Procedure TestForBoolDo;
  189. // strings
  190. Procedure TestCharConst;
  191. Procedure TestChar_Compare;
  192. Procedure TestChar_Ord;
  193. Procedure TestChar_Chr;
  194. Procedure TestStringConst;
  195. Procedure TestString_Length;
  196. Procedure TestString_Compare;
  197. Procedure TestString_SetLength;
  198. Procedure TestString_CharAt;
  199. Procedure TestStr;
  200. Procedure TestBaseType_AnsiStringFail;
  201. Procedure TestBaseType_WideStringFail;
  202. Procedure TestBaseType_ShortStringFail;
  203. Procedure TestBaseType_RawByteStringFail;
  204. Procedure TestTypeShortstring_Fail;
  205. Procedure TestCharSet_Custom;
  206. Procedure TestForCharDo;
  207. Procedure TestForCharInDo;
  208. // alias types
  209. Procedure TestAliasTypeRef;
  210. Procedure TestTypeCast_BaseTypes;
  211. Procedure TestTypeCast_AliasBaseTypes;
  212. // functions
  213. Procedure TestEmptyProc;
  214. Procedure TestProcOneParam;
  215. Procedure TestFunctionWithoutParams;
  216. Procedure TestProcedureWithoutParams;
  217. Procedure TestPrgProcVar;
  218. Procedure TestProcTwoArgs;
  219. Procedure TestProc_DefaultValue;
  220. Procedure TestUnitProcVar;
  221. Procedure TestImplProc;
  222. Procedure TestFunctionResult;
  223. Procedure TestNestedProc;
  224. Procedure TestForwardProc;
  225. Procedure TestNestedForwardProc;
  226. Procedure TestAssignFunctionResult;
  227. Procedure TestFunctionResultInCondition;
  228. Procedure TestExit;
  229. Procedure TestBreak;
  230. Procedure TestContinue;
  231. Procedure TestProc_External;
  232. Procedure TestProc_ExternalOtherUnit;
  233. Procedure TestProc_Asm;
  234. Procedure TestProc_Assembler;
  235. Procedure TestProc_VarParam;
  236. Procedure TestProc_Overload;
  237. Procedure TestProc_OverloadForward;
  238. Procedure TestProc_OverloadUnit;
  239. Procedure TestProc_OverloadNested;
  240. Procedure TestProc_Varargs;
  241. Procedure TestProc_ConstOrder;
  242. // enums, sets
  243. Procedure TestEnum_Name;
  244. Procedure TestEnum_Number;
  245. Procedure TestEnum_Functions;
  246. Procedure TestEnum_AsParams;
  247. Procedure TestEnumRange_Array;
  248. Procedure TestEnum_ForIn;
  249. Procedure TestSet;
  250. Procedure TestSet_Operators;
  251. Procedure TestSet_Operator_In;
  252. Procedure TestSet_Functions;
  253. Procedure TestSet_PassAsArgClone;
  254. Procedure TestSet_AsParams;
  255. Procedure TestSet_Property;
  256. Procedure TestSet_EnumConst;
  257. Procedure TestSet_AnonymousEnumType;
  258. Procedure TestSet_ConstEnum;
  259. Procedure TestSet_ConstChar;
  260. Procedure TestSet_ConstInt;
  261. // statements
  262. Procedure TestNestBegin;
  263. Procedure TestIncDec;
  264. Procedure TestAssignments;
  265. Procedure TestArithmeticOperators1;
  266. Procedure TestLogicalOperators;
  267. Procedure TestBitwiseOperators;
  268. Procedure TestFunctionInt;
  269. Procedure TestFunctionString;
  270. Procedure TestForLoop;
  271. Procedure TestForLoopInsideFunction;
  272. Procedure TestForLoop_ReadVarAfter;
  273. Procedure TestForLoop_Nested;
  274. Procedure TestRepeatUntil;
  275. Procedure TestAsmBlock;
  276. Procedure TestAsmPas_Impl; // ToDo
  277. Procedure TestTryFinally;
  278. Procedure TestTryExcept;
  279. Procedure TestCaseOf;
  280. Procedure TestCaseOf_UseSwitch;
  281. Procedure TestCaseOfNoElse;
  282. Procedure TestCaseOfNoElse_UseSwitch;
  283. Procedure TestCaseOfRange;
  284. // arrays
  285. Procedure TestArray_Dynamic;
  286. Procedure TestArray_Dynamic_Nil;
  287. Procedure TestArray_DynMultiDimensional;
  288. Procedure TestArray_StaticInt;
  289. Procedure TestArray_StaticBool;
  290. Procedure TestArray_StaticChar;
  291. Procedure TestArray_StaticMultiDim; // ToDo
  292. Procedure TestArrayOfRecord;
  293. // ToDo: Procedure TestArrayOfSet;
  294. Procedure TestArray_AsParams;
  295. Procedure TestArrayElement_AsParams;
  296. Procedure TestArrayElementFromFuncResult_AsParams;
  297. Procedure TestArrayEnumTypeRange;
  298. Procedure TestArray_SetLengthOutArg;
  299. Procedure TestArray_SetLengthProperty;
  300. Procedure TestArray_SetLengthMultiDim;
  301. Procedure TestArray_OpenArrayOfString;
  302. Procedure TestArray_Concat;
  303. Procedure TestArray_Copy;
  304. Procedure TestArray_InsertDelete;
  305. Procedure TestArray_DynArrayConst;
  306. Procedure TestExternalClass_TypeCastArrayToExternalArray;
  307. Procedure TestExternalClass_TypeCastArrayFromExternalArray;
  308. // record
  309. Procedure TestRecord_Var;
  310. Procedure TestWithRecordDo;
  311. Procedure TestRecord_Assign;
  312. Procedure TestRecord_PassAsArgClone;
  313. Procedure TestRecord_AsParams;
  314. Procedure TestRecordElement_AsParams;
  315. Procedure TestRecordElementFromFuncResult_AsParams;
  316. Procedure TestRecordElementFromWith_AsParams;
  317. Procedure TestRecord_Equal;
  318. Procedure TestRecord_TypeCastJSValueToRecord;
  319. // ToDo: const record
  320. // classes
  321. Procedure TestClass_TObjectDefaultConstructor;
  322. Procedure TestClass_TObjectConstructorWithParams;
  323. Procedure TestClass_TObjectConstructorWithDefaultParam;
  324. Procedure TestClass_Var;
  325. Procedure TestClass_Method;
  326. Procedure TestClass_Implementation;
  327. Procedure TestClass_Inheritance;
  328. Procedure TestClass_AbstractMethod;
  329. Procedure TestClass_CallInherited_NoParams;
  330. Procedure TestClass_CallInherited_WithParams;
  331. Procedure TestClasS_CallInheritedConstructor;
  332. Procedure TestClass_ClassVar;
  333. Procedure TestClass_CallClassMethod;
  334. Procedure TestClass_Property;
  335. Procedure TestClass_Property_ClassMethod;
  336. Procedure TestClass_Property_Indexed;
  337. Procedure TestClass_Property_IndexSpec;
  338. Procedure TestClass_PropertyOfTypeArray;
  339. Procedure TestClass_PropertyDefault;
  340. Procedure TestClass_PropertyOverride;
  341. Procedure TestClass_Assigned;
  342. Procedure TestClass_WithClassDoCreate;
  343. Procedure TestClass_WithClassInstDoProperty;
  344. Procedure TestClass_WithClassInstDoPropertyWithParams;
  345. Procedure TestClass_WithClassInstDoFunc;
  346. Procedure TestClass_TypeCast;
  347. Procedure TestClass_TypeCastUntypedParam;
  348. Procedure TestClass_Overloads;
  349. Procedure TestClass_OverloadsAncestor;
  350. Procedure TestClass_OverloadConstructor;
  351. Procedure TestClass_OverloadDelphiOverride;
  352. Procedure TestClass_ReintroducedVar;
  353. Procedure TestClass_RaiseDescendant;
  354. Procedure TestClass_ExternalMethod;
  355. Procedure TestClass_ExternalVirtualNameMismatchFail;
  356. Procedure TestClass_ExternalOverrideFail;
  357. Procedure TestClass_ExternalVar;
  358. Procedure TestClass_Const;
  359. Procedure TestClass_LocalVarSelfFail;
  360. Procedure TestClass_ArgSelfFail;
  361. Procedure TestClass_NestedSelf;
  362. Procedure TestClass_NestedClassSelf;
  363. Procedure TestClass_NestedCallInherited;
  364. Procedure TestClass_TObjectFree;
  365. Procedure TestClass_TObjectFreeNewInstance;
  366. Procedure TestClass_TObjectFreeLowerCase;
  367. Procedure TestClass_TObjectFreeFunctionFail;
  368. Procedure TestClass_TObjectFreePropertyFail;
  369. // class of
  370. Procedure TestClassOf_Create;
  371. Procedure TestClassOf_Call;
  372. Procedure TestClassOf_Assign;
  373. Procedure TestClassOf_Is;
  374. Procedure TestClassOf_Compare;
  375. Procedure TestClassOf_ClassVar;
  376. Procedure TestClassOf_ClassMethod;
  377. Procedure TestClassOf_ClassProperty;
  378. Procedure TestClassOf_ClassMethodSelf;
  379. Procedure TestClassOf_TypeCast;
  380. Procedure TestClassOf_ImplicitFunctionCall;
  381. Procedure TestClassOf_Const;
  382. // nested class
  383. Procedure TestNestedClass_Fail;
  384. // external class
  385. Procedure TestExternalClass_Var;
  386. //ToDo Procedure TestExternalClass_Const;
  387. Procedure TestExternalClass_Dollar;
  388. Procedure TestExternalClass_DuplicateVarFail;
  389. Procedure TestExternalClass_Method;
  390. Procedure TestExternalClass_NonExternalOverride;
  391. Procedure TestExternalClass_Property;
  392. Procedure TestExternalClass_ClassProperty;
  393. Procedure TestExternalClass_ClassOf;
  394. Procedure TestExternalClass_ClassOtherUnit;
  395. Procedure TestExternalClass_Is;
  396. Procedure TestExternalClass_As;
  397. Procedure TestExternalClass_DestructorFail;
  398. Procedure TestExternalClass_New;
  399. Procedure TestExternalClass_ClassOf_New;
  400. Procedure TestExternalClass_FuncClassOf_New;
  401. Procedure TestExternalClass_LocalConstSameName;
  402. Procedure TestExternalClass_ReintroduceOverload;
  403. Procedure TestExternalClass_Inherited;
  404. Procedure TestExternalClass_PascalAncestorFail;
  405. Procedure TestExternalClass_NewInstance;
  406. Procedure TestExternalClass_NewInstance_NonVirtualFail;
  407. Procedure TestExternalClass_NewInstance_FirstParamNotString_Fail;
  408. Procedure TestExternalClass_NewInstance_SecondParamTyped_Fail;
  409. Procedure TestExternalClass_PascalProperty;
  410. Procedure TestExternalClass_TypeCastToRootClass;
  411. Procedure TestExternalClass_TypeCastStringToExternalString;
  412. Procedure TestExternalClass_CallClassFunctionOfInstanceFail;
  413. Procedure TestExternalClass_BracketAccessor;
  414. Procedure TestExternalClass_BracketAccessor_2ParamsFail;
  415. Procedure TestExternalClass_BracketAccessor_ReadOnly;
  416. Procedure TestExternalClass_BracketAccessor_WriteOnly;
  417. Procedure TestExternalClass_BracketAccessor_MultiType;
  418. Procedure TestExternalClass_BracketAccessor_Index;
  419. // class interfaces
  420. Procedure TestClassInterface_Ignore;
  421. // proc types
  422. Procedure TestProcType;
  423. Procedure TestProcType_FunctionFPC;
  424. Procedure TestProcType_FunctionDelphi;
  425. Procedure TestProcType_ProcedureDelphi;
  426. Procedure TestProcType_AsParam;
  427. Procedure TestProcType_MethodFPC;
  428. Procedure TestProcType_MethodDelphi;
  429. Procedure TestProcType_PropertyFPC;
  430. Procedure TestProcType_PropertyDelphi;
  431. Procedure TestProcType_WithClassInstDoPropertyFPC;
  432. Procedure TestProcType_Nested;
  433. Procedure TestProcType_NestedOfObject;
  434. Procedure TestProcType_ReferenceToProc;
  435. Procedure TestProcType_ReferenceToMethod;
  436. Procedure TestProcType_Typecast;
  437. Procedure TestProcType_PassProcToUntyped;
  438. // pointer
  439. Procedure TestPointer;
  440. Procedure TestPointer_Proc;
  441. Procedure TestPointer_AssignRecordFail;
  442. Procedure TestPointer_AssignStaticArrayFail;
  443. Procedure TestPointer_ArrayParamsFail;
  444. Procedure TestPointer_TypeCastJSValueToPointer;
  445. // jsvalue
  446. Procedure TestJSValue_AssignToJSValue;
  447. Procedure TestJSValue_TypeCastToBaseType;
  448. Procedure TestJSValue_Equal;
  449. Procedure TestJSValue_If;
  450. Procedure TestJSValue_Enum;
  451. Procedure TestJSValue_ClassInstance;
  452. Procedure TestJSValue_ClassOf;
  453. Procedure TestJSValue_ArrayOfJSValue;
  454. Procedure TestJSValue_Params;
  455. Procedure TestJSValue_UntypedParam;
  456. Procedure TestJSValue_FuncResultType;
  457. Procedure TestJSValue_ProcType_Assign;
  458. Procedure TestJSValue_ProcType_Equal;
  459. Procedure TestJSValue_AssignToPointerFail;
  460. Procedure TestJSValue_OverloadDouble;
  461. Procedure TestJSValue_OverloadNativeInt;
  462. Procedure TestJSValue_OverloadWord;
  463. Procedure TestJSValue_OverloadString;
  464. Procedure TestJSValue_OverloadChar;
  465. Procedure TestJSValue_OverloadPointer;
  466. // RTTI
  467. Procedure TestRTTI_ProcType;
  468. Procedure TestRTTI_ProcType_ArgFromOtherUnit;
  469. Procedure TestRTTI_EnumAndSetType;
  470. Procedure TestRTTI_EnumRange;
  471. Procedure TestRTTI_AnonymousEnumType;
  472. Procedure TestRTTI_StaticArray;
  473. Procedure TestRTTI_DynArray;
  474. Procedure TestRTTI_ArrayNestedAnonymous;
  475. // ToDo: Procedure TestRTTI_Pointer;
  476. Procedure TestRTTI_PublishedMethodOverloadFail;
  477. Procedure TestRTTI_PublishedMethodExternalFail;
  478. Procedure TestRTTI_PublishedClassPropertyFail;
  479. Procedure TestRTTI_PublishedClassFieldFail;
  480. Procedure TestRTTI_PublishedFieldExternalFail;
  481. Procedure TestRTTI_IndexModifier;
  482. Procedure TestRTTI_StoredModifier;
  483. Procedure TestRTTI_DefaultValue;
  484. Procedure TestRTTI_DefaultValueSet;
  485. Procedure TestRTTI_DefaultValueRangeType;
  486. Procedure TestRTTI_Class_Field;
  487. Procedure TestRTTI_Class_Method;
  488. Procedure TestRTTI_Class_MethodArgFlags;
  489. Procedure TestRTTI_Class_Property;
  490. Procedure TestRTTI_Class_PropertyParams;
  491. Procedure TestRTTI_OverrideMethod;
  492. Procedure TestRTTI_OverloadProperty;
  493. // ToDo: array argument
  494. Procedure TestRTTI_ClassForward;
  495. Procedure TestRTTI_ClassOf;
  496. Procedure TestRTTI_Record;
  497. Procedure TestRTTI_RecordAnonymousArray;
  498. Procedure TestRTTI_LocalTypes;
  499. Procedure TestRTTI_TypeInfo_BaseTypes;
  500. Procedure TestRTTI_TypeInfo_LocalFail;
  501. Procedure TestRTTI_TypeInfo_ExtTypeInfoClasses1;
  502. Procedure TestRTTI_TypeInfo_ExtTypeInfoClasses2;
  503. Procedure TestRTTI_TypeInfo_ExtTypeInfoClasses3;
  504. Procedure TestRTTI_TypeInfo_FunctionClassType;
  505. // Resourcestring
  506. Procedure TestResourcestringProgram;
  507. Procedure TestResourcestringUnit;
  508. Procedure TestResourcestringImplementation;
  509. // ToDo: in unit interface and implementation
  510. // Attributes
  511. Procedure TestAtributes_Ignore;
  512. end;
  513. function LinesToStr(Args: array of const): string;
  514. function ExtractFileUnitName(aFilename: string): string;
  515. function JSToStr(El: TJSElement): string;
  516. implementation
  517. function LinesToStr(Args: array of const): string;
  518. var
  519. s: String;
  520. i: Integer;
  521. begin
  522. s:='';
  523. for i:=Low(Args) to High(Args) do
  524. case Args[i].VType of
  525. vtChar: s += Args[i].VChar+LineEnding;
  526. vtString: s += Args[i].VString^+LineEnding;
  527. vtPChar: s += Args[i].VPChar+LineEnding;
  528. vtWideChar: s += AnsiString(Args[i].VWideChar)+LineEnding;
  529. vtPWideChar: s += AnsiString(Args[i].VPWideChar)+LineEnding;
  530. vtAnsiString: s += AnsiString(Args[i].VAnsiString)+LineEnding;
  531. vtWidestring: s += AnsiString(WideString(Args[i].VWideString))+LineEnding;
  532. vtUnicodeString:s += AnsiString(UnicodeString(Args[i].VUnicodeString))+LineEnding;
  533. end;
  534. Result:=s;
  535. end;
  536. function ExtractFileUnitName(aFilename: string): string;
  537. var
  538. p: Integer;
  539. begin
  540. Result:=ExtractFileName(aFilename);
  541. if Result='' then exit;
  542. for p:=length(Result) downto 1 do
  543. case Result[p] of
  544. '/','\': exit;
  545. '.':
  546. begin
  547. Delete(Result,p,length(Result));
  548. exit;
  549. end;
  550. end;
  551. end;
  552. function JSToStr(El: TJSElement): string;
  553. var
  554. aWriter: TBufferWriter;
  555. aJSWriter: TJSWriter;
  556. begin
  557. aJSWriter:=nil;
  558. aWriter:=TBufferWriter.Create(1000);
  559. try
  560. aJSWriter:=TJSWriter.Create(aWriter);
  561. aJSWriter.IndentSize:=2;
  562. aJSWriter.WriteJS(El);
  563. Result:=aWriter.AsAnsistring;
  564. finally
  565. aJSWriter.Free;
  566. aWriter.Free;
  567. end;
  568. end;
  569. { TTestEnginePasResolver }
  570. procedure TTestEnginePasResolver.SetModule(AValue: TPasModule);
  571. begin
  572. if FModule=AValue then Exit;
  573. if Module<>nil then
  574. Module.Release;
  575. FModule:=AValue;
  576. if Module<>nil then
  577. Module.AddRef;
  578. end;
  579. destructor TTestEnginePasResolver.Destroy;
  580. begin
  581. FreeAndNil(FResolver);
  582. Module:=nil;
  583. FreeAndNil(FParser);
  584. FreeAndNil(FScanner);
  585. FreeAndNil(FResolver);
  586. inherited Destroy;
  587. end;
  588. function TTestEnginePasResolver.FindModule(const AName: String): TPasModule;
  589. begin
  590. Result:=nil;
  591. if Assigned(OnFindUnit) then
  592. Result:=OnFindUnit(AName);
  593. end;
  594. { TCustomTestModule }
  595. function TCustomTestModule.GetResolverCount: integer;
  596. begin
  597. Result:=FModules.Count;
  598. end;
  599. function TCustomTestModule.GetResolvers(Index: integer
  600. ): TTestEnginePasResolver;
  601. begin
  602. Result:=TTestEnginePasResolver(FModules[Index]);
  603. end;
  604. function TCustomTestModule.OnPasResolverFindUnit(const aUnitName: String
  605. ): TPasModule;
  606. var
  607. DefNamespace: String;
  608. begin
  609. //writeln('TTestModule.OnPasResolverFindUnit START Unit="',aUnitName,'"');
  610. if (Pos('.',aUnitName)<1) then
  611. begin
  612. DefNamespace:=GetDefaultNamespace;
  613. if DefNamespace<>'' then
  614. begin
  615. Result:=FindUnit(DefNamespace+'.'+aUnitName);
  616. if Result<>nil then exit;
  617. end;
  618. end;
  619. Result:=FindUnit(aUnitName);
  620. if Result<>nil then exit;
  621. writeln('TTestModule.OnPasResolverFindUnit missing unit "',aUnitName,'"');
  622. Fail('can''t find unit "'+aUnitName+'"');
  623. end;
  624. function TCustomTestModule.FindUnit(const aUnitName: String): TPasModule;
  625. var
  626. i: Integer;
  627. CurEngine: TTestEnginePasResolver;
  628. CurUnitName: String;
  629. begin
  630. //writeln('TTestModule.FindUnit START Unit="',aUnitName,'"');
  631. Result:=nil;
  632. if (Module.ClassType=TPasModule)
  633. and (CompareText(Module.Name,aUnitName)=0) then
  634. exit(Module);
  635. for i:=0 to ResolverCount-1 do
  636. begin
  637. CurEngine:=Resolvers[i];
  638. CurUnitName:=ExtractFileUnitName(CurEngine.Filename);
  639. //writeln('TTestModule.FindUnit Checking ',i,'/',ResolverCount,' ',CurEngine.Filename,' ',CurUnitName);
  640. if CompareText(aUnitName,CurUnitName)=0 then
  641. begin
  642. Result:=CurEngine.Module;
  643. if Result<>nil then exit;
  644. //writeln('TTestModule.FindUnit PARSING unit "',CurEngine.Filename,'"');
  645. FileResolver.FindSourceFile(aUnitName);
  646. CurEngine.Resolver:=TStreamResolver.Create;
  647. CurEngine.Resolver.OwnsStreams:=True;
  648. //writeln('TTestModule.FindUnit SOURCE=',CurEngine.Source);
  649. CurEngine.Resolver.AddStream(CurEngine.FileName,TStringStream.Create(CurEngine.Source));
  650. CurEngine.Scanner:=TPascalScanner.Create(CurEngine.Resolver);
  651. CurEngine.Parser:=TTestPasParser.Create(CurEngine.Scanner,CurEngine.Resolver,CurEngine);
  652. CurEngine.Parser.Options:=CurEngine.Parser.Options+po_pas2js+[po_KeepScannerError];
  653. if CompareText(CurUnitName,'System')=0 then
  654. CurEngine.Parser.ImplicitUses.Clear;
  655. CurEngine.Scanner.OpenFile(CurEngine.Filename);
  656. try
  657. CurEngine.Parser.NextToken;
  658. CurEngine.Parser.ParseUnit(CurEngine.FModule);
  659. except
  660. on E: Exception do
  661. HandleException(E);
  662. end;
  663. //writeln('TTestModule.FindUnit END ',CurUnitName);
  664. Result:=CurEngine.Module;
  665. exit;
  666. end;
  667. end;
  668. end;
  669. procedure TCustomTestModule.SetUp;
  670. begin
  671. inherited SetUp;
  672. FSkipTests:=false;
  673. FSource:=TStringList.Create;
  674. FModules:=TObjectList.Create(true);
  675. FFilename:='test1.pp';
  676. FFileResolver:=TStreamResolver.Create;
  677. FFileResolver.OwnsStreams:=True;
  678. FScanner:=TPascalScanner.Create(FFileResolver);
  679. FScanner.AllowedModeSwitches:=msAllPas2jsModeSwitches;
  680. FScanner.ReadOnlyModeSwitches:=msAllPas2jsModeSwitchesReadOnly;
  681. FScanner.CurrentModeSwitches:=OBJFPCModeSwitches*msAllPas2jsModeSwitches+msAllPas2jsModeSwitchesReadOnly;
  682. FEngine:=AddModule(Filename);
  683. FParser:=TTestPasParser.Create(FScanner,FFileResolver,FEngine);
  684. Parser.Options:=Parser.Options+po_pas2js+[po_KeepScannerError];
  685. FModule:=Nil;
  686. FConverter:=CreateConverter;
  687. FExpectedErrorClass:=nil;
  688. end;
  689. function TCustomTestModule.CreateConverter: TPasToJSConverter;
  690. begin
  691. Result:=TPasToJSConverter.Create;
  692. Result.Options:=co_tcmodules;
  693. end;
  694. procedure TCustomTestModule.TearDown;
  695. begin
  696. FSkipTests:=false;
  697. FJSModule:=nil;
  698. FJSRegModuleCall:=nil;
  699. FJSModuleCallArgs:=nil;
  700. FJSImplentationUses:=nil;
  701. FJSInterfaceUses:=nil;
  702. FJSModuleSrc:=nil;
  703. FJSInitBody:=nil;
  704. FreeAndNil(FJSSource);
  705. FreeAndNil(FJSModule);
  706. FreeAndNil(FConverter);
  707. Engine.Clear;
  708. if Assigned(FModule) then
  709. begin
  710. FModule.Release;
  711. FModule:=nil;
  712. end;
  713. FreeAndNil(FSource);
  714. FreeAndNil(FParser);
  715. FreeAndNil(FScanner);
  716. FreeAndNil(FFileResolver);
  717. if FModules<>nil then
  718. begin
  719. FreeAndNil(FModules);
  720. FEngine:=nil;
  721. end;
  722. inherited TearDown;
  723. end;
  724. procedure TCustomTestModule.Add(Line: string);
  725. begin
  726. Source.Add(Line);
  727. end;
  728. procedure TCustomTestModule.Add(const Lines: array of string);
  729. var
  730. i: Integer;
  731. begin
  732. for i:=low(Lines) to high(Lines) do
  733. Add(Lines[i]);
  734. end;
  735. procedure TCustomTestModule.StartParsing;
  736. var
  737. Src: String;
  738. begin
  739. Src:=Source.Text;
  740. FEngine.Source:=Src;
  741. FileResolver.AddStream(FileName,TStringStream.Create(Src));
  742. Scanner.OpenFile(FileName);
  743. Writeln('// Test : ',Self.TestName);
  744. Writeln(Src);
  745. end;
  746. procedure TCustomTestModule.ParseModule;
  747. begin
  748. if SkipTests then exit;
  749. FFirstPasStatement:=nil;
  750. try
  751. StartParsing;
  752. Parser.ParseMain(FModule);
  753. except
  754. on E: Exception do
  755. HandleException(E);
  756. end;
  757. if SkipTests then exit;
  758. AssertNotNull('Module resulted in Module',FModule);
  759. AssertEquals('modulename',lowercase(ChangeFileExt(FFileName,'')),lowercase(Module.Name));
  760. TAssert.AssertSame('Has resolver',Engine,Parser.Engine);
  761. end;
  762. procedure TCustomTestModule.ParseProgram;
  763. begin
  764. if SkipTests then exit;
  765. ParseModule;
  766. if SkipTests then exit;
  767. AssertEquals('Has program',TPasProgram,Module.ClassType);
  768. FPasProgram:=TPasProgram(Module);
  769. AssertNotNull('Has program section',PasProgram.ProgramSection);
  770. AssertNotNull('Has initialization section',PasProgram.InitializationSection);
  771. if (PasProgram.InitializationSection.Elements.Count>0) then
  772. if TObject(PasProgram.InitializationSection.Elements[0]) is TPasImplBlock then
  773. FFirstPasStatement:=TPasImplBlock(PasProgram.InitializationSection.Elements[0]);
  774. end;
  775. procedure TCustomTestModule.ParseUnit;
  776. begin
  777. if SkipTests then exit;
  778. ParseModule;
  779. if SkipTests then exit;
  780. AssertEquals('Has unit (TPasModule)',TPasModule,Module.ClassType);
  781. AssertNotNull('Has interface section',Module.InterfaceSection);
  782. AssertNotNull('Has implementation section',Module.ImplementationSection);
  783. if (Module.InitializationSection<>nil)
  784. and (Module.InitializationSection.Elements.Count>0)
  785. and (TObject(Module.InitializationSection.Elements[0]) is TPasImplBlock) then
  786. FFirstPasStatement:=TPasImplBlock(Module.InitializationSection.Elements[0]);
  787. end;
  788. function TCustomTestModule.FindModuleWithFilename(aFilename: string
  789. ): TTestEnginePasResolver;
  790. var
  791. i: Integer;
  792. begin
  793. for i:=0 to ResolverCount-1 do
  794. if CompareText(Resolvers[i].Filename,aFilename)=0 then
  795. exit(Resolvers[i]);
  796. Result:=nil;
  797. end;
  798. function TCustomTestModule.AddModule(aFilename: string
  799. ): TTestEnginePasResolver;
  800. begin
  801. //writeln('TTestModuleConverter.AddModule ',aFilename);
  802. if FindModuleWithFilename(aFilename)<>nil then
  803. Fail('TTestModuleConverter.AddModule: file "'+aFilename+'" already exists');
  804. Result:=TTestEnginePasResolver.Create;
  805. Result.Filename:=aFilename;
  806. Result.AddObjFPCBuiltInIdentifiers(btAllJSBaseTypes,bfAllJSBaseProcs);
  807. Result.OnFindUnit:=@OnPasResolverFindUnit;
  808. FModules.Add(Result);
  809. end;
  810. function TCustomTestModule.AddModuleWithSrc(aFilename, Src: string
  811. ): TTestEnginePasResolver;
  812. begin
  813. Result:=AddModule(aFilename);
  814. Result.Source:=Src;
  815. end;
  816. function TCustomTestModule.AddModuleWithIntfImplSrc(aFilename, InterfaceSrc,
  817. ImplementationSrc: string): TTestEnginePasResolver;
  818. var
  819. Src: String;
  820. begin
  821. Src:='unit '+ExtractFileUnitName(aFilename)+';'+LineEnding;
  822. Src+=LineEnding;
  823. Src+='interface'+LineEnding;
  824. Src+=LineEnding;
  825. Src+=InterfaceSrc;
  826. Src+='implementation'+LineEnding;
  827. Src+=LineEnding;
  828. Src+=ImplementationSrc;
  829. Src+='end.'+LineEnding;
  830. Result:=AddModuleWithSrc(aFilename,Src);
  831. end;
  832. procedure TCustomTestModule.AddSystemUnit;
  833. begin
  834. AddModuleWithIntfImplSrc('system.pp',
  835. // interface
  836. LinesToStr([
  837. 'type',
  838. ' integer=longint;',
  839. 'var',
  840. ' ExitCode: Longint;',
  841. ''
  842. // implementation
  843. ]),LinesToStr([
  844. ''
  845. ]));
  846. end;
  847. procedure TCustomTestModule.StartProgram(NeedSystemUnit: boolean);
  848. begin
  849. if NeedSystemUnit then
  850. AddSystemUnit
  851. else
  852. Parser.ImplicitUses.Clear;
  853. Add('program '+ExtractFileUnitName(Filename)+';');
  854. Add('');
  855. end;
  856. procedure TCustomTestModule.StartUnit(NeedSystemUnit: boolean);
  857. begin
  858. if NeedSystemUnit then
  859. AddSystemUnit
  860. else
  861. Parser.ImplicitUses.Clear;
  862. Add('unit Test1;');
  863. Add('');
  864. end;
  865. procedure TCustomTestModule.ConvertModule;
  866. procedure CheckUsesList(UsesName: String; Arg: TJSArrayLiteralElement;
  867. out UsesLit: TJSArrayLiteral);
  868. var
  869. i: Integer;
  870. Item: TJSElement;
  871. Lit: TJSLiteral;
  872. begin
  873. UsesLit:=nil;
  874. AssertNotNull(UsesName+' uses section',Arg.Expr);
  875. if (Arg.Expr.ClassType=TJSLiteral) and TJSLiteral(Arg.Expr).Value.IsNull then
  876. exit; // null is ok
  877. AssertEquals(UsesName+' uses section param is array',TJSArrayLiteral,Arg.Expr.ClassType);
  878. FJSInterfaceUses:=TJSArrayLiteral(Arg.Expr);
  879. for i:=0 to FJSInterfaceUses.Elements.Count-1 do
  880. begin
  881. Item:=FJSInterfaceUses.Elements.Elements[i].Expr;
  882. AssertNotNull(UsesName+' uses section item['+IntToStr(i)+'].Expr',Item);
  883. AssertEquals(UsesName+' uses section item['+IntToStr(i)+'] is lit',TJSLiteral,Item.ClassType);
  884. Lit:=TJSLiteral(Item);
  885. AssertEquals(UsesName+' uses section item['+IntToStr(i)+'] is string lit',
  886. ord(jsbase.jstString),ord(Lit.Value.ValueType));
  887. end;
  888. end;
  889. procedure CheckFunctionParam(ParamName: string; Arg: TJSArrayLiteralElement;
  890. out Src: TJSSourceElements);
  891. var
  892. FunDecl: TJSFunctionDeclarationStatement;
  893. FunDef: TJSFuncDef;
  894. FunBody: TJSFunctionBody;
  895. begin
  896. Src:=nil;
  897. AssertNotNull(ParamName,Arg.Expr);
  898. AssertEquals(ParamName+' Arg.Expr type',TJSFunctionDeclarationStatement,Arg.Expr.ClassType);
  899. FunDecl:=Arg.Expr as TJSFunctionDeclarationStatement;
  900. AssertNotNull(ParamName+' FunDecl.AFunction',FunDecl.AFunction);
  901. AssertEquals(ParamName+' FunDecl.AFunction type',TJSFuncDef,FunDecl.AFunction.ClassType);
  902. FunDef:=FunDecl.AFunction as TJSFuncDef;
  903. AssertEquals(ParamName+' name empty','',String(FunDef.Name));
  904. AssertNotNull(ParamName+' body',FunDef.Body);
  905. AssertEquals(ParamName+' body type',TJSFunctionBody,FunDef.Body.ClassType);
  906. FunBody:=FunDef.Body as TJSFunctionBody;
  907. AssertNotNull(ParamName+' body.A',FunBody.A);
  908. AssertEquals(ParamName+' body.A type',TJSSourceElements,FunBody.A.ClassType);
  909. Src:=FunBody.A as TJSSourceElements;
  910. end;
  911. var
  912. ModuleNameExpr: TJSLiteral;
  913. InitFunction: TJSFunctionDeclarationStatement;
  914. InitAssign: TJSSimpleAssignStatement;
  915. InitName: String;
  916. LastNode: TJSElement;
  917. Arg: TJSArrayLiteralElement;
  918. begin
  919. if SkipTests then exit;
  920. try
  921. FJSModule:=FConverter.ConvertPasElement(Module,Engine) as TJSSourceElements;
  922. except
  923. on E: Exception do
  924. HandleException(E);
  925. end;
  926. if SkipTests then exit;
  927. if ExpectedErrorClass<>nil then
  928. Fail('Missing '+ExpectedErrorClass.ClassName+' error {'+ExpectedErrorMsg+'} ('+IntToStr(ExpectedErrorNumber)+')');
  929. FJSSource:=TStringList.Create;
  930. FJSSource.Text:=ConvertJSModuleToString(JSModule);
  931. {$IFDEF VerbosePas2JS}
  932. writeln('TTestModule.ConvertModule JS:');
  933. write(FJSSource.Text);
  934. {$ENDIF}
  935. // rtl.module(...
  936. AssertEquals('jsmodule has one statement - the call',1,JSModule.Statements.Count);
  937. AssertNotNull('register module call',JSModule.Statements.Nodes[0].Node);
  938. AssertEquals('register module call',TJSCallExpression,JSModule.Statements.Nodes[0].Node.ClassType);
  939. FJSRegModuleCall:=JSModule.Statements.Nodes[0].Node as TJSCallExpression;
  940. AssertNotNull('register module rtl.module expr',JSRegModuleCall.Expr);
  941. AssertNotNull('register module rtl.module args',JSRegModuleCall.Args);
  942. AssertEquals('rtl.module args',TJSArguments,JSRegModuleCall.Args.ClassType);
  943. FJSModuleCallArgs:=JSRegModuleCall.Args as TJSArguments;
  944. // parameter 'unitname'
  945. if JSModuleCallArgs.Elements.Count<1 then
  946. Fail('rtl.module first param unit missing');
  947. Arg:=JSModuleCallArgs.Elements.Elements[0];
  948. AssertNotNull('module name param',Arg.Expr);
  949. ModuleNameExpr:=Arg.Expr as TJSLiteral;
  950. AssertEquals('module name param is string',ord(jstString),ord(ModuleNameExpr.Value.ValueType));
  951. if Module is TPasProgram then
  952. AssertEquals('module name','program',String(ModuleNameExpr.Value.AsString))
  953. else
  954. AssertEquals('module name',Module.Name,String(ModuleNameExpr.Value.AsString));
  955. // main uses section
  956. if JSModuleCallArgs.Elements.Count<2 then
  957. Fail('rtl.module second param main uses missing');
  958. Arg:=JSModuleCallArgs.Elements.Elements[1];
  959. CheckUsesList('interface',Arg,FJSInterfaceUses);
  960. // program/library/interface function()
  961. if JSModuleCallArgs.Elements.Count<3 then
  962. Fail('rtl.module third param intf-function missing');
  963. Arg:=JSModuleCallArgs.Elements.Elements[2];
  964. CheckFunctionParam('module intf-function',Arg,FJSModuleSrc);
  965. // search for $mod.$init or $mod.$main - the last statement
  966. if Module is TPasProgram then
  967. begin
  968. InitName:='$main';
  969. AssertEquals('$mod.'+InitName+' function 1',true,JSModuleSrc.Statements.Count>0);
  970. end
  971. else
  972. InitName:='$init';
  973. FJSInitBody:=nil;
  974. if JSModuleSrc.Statements.Count>0 then
  975. begin
  976. LastNode:=JSModuleSrc.Statements.Nodes[JSModuleSrc.Statements.Count-1].Node;
  977. if LastNode is TJSSimpleAssignStatement then
  978. begin
  979. InitAssign:=LastNode as TJSSimpleAssignStatement;
  980. if GetDottedIdentifier(InitAssign.LHS)='$mod.'+InitName then
  981. begin
  982. InitFunction:=InitAssign.Expr as TJSFunctionDeclarationStatement;
  983. FJSInitBody:=InitFunction.AFunction.Body as TJSFunctionBody;
  984. end
  985. else if Module is TPasProgram then
  986. CheckDottedIdentifier('init function',InitAssign.LHS,'$mod.'+InitName);
  987. end;
  988. end;
  989. // optional: implementation uses section
  990. if JSModuleCallArgs.Elements.Count<4 then
  991. exit;
  992. Arg:=JSModuleCallArgs.Elements.Elements[3];
  993. CheckUsesList('implementation',Arg,FJSImplentationUses);
  994. // optional: implementation function()
  995. if JSModuleCallArgs.Elements.Count<5 then
  996. exit;
  997. Arg:=JSModuleCallArgs.Elements.Elements[4];
  998. CheckFunctionParam('module impl-function',Arg,FJSImplementationSrc);
  999. end;
  1000. procedure TCustomTestModule.ConvertProgram;
  1001. begin
  1002. Add('end.');
  1003. ParseProgram;
  1004. ConvertModule;
  1005. end;
  1006. procedure TCustomTestModule.ConvertUnit;
  1007. begin
  1008. Add('end.');
  1009. ParseUnit;
  1010. ConvertModule;
  1011. end;
  1012. function TCustomTestModule.ConvertJSModuleToString(El: TJSElement): string;
  1013. begin
  1014. Result:=tcmodules.JSToStr(El);
  1015. end;
  1016. procedure TCustomTestModule.CheckDottedIdentifier(Msg: string; El: TJSElement;
  1017. DottedName: string);
  1018. begin
  1019. if DottedName='' then
  1020. begin
  1021. AssertNull(Msg,El);
  1022. end
  1023. else
  1024. begin
  1025. AssertNotNull(Msg,El);
  1026. AssertEquals(Msg,DottedName,GetDottedIdentifier(El));
  1027. end;
  1028. end;
  1029. function TCustomTestModule.GetDottedIdentifier(El: TJSElement): string;
  1030. begin
  1031. if El=nil then
  1032. Result:=''
  1033. else if El is TJSPrimaryExpressionIdent then
  1034. Result:=String(TJSPrimaryExpressionIdent(El).Name)
  1035. else if El is TJSDotMemberExpression then
  1036. Result:=GetDottedIdentifier(TJSDotMemberExpression(El).MExpr)+'.'+String(TJSDotMemberExpression(El).Name)
  1037. else
  1038. AssertEquals('GetDottedIdentifier',TJSPrimaryExpressionIdent,El.ClassType);
  1039. end;
  1040. procedure TCustomTestModule.CheckSource(Msg, Statements: String;
  1041. InitStatements: string; ImplStatements: string);
  1042. var
  1043. ActualSrc, ExpectedSrc, InitName: String;
  1044. begin
  1045. ActualSrc:=JSToStr(JSModuleSrc);
  1046. ExpectedSrc:=
  1047. 'var $mod = this;'+LineEnding
  1048. +Statements;
  1049. if coUseStrict in Converter.Options then
  1050. ExpectedSrc:='"use strict";'+LineEnding+ExpectedSrc;
  1051. if Module is TPasProgram then
  1052. InitName:='$main'
  1053. else
  1054. InitName:='$init';
  1055. if (Module is TPasProgram) or (Trim(InitStatements)<>'') then
  1056. ExpectedSrc:=ExpectedSrc+LineEnding
  1057. +'$mod.'+InitName+' = function () {'+LineEnding
  1058. +InitStatements
  1059. +'};'+LineEnding;
  1060. //writeln('TCustomTestModule.CheckSource ExpectedIntf="',ExpectedSrc,'"');
  1061. //writeln('TTestModule.CheckSource InitStatements="',Trim(InitStatements),'"');
  1062. CheckDiff(Msg,ExpectedSrc,ActualSrc);
  1063. if (JSImplementationSrc<>nil) then
  1064. begin
  1065. ActualSrc:=JSToStr(JSImplementationSrc);
  1066. ExpectedSrc:=
  1067. 'var $mod = this;'+LineEnding
  1068. +'var $impl = $mod.$impl;'+LineEnding
  1069. +ImplStatements;
  1070. end
  1071. else
  1072. begin
  1073. ActualSrc:='';
  1074. ExpectedSrc:=ImplStatements;
  1075. end;
  1076. //writeln('TTestModule.CheckSource InitStatements="',InitStatements,'"');
  1077. CheckDiff(Msg,ExpectedSrc,ActualSrc);
  1078. end;
  1079. procedure TCustomTestModule.CheckDiff(Msg, Expected, Actual: string);
  1080. // search diff, ignore changes in spaces
  1081. const
  1082. SpaceChars = [#9,#10,#13,' '];
  1083. var
  1084. ExpectedP, ActualP: PChar;
  1085. function FindLineEnd(p: PChar): PChar;
  1086. begin
  1087. Result:=p;
  1088. while not (Result^ in [#0,#10,#13]) do inc(Result);
  1089. end;
  1090. function FindLineStart(p, MinP: PChar): PChar;
  1091. begin
  1092. while (p>MinP) and not (p[-1] in [#10,#13]) do dec(p);
  1093. Result:=p;
  1094. end;
  1095. procedure DiffFound;
  1096. var
  1097. ActLineStartP, ActLineEndP, p, StartPos: PChar;
  1098. ExpLine, ActLine: String;
  1099. i: Integer;
  1100. begin
  1101. writeln('Diff found "',Msg,'". Lines:');
  1102. // write correct lines
  1103. p:=PChar(Expected);
  1104. repeat
  1105. StartPos:=p;
  1106. while not (p^ in [#0,#10,#13]) do inc(p);
  1107. ExpLine:=copy(Expected,StartPos-PChar(Expected)+1,p-StartPos);
  1108. if p^ in [#10,#13] then begin
  1109. if (p[1] in [#10,#13]) and (p^<>p[1]) then
  1110. inc(p,2)
  1111. else
  1112. inc(p);
  1113. end;
  1114. if (p<=ExpectedP) and (p^<>#0) then begin
  1115. writeln('= ',ExpLine);
  1116. end else begin
  1117. // diff line
  1118. // write actual line
  1119. ActLineStartP:=FindLineStart(ActualP,PChar(Actual));
  1120. ActLineEndP:=FindLineEnd(ActualP);
  1121. ActLine:=copy(Actual,ActLineStartP-PChar(Actual)+1,ActLineEndP-ActLineStartP);
  1122. writeln('- ',ActLine);
  1123. // write expected line
  1124. writeln('+ ',ExpLine);
  1125. // write empty line with pointer ^
  1126. for i:=1 to 2+ExpectedP-StartPos do write(' ');
  1127. writeln('^');
  1128. AssertEquals(Msg,ExpLine,ActLine);
  1129. break;
  1130. end;
  1131. until p^=#0;
  1132. writeln('DiffFound Actual:-----------------------');
  1133. writeln(Actual);
  1134. writeln('DiffFound Expected:---------------------');
  1135. writeln(Expected);
  1136. writeln('DiffFound ------------------------------');
  1137. Fail('diff found, but lines are the same, internal error');
  1138. end;
  1139. var
  1140. IsSpaceNeeded: Boolean;
  1141. LastChar: Char;
  1142. begin
  1143. if Expected='' then Expected:=' ';
  1144. if Actual='' then Actual:=' ';
  1145. ExpectedP:=PChar(Expected);
  1146. ActualP:=PChar(Actual);
  1147. repeat
  1148. //writeln('TTestModule.CheckDiff Exp="',ExpectedP^,'" Act="',ActualP^,'"');
  1149. case ExpectedP^ of
  1150. #0:
  1151. begin
  1152. // check that rest of Actual has only spaces
  1153. while ActualP^ in SpaceChars do inc(ActualP);
  1154. if ActualP^<>#0 then
  1155. DiffFound;
  1156. exit;
  1157. end;
  1158. ' ',#9,#10,#13:
  1159. begin
  1160. // skip space in Expected
  1161. IsSpaceNeeded:=false;
  1162. if ExpectedP>PChar(Expected) then
  1163. LastChar:=ExpectedP[-1]
  1164. else
  1165. LastChar:=#0;
  1166. while ExpectedP^ in SpaceChars do inc(ExpectedP);
  1167. if (LastChar in ['a'..'z','A'..'Z','0'..'9','_','$'])
  1168. and (ExpectedP^ in ['a'..'z','A'..'Z','0'..'9','_','$']) then
  1169. IsSpaceNeeded:=true;
  1170. if IsSpaceNeeded and (not (ActualP^ in SpaceChars)) then
  1171. DiffFound;
  1172. while ActualP^ in SpaceChars do inc(ActualP);
  1173. end;
  1174. else
  1175. while ActualP^ in SpaceChars do inc(ActualP);
  1176. if ExpectedP^<>ActualP^ then
  1177. DiffFound;
  1178. inc(ExpectedP);
  1179. inc(ActualP);
  1180. end;
  1181. until false;
  1182. end;
  1183. procedure TCustomTestModule.CheckUnit(Filename, ExpectedSrc: string);
  1184. var
  1185. aResolver: TTestEnginePasResolver;
  1186. aConverter: TPasToJSConverter;
  1187. aJSModule: TJSSourceElements;
  1188. ActualSrc: String;
  1189. begin
  1190. aResolver:=GetResolver(Filename);
  1191. AssertNotNull('missing resolver of unit '+Filename,aResolver);
  1192. {$IFDEF VerbosePas2JS}
  1193. writeln('CheckUnit '+Filename+' converting ...');
  1194. {$ENDIF}
  1195. aConverter:=CreateConverter;
  1196. try
  1197. try
  1198. aJSModule:=aConverter.ConvertPasElement(aResolver.Module,aResolver) as TJSSourceElements;
  1199. except
  1200. on E: Exception do
  1201. HandleException(E);
  1202. end;
  1203. ActualSrc:=ConvertJSModuleToString(aJSModule);
  1204. {$IFDEF VerbosePas2JS}
  1205. writeln('TTestModule.CheckUnit ',Filename,' Pas:');
  1206. write(aResolver.Source);
  1207. writeln('TTestModule.CheckUnit ',Filename,' JS:');
  1208. write(ActualSrc);
  1209. {$ENDIF}
  1210. CheckDiff('Converted unit: "'+ChangeFileExt(Filename,'.js')+'"',ExpectedSrc,ActualSrc);
  1211. finally
  1212. aConverter.Free;
  1213. end;
  1214. end;
  1215. procedure TCustomTestModule.SetExpectedScannerError(Msg: string;
  1216. MsgNumber: integer);
  1217. begin
  1218. ExpectedErrorClass:=EScannerError;
  1219. ExpectedErrorMsg:=Msg;
  1220. ExpectedErrorNumber:=MsgNumber;
  1221. end;
  1222. procedure TCustomTestModule.SetExpectedParserError(Msg: string;
  1223. MsgNumber: integer);
  1224. begin
  1225. ExpectedErrorClass:=EParserError;
  1226. ExpectedErrorMsg:=Msg;
  1227. ExpectedErrorNumber:=MsgNumber;
  1228. end;
  1229. procedure TCustomTestModule.SetExpectedPasResolverError(Msg: string;
  1230. MsgNumber: integer);
  1231. begin
  1232. ExpectedErrorClass:=EPasResolve;
  1233. ExpectedErrorMsg:=Msg;
  1234. ExpectedErrorNumber:=MsgNumber;
  1235. end;
  1236. procedure TCustomTestModule.SetExpectedConverterError(Msg: string;
  1237. MsgNumber: integer);
  1238. begin
  1239. ExpectedErrorClass:=EPas2JS;
  1240. ExpectedErrorMsg:=Msg;
  1241. ExpectedErrorNumber:=MsgNumber;
  1242. end;
  1243. function TCustomTestModule.IsErrorExpected(E: Exception): boolean;
  1244. var
  1245. MsgNumber: Integer;
  1246. Msg: String;
  1247. begin
  1248. Result:=false;
  1249. if (ExpectedErrorClass=nil) or (ExpectedErrorClass<>E.ClassType) then exit;
  1250. Msg:=E.Message;
  1251. if E is EPas2JS then
  1252. MsgNumber:=EPas2JS(E).MsgNumber
  1253. else if E is EPasResolve then
  1254. MsgNumber:=EPasResolve(E).MsgNumber
  1255. else if E is EParserError then
  1256. MsgNumber:=Parser.LastMsgNumber
  1257. else if E is EScannerError then
  1258. begin
  1259. MsgNumber:=Scanner.LastMsgNumber;
  1260. Msg:=Scanner.LastMsg;
  1261. end
  1262. else
  1263. MsgNumber:=0;
  1264. Result:=(MsgNumber=ExpectedErrorNumber) and (Msg=ExpectedErrorMsg);
  1265. if Result then
  1266. SkipTests:=true;
  1267. end;
  1268. procedure TCustomTestModule.HandleScannerError(E: EScannerError);
  1269. begin
  1270. if IsErrorExpected(E) then exit;
  1271. WriteSources(Scanner.CurFilename,Scanner.CurRow,Scanner.CurColumn);
  1272. writeln('ERROR: TCustomTestModule.HandleScannerError '+E.ClassName+':'+E.Message
  1273. +' '+Scanner.CurFilename
  1274. +'('+IntToStr(Scanner.CurRow)+','+IntToStr(Scanner.CurColumn)+')');
  1275. RaiseException(E);
  1276. end;
  1277. procedure TCustomTestModule.HandleParserError(E: EParserError);
  1278. begin
  1279. if IsErrorExpected(E) then exit;
  1280. WriteSources(E.Filename,E.Row,E.Column);
  1281. writeln('ERROR: TCustomTestModule.HandleParserError '+E.ClassName+':'+E.Message
  1282. +' '+E.Filename+'('+IntToStr(E.Row)+','+IntToStr(E.Column)+')'
  1283. +' MainModuleScannerLine="'+Scanner.CurLine+'"'
  1284. );
  1285. RaiseException(E);
  1286. end;
  1287. procedure TCustomTestModule.HandlePasResolveError(E: EPasResolve);
  1288. var
  1289. P: TPasSourcePos;
  1290. begin
  1291. if IsErrorExpected(E) then exit;
  1292. P:=E.SourcePos;
  1293. WriteSources(P.FileName,P.Row,P.Column);
  1294. writeln('ERROR: TCustomTestModule.HandlePasResolveError '+E.ClassName+':'+E.Message
  1295. +' '+P.FileName+'('+IntToStr(P.Row)+','+IntToStr(P.Column)+')');
  1296. RaiseException(E);
  1297. end;
  1298. procedure TCustomTestModule.HandlePas2JSError(E: EPas2JS);
  1299. var
  1300. Row, Col: integer;
  1301. begin
  1302. if IsErrorExpected(E) then exit;
  1303. Engine.UnmangleSourceLineNumber(E.PasElement.SourceLinenumber,Row,Col);
  1304. WriteSources(E.PasElement.SourceFilename,Row,Col);
  1305. writeln('ERROR: TCustomTestModule.HandlePas2JSError '+E.ClassName+':'+E.Message
  1306. +' '+E.PasElement.SourceFilename
  1307. +'('+IntToStr(Row)+','+IntToStr(Col)+')');
  1308. RaiseException(E);
  1309. end;
  1310. procedure TCustomTestModule.HandleException(E: Exception);
  1311. begin
  1312. if E is EScannerError then
  1313. HandleScannerError(EScannerError(E))
  1314. else if E is EParserError then
  1315. HandleParserError(EParserError(E))
  1316. else if E is EPasResolve then
  1317. HandlePasResolveError(EPasResolve(E))
  1318. else if E is EPas2JS then
  1319. HandlePas2JSError(EPas2JS(E))
  1320. else
  1321. begin
  1322. if IsErrorExpected(E) then exit;
  1323. if not (E is EAssertionFailedError) then
  1324. begin
  1325. WriteSources('',0,0);
  1326. writeln('ERROR: TCustomTestModule.HandleException '+E.ClassName+':'+E.Message);
  1327. end;
  1328. RaiseException(E);
  1329. end;
  1330. end;
  1331. procedure TCustomTestModule.RaiseException(E: Exception);
  1332. var
  1333. MsgNumber: Integer;
  1334. begin
  1335. if ExpectedErrorClass<>nil then begin
  1336. if FExpectedErrorClass=E.ClassType then begin
  1337. if E is EPas2JS then
  1338. MsgNumber:=EPas2JS(E).MsgNumber
  1339. else if E is EPasResolve then
  1340. MsgNumber:=EPasResolve(E).MsgNumber
  1341. else if E is EParserError then
  1342. MsgNumber:=Parser.LastMsgNumber
  1343. else if E is EScannerError then
  1344. MsgNumber:=Scanner.LastMsgNumber
  1345. else
  1346. MsgNumber:=0;
  1347. AssertEquals('Expected error message ('+IntToStr(ExpectedErrorNumber)+')','{'+ExpectedErrorMsg+'}','{'+E.Message+'}');
  1348. AssertEquals('Expected {'+ExpectedErrorMsg+'}, but got msg {'+E.Message+'} number',
  1349. ExpectedErrorNumber,MsgNumber);
  1350. end else begin
  1351. AssertEquals('Wrong exception class',ExpectedErrorClass.ClassName,E.ClassName);
  1352. end;
  1353. end;
  1354. Fail(E.Message);
  1355. end;
  1356. procedure TCustomTestModule.WriteSources(const aFilename: string; aRow,
  1357. aCol: integer);
  1358. var
  1359. IsSrc: Boolean;
  1360. i, j: Integer;
  1361. SrcLines: TStringList;
  1362. Line: string;
  1363. aModule: TTestEnginePasResolver;
  1364. begin
  1365. writeln('TCustomTestModule.WriteSources File="',aFilename,'" Row=',aRow,' Col=',aCol);
  1366. for i:=0 to ResolverCount-1 do
  1367. begin
  1368. aModule:=Resolvers[i];
  1369. SrcLines:=TStringList.Create;
  1370. try
  1371. SrcLines.Text:=aModule.Source;
  1372. IsSrc:=ExtractFilename(aModule.Filename)=ExtractFileName(aFilename);
  1373. writeln('Testcode:-File="',aModule.Filename,'"----------------------------------:');
  1374. for j:=1 to SrcLines.Count do
  1375. begin
  1376. Line:=SrcLines[j-1];
  1377. if IsSrc and (j=aRow) then
  1378. begin
  1379. write('*');
  1380. Line:=LeftStr(Line,aCol-1)+'|'+copy(Line,aCol,length(Line));
  1381. end;
  1382. writeln(Format('%:4d: ',[j]),Line);
  1383. end;
  1384. finally
  1385. SrcLines.Free;
  1386. end;
  1387. end;
  1388. end;
  1389. function TCustomTestModule.IndexOfResolver(const Filename: string): integer;
  1390. var
  1391. i: Integer;
  1392. begin
  1393. for i:=0 to ResolverCount-1 do
  1394. if Filename=Resolvers[i].Filename then exit(i);
  1395. Result:=-1;
  1396. end;
  1397. function TCustomTestModule.GetResolver(const Filename: string
  1398. ): TTestEnginePasResolver;
  1399. var
  1400. i: Integer;
  1401. begin
  1402. i:=IndexOfResolver(Filename);
  1403. if i<0 then exit(nil);
  1404. Result:=Resolvers[i];
  1405. end;
  1406. function TCustomTestModule.GetDefaultNamespace: string;
  1407. var
  1408. C: TClass;
  1409. begin
  1410. Result:='';
  1411. if FModule=nil then exit;
  1412. C:=FModule.ClassType;
  1413. if (C=TPasProgram) or (C=TPasLibrary) or (C=TPasPackage) then
  1414. Result:=Engine.DefaultNameSpace;
  1415. end;
  1416. { TTestModule }
  1417. procedure TTestModule.TestEmptyProgram;
  1418. begin
  1419. StartProgram(false);
  1420. Add('begin');
  1421. ConvertProgram;
  1422. CheckSource('TestEmptyProgram','','');
  1423. end;
  1424. procedure TTestModule.TestEmptyProgramUseStrict;
  1425. begin
  1426. Converter.Options:=Converter.Options+[coUseStrict];
  1427. StartProgram(false);
  1428. Add('begin');
  1429. ConvertProgram;
  1430. CheckSource('TestEmptyProgramUseStrict','','');
  1431. end;
  1432. procedure TTestModule.TestEmptyUnit;
  1433. begin
  1434. StartUnit(false);
  1435. Add('interface');
  1436. Add('implementation');
  1437. ConvertUnit;
  1438. CheckSource('TestEmptyUnit',
  1439. LinesToStr([
  1440. ]),
  1441. '');
  1442. end;
  1443. procedure TTestModule.TestEmptyUnitUseStrict;
  1444. begin
  1445. Converter.Options:=Converter.Options+[coUseStrict];
  1446. StartUnit(false);
  1447. Add('interface');
  1448. Add('implementation');
  1449. ConvertUnit;
  1450. CheckSource('TestEmptyUnitUseStrict',
  1451. LinesToStr([
  1452. ''
  1453. ]),
  1454. '');
  1455. end;
  1456. procedure TTestModule.TestDottedUnitNames;
  1457. begin
  1458. AddModuleWithIntfImplSrc('NS1.Unit2.pas',
  1459. LinesToStr([
  1460. 'var iV: longint;'
  1461. ]),
  1462. '');
  1463. FFilename:='ns1.test1.pp';
  1464. StartProgram(true);
  1465. Add('uses unIt2;');
  1466. Add('implementation');
  1467. Add('var');
  1468. Add(' i: longint;');
  1469. Add('begin');
  1470. Add(' i:=iv;');
  1471. Add(' i:=uNit2.iv;');
  1472. Add(' i:=Ns1.TEst1.i;');
  1473. ConvertProgram;
  1474. CheckSource('TestDottedUnitNames',
  1475. LinesToStr([
  1476. 'this.i = 0;',
  1477. '']),
  1478. LinesToStr([ // this.$init
  1479. '$mod.i = pas["NS1.Unit2"].iV;',
  1480. '$mod.i = pas["NS1.Unit2"].iV;',
  1481. '$mod.i = $mod.i;',
  1482. '']) );
  1483. end;
  1484. procedure TTestModule.TestDottedUnitNameImpl;
  1485. begin
  1486. AddModuleWithIntfImplSrc('TEST.UnitA.pas',
  1487. LinesToStr([
  1488. 'type',
  1489. ' TObject = class end;',
  1490. ' TTestA = class',
  1491. ' end;'
  1492. ]),
  1493. LinesToStr(['uses TEST.UnitB;'])
  1494. );
  1495. AddModuleWithIntfImplSrc('TEST.UnitB.pas',
  1496. LinesToStr([
  1497. 'uses TEST.UnitA;',
  1498. 'type TTestB = class(TTestA);'
  1499. ]),
  1500. ''
  1501. );
  1502. StartProgram(true);
  1503. Add('uses TEST.UnitA;');
  1504. Add('begin');
  1505. ConvertProgram;
  1506. CheckSource('TestDottedUnitNameImpl',
  1507. LinesToStr([
  1508. '']),
  1509. LinesToStr([ // this.$init
  1510. '']) );
  1511. CheckUnit('TEST.UnitA.pas',
  1512. LinesToStr([
  1513. 'rtl.module("TEST.UnitA", ["system"], function () {',
  1514. ' var $mod = this;',
  1515. ' rtl.createClass($mod, "TObject", null, function () {',
  1516. ' this.$init = function () {',
  1517. ' };',
  1518. ' this.$final = function () {',
  1519. ' };',
  1520. ' });',
  1521. ' rtl.createClass($mod, "TTestA", $mod.TObject, function () {',
  1522. ' });',
  1523. '}, ["TEST.UnitB"]);'
  1524. ]));
  1525. CheckUnit('TEST.UnitB.pas',
  1526. LinesToStr([
  1527. 'rtl.module("TEST.UnitB", ["system","TEST.UnitA"], function () {',
  1528. ' var $mod = this;',
  1529. ' rtl.createClass($mod, "TTestB", pas["TEST.UnitA"].TTestA, function () {',
  1530. ' });',
  1531. '});'
  1532. ]));
  1533. end;
  1534. procedure TTestModule.TestDottedUnitExpr;
  1535. begin
  1536. AddModuleWithIntfImplSrc('NS2.SubNs2.Unit2.pas',
  1537. LinesToStr([
  1538. 'procedure DoIt;'
  1539. ]),
  1540. 'procedure DoIt; begin end;');
  1541. FFilename:='Ns1.SubNs1.Test1.pp';
  1542. StartProgram(true);
  1543. Add('uses Ns2.sUbnS2.unIt2;');
  1544. Add('implementation');
  1545. Add('var');
  1546. Add(' i: longint;');
  1547. Add('begin');
  1548. Add(' ns2.subns2.unit2.doit;');
  1549. Add(' i:=Ns1.SubNS1.TEst1.i;');
  1550. ConvertProgram;
  1551. CheckSource('TestDottedUnitExpr',
  1552. LinesToStr([
  1553. 'this.i = 0;',
  1554. '']),
  1555. LinesToStr([ // this.$init
  1556. 'pas["NS2.SubNs2.Unit2"].DoIt();',
  1557. '$mod.i = $mod.i;',
  1558. '']) );
  1559. end;
  1560. procedure TTestModule.Test_ModeFPCFail;
  1561. begin
  1562. StartProgram(false);
  1563. Add('{$mode FPC}');
  1564. Add('begin');
  1565. SetExpectedScannerError('Invalid mode: "FPC"',nErrInvalidMode);
  1566. ConvertProgram;
  1567. end;
  1568. procedure TTestModule.Test_ModeSwitchCBlocksFail;
  1569. begin
  1570. StartProgram(false);
  1571. Add('{$modeswitch cblocks-}');
  1572. Add('begin');
  1573. SetExpectedScannerError('Invalid mode switch: "cblocks-"',nErrInvalidModeSwitch);
  1574. ConvertProgram;
  1575. end;
  1576. procedure TTestModule.TestUnit_Intf1Impl2Intf1;
  1577. begin
  1578. AddModuleWithIntfImplSrc('unit1.pp',
  1579. LinesToStr([
  1580. 'type number = longint;']),
  1581. LinesToStr([
  1582. 'uses test1;',
  1583. 'procedure DoIt;',
  1584. 'begin',
  1585. ' i:=3;',
  1586. 'end;']));
  1587. StartUnit(true);
  1588. Add([
  1589. 'interface',
  1590. 'uses unit1;',
  1591. 'var i: number;',
  1592. 'implementation']);
  1593. ConvertUnit;
  1594. CheckSource('TestUnit_Intf1Impl2Intf1',
  1595. LinesToStr([
  1596. 'this.i = 0;',
  1597. '']),
  1598. LinesToStr([
  1599. '']) );
  1600. end;
  1601. procedure TTestModule.TestVarInt;
  1602. begin
  1603. StartProgram(false);
  1604. Add('var MyI: longint;');
  1605. Add('begin');
  1606. ConvertProgram;
  1607. CheckSource('TestVarInt','this.MyI=0;','');
  1608. end;
  1609. procedure TTestModule.TestVarBaseTypes;
  1610. begin
  1611. StartProgram(false);
  1612. Add('var');
  1613. Add(' i: longint;');
  1614. Add(' s: string;');
  1615. Add(' c: char;');
  1616. Add(' b: boolean;');
  1617. Add(' d: double;');
  1618. Add(' i2: longint = 3;');
  1619. Add(' s2: string = ''foo'';');
  1620. Add(' c2: char = ''4'';');
  1621. Add(' b2: boolean = true;');
  1622. Add(' d2: double = 5.6;');
  1623. Add(' i3: longint = $707;');
  1624. Add(' i4: nativeint = 4503599627370495;');
  1625. Add(' i5: nativeint = -4503599627370496;');
  1626. Add(' i6: nativeint = $fffffffffffff;');
  1627. Add(' i7: nativeint = -$10000000000000;');
  1628. Add(' u8: nativeuint = $fffffffffffff;');
  1629. Add(' u9: nativeuint = $0000000000000;');
  1630. Add('begin');
  1631. ConvertProgram;
  1632. CheckSource('TestVarBaseTypes',
  1633. LinesToStr([
  1634. 'this.i=0;',
  1635. 'this.s="";',
  1636. 'this.c="";',
  1637. 'this.b=false;',
  1638. 'this.d=0.0;',
  1639. 'this.i2=3;',
  1640. 'this.s2="foo";',
  1641. 'this.c2="4";',
  1642. 'this.b2=true;',
  1643. 'this.d2=5.6;',
  1644. 'this.i3=0x707;',
  1645. 'this.i4= 4503599627370495;',
  1646. 'this.i5= -4503599627370496;',
  1647. 'this.i6= 0xfffffffffffff;',
  1648. 'this.i7=-0x10000000000000;',
  1649. 'this.u8= 0xfffffffffffff;',
  1650. 'this.u9= 0x0000000000000;'
  1651. ]),
  1652. '');
  1653. end;
  1654. procedure TTestModule.TestBaseTypeSingleFail;
  1655. begin
  1656. StartProgram(false);
  1657. Add('var s: single;');
  1658. SetExpectedPasResolverError('identifier not found "single"',PasResolveEval.nIdentifierNotFound);
  1659. ConvertProgram;
  1660. end;
  1661. procedure TTestModule.TestBaseTypeExtendedFail;
  1662. begin
  1663. StartProgram(false);
  1664. Add('var e: extended;');
  1665. SetExpectedPasResolverError('identifier not found "extended"',PasResolveEval.nIdentifierNotFound);
  1666. ConvertProgram;
  1667. end;
  1668. procedure TTestModule.TestConstBaseTypes;
  1669. begin
  1670. StartProgram(false);
  1671. Add('const');
  1672. Add(' i: longint = 3;');
  1673. Add(' s: string = ''foo'';');
  1674. Add(' c: char = ''4'';');
  1675. Add(' b: boolean = true;');
  1676. Add(' d: double = 5.6;');
  1677. Add(' e = low(word);');
  1678. Add(' f = high(word);');
  1679. Add('begin');
  1680. ConvertProgram;
  1681. CheckSource('TestVarBaseTypes',
  1682. LinesToStr([
  1683. 'this.i=3;',
  1684. 'this.s="foo";',
  1685. 'this.c="4";',
  1686. 'this.b=true;',
  1687. 'this.d=5.6;',
  1688. 'this.e = 0;',
  1689. 'this.f = 65535;'
  1690. ]),
  1691. '');
  1692. end;
  1693. procedure TTestModule.TestAliasTypeRef;
  1694. begin
  1695. StartProgram(false);
  1696. Add('type');
  1697. Add(' a=longint;');
  1698. Add(' b=a;');
  1699. Add('var');
  1700. Add(' c: A;');
  1701. Add(' d: B;');
  1702. Add('begin');
  1703. ConvertProgram;
  1704. CheckSource('TestAliasTypeRef',
  1705. LinesToStr([ // statements
  1706. 'this.c = 0;',
  1707. 'this.d = 0;'
  1708. ]),
  1709. LinesToStr([ // this.$main
  1710. ''
  1711. ]));
  1712. end;
  1713. procedure TTestModule.TestTypeCast_BaseTypes;
  1714. begin
  1715. StartProgram(false);
  1716. Add('var');
  1717. Add(' i: longint;');
  1718. Add(' b: boolean;');
  1719. Add(' d: double;');
  1720. Add(' s: string;');
  1721. Add(' c: char;');
  1722. Add('begin');
  1723. Add(' i:=longint(i);');
  1724. Add(' i:=longint(b);');
  1725. Add(' b:=boolean(b);');
  1726. Add(' b:=boolean(i);');
  1727. Add(' d:=double(d);');
  1728. Add(' d:=double(i);');
  1729. Add(' s:=string(s);');
  1730. Add(' s:=string(c);');
  1731. Add(' c:=char(c);');
  1732. ConvertProgram;
  1733. CheckSource('TestAliasTypeRef',
  1734. LinesToStr([ // statements
  1735. 'this.i = 0;',
  1736. 'this.b = false;',
  1737. 'this.d = 0.0;',
  1738. 'this.s = "";',
  1739. 'this.c = "";',
  1740. '']),
  1741. LinesToStr([ // this.$main
  1742. '$mod.i = $mod.i;',
  1743. '$mod.i = ($mod.b ? 1 : 0);',
  1744. '$mod.b = $mod.b;',
  1745. '$mod.b = $mod.i != 0;',
  1746. '$mod.d = $mod.d;',
  1747. '$mod.d = $mod.i;',
  1748. '$mod.s = $mod.s;',
  1749. '$mod.s = $mod.c;',
  1750. '$mod.c = $mod.c;',
  1751. '']));
  1752. end;
  1753. procedure TTestModule.TestTypeCast_AliasBaseTypes;
  1754. begin
  1755. StartProgram(false);
  1756. Add('type');
  1757. Add(' integer = longint;');
  1758. Add(' TYesNo = boolean;');
  1759. Add(' TFloat = double;');
  1760. Add(' TCaption = string;');
  1761. Add(' TChar = char;');
  1762. Add('var');
  1763. Add(' i: integer;');
  1764. Add(' b: TYesNo;');
  1765. Add(' d: TFloat;');
  1766. Add(' s: TCaption;');
  1767. Add(' c: TChar;');
  1768. Add('begin');
  1769. Add(' i:=integer(i);');
  1770. Add(' i:=integer(b);');
  1771. Add(' b:=TYesNo(b);');
  1772. Add(' b:=TYesNo(i);');
  1773. Add(' d:=TFloat(d);');
  1774. Add(' d:=TFloat(i);');
  1775. Add(' s:=TCaption(s);');
  1776. Add(' s:=TCaption(c);');
  1777. Add(' c:=TChar(c);');
  1778. ConvertProgram;
  1779. CheckSource('TestAliasTypeRef',
  1780. LinesToStr([ // statements
  1781. 'this.i = 0;',
  1782. 'this.b = false;',
  1783. 'this.d = 0.0;',
  1784. 'this.s = "";',
  1785. 'this.c = "";',
  1786. '']),
  1787. LinesToStr([ // this.$main
  1788. '$mod.i = $mod.i;',
  1789. '$mod.i = ($mod.b ? 1 : 0);',
  1790. '$mod.b = $mod.b;',
  1791. '$mod.b = $mod.i != 0;',
  1792. '$mod.d = $mod.d;',
  1793. '$mod.d = $mod.i;',
  1794. '$mod.s = $mod.s;',
  1795. '$mod.s = $mod.c;',
  1796. '$mod.c = $mod.c;',
  1797. '']));
  1798. end;
  1799. procedure TTestModule.TestEmptyProc;
  1800. begin
  1801. StartProgram(false);
  1802. Add('procedure Test;');
  1803. Add('begin');
  1804. Add('end;');
  1805. Add('begin');
  1806. ConvertProgram;
  1807. CheckSource('TestEmptyProc',
  1808. LinesToStr([ // statements
  1809. 'this.Test = function () {',
  1810. '};'
  1811. ]),
  1812. LinesToStr([ // this.$main
  1813. ''
  1814. ]));
  1815. end;
  1816. procedure TTestModule.TestProcOneParam;
  1817. begin
  1818. StartProgram(false);
  1819. Add('procedure ProcA(i: longint);');
  1820. Add('begin');
  1821. Add('end;');
  1822. Add('begin');
  1823. Add(' PROCA(3);');
  1824. ConvertProgram;
  1825. CheckSource('TestProcOneParam',
  1826. LinesToStr([ // statements
  1827. 'this.ProcA = function (i) {',
  1828. '};'
  1829. ]),
  1830. LinesToStr([ // this.$main
  1831. '$mod.ProcA(3);'
  1832. ]));
  1833. end;
  1834. procedure TTestModule.TestFunctionWithoutParams;
  1835. begin
  1836. StartProgram(false);
  1837. Add('function FuncA: longint;');
  1838. Add('begin');
  1839. Add('end;');
  1840. Add('var i: longint;');
  1841. Add('begin');
  1842. Add(' I:=FUNCA();');
  1843. Add(' I:=FUNCA;');
  1844. Add(' FUNCA();');
  1845. Add(' FUNCA;');
  1846. ConvertProgram;
  1847. CheckSource('TestProcWithoutParams',
  1848. LinesToStr([ // statements
  1849. 'this.FuncA = function () {',
  1850. ' var Result = 0;',
  1851. ' return Result;',
  1852. '};',
  1853. 'this.i=0;'
  1854. ]),
  1855. LinesToStr([ // this.$main
  1856. '$mod.i=$mod.FuncA();',
  1857. '$mod.i=$mod.FuncA();',
  1858. '$mod.FuncA();',
  1859. '$mod.FuncA();'
  1860. ]));
  1861. end;
  1862. procedure TTestModule.TestProcedureWithoutParams;
  1863. begin
  1864. StartProgram(false);
  1865. Add('procedure ProcA;');
  1866. Add('begin');
  1867. Add('end;');
  1868. Add('begin');
  1869. Add(' PROCA();');
  1870. Add(' PROCA;');
  1871. ConvertProgram;
  1872. CheckSource('TestProcWithoutParams',
  1873. LinesToStr([ // statements
  1874. 'this.ProcA = function () {',
  1875. '};'
  1876. ]),
  1877. LinesToStr([ // this.$main
  1878. '$mod.ProcA();',
  1879. '$mod.ProcA();'
  1880. ]));
  1881. end;
  1882. procedure TTestModule.TestIncDec;
  1883. begin
  1884. StartProgram(false);
  1885. Add([
  1886. 'procedure DoIt(var i: longint);',
  1887. 'begin',
  1888. ' inc(i);',
  1889. ' inc(i,2);',
  1890. 'end;',
  1891. 'var',
  1892. ' Bar: longint;',
  1893. 'begin',
  1894. ' inc(bar);',
  1895. ' inc(bar,2);',
  1896. ' dec(bar);',
  1897. ' dec(bar,3);',
  1898. '']);
  1899. ConvertProgram;
  1900. CheckSource('TestIncDec',
  1901. LinesToStr([ // statements
  1902. 'this.DoIt = function (i) {',
  1903. ' i.set(i.get()+1);',
  1904. ' i.set(i.get()+2);',
  1905. '};',
  1906. 'this.Bar = 0;'
  1907. ]),
  1908. LinesToStr([ // this.$main
  1909. '$mod.Bar+=1;',
  1910. '$mod.Bar+=2;',
  1911. '$mod.Bar-=1;',
  1912. '$mod.Bar-=3;'
  1913. ]));
  1914. end;
  1915. procedure TTestModule.TestAssignments;
  1916. begin
  1917. StartProgram(false);
  1918. Parser.Options:=Parser.Options+[po_cassignments];
  1919. Add('var');
  1920. Add(' Bar:longint;');
  1921. Add('begin');
  1922. Add(' bar:=3;');
  1923. Add(' bar+=4;');
  1924. Add(' bar-=5;');
  1925. Add(' bar*=6;');
  1926. ConvertProgram;
  1927. CheckSource('TestAssignments',
  1928. LinesToStr([ // statements
  1929. 'this.Bar = 0;'
  1930. ]),
  1931. LinesToStr([ // this.$main
  1932. '$mod.Bar=3;',
  1933. '$mod.Bar+=4;',
  1934. '$mod.Bar-=5;',
  1935. '$mod.Bar*=6;'
  1936. ]));
  1937. end;
  1938. procedure TTestModule.TestArithmeticOperators1;
  1939. begin
  1940. StartProgram(false);
  1941. Add('var');
  1942. Add(' vA,vB,vC:longint;');
  1943. Add('begin');
  1944. Add(' va:=1;');
  1945. Add(' vb:=va+va;');
  1946. Add(' vb:=va div vb;');
  1947. Add(' vb:=va mod vb;');
  1948. Add(' vb:=va+va*vb+va div vb;');
  1949. Add(' vc:=-va;');
  1950. Add(' va:=va-vb;');
  1951. Add(' vb:=va;');
  1952. Add(' if va<vb then vc:=va else vc:=vb;');
  1953. ConvertProgram;
  1954. CheckSource('TestArithmeticOperators1',
  1955. LinesToStr([ // statements
  1956. 'this.vA = 0;',
  1957. 'this.vB = 0;',
  1958. 'this.vC = 0;'
  1959. ]),
  1960. LinesToStr([ // this.$main
  1961. '$mod.vA = 1;',
  1962. '$mod.vB = $mod.vA + $mod.vA;',
  1963. '$mod.vB = Math.floor($mod.vA / $mod.vB);',
  1964. '$mod.vB = $mod.vA % $mod.vB;',
  1965. '$mod.vB = ($mod.vA + ($mod.vA * $mod.vB)) + Math.floor($mod.vA / $mod.vB);',
  1966. '$mod.vC = -$mod.vA;',
  1967. '$mod.vA = $mod.vA - $mod.vB;',
  1968. '$mod.vB = $mod.vA;',
  1969. 'if ($mod.vA < $mod.vB){ $mod.vC = $mod.vA } else $mod.vC = $mod.vB;'
  1970. ]));
  1971. end;
  1972. procedure TTestModule.TestLogicalOperators;
  1973. begin
  1974. StartProgram(false);
  1975. Add('var');
  1976. Add(' vA,vB,vC:boolean;');
  1977. Add('begin');
  1978. Add(' va:=vb and vc;');
  1979. Add(' va:=vb or vc;');
  1980. Add(' va:=vb xor vc;');
  1981. Add(' va:=true and vc;');
  1982. Add(' va:=(vb and vc) or (va and vb);');
  1983. Add(' va:=not vb;');
  1984. ConvertProgram;
  1985. CheckSource('TestLogicalOperators',
  1986. LinesToStr([ // statements
  1987. 'this.vA = false;',
  1988. 'this.vB = false;',
  1989. 'this.vC = false;'
  1990. ]),
  1991. LinesToStr([ // this.$main
  1992. '$mod.vA = $mod.vB && $mod.vC;',
  1993. '$mod.vA = $mod.vB || $mod.vC;',
  1994. '$mod.vA = $mod.vB ^ $mod.vC;',
  1995. '$mod.vA = true && $mod.vC;',
  1996. '$mod.vA = ($mod.vB && $mod.vC) || ($mod.vA && $mod.vB);',
  1997. '$mod.vA = !$mod.vB;'
  1998. ]));
  1999. end;
  2000. procedure TTestModule.TestBitwiseOperators;
  2001. begin
  2002. StartProgram(false);
  2003. Add('var');
  2004. Add(' vA,vB,vC:longint;');
  2005. Add('begin');
  2006. Add(' va:=vb and vc;');
  2007. Add(' va:=vb or vc;');
  2008. Add(' va:=vb xor vc;');
  2009. Add(' va:=vb shl vc;');
  2010. Add(' va:=vb shr vc;');
  2011. Add(' va:=3 and vc;');
  2012. Add(' va:=(vb and vc) or (va and vb);');
  2013. Add(' va:=not vb;');
  2014. ConvertProgram;
  2015. CheckSource('TestBitwiseOperators',
  2016. LinesToStr([ // statements
  2017. 'this.vA = 0;',
  2018. 'this.vB = 0;',
  2019. 'this.vC = 0;'
  2020. ]),
  2021. LinesToStr([ // this.$main
  2022. '$mod.vA = $mod.vB & $mod.vC;',
  2023. '$mod.vA = $mod.vB | $mod.vC;',
  2024. '$mod.vA = $mod.vB ^ $mod.vC;',
  2025. '$mod.vA = $mod.vB << $mod.vC;',
  2026. '$mod.vA = $mod.vB >>> $mod.vC;',
  2027. '$mod.vA = 3 & $mod.vC;',
  2028. '$mod.vA = ($mod.vB & $mod.vC) | ($mod.vA & $mod.vB);',
  2029. '$mod.vA = ~$mod.vB;'
  2030. ]));
  2031. end;
  2032. procedure TTestModule.TestPrgProcVar;
  2033. begin
  2034. StartProgram(false);
  2035. Add('procedure Proc1;');
  2036. Add('type');
  2037. Add(' t1=longint;');
  2038. Add('var');
  2039. Add(' vA:t1;');
  2040. Add('begin');
  2041. Add('end;');
  2042. Add('begin');
  2043. ConvertProgram;
  2044. CheckSource('TestPrgProcVar',
  2045. LinesToStr([ // statements
  2046. 'this.Proc1 = function () {',
  2047. ' var vA=0;',
  2048. '};'
  2049. ]),
  2050. LinesToStr([ // this.$main
  2051. ''
  2052. ]));
  2053. end;
  2054. procedure TTestModule.TestUnitProcVar;
  2055. begin
  2056. StartUnit(false);
  2057. Add('interface');
  2058. Add('');
  2059. Add('type tA=string; // unit scope');
  2060. Add('procedure Proc1;');
  2061. Add('');
  2062. Add('implementation');
  2063. Add('');
  2064. Add('procedure Proc1;');
  2065. Add('type tA=longint; // local proc scope');
  2066. Add('var v1:tA; // using local tA');
  2067. Add('begin');
  2068. Add('end;');
  2069. Add('var v2:tA; // using interface tA');
  2070. ConvertUnit;
  2071. CheckSource('TestUnitProcVar',
  2072. LinesToStr([ // statements
  2073. 'var $impl = $mod.$impl;',
  2074. 'this.Proc1 = function () {',
  2075. ' var v1 = 0;',
  2076. '};',
  2077. '']),
  2078. // this.$init
  2079. '',
  2080. // implementation
  2081. LinesToStr([
  2082. '$impl.v2 = "";',
  2083. '']));
  2084. end;
  2085. procedure TTestModule.TestImplProc;
  2086. begin
  2087. StartUnit(false);
  2088. Add('interface');
  2089. Add('');
  2090. Add('procedure Proc1;');
  2091. Add('');
  2092. Add('implementation');
  2093. Add('');
  2094. Add('procedure Proc1; begin end;');
  2095. Add('procedure Proc2; begin end;');
  2096. Add('initialization');
  2097. Add(' Proc1;');
  2098. Add(' Proc2;');
  2099. ConvertUnit;
  2100. CheckSource('TestImplProc',
  2101. LinesToStr([ // statements
  2102. 'var $impl = $mod.$impl;',
  2103. 'this.Proc1 = function () {',
  2104. '};',
  2105. '']),
  2106. LinesToStr([ // this.$init
  2107. '$mod.Proc1();',
  2108. '$impl.Proc2();',
  2109. '']),
  2110. LinesToStr([ // implementation
  2111. '$impl.Proc2 = function () {',
  2112. '};',
  2113. ''])
  2114. );
  2115. end;
  2116. procedure TTestModule.TestFunctionResult;
  2117. begin
  2118. StartProgram(false);
  2119. Add('function Func1: longint;');
  2120. Add('begin');
  2121. Add(' Result:=3;');
  2122. Add(' Func1:=4;');
  2123. Add('end;');
  2124. Add('begin');
  2125. ConvertProgram;
  2126. CheckSource('TestFunctionResult',
  2127. LinesToStr([ // statements
  2128. 'this.Func1 = function () {',
  2129. ' var Result = 0;',
  2130. ' Result = 3;',
  2131. ' Result = 4;',
  2132. ' return Result;',
  2133. '};'
  2134. ]),
  2135. '');
  2136. end;
  2137. procedure TTestModule.TestNestedProc;
  2138. begin
  2139. StartProgram(false);
  2140. Add([
  2141. 'var vInUnit: longint;',
  2142. 'function DoIt(pA,pD: longint): longint;',
  2143. 'var',
  2144. ' vB: longint;',
  2145. ' vC: longint;',
  2146. ' function Nesty(pA: longint): longint; ',
  2147. ' var vB: longint;',
  2148. ' begin',
  2149. ' Result:=pa+vb+vc+pd+vInUnit;',
  2150. ' nesty:=3;',
  2151. ' doit:=4;',
  2152. ' exit;',
  2153. ' end;',
  2154. 'begin',
  2155. ' Result:=pa+vb+vc;',
  2156. ' doit:=6;',
  2157. ' exit;',
  2158. 'end;',
  2159. 'begin']);
  2160. ConvertProgram;
  2161. CheckSource('TestNestedProc',
  2162. LinesToStr([ // statements
  2163. 'this.vInUnit = 0;',
  2164. 'this.DoIt = function (pA, pD) {',
  2165. ' var Result = 0;',
  2166. ' var vB = 0;',
  2167. ' var vC = 0;',
  2168. ' function Nesty(pA) {',
  2169. ' var Result$1 = 0;',
  2170. ' var vB = 0;',
  2171. ' Result$1 = (((pA + vB) + vC) + pD) + $mod.vInUnit;',
  2172. ' Result$1 = 3;',
  2173. ' Result = 4;',
  2174. ' return Result$1;',
  2175. ' return Result$1;',
  2176. ' };',
  2177. ' Result = (pA + vB) + vC;',
  2178. ' Result = 6;',
  2179. ' return Result;',
  2180. ' return Result;',
  2181. '};'
  2182. ]),
  2183. '');
  2184. end;
  2185. procedure TTestModule.TestForwardProc;
  2186. begin
  2187. StartProgram(false);
  2188. Add('procedure FuncA(Bar: longint); forward;');
  2189. Add('procedure FuncB(Bar: longint);');
  2190. Add('begin');
  2191. Add(' funca(bar);');
  2192. Add('end;');
  2193. Add('procedure funca(bar: longint);');
  2194. Add('begin');
  2195. Add(' if bar=3 then ;');
  2196. Add('end;');
  2197. Add('begin');
  2198. Add(' funca(4);');
  2199. Add(' funcb(5);');
  2200. ConvertProgram;
  2201. CheckSource('TestForwardProc',
  2202. LinesToStr([ // statements'
  2203. 'this.FuncB = function (Bar) {',
  2204. ' $mod.FuncA(Bar);',
  2205. '};',
  2206. 'this.FuncA = function (Bar) {',
  2207. ' if (Bar === 3);',
  2208. '};'
  2209. ]),
  2210. LinesToStr([
  2211. '$mod.FuncA(4);',
  2212. '$mod.FuncB(5);'
  2213. ])
  2214. );
  2215. end;
  2216. procedure TTestModule.TestNestedForwardProc;
  2217. begin
  2218. StartProgram(false);
  2219. Add('procedure FuncA;');
  2220. Add(' procedure FuncB(i: longint); forward;');
  2221. Add(' procedure FuncC(i: longint);');
  2222. Add(' begin');
  2223. Add(' funcb(i);');
  2224. Add(' end;');
  2225. Add(' procedure FuncB(i: longint);');
  2226. Add(' begin');
  2227. Add(' if i=3 then ;');
  2228. Add(' end;');
  2229. Add('begin');
  2230. Add(' funcc(4)');
  2231. Add('end;');
  2232. Add('begin');
  2233. Add(' funca;');
  2234. ConvertProgram;
  2235. CheckSource('TestNestedForwardProc',
  2236. LinesToStr([ // statements'
  2237. 'this.FuncA = function () {',
  2238. ' function FuncC(i) {',
  2239. ' FuncB(i);',
  2240. ' };',
  2241. ' function FuncB(i) {',
  2242. ' if (i === 3);',
  2243. ' };',
  2244. ' FuncC(4);',
  2245. '};'
  2246. ]),
  2247. LinesToStr([
  2248. '$mod.FuncA();'
  2249. ])
  2250. );
  2251. end;
  2252. procedure TTestModule.TestAssignFunctionResult;
  2253. begin
  2254. StartProgram(false);
  2255. Add('function Func1: longint;');
  2256. Add('begin');
  2257. Add('end;');
  2258. Add('var i: longint;');
  2259. Add('begin');
  2260. Add(' i:=func1();');
  2261. Add(' i:=func1()+func1();');
  2262. ConvertProgram;
  2263. CheckSource('TestAssignFunctionResult',
  2264. LinesToStr([ // statements
  2265. 'this.Func1 = function () {',
  2266. ' var Result = 0;',
  2267. ' return Result;',
  2268. '};',
  2269. 'this.i = 0;'
  2270. ]),
  2271. LinesToStr([
  2272. '$mod.i = $mod.Func1();',
  2273. '$mod.i = $mod.Func1() + $mod.Func1();'
  2274. ]));
  2275. end;
  2276. procedure TTestModule.TestFunctionResultInCondition;
  2277. begin
  2278. StartProgram(false);
  2279. Add('function Func1: longint;');
  2280. Add('begin');
  2281. Add('end;');
  2282. Add('function Func2: boolean;');
  2283. Add('begin');
  2284. Add('end;');
  2285. Add('var i: longint;');
  2286. Add('begin');
  2287. Add(' if func2 then ;');
  2288. Add(' if i=func1() then ;');
  2289. Add(' if i=func1 then ;');
  2290. ConvertProgram;
  2291. CheckSource('TestFunctionResultInCondition',
  2292. LinesToStr([ // statements
  2293. 'this.Func1 = function () {',
  2294. ' var Result = 0;',
  2295. ' return Result;',
  2296. '};',
  2297. 'this.Func2 = function () {',
  2298. ' var Result = false;',
  2299. ' return Result;',
  2300. '};',
  2301. 'this.i = 0;'
  2302. ]),
  2303. LinesToStr([
  2304. 'if ($mod.Func2());',
  2305. 'if ($mod.i === $mod.Func1());',
  2306. 'if ($mod.i === $mod.Func1());'
  2307. ]));
  2308. end;
  2309. procedure TTestModule.TestExit;
  2310. begin
  2311. StartProgram(false);
  2312. Add('procedure ProcA;');
  2313. Add('begin');
  2314. Add(' exit;');
  2315. Add('end;');
  2316. Add('function FuncB: longint;');
  2317. Add('begin');
  2318. Add(' exit;');
  2319. Add(' exit(3);');
  2320. Add('end;');
  2321. Add('function FuncC: string;');
  2322. Add('begin');
  2323. Add(' exit;');
  2324. Add(' exit(''a'');');
  2325. Add(' exit(''abc'');');
  2326. Add('end;');
  2327. Add('begin');
  2328. Add(' exit;');
  2329. Add(' exit(1);');
  2330. ConvertProgram;
  2331. CheckSource('TestExit',
  2332. LinesToStr([ // statements
  2333. 'this.ProcA = function () {',
  2334. ' return;',
  2335. '};',
  2336. 'this.FuncB = function () {',
  2337. ' var Result = 0;',
  2338. ' return Result;',
  2339. ' return 3;',
  2340. ' return Result;',
  2341. '};',
  2342. 'this.FuncC = function () {',
  2343. ' var Result = "";',
  2344. ' return Result;',
  2345. ' return "a";',
  2346. ' return "abc";',
  2347. ' return Result;',
  2348. '};'
  2349. ]),
  2350. LinesToStr([
  2351. 'return;',
  2352. 'return 1;',
  2353. '']));
  2354. end;
  2355. procedure TTestModule.TestBreak;
  2356. begin
  2357. StartProgram(false);
  2358. Add('var i: longint;');
  2359. Add('begin');
  2360. Add(' repeat');
  2361. Add(' break;');
  2362. Add(' until true;');
  2363. Add(' while true do');
  2364. Add(' break;');
  2365. Add(' for i:=1 to 2 do');
  2366. Add(' break;');
  2367. ConvertProgram;
  2368. CheckSource('TestBreak',
  2369. LinesToStr([ // statements
  2370. 'this.i = 0;'
  2371. ]),
  2372. LinesToStr([
  2373. 'do {',
  2374. ' break;',
  2375. '} while (!true);',
  2376. 'while (true) break;',
  2377. 'for ($mod.i = 1; $mod.i <= 2; $mod.i++) break;',
  2378. '']));
  2379. end;
  2380. procedure TTestModule.TestContinue;
  2381. begin
  2382. StartProgram(false);
  2383. Add('var i: longint;');
  2384. Add('begin');
  2385. Add(' repeat');
  2386. Add(' continue;');
  2387. Add(' until true;');
  2388. Add(' while true do');
  2389. Add(' continue;');
  2390. Add(' for i:=1 to 2 do');
  2391. Add(' continue;');
  2392. ConvertProgram;
  2393. CheckSource('TestContinue',
  2394. LinesToStr([ // statements
  2395. 'this.i = 0;'
  2396. ]),
  2397. LinesToStr([
  2398. 'do {',
  2399. ' continue;',
  2400. '} while (!true);',
  2401. 'while (true) continue;',
  2402. 'for ($mod.i = 1; $mod.i <= 2; $mod.i++) continue;',
  2403. '']));
  2404. end;
  2405. procedure TTestModule.TestProc_External;
  2406. begin
  2407. StartProgram(false);
  2408. Add('procedure Foo; external name ''console.log'';');
  2409. Add('function Bar: longint; external name ''get.item'';');
  2410. Add('function Bla(s: string): longint; external name ''apply.something'';');
  2411. Add('var');
  2412. Add(' i: longint;');
  2413. Add('begin');
  2414. Add(' Foo;');
  2415. Add(' i:=Bar;');
  2416. Add(' i:=Bla(''abc'');');
  2417. ConvertProgram;
  2418. CheckSource('TestProcedureExternal',
  2419. LinesToStr([ // statements
  2420. 'this.i = 0;'
  2421. ]),
  2422. LinesToStr([
  2423. 'console.log();',
  2424. '$mod.i = get.item();',
  2425. '$mod.i = apply.something("abc");'
  2426. ]));
  2427. end;
  2428. procedure TTestModule.TestProc_ExternalOtherUnit;
  2429. begin
  2430. AddModuleWithIntfImplSrc('unit2.pas',
  2431. LinesToStr([
  2432. 'procedure Now; external name ''Date.now'';',
  2433. 'procedure DoIt;'
  2434. ]),
  2435. 'procedure doit; begin end;');
  2436. StartUnit(true);
  2437. Add('interface');
  2438. Add('uses unit2;');
  2439. Add('implementation');
  2440. Add('begin');
  2441. Add(' now;');
  2442. Add(' now();');
  2443. Add(' uNit2.now;');
  2444. Add(' uNit2.now();');
  2445. Add(' doit;');
  2446. Add(' uNit2.doit;');
  2447. ConvertUnit;
  2448. CheckSource('TestProcedureExternalOtherUnit',
  2449. LinesToStr([
  2450. '']),
  2451. LinesToStr([
  2452. 'Date.now();',
  2453. 'Date.now();',
  2454. 'Date.now();',
  2455. 'Date.now();',
  2456. 'pas.unit2.DoIt();',
  2457. 'pas.unit2.DoIt();',
  2458. '']));
  2459. end;
  2460. procedure TTestModule.TestProc_Asm;
  2461. begin
  2462. StartProgram(false);
  2463. Add([
  2464. 'function DoIt: longint;',
  2465. 'begin;',
  2466. ' asm',
  2467. ' { a:{ b:{}, c:[]}, d:''1'' };',
  2468. ' end;',
  2469. ' asm console.log(); end;',
  2470. 'end;',
  2471. 'begin']);
  2472. ConvertProgram;
  2473. CheckSource('TestProcedureAsm',
  2474. LinesToStr([ // statements
  2475. 'this.DoIt = function () {',
  2476. ' var Result = 0;',
  2477. ' { a:{ b:{}, c:[]}, d:''1'' };',
  2478. ' console.log();',
  2479. ' return Result;',
  2480. '};'
  2481. ]),
  2482. LinesToStr([
  2483. ''
  2484. ]));
  2485. end;
  2486. procedure TTestModule.TestProc_Assembler;
  2487. begin
  2488. StartProgram(false);
  2489. Add('function DoIt: longint; assembler;');
  2490. Add('asm');
  2491. Add('{ a:{ b:{}, c:[]}, d:''1'' };');
  2492. Add('end;');
  2493. Add('begin');
  2494. ConvertProgram;
  2495. CheckSource('TestProcedureAssembler',
  2496. LinesToStr([ // statements
  2497. 'this.DoIt = function () {',
  2498. ' { a:{ b:{}, c:[]}, d:''1'' };',
  2499. '};'
  2500. ]),
  2501. LinesToStr([
  2502. ''
  2503. ]));
  2504. end;
  2505. procedure TTestModule.TestProc_VarParam;
  2506. begin
  2507. StartProgram(false);
  2508. Add('type integer = longint;');
  2509. Add('procedure DoIt(vG: integer; const vH: integer; var vI: integer);');
  2510. Add('var vJ: integer;');
  2511. Add('begin');
  2512. Add(' vg:=vg+1;');
  2513. Add(' vj:=vh+2;');
  2514. Add(' vi:=vi+3;');
  2515. Add(' doit(vg,vg,vg);');
  2516. Add(' doit(vh,vh,vj);');
  2517. Add(' doit(vi,vi,vi);');
  2518. Add(' doit(vj,vj,vj);');
  2519. Add('end;');
  2520. Add('var i: integer;');
  2521. Add('begin');
  2522. Add(' doit(i,i,i);');
  2523. ConvertProgram;
  2524. CheckSource('TestProcedure_VarParam',
  2525. LinesToStr([ // statements
  2526. 'this.DoIt = function (vG,vH,vI) {',
  2527. ' var vJ = 0;',
  2528. ' vG = vG + 1;',
  2529. ' vJ = vH + 2;',
  2530. ' vI.set(vI.get()+3);',
  2531. ' $mod.DoIt(vG, vG, {',
  2532. ' get: function () {',
  2533. ' return vG;',
  2534. ' },',
  2535. ' set: function (v) {',
  2536. ' vG = v;',
  2537. ' }',
  2538. ' });',
  2539. ' $mod.DoIt(vH, vH, {',
  2540. ' get: function () {',
  2541. ' return vJ;',
  2542. ' },',
  2543. ' set: function (v) {',
  2544. ' vJ = v;',
  2545. ' }',
  2546. ' });',
  2547. ' $mod.DoIt(vI.get(), vI.get(), vI);',
  2548. ' $mod.DoIt(vJ, vJ, {',
  2549. ' get: function () {',
  2550. ' return vJ;',
  2551. ' },',
  2552. ' set: function (v) {',
  2553. ' vJ = v;',
  2554. ' }',
  2555. ' });',
  2556. '};',
  2557. 'this.i = 0;'
  2558. ]),
  2559. LinesToStr([
  2560. '$mod.DoIt($mod.i,$mod.i,{',
  2561. ' p: $mod,',
  2562. ' get: function () {',
  2563. ' return this.p.i;',
  2564. ' },',
  2565. ' set: function (v) {',
  2566. ' this.p.i = v;',
  2567. ' }',
  2568. '});'
  2569. ]));
  2570. end;
  2571. procedure TTestModule.TestProc_Overload;
  2572. begin
  2573. StartProgram(false);
  2574. Add('procedure DoIt(vI: longint); begin end;');
  2575. Add('procedure DoIt(vI, vJ: longint); begin end;');
  2576. Add('procedure DoIt(vD: double); begin end;');
  2577. Add('begin');
  2578. Add(' DoIt(1);');
  2579. Add(' DoIt(2,3);');
  2580. Add(' DoIt(4.5);');
  2581. ConvertProgram;
  2582. CheckSource('TestProcedureOverload',
  2583. LinesToStr([ // statements
  2584. 'this.DoIt = function (vI) {',
  2585. '};',
  2586. 'this.DoIt$1 = function (vI, vJ) {',
  2587. '};',
  2588. 'this.DoIt$2 = function (vD) {',
  2589. '};',
  2590. '']),
  2591. LinesToStr([
  2592. '$mod.DoIt(1);',
  2593. '$mod.DoIt$1(2, 3);',
  2594. '$mod.DoIt$2(4.5);',
  2595. '']));
  2596. end;
  2597. procedure TTestModule.TestProc_OverloadForward;
  2598. begin
  2599. StartProgram(false);
  2600. Add('procedure DoIt(vI: longint); forward;');
  2601. Add('procedure DoIt(vI, vJ: longint); begin end;');
  2602. Add('procedure doit(vi: longint); begin end;');
  2603. Add('begin');
  2604. Add(' doit(1);');
  2605. Add(' doit(2,3);');
  2606. ConvertProgram;
  2607. CheckSource('TestProcedureOverloadForward',
  2608. LinesToStr([ // statements
  2609. 'this.DoIt$1 = function (vI, vJ) {',
  2610. '};',
  2611. 'this.DoIt = function (vI) {',
  2612. '};',
  2613. '']),
  2614. LinesToStr([
  2615. '$mod.DoIt(1);',
  2616. '$mod.DoIt$1(2, 3);',
  2617. '']));
  2618. end;
  2619. procedure TTestModule.TestProc_OverloadUnit;
  2620. begin
  2621. StartUnit(false);
  2622. Add('interface');
  2623. Add('procedure DoIt(vI: longint);');
  2624. Add('procedure DoIt(vI, vJ: longint);');
  2625. Add('implementation');
  2626. Add('procedure DoIt(vI, vJ, vK, vL, vM: longint); forward;');
  2627. Add('procedure DoIt(vI, vJ, vK: longint); begin end;');
  2628. Add('procedure DoIt(vi: longint); begin end;');
  2629. Add('procedure DoIt(vI, vJ, vK, vL: longint); begin end;');
  2630. Add('procedure DoIt(vi, vj: longint); begin end;');
  2631. Add('procedure DoIt(vi, vj, vk, vl, vm: longint); begin end;');
  2632. Add('begin');
  2633. Add(' doit(1);');
  2634. Add(' doit(2,3);');
  2635. Add(' doit(4,5,6);');
  2636. Add(' doit(7,8,9,10);');
  2637. Add(' doit(11,12,13,14,15);');
  2638. ConvertUnit;
  2639. CheckSource('TestProcedureOverloadUnit',
  2640. LinesToStr([ // statements
  2641. 'var $impl = $mod.$impl;',
  2642. 'this.DoIt = function (vI) {',
  2643. '};',
  2644. 'this.DoIt$1 = function (vI, vJ) {',
  2645. '};',
  2646. '']),
  2647. LinesToStr([ // this.$init
  2648. '$mod.DoIt(1);',
  2649. '$mod.DoIt$1(2, 3);',
  2650. '$impl.DoIt$3(4,5,6);',
  2651. '$impl.DoIt$4(7,8,9,10);',
  2652. '$impl.DoIt$2(11,12,13,14,15);',
  2653. '']),
  2654. LinesToStr([ // implementation
  2655. '$impl.DoIt$3 = function (vI, vJ, vK) {',
  2656. '};',
  2657. '$impl.DoIt$4 = function (vI, vJ, vK, vL) {',
  2658. '};',
  2659. '$impl.DoIt$2 = function (vI, vJ, vK, vL, vM) {',
  2660. '};',
  2661. '']));
  2662. end;
  2663. procedure TTestModule.TestProc_OverloadNested;
  2664. begin
  2665. StartProgram(false);
  2666. Add([
  2667. 'procedure DoIt(vA: longint); overload; forward;',
  2668. 'procedure DoIt(vB, vC: longint); overload;',
  2669. 'begin // 2 param overload',
  2670. ' doit(1);',
  2671. ' doit(1,2);',
  2672. 'end;',
  2673. 'procedure doit(vA: longint);',
  2674. ' procedure DoIt(vA, vB, vC: longint); overload; forward;',
  2675. ' procedure DoIt(vA, vB, vC, vD: longint); overload;',
  2676. ' begin // 4 param overload',
  2677. ' doit(1);',
  2678. ' doit(1,2);',
  2679. ' doit(1,2,3);',
  2680. ' doit(1,2,3,4);',
  2681. ' end;',
  2682. ' procedure doit(vA, vB, vC: longint);',
  2683. ' procedure DoIt(vA, vB, vC, vD, vE: longint); overload; forward;',
  2684. ' procedure DoIt(vA, vB, vC, vD, vE, vF: longint); overload;',
  2685. ' begin // 6 param overload',
  2686. ' doit(1);',
  2687. ' doit(1,2);',
  2688. ' doit(1,2,3);',
  2689. ' doit(1,2,3,4);',
  2690. ' doit(1,2,3,4,5);',
  2691. ' doit(1,2,3,4,5,6);',
  2692. ' end;',
  2693. ' procedure doit(vA, vB, vC, vD, vE: longint);',
  2694. ' begin // 5 param overload',
  2695. ' doit(1);',
  2696. ' doit(1,2);',
  2697. ' doit(1,2,3);',
  2698. ' doit(1,2,3,4);',
  2699. ' doit(1,2,3,4,5);',
  2700. ' doit(1,2,3,4,5,6);',
  2701. ' end;',
  2702. ' begin // 3 param overload',
  2703. ' doit(1);',
  2704. ' doit(1,2);',
  2705. ' doit(1,2,3);',
  2706. ' doit(1,2,3,4);',
  2707. ' doit(1,2,3,4,5);',
  2708. ' doit(1,2,3,4,5,6);',
  2709. ' end;',
  2710. 'begin // 1 param overload',
  2711. ' doit(1);',
  2712. ' doit(1,2);',
  2713. ' doit(1,2,3);',
  2714. ' doit(1,2,3,4);',
  2715. 'end;',
  2716. 'begin // main',
  2717. ' doit(1);',
  2718. ' doit(1,2);']);
  2719. ConvertProgram;
  2720. CheckSource('TestProcedureOverloadNested',
  2721. LinesToStr([ // statements
  2722. 'this.DoIt$1 = function (vB, vC) {',
  2723. ' $mod.DoIt(1);',
  2724. ' $mod.DoIt$1(1, 2);',
  2725. '};',
  2726. 'this.DoIt = function (vA) {',
  2727. ' function DoIt$3(vA, vB, vC, vD) {',
  2728. ' $mod.DoIt(1);',
  2729. ' $mod.DoIt$1(1, 2);',
  2730. ' DoIt$2(1, 2, 3);',
  2731. ' DoIt$3(1, 2, 3, 4);',
  2732. ' };',
  2733. ' function DoIt$2(vA, vB, vC) {',
  2734. ' function DoIt$5(vA, vB, vC, vD, vE, vF) {',
  2735. ' $mod.DoIt(1);',
  2736. ' $mod.DoIt$1(1, 2);',
  2737. ' DoIt$2(1, 2, 3);',
  2738. ' DoIt$3(1, 2, 3, 4);',
  2739. ' DoIt$4(1, 2, 3, 4, 5);',
  2740. ' DoIt$5(1, 2, 3, 4, 5, 6);',
  2741. ' };',
  2742. ' function DoIt$4(vA, vB, vC, vD, vE) {',
  2743. ' $mod.DoIt(1);',
  2744. ' $mod.DoIt$1(1, 2);',
  2745. ' DoIt$2(1, 2, 3);',
  2746. ' DoIt$3(1, 2, 3, 4);',
  2747. ' DoIt$4(1, 2, 3, 4, 5);',
  2748. ' DoIt$5(1, 2, 3, 4, 5, 6);',
  2749. ' };',
  2750. ' $mod.DoIt(1);',
  2751. ' $mod.DoIt$1(1, 2);',
  2752. ' DoIt$2(1, 2, 3);',
  2753. ' DoIt$3(1, 2, 3, 4);',
  2754. ' DoIt$4(1, 2, 3, 4, 5);',
  2755. ' DoIt$5(1, 2, 3, 4, 5, 6);',
  2756. ' };',
  2757. ' $mod.DoIt(1);',
  2758. ' $mod.DoIt$1(1, 2);',
  2759. ' DoIt$2(1, 2, 3);',
  2760. ' DoIt$3(1, 2, 3, 4);',
  2761. '};',
  2762. '']),
  2763. LinesToStr([
  2764. '$mod.DoIt(1);',
  2765. '$mod.DoIt$1(1, 2);',
  2766. '']));
  2767. end;
  2768. procedure TTestModule.TestProc_Varargs;
  2769. begin
  2770. StartProgram(false);
  2771. Add('procedure ProcA(i:longint); varargs; external name ''ProcA'';');
  2772. Add('procedure ProcB; varargs; external name ''ProcB'';');
  2773. Add('procedure ProcC(i: longint = 17); varargs; external name ''ProcC'';');
  2774. Add('function GetIt: longint; begin end;');
  2775. Add('begin');
  2776. Add(' ProcA(1);');
  2777. Add(' ProcA(1,2);');
  2778. Add(' ProcA(1,2.0);');
  2779. Add(' ProcA(1,2,3);');
  2780. Add(' ProcA(1,''2'');');
  2781. Add(' ProcA(2,'''');');
  2782. Add(' ProcA(3,false);');
  2783. Add(' ProcB;');
  2784. Add(' ProcB();');
  2785. Add(' ProcB(4);');
  2786. Add(' ProcB(''foo'');');
  2787. Add(' ProcC;');
  2788. Add(' ProcC();');
  2789. Add(' ProcC(4);');
  2790. Add(' ProcC(5,''foo'');');
  2791. Add(' ProcB(GetIt);');
  2792. Add(' ProcB(GetIt());');
  2793. Add(' ProcB(GetIt,GetIt());');
  2794. ConvertProgram;
  2795. CheckSource('TestProc_Varargs',
  2796. LinesToStr([ // statements
  2797. 'this.GetIt = function () {',
  2798. ' var Result = 0;',
  2799. ' return Result;',
  2800. '};',
  2801. '']),
  2802. LinesToStr([
  2803. 'ProcA(1);',
  2804. 'ProcA(1, 2);',
  2805. 'ProcA(1, 2.0);',
  2806. 'ProcA(1, 2, 3);',
  2807. 'ProcA(1, "2");',
  2808. 'ProcA(2, "");',
  2809. 'ProcA(3, false);',
  2810. 'ProcB();',
  2811. 'ProcB();',
  2812. 'ProcB(4);',
  2813. 'ProcB("foo");',
  2814. 'ProcC(17);',
  2815. 'ProcC(17);',
  2816. 'ProcC(4);',
  2817. 'ProcC(5, "foo");',
  2818. 'ProcB($mod.GetIt());',
  2819. 'ProcB($mod.GetIt());',
  2820. 'ProcB($mod.GetIt(), $mod.GetIt());',
  2821. '']));
  2822. end;
  2823. procedure TTestModule.TestProc_ConstOrder;
  2824. begin
  2825. StartProgram(false);
  2826. Add([
  2827. 'const A = 3;',
  2828. 'const B = A+1;',
  2829. 'procedure DoIt;',
  2830. 'const C = A+1;',
  2831. 'const D = B+1;',
  2832. 'const E = D+C+B+A;',
  2833. 'begin',
  2834. 'end;',
  2835. 'begin'
  2836. ]);
  2837. ConvertProgram;
  2838. CheckSource('TestProc_ConstOrder',
  2839. LinesToStr([ // statements
  2840. 'this.A = 3;',
  2841. 'this.B = $mod.A + 1;',
  2842. 'var C = $mod.A + 1;',
  2843. 'var D = $mod.B + 1;',
  2844. 'var E = ((D + C) + $mod.B) + $mod.A;',
  2845. 'this.DoIt = function () {',
  2846. '};',
  2847. '']),
  2848. LinesToStr([
  2849. ''
  2850. ]));
  2851. end;
  2852. procedure TTestModule.TestEnum_Name;
  2853. begin
  2854. StartProgram(false);
  2855. Add('type TMyEnum = (Red, Green, Blue);');
  2856. Add('var e: TMyEnum;');
  2857. Add('var f: TMyEnum = Blue;');
  2858. Add('begin');
  2859. Add(' e:=green;');
  2860. ConvertProgram;
  2861. CheckSource('TestEnumName',
  2862. LinesToStr([ // statements
  2863. 'this.TMyEnum = {',
  2864. ' "0":"Red",',
  2865. ' Red:0,',
  2866. ' "1":"Green",',
  2867. ' Green:1,',
  2868. ' "2":"Blue",',
  2869. ' Blue:2',
  2870. ' };',
  2871. 'this.e = 0;',
  2872. 'this.f = $mod.TMyEnum.Blue;'
  2873. ]),
  2874. LinesToStr([
  2875. '$mod.e=$mod.TMyEnum.Green;'
  2876. ]));
  2877. end;
  2878. procedure TTestModule.TestEnum_Number;
  2879. begin
  2880. Converter.Options:=Converter.Options+[coEnumNumbers];
  2881. StartProgram(false);
  2882. Add('type TMyEnum = (Red, Green);');
  2883. Add('var');
  2884. Add(' e: TMyEnum;');
  2885. Add(' f: TMyEnum = Green;');
  2886. Add(' i: longint;');
  2887. Add('begin');
  2888. Add(' e:=green;');
  2889. //Add(' i:=longint(e);');
  2890. ConvertProgram;
  2891. CheckSource('TestEnumNumber',
  2892. LinesToStr([ // statements
  2893. 'this.TMyEnum = {',
  2894. ' "0":"Red",',
  2895. ' Red:0,',
  2896. ' "1":"Green",',
  2897. ' Green:1',
  2898. ' };',
  2899. 'this.e = 0;',
  2900. 'this.f = 1;',
  2901. 'this.i = 0;'
  2902. ]),
  2903. LinesToStr([
  2904. '$mod.e=1;'
  2905. //'$mod.i=$mod.e;'
  2906. ]));
  2907. end;
  2908. procedure TTestModule.TestEnum_Functions;
  2909. begin
  2910. StartProgram(false);
  2911. Add('type TMyEnum = (Red, Green);');
  2912. Add('var');
  2913. Add(' e: TMyEnum;');
  2914. Add(' i: longint;');
  2915. Add(' s: string;');
  2916. Add(' b: boolean;');
  2917. Add('begin');
  2918. Add(' i:=ord(red);');
  2919. Add(' i:=ord(green);');
  2920. Add(' i:=ord(e);');
  2921. Add(' i:=ord(b);');
  2922. Add(' e:=low(tmyenum);');
  2923. Add(' e:=low(e);');
  2924. Add(' b:=low(boolean);');
  2925. Add(' e:=high(tmyenum);');
  2926. Add(' e:=high(e);');
  2927. Add(' b:=high(boolean);');
  2928. Add(' e:=pred(green);');
  2929. Add(' e:=pred(e);');
  2930. Add(' b:=pred(b);');
  2931. Add(' e:=succ(red);');
  2932. Add(' e:=succ(e);');
  2933. Add(' b:=succ(b);');
  2934. Add(' e:=tmyenum(1);');
  2935. Add(' e:=tmyenum(i);');
  2936. Add(' s:=str(e);');
  2937. Add(' str(e,s);');
  2938. Add(' s:=str(e:3);');
  2939. Add(' e:=TMyEnum(i);');
  2940. Add(' i:=longint(e);');
  2941. ConvertProgram;
  2942. CheckSource('TestEnum_Functions',
  2943. LinesToStr([ // statements
  2944. 'this.TMyEnum = {',
  2945. ' "0":"Red",',
  2946. ' Red:0,',
  2947. ' "1":"Green",',
  2948. ' Green:1',
  2949. ' };',
  2950. 'this.e = 0;',
  2951. 'this.i = 0;',
  2952. 'this.s = "";',
  2953. 'this.b = false;',
  2954. '']),
  2955. LinesToStr([
  2956. '$mod.i=$mod.TMyEnum.Red;',
  2957. '$mod.i=$mod.TMyEnum.Green;',
  2958. '$mod.i=$mod.e;',
  2959. '$mod.i=$mod.b+0;',
  2960. '$mod.e=$mod.TMyEnum.Red;',
  2961. '$mod.e=$mod.TMyEnum.Red;',
  2962. '$mod.b=false;',
  2963. '$mod.e=$mod.TMyEnum.Green;',
  2964. '$mod.e=$mod.TMyEnum.Green;',
  2965. '$mod.b=true;',
  2966. '$mod.e=$mod.TMyEnum.Green-1;',
  2967. '$mod.e=$mod.e-1;',
  2968. '$mod.b=false;',
  2969. '$mod.e=$mod.TMyEnum.Red+1;',
  2970. '$mod.e=$mod.e+1;',
  2971. '$mod.b=true;',
  2972. '$mod.e=1;',
  2973. '$mod.e=$mod.i;',
  2974. '$mod.s = $mod.TMyEnum[$mod.e];',
  2975. '$mod.s = $mod.TMyEnum[$mod.e];',
  2976. '$mod.s = rtl.spaceLeft($mod.TMyEnum[$mod.e], 3);',
  2977. '$mod.e=$mod.i;',
  2978. '$mod.i=$mod.e;',
  2979. '']));
  2980. end;
  2981. procedure TTestModule.TestEnum_AsParams;
  2982. begin
  2983. StartProgram(false);
  2984. Add('type TEnum = (Red,Blue);');
  2985. Add('procedure DoIt(vG: TEnum; const vH: TEnum; var vI: TEnum);');
  2986. Add('var vJ: TEnum;');
  2987. Add('begin');
  2988. Add(' vg:=vg;');
  2989. Add(' vj:=vh;');
  2990. Add(' vi:=vi;');
  2991. Add(' doit(vg,vg,vg);');
  2992. Add(' doit(vh,vh,vj);');
  2993. Add(' doit(vi,vi,vi);');
  2994. Add(' doit(vj,vj,vj);');
  2995. Add('end;');
  2996. Add('var i: TEnum;');
  2997. Add('begin');
  2998. Add(' doit(i,i,i);');
  2999. ConvertProgram;
  3000. CheckSource('TestEnum_AsParams',
  3001. LinesToStr([ // statements
  3002. 'this.TEnum = {',
  3003. ' "0": "Red",',
  3004. ' Red: 0,',
  3005. ' "1": "Blue",',
  3006. ' Blue: 1',
  3007. '};',
  3008. 'this.DoIt = function (vG,vH,vI) {',
  3009. ' var vJ = 0;',
  3010. ' vG = vG;',
  3011. ' vJ = vH;',
  3012. ' vI.set(vI.get());',
  3013. ' $mod.DoIt(vG, vG, {',
  3014. ' get: function () {',
  3015. ' return vG;',
  3016. ' },',
  3017. ' set: function (v) {',
  3018. ' vG = v;',
  3019. ' }',
  3020. ' });',
  3021. ' $mod.DoIt(vH, vH, {',
  3022. ' get: function () {',
  3023. ' return vJ;',
  3024. ' },',
  3025. ' set: function (v) {',
  3026. ' vJ = v;',
  3027. ' }',
  3028. ' });',
  3029. ' $mod.DoIt(vI.get(), vI.get(), vI);',
  3030. ' $mod.DoIt(vJ, vJ, {',
  3031. ' get: function () {',
  3032. ' return vJ;',
  3033. ' },',
  3034. ' set: function (v) {',
  3035. ' vJ = v;',
  3036. ' }',
  3037. ' });',
  3038. '};',
  3039. 'this.i = 0;'
  3040. ]),
  3041. LinesToStr([
  3042. '$mod.DoIt($mod.i,$mod.i,{',
  3043. ' p: $mod,',
  3044. ' get: function () {',
  3045. ' return this.p.i;',
  3046. ' },',
  3047. ' set: function (v) {',
  3048. ' this.p.i = v;',
  3049. ' }',
  3050. '});'
  3051. ]));
  3052. end;
  3053. procedure TTestModule.TestEnumRange_Array;
  3054. begin
  3055. StartProgram(false);
  3056. Add([
  3057. 'type',
  3058. ' TEnum = (Red, Green, Blue);',
  3059. ' TEnumRg = green..blue;',
  3060. ' TArr = array[TEnumRg] of byte;',
  3061. 'var',
  3062. ' a: TArr;',
  3063. ' b: TArr = (3,4);',
  3064. 'begin',
  3065. ' a[green] := b[blue];']);
  3066. ConvertProgram;
  3067. CheckSource('TestEnumRange_Array',
  3068. LinesToStr([ // statements
  3069. 'this.TEnum = {',
  3070. ' "0": "Red",',
  3071. ' Red: 0,',
  3072. ' "1": "Green",',
  3073. ' Green: 1,',
  3074. ' "2": "Blue",',
  3075. ' Blue: 2',
  3076. '};',
  3077. 'this.a = rtl.arraySetLength(null, 0, 2);',
  3078. 'this.b = [3, 4];',
  3079. '']),
  3080. LinesToStr([
  3081. ' $mod.a[$mod.TEnum.Green - 1] = $mod.b[$mod.TEnum.Blue - 1];',
  3082. '']));
  3083. end;
  3084. procedure TTestModule.TestEnum_ForIn;
  3085. begin
  3086. StartProgram(false);
  3087. Add([
  3088. 'type',
  3089. ' TEnum = (Red, Green, Blue);',
  3090. ' TEnumRg = green..blue;',
  3091. ' TArr = array[TEnum] of byte;',
  3092. ' TArrRg = array[TEnumRg] of byte;',
  3093. 'var',
  3094. ' e: TEnum;',
  3095. ' a1: TArr = (3,4,5);',
  3096. ' a2: TArrRg = (11,12);',
  3097. ' b: byte;',
  3098. 'begin',
  3099. ' for e in TEnum do ;',
  3100. ' for e in TEnumRg do ;',
  3101. ' for e in TArr do ;',
  3102. ' for e in TArrRg do ;',
  3103. ' for b in a1 do ;',
  3104. ' for b in a2 do ;',
  3105. '']);
  3106. ConvertProgram;
  3107. CheckSource('TestEnum_ForIn',
  3108. LinesToStr([ // statements
  3109. 'this.TEnum = {',
  3110. ' "0": "Red",',
  3111. ' Red: 0,',
  3112. ' "1": "Green",',
  3113. ' Green: 1,',
  3114. ' "2": "Blue",',
  3115. ' Blue: 2',
  3116. '};',
  3117. 'this.e = 0;',
  3118. 'this.a1 = [3, 4, 5];',
  3119. 'this.a2 = [11, 12];',
  3120. 'this.b = 0;',
  3121. '']),
  3122. LinesToStr([
  3123. ' for ($mod.e = 0; $mod.e <= 2; $mod.e++) ;',
  3124. ' for ($mod.e = 1; $mod.e <= 2; $mod.e++) ;',
  3125. ' for ($mod.e = 0; $mod.e <= 2; $mod.e++) ;',
  3126. ' for ($mod.e = 1; $mod.e <= 2; $mod.e++) ;',
  3127. ' for (var $in1 = $mod.a1, $l2 = 0, $end3 = rtl.length($in1) - 1; $l2 <= $end3; $l2++) $mod.b = $in1[$l2];',
  3128. ' for (var $in4 = $mod.a2, $l5 = 0, $end6 = rtl.length($in4) - 1; $l5 <= $end6; $l5++) $mod.b = $in4[$l5];',
  3129. '']));
  3130. end;
  3131. procedure TTestModule.TestSet;
  3132. begin
  3133. StartProgram(false);
  3134. Add('type');
  3135. Add(' TColor = (Red, Green, Blue);');
  3136. Add(' TColors = set of TColor;');
  3137. Add('var');
  3138. Add(' c: TColor;');
  3139. Add(' s: TColors;');
  3140. Add(' t: TColors = [];');
  3141. Add(' u: TColors = [Red];');
  3142. Add('begin');
  3143. Add(' s:=[];');
  3144. Add(' s:=[Green];');
  3145. Add(' s:=[Green,Blue];');
  3146. Add(' s:=[Red..Blue];');
  3147. Add(' s:=[Red,Green..Blue];');
  3148. Add(' s:=[Red,c];');
  3149. Add(' s:=t;');
  3150. ConvertProgram;
  3151. CheckSource('TestEnumName',
  3152. LinesToStr([ // statements
  3153. 'this.TColor = {',
  3154. ' "0":"Red",',
  3155. ' Red:0,',
  3156. ' "1":"Green",',
  3157. ' Green:1,',
  3158. ' "2":"Blue",',
  3159. ' Blue:2',
  3160. ' };',
  3161. 'this.c = 0;',
  3162. 'this.s = {};',
  3163. 'this.t = {};',
  3164. 'this.u = rtl.createSet($mod.TColor.Red);'
  3165. ]),
  3166. LinesToStr([
  3167. '$mod.s={};',
  3168. '$mod.s=rtl.createSet($mod.TColor.Green);',
  3169. '$mod.s=rtl.createSet($mod.TColor.Green,$mod.TColor.Blue);',
  3170. '$mod.s=rtl.createSet(null,$mod.TColor.Red,$mod.TColor.Blue);',
  3171. '$mod.s=rtl.createSet($mod.TColor.Red,null,$mod.TColor.Green,$mod.TColor.Blue);',
  3172. '$mod.s=rtl.createSet($mod.TColor.Red,$mod.c);',
  3173. '$mod.s=rtl.refSet($mod.t);',
  3174. '']));
  3175. end;
  3176. procedure TTestModule.TestSet_Operators;
  3177. begin
  3178. StartProgram(false);
  3179. Add('type');
  3180. Add(' TColor = (Red, Green, Blue);');
  3181. Add(' TColors = set of tcolor;');
  3182. Add('var');
  3183. Add(' vC: TColor;');
  3184. Add(' vS: TColors;');
  3185. Add(' vT: TColors;');
  3186. Add(' vU: TColors;');
  3187. Add(' B: boolean;');
  3188. Add('begin');
  3189. Add(' include(vs,green);');
  3190. Add(' exclude(vs,vc);');
  3191. Add(' vs:=vt+vu;');
  3192. Add(' vs:=vt+[red];');
  3193. Add(' vs:=[red]+vt;');
  3194. Add(' vs:=[red]+[green];');
  3195. Add(' vs:=vt-vu;');
  3196. Add(' vs:=vt-[red];');
  3197. Add(' vs:=[red]-vt;');
  3198. Add(' vs:=[red]-[green];');
  3199. Add(' vs:=vt*vu;');
  3200. Add(' vs:=vt*[red];');
  3201. Add(' vs:=[red]*vt;');
  3202. Add(' vs:=[red]*[green];');
  3203. Add(' vs:=vt><vu;');
  3204. Add(' vs:=vt><[red];');
  3205. Add(' vs:=[red]><vt;');
  3206. Add(' vs:=[red]><[green];');
  3207. Add(' b:=vt=vu;');
  3208. Add(' b:=vt=[red];');
  3209. Add(' b:=[red]=vt;');
  3210. Add(' b:=[red]=[green];');
  3211. Add(' b:=vt<>vu;');
  3212. Add(' b:=vt<>[red];');
  3213. Add(' b:=[red]<>vt;');
  3214. Add(' b:=[red]<>[green];');
  3215. Add(' b:=vt<=vu;');
  3216. Add(' b:=vt<=[red];');
  3217. Add(' b:=[red]<=vt;');
  3218. Add(' b:=[red]<=[green];');
  3219. Add(' b:=vt>=vu;');
  3220. Add(' b:=vt>=[red];');
  3221. Add(' b:=[red]>=vt;');
  3222. Add(' b:=[red]>=[green];');
  3223. ConvertProgram;
  3224. CheckSource('TestSet_Operators',
  3225. LinesToStr([ // statements
  3226. 'this.TColor = {',
  3227. ' "0":"Red",',
  3228. ' Red:0,',
  3229. ' "1":"Green",',
  3230. ' Green:1,',
  3231. ' "2":"Blue",',
  3232. ' Blue:2',
  3233. ' };',
  3234. 'this.vC = 0;',
  3235. 'this.vS = {};',
  3236. 'this.vT = {};',
  3237. 'this.vU = {};',
  3238. 'this.B = false;'
  3239. ]),
  3240. LinesToStr([
  3241. '$mod.vS = rtl.includeSet($mod.vS,$mod.TColor.Green);',
  3242. '$mod.vS = rtl.excludeSet($mod.vS,$mod.vC);',
  3243. '$mod.vS = rtl.unionSet($mod.vT, $mod.vU);',
  3244. '$mod.vS = rtl.unionSet($mod.vT, rtl.createSet($mod.TColor.Red));',
  3245. '$mod.vS = rtl.unionSet(rtl.createSet($mod.TColor.Red), $mod.vT);',
  3246. '$mod.vS = rtl.unionSet(rtl.createSet($mod.TColor.Red), rtl.createSet($mod.TColor.Green));',
  3247. '$mod.vS = rtl.diffSet($mod.vT, $mod.vU);',
  3248. '$mod.vS = rtl.diffSet($mod.vT, rtl.createSet($mod.TColor.Red));',
  3249. '$mod.vS = rtl.diffSet(rtl.createSet($mod.TColor.Red), $mod.vT);',
  3250. '$mod.vS = rtl.diffSet(rtl.createSet($mod.TColor.Red), rtl.createSet($mod.TColor.Green));',
  3251. '$mod.vS = rtl.intersectSet($mod.vT, $mod.vU);',
  3252. '$mod.vS = rtl.intersectSet($mod.vT, rtl.createSet($mod.TColor.Red));',
  3253. '$mod.vS = rtl.intersectSet(rtl.createSet($mod.TColor.Red), $mod.vT);',
  3254. '$mod.vS = rtl.intersectSet(rtl.createSet($mod.TColor.Red), rtl.createSet($mod.TColor.Green));',
  3255. '$mod.vS = rtl.symDiffSet($mod.vT, $mod.vU);',
  3256. '$mod.vS = rtl.symDiffSet($mod.vT, rtl.createSet($mod.TColor.Red));',
  3257. '$mod.vS = rtl.symDiffSet(rtl.createSet($mod.TColor.Red), $mod.vT);',
  3258. '$mod.vS = rtl.symDiffSet(rtl.createSet($mod.TColor.Red), rtl.createSet($mod.TColor.Green));',
  3259. '$mod.B = rtl.eqSet($mod.vT, $mod.vU);',
  3260. '$mod.B = rtl.eqSet($mod.vT, rtl.createSet($mod.TColor.Red));',
  3261. '$mod.B = rtl.eqSet(rtl.createSet($mod.TColor.Red), $mod.vT);',
  3262. '$mod.B = rtl.eqSet(rtl.createSet($mod.TColor.Red), rtl.createSet($mod.TColor.Green));',
  3263. '$mod.B = rtl.neSet($mod.vT, $mod.vU);',
  3264. '$mod.B = rtl.neSet($mod.vT, rtl.createSet($mod.TColor.Red));',
  3265. '$mod.B = rtl.neSet(rtl.createSet($mod.TColor.Red), $mod.vT);',
  3266. '$mod.B = rtl.neSet(rtl.createSet($mod.TColor.Red), rtl.createSet($mod.TColor.Green));',
  3267. '$mod.B = rtl.leSet($mod.vT, $mod.vU);',
  3268. '$mod.B = rtl.leSet($mod.vT, rtl.createSet($mod.TColor.Red));',
  3269. '$mod.B = rtl.leSet(rtl.createSet($mod.TColor.Red), $mod.vT);',
  3270. '$mod.B = rtl.leSet(rtl.createSet($mod.TColor.Red), rtl.createSet($mod.TColor.Green));',
  3271. '$mod.B = rtl.geSet($mod.vT, $mod.vU);',
  3272. '$mod.B = rtl.geSet($mod.vT, rtl.createSet($mod.TColor.Red));',
  3273. '$mod.B = rtl.geSet(rtl.createSet($mod.TColor.Red), $mod.vT);',
  3274. '$mod.B = rtl.geSet(rtl.createSet($mod.TColor.Red), rtl.createSet($mod.TColor.Green));',
  3275. '']));
  3276. end;
  3277. procedure TTestModule.TestSet_Operator_In;
  3278. begin
  3279. StartProgram(false);
  3280. Add('type');
  3281. Add(' TColor = (Red, Green, Blue);');
  3282. Add(' TColors = set of tcolor;');
  3283. Add('var');
  3284. Add(' vC: tcolor;');
  3285. Add(' vT: tcolors;');
  3286. Add(' B: boolean;');
  3287. Add('begin');
  3288. Add(' b:=red in vt;');
  3289. Add(' b:=vc in vt;');
  3290. Add(' b:=green in [red..blue];');
  3291. Add(' b:=vc in [red..blue];');
  3292. Add(' ');
  3293. Add(' if red in vt then ;');
  3294. Add(' while vC in vt do ;');
  3295. Add(' repeat');
  3296. Add(' until vC in vt;');
  3297. ConvertProgram;
  3298. CheckSource('TestSet_Operator_In',
  3299. LinesToStr([ // statements
  3300. 'this.TColor = {',
  3301. ' "0":"Red",',
  3302. ' Red:0,',
  3303. ' "1":"Green",',
  3304. ' Green:1,',
  3305. ' "2":"Blue",',
  3306. ' Blue:2',
  3307. ' };',
  3308. 'this.vC = 0;',
  3309. 'this.vT = {};',
  3310. 'this.B = false;'
  3311. ]),
  3312. LinesToStr([
  3313. '$mod.B = $mod.TColor.Red in $mod.vT;',
  3314. '$mod.B = $mod.vC in $mod.vT;',
  3315. '$mod.B = $mod.TColor.Green in rtl.createSet(null, $mod.TColor.Red, $mod.TColor.Blue);',
  3316. '$mod.B = $mod.vC in rtl.createSet(null, $mod.TColor.Red, $mod.TColor.Blue);',
  3317. 'if ($mod.TColor.Red in $mod.vT) ;',
  3318. 'while ($mod.vC in $mod.vT) {',
  3319. '};',
  3320. 'do {',
  3321. '} while (!($mod.vC in $mod.vT));',
  3322. '']));
  3323. end;
  3324. procedure TTestModule.TestSet_Functions;
  3325. begin
  3326. StartProgram(false);
  3327. Add('type');
  3328. Add(' TMyEnum = (Red, Green);');
  3329. Add(' TMyEnums = set of TMyEnum;');
  3330. Add('var');
  3331. Add(' e: TMyEnum;');
  3332. Add(' s: TMyEnums;');
  3333. Add('begin');
  3334. Add(' e:=Low(TMyEnums);');
  3335. Add(' e:=Low(s);');
  3336. Add(' e:=High(TMyEnums);');
  3337. Add(' e:=High(s);');
  3338. ConvertProgram;
  3339. CheckSource('TestSetFunctions',
  3340. LinesToStr([ // statements
  3341. 'this.TMyEnum = {',
  3342. ' "0":"Red",',
  3343. ' Red:0,',
  3344. ' "1":"Green",',
  3345. ' Green:1',
  3346. ' };',
  3347. 'this.e = 0;',
  3348. 'this.s = {};'
  3349. ]),
  3350. LinesToStr([
  3351. '$mod.e=$mod.TMyEnum.Red;',
  3352. '$mod.e=$mod.TMyEnum.Red;',
  3353. '$mod.e=$mod.TMyEnum.Green;',
  3354. '$mod.e=$mod.TMyEnum.Green;',
  3355. '']));
  3356. end;
  3357. procedure TTestModule.TestSet_PassAsArgClone;
  3358. begin
  3359. StartProgram(false);
  3360. Add('type');
  3361. Add(' TMyEnum = (Red, Green);');
  3362. Add(' TMyEnums = set of TMyEnum;');
  3363. Add('procedure DoDefault(s: tmyenums); begin end;');
  3364. Add('procedure DoConst(const s: tmyenums); begin end;');
  3365. Add('var');
  3366. Add(' aSet: tmyenums;');
  3367. Add('begin');
  3368. Add(' dodefault(aset);');
  3369. Add(' doconst(aset);');
  3370. ConvertProgram;
  3371. CheckSource('TestSetFunctions',
  3372. LinesToStr([ // statements
  3373. 'this.TMyEnum = {',
  3374. ' "0":"Red",',
  3375. ' Red:0,',
  3376. ' "1":"Green",',
  3377. ' Green:1',
  3378. ' };',
  3379. 'this.DoDefault = function (s) {',
  3380. '};',
  3381. 'this.DoConst = function (s) {',
  3382. '};',
  3383. 'this.aSet = {};'
  3384. ]),
  3385. LinesToStr([
  3386. '$mod.DoDefault(rtl.refSet($mod.aSet));',
  3387. '$mod.DoConst($mod.aSet);',
  3388. '']));
  3389. end;
  3390. procedure TTestModule.TestSet_AsParams;
  3391. begin
  3392. StartProgram(false);
  3393. Add('type TEnum = (Red,Blue);');
  3394. Add('type TEnums = set of TEnum;');
  3395. Add('procedure DoIt(vG: TEnums; const vH: TEnums; var vI: TEnums);');
  3396. Add('var vJ: TEnums;');
  3397. Add('begin');
  3398. Add(' vg:=vg;');
  3399. Add(' vj:=vh;');
  3400. Add(' vi:=vi;');
  3401. Add(' doit(vg,vg,vg);');
  3402. Add(' doit(vh,vh,vj);');
  3403. Add(' doit(vi,vi,vi);');
  3404. Add(' doit(vj,vj,vj);');
  3405. Add('end;');
  3406. Add('var i: TEnums;');
  3407. Add('begin');
  3408. Add(' doit(i,i,i);');
  3409. ConvertProgram;
  3410. CheckSource('TestSet_AsParams',
  3411. LinesToStr([ // statements
  3412. 'this.TEnum = {',
  3413. ' "0": "Red",',
  3414. ' Red: 0,',
  3415. ' "1": "Blue",',
  3416. ' Blue: 1',
  3417. '};',
  3418. 'this.DoIt = function (vG,vH,vI) {',
  3419. ' var vJ = {};',
  3420. ' vG = rtl.refSet(vG);',
  3421. ' vJ = rtl.refSet(vH);',
  3422. ' vI.set(rtl.refSet(vI.get()));',
  3423. ' $mod.DoIt(rtl.refSet(vG), vG, {',
  3424. ' get: function () {',
  3425. ' return vG;',
  3426. ' },',
  3427. ' set: function (v) {',
  3428. ' vG = v;',
  3429. ' }',
  3430. ' });',
  3431. ' $mod.DoIt(rtl.refSet(vH), vH, {',
  3432. ' get: function () {',
  3433. ' return vJ;',
  3434. ' },',
  3435. ' set: function (v) {',
  3436. ' vJ = v;',
  3437. ' }',
  3438. ' });',
  3439. ' $mod.DoIt(rtl.refSet(vI.get()), vI.get(), vI);',
  3440. ' $mod.DoIt(rtl.refSet(vJ), vJ, {',
  3441. ' get: function () {',
  3442. ' return vJ;',
  3443. ' },',
  3444. ' set: function (v) {',
  3445. ' vJ = v;',
  3446. ' }',
  3447. ' });',
  3448. '};',
  3449. 'this.i = {};'
  3450. ]),
  3451. LinesToStr([
  3452. '$mod.DoIt(rtl.refSet($mod.i),$mod.i,{',
  3453. ' p: $mod,',
  3454. ' get: function () {',
  3455. ' return this.p.i;',
  3456. ' },',
  3457. ' set: function (v) {',
  3458. ' this.p.i = v;',
  3459. ' }',
  3460. '});'
  3461. ]));
  3462. end;
  3463. procedure TTestModule.TestSet_Property;
  3464. begin
  3465. StartProgram(false);
  3466. Add('type');
  3467. Add(' TEnum = (Red,Blue);');
  3468. Add(' TEnums = set of TEnum;');
  3469. Add(' TObject = class');
  3470. Add(' function GetColors: TEnums; external name ''GetColors'';');
  3471. Add(' procedure SetColors(const Value: TEnums); external name ''SetColors'';');
  3472. Add(' property Colors: TEnums read GetColors write SetColors;');
  3473. Add(' end;');
  3474. Add('procedure DoIt(i: TEnums; const j: TEnums; var k: TEnums; out l: TEnums);');
  3475. Add('begin end;');
  3476. Add('var Obj: TObject;');
  3477. Add('begin');
  3478. Add(' Include(Obj.Colors,Red);');
  3479. Add(' Exclude(Obj.Colors,Red);');
  3480. //Add(' DoIt(Obj.Colors,Obj.Colors,Obj.Colors,Obj.Colors);');
  3481. ConvertProgram;
  3482. CheckSource('TestSet_Property',
  3483. LinesToStr([ // statements
  3484. 'this.TEnum = {',
  3485. ' "0": "Red",',
  3486. ' Red: 0,',
  3487. ' "1": "Blue",',
  3488. ' Blue: 1',
  3489. '};',
  3490. 'rtl.createClass($mod, "TObject", null, function () {',
  3491. ' this.$init = function () {',
  3492. ' };',
  3493. ' this.$final = function () {',
  3494. ' };',
  3495. '});',
  3496. 'this.DoIt = function (i, j, k, l) {',
  3497. '};',
  3498. 'this.Obj = null;',
  3499. '']),
  3500. LinesToStr([
  3501. '$mod.Obj.SetColors(rtl.includeSet($mod.Obj.GetColors(), $mod.TEnum.Red));',
  3502. '$mod.Obj.SetColors(rtl.excludeSet($mod.Obj.GetColors(), $mod.TEnum.Red));',
  3503. '']));
  3504. end;
  3505. procedure TTestModule.TestSet_EnumConst;
  3506. begin
  3507. StartProgram(false);
  3508. Add('type');
  3509. Add(' TEnum = (Red,Blue);');
  3510. Add(' TEnums = set of TEnum;');
  3511. Add('const');
  3512. Add(' Orange = red;');
  3513. Add('var');
  3514. Add(' Enum: tenum;');
  3515. Add(' Enums: tenums;');
  3516. Add('begin');
  3517. Add(' Include(enums,orange);');
  3518. Add(' Exclude(enums,orange);');
  3519. Add(' if orange in enums then;');
  3520. Add(' if orange in [orange,red] then;');
  3521. ConvertProgram;
  3522. CheckSource('TestEnumConst',
  3523. LinesToStr([ // statements
  3524. 'this.TEnum = {',
  3525. ' "0": "Red",',
  3526. ' Red: 0,',
  3527. ' "1": "Blue",',
  3528. ' Blue: 1',
  3529. '};',
  3530. 'this.Orange = $mod.TEnum.Red;',
  3531. 'this.Enum = 0;',
  3532. 'this.Enums = {};',
  3533. '']),
  3534. LinesToStr([
  3535. '$mod.Enums = rtl.includeSet($mod.Enums, $mod.Orange);',
  3536. '$mod.Enums = rtl.excludeSet($mod.Enums, $mod.Orange);',
  3537. 'if ($mod.Orange in $mod.Enums) ;',
  3538. 'if ($mod.Orange in rtl.createSet($mod.Orange, $mod.TEnum.Red)) ;',
  3539. '']));
  3540. end;
  3541. procedure TTestModule.TestSet_AnonymousEnumType;
  3542. begin
  3543. StartProgram(false);
  3544. Add('type');
  3545. Add(' TFlags = set of (red, green);');
  3546. Add('const');
  3547. Add(' favorite = red;');
  3548. Add('var');
  3549. Add(' f: TFlags;');
  3550. Add(' i: longint;');
  3551. Add('begin');
  3552. Add(' Include(f,red);');
  3553. Add(' Include(f,favorite);');
  3554. Add(' i:=ord(red);');
  3555. Add(' i:=ord(favorite);');
  3556. Add(' i:=ord(low(TFlags));');
  3557. Add(' i:=ord(low(f));');
  3558. Add(' i:=ord(low(favorite));');
  3559. Add(' i:=ord(high(TFlags));');
  3560. Add(' i:=ord(high(f));');
  3561. Add(' i:=ord(high(favorite));');
  3562. Add(' f:=[green,favorite];');
  3563. ConvertProgram;
  3564. CheckSource('TestSet_AnonymousEnumType',
  3565. LinesToStr([ // statements
  3566. 'this.TFlags$a = {',
  3567. ' "0": "red",',
  3568. ' red: 0,',
  3569. ' "1": "green",',
  3570. ' green: 1',
  3571. '};',
  3572. 'this.favorite = $mod.TFlags$a.red;',
  3573. 'this.f = {};',
  3574. 'this.i = 0;',
  3575. '']),
  3576. LinesToStr([
  3577. '$mod.f = rtl.includeSet($mod.f, $mod.TFlags$a.red);',
  3578. '$mod.f = rtl.includeSet($mod.f, $mod.favorite);',
  3579. '$mod.i = $mod.TFlags$a.red;',
  3580. '$mod.i = $mod.favorite;',
  3581. '$mod.i = $mod.TFlags$a.red;',
  3582. '$mod.i = $mod.TFlags$a.red;',
  3583. '$mod.i = $mod.TFlags$a.red;',
  3584. '$mod.i = $mod.TFlags$a.green;',
  3585. '$mod.i = $mod.TFlags$a.green;',
  3586. '$mod.i = $mod.TFlags$a.green;',
  3587. '$mod.f = rtl.createSet($mod.TFlags$a.green, $mod.favorite);',
  3588. '']));
  3589. end;
  3590. procedure TTestModule.TestSet_ConstEnum;
  3591. begin
  3592. StartProgram(false);
  3593. Add([
  3594. 'type',
  3595. ' TEnum = (red,blue,green);',
  3596. ' TEnums = set of TEnum;',
  3597. 'const',
  3598. ' teAny = [low(TEnum)..high(TEnum)];',
  3599. ' teRedBlue = [low(TEnum)..pred(high(TEnum))];',
  3600. 'var',
  3601. ' e: TEnum;',
  3602. ' s: TEnums;',
  3603. 'begin',
  3604. ' if blue in teAny then;',
  3605. ' if blue in teAny+[e] then;',
  3606. ' if blue in teAny+teRedBlue then;',
  3607. ' if e in [red,blue] then;',
  3608. ' s:=teAny;',
  3609. ' s:=teAny+[e];',
  3610. ' s:=[e]+teAny;',
  3611. ' s:=teAny+teRedBlue;',
  3612. ' s:=teAny+teRedBlue+[e];',
  3613. '']);
  3614. ConvertProgram;
  3615. CheckSource('TestSet_ConstEnum',
  3616. LinesToStr([ // statements
  3617. 'this.TEnum = {',
  3618. ' "0": "red",',
  3619. ' red: 0,',
  3620. ' "1": "blue",',
  3621. ' blue: 1,',
  3622. ' "2": "green",',
  3623. ' green: 2',
  3624. '};',
  3625. 'this.teAny = rtl.createSet(null, $mod.TEnum.red, $mod.TEnum.green);',
  3626. 'this.teRedBlue = rtl.createSet(null, $mod.TEnum.red, $mod.TEnum.green - 1);',
  3627. 'this.e = 0;',
  3628. 'this.s = {};',
  3629. '']),
  3630. LinesToStr([
  3631. 'if ($mod.TEnum.blue in $mod.teAny) ;',
  3632. 'if ($mod.TEnum.blue in rtl.unionSet($mod.teAny, rtl.createSet($mod.e))) ;',
  3633. 'if ($mod.TEnum.blue in rtl.unionSet($mod.teAny, $mod.teRedBlue)) ;',
  3634. 'if ($mod.e in rtl.createSet($mod.TEnum.red, $mod.TEnum.blue)) ;',
  3635. '$mod.s = rtl.refSet($mod.teAny);',
  3636. '$mod.s = rtl.unionSet($mod.teAny, rtl.createSet($mod.e));',
  3637. '$mod.s = rtl.unionSet(rtl.createSet($mod.e), $mod.teAny);',
  3638. '$mod.s = rtl.unionSet($mod.teAny, $mod.teRedBlue);',
  3639. '$mod.s = rtl.unionSet(rtl.unionSet($mod.teAny, $mod.teRedBlue), rtl.createSet($mod.e));',
  3640. '']));
  3641. end;
  3642. procedure TTestModule.TestSet_ConstChar;
  3643. begin
  3644. StartProgram(false);
  3645. Add([
  3646. 'const',
  3647. ' LowChars = [''a''..''z''];',
  3648. ' Chars = LowChars+[''A''..''Z''];',
  3649. 'var',
  3650. ' c: char;',
  3651. ' s: string;',
  3652. 'begin',
  3653. ' if c in lowchars then ;',
  3654. ' if ''a'' in lowchars then ;',
  3655. ' if s[1] in lowchars then ;',
  3656. ' if c in chars then ;',
  3657. ' if c in [''a''..''z'',''_''] then ;',
  3658. ' if ''b'' in [''a''..''z'',''_''] then ;',
  3659. '']);
  3660. ConvertProgram;
  3661. CheckSource('TestSet_ConstChar',
  3662. LinesToStr([ // statements
  3663. 'this.LowChars = rtl.createSet(null, 97, 122);',
  3664. 'this.Chars = rtl.unionSet($mod.LowChars, rtl.createSet(null, 65, 90));',
  3665. 'this.c = "";',
  3666. 'this.s = "";',
  3667. '']),
  3668. LinesToStr([
  3669. 'if ($mod.c.charCodeAt() in $mod.LowChars) ;',
  3670. 'if (97 in $mod.LowChars) ;',
  3671. 'if ($mod.s.charCodeAt(0) in $mod.LowChars) ;',
  3672. 'if ($mod.c.charCodeAt() in $mod.Chars) ;',
  3673. 'if ($mod.c.charCodeAt() in rtl.createSet(null, 97, 122, 95)) ;',
  3674. 'if (98 in rtl.createSet(null, 97, 122, 95)) ;',
  3675. '']));
  3676. end;
  3677. procedure TTestModule.TestSet_ConstInt;
  3678. begin
  3679. StartProgram(false);
  3680. Add([
  3681. 'const',
  3682. ' Months = [1..12];',
  3683. ' Mirror = [-12..-1]+Months;',
  3684. 'var',
  3685. ' i: smallint;',
  3686. 'begin',
  3687. ' if 3 in Months then;',
  3688. ' if i in Months+[i] then;',
  3689. ' if i in Months+Mirror then;',
  3690. ' if i in [4..6,8] then;',
  3691. '']);
  3692. ConvertProgram;
  3693. CheckSource('TestSet_ConstInt',
  3694. LinesToStr([ // statements
  3695. 'this.Months = rtl.createSet(null, 1, 12);',
  3696. 'this.Mirror = rtl.unionSet(rtl.createSet(null, -12, -1), $mod.Months);',
  3697. 'this.i = 0;',
  3698. '']),
  3699. LinesToStr([
  3700. 'if (3 in $mod.Months) ;',
  3701. 'if ($mod.i in rtl.unionSet($mod.Months, rtl.createSet($mod.i))) ;',
  3702. 'if ($mod.i in rtl.unionSet($mod.Months, $mod.Mirror)) ;',
  3703. 'if ($mod.i in rtl.createSet(null, 4, 6, 8)) ;',
  3704. '']));
  3705. end;
  3706. procedure TTestModule.TestNestBegin;
  3707. begin
  3708. StartProgram(false);
  3709. Add('begin');
  3710. Add(' begin');
  3711. Add(' begin');
  3712. Add(' end;');
  3713. Add(' begin');
  3714. Add(' if true then ;');
  3715. Add(' end;');
  3716. Add(' end;');
  3717. ConvertProgram;
  3718. CheckSource('TestNestBegin',
  3719. '',
  3720. 'if (true) ;');
  3721. end;
  3722. procedure TTestModule.TestUnitImplVars;
  3723. begin
  3724. StartUnit(false);
  3725. Add('interface');
  3726. Add('implementation');
  3727. Add('var');
  3728. Add(' V1:longint;');
  3729. Add(' V2:longint = 3;');
  3730. Add(' V3:string = ''abc'';');
  3731. ConvertUnit;
  3732. CheckSource('TestUnitImplVars',
  3733. LinesToStr([ // statements
  3734. 'var $impl = $mod.$impl;',
  3735. '']),
  3736. '', // this.$init
  3737. LinesToStr([ // implementation
  3738. '$impl.V1 = 0;',
  3739. '$impl.V2 = 3;',
  3740. '$impl.V3 = "abc";',
  3741. '']) );
  3742. end;
  3743. procedure TTestModule.TestUnitImplConsts;
  3744. begin
  3745. StartUnit(false);
  3746. Add('interface');
  3747. Add('implementation');
  3748. Add('const');
  3749. Add(' v1 = 3;');
  3750. Add(' v2:longint = 4;');
  3751. Add(' v3:string = ''abc'';');
  3752. ConvertUnit;
  3753. CheckSource('TestUnitImplConsts',
  3754. LinesToStr([ // statements
  3755. 'var $impl = $mod.$impl;',
  3756. '']),
  3757. '', // this.$init
  3758. LinesToStr([ // implementation
  3759. '$impl.v1 = 3;',
  3760. '$impl.v2 = 4;',
  3761. '$impl.v3 = "abc";',
  3762. '']) );
  3763. end;
  3764. procedure TTestModule.TestUnitImplRecord;
  3765. begin
  3766. StartUnit(false);
  3767. Add('interface');
  3768. Add('implementation');
  3769. Add('type');
  3770. Add(' TMyRecord = record');
  3771. Add(' i: longint;');
  3772. Add(' end;');
  3773. Add('var aRec: TMyRecord;');
  3774. Add('initialization');
  3775. Add(' arec.i:=3;');
  3776. ConvertUnit;
  3777. CheckSource('TestUnitImplRecord',
  3778. LinesToStr([ // statements
  3779. 'var $impl = $mod.$impl;',
  3780. '']),
  3781. // this.$init
  3782. '$impl.aRec.i = 3;',
  3783. LinesToStr([ // implementation
  3784. '$impl.TMyRecord = function (s) {',
  3785. ' if (s) {',
  3786. ' this.i = s.i;',
  3787. ' } else {',
  3788. ' this.i = 0;',
  3789. ' };',
  3790. ' this.$equal = function (b) {',
  3791. ' return this.i === b.i;',
  3792. ' };',
  3793. '};',
  3794. '$impl.aRec = new $impl.TMyRecord();',
  3795. '']) );
  3796. end;
  3797. procedure TTestModule.TestRenameJSNameConflict;
  3798. begin
  3799. StartProgram(false);
  3800. Add('var apply: longint;');
  3801. Add('var bind: longint;');
  3802. Add('var call: longint;');
  3803. Add('begin');
  3804. ConvertProgram;
  3805. CheckSource('TestRenameJSNameConflict',
  3806. LinesToStr([ // statements
  3807. 'this.Apply = 0;',
  3808. 'this.Bind = 0;',
  3809. 'this.Call = 0;'
  3810. ]),
  3811. LinesToStr([ // this.$main
  3812. ''
  3813. ]));
  3814. end;
  3815. procedure TTestModule.TestLocalConst;
  3816. begin
  3817. StartProgram(false);
  3818. Add('procedure DoIt;');
  3819. Add('const');
  3820. Add(' cA: longint = 1;');
  3821. Add(' cB = 2;');
  3822. Add(' procedure Sub;');
  3823. Add(' const');
  3824. Add(' csA = 3;');
  3825. Add(' cB: double = 4;');
  3826. Add(' begin');
  3827. Add(' cb:=cb+csa;');
  3828. Add(' ca:=ca+csa+5;');
  3829. Add(' end;');
  3830. Add('begin');
  3831. Add(' ca:=ca+cb+6;');
  3832. Add('end;');
  3833. Add('begin');
  3834. ConvertProgram;
  3835. CheckSource('TestLocalConst',
  3836. LinesToStr([
  3837. 'var cA = 1;',
  3838. 'var cB = 2;',
  3839. 'var csA = 3;',
  3840. 'var cB$1 = 4;',
  3841. 'this.DoIt = function () {',
  3842. ' function Sub() {',
  3843. ' cB$1 = cB$1 + csA;',
  3844. ' cA = (cA + csA) + 5;',
  3845. ' };',
  3846. ' cA = (cA + cB) + 6;',
  3847. '};'
  3848. ]),
  3849. LinesToStr([
  3850. ]));
  3851. end;
  3852. procedure TTestModule.TestVarExternal;
  3853. begin
  3854. StartProgram(false);
  3855. Add('var');
  3856. Add(' NaN: double; external name ''Global.NaN'';');
  3857. Add(' d: double;');
  3858. Add('begin');
  3859. Add(' d:=NaN;');
  3860. ConvertProgram;
  3861. CheckSource('TestVarExternal',
  3862. LinesToStr([
  3863. 'this.d = 0.0;'
  3864. ]),
  3865. LinesToStr([
  3866. '$mod.d = Global.NaN;'
  3867. ]));
  3868. end;
  3869. procedure TTestModule.TestVarExternalOtherUnit;
  3870. begin
  3871. AddModuleWithIntfImplSrc('unit2.pas',
  3872. LinesToStr([
  3873. 'var NaN: double; external name ''Global.NaN'';',
  3874. 'var iV: longint;'
  3875. ]),
  3876. '');
  3877. StartUnit(true);
  3878. Add('interface');
  3879. Add('uses unit2;');
  3880. Add('implementation');
  3881. Add('var');
  3882. Add(' d: double;');
  3883. Add(' i: longint; external name ''$i'';');
  3884. Add('begin');
  3885. Add(' d:=nan;');
  3886. Add(' d:=uNit2.nan;');
  3887. Add(' d:=test1.d;');
  3888. Add(' i:=iv;');
  3889. Add(' i:=uNit2.iv;');
  3890. Add(' i:=test1.i;');
  3891. ConvertUnit;
  3892. CheckSource('TestVarExternalOtherUnit',
  3893. LinesToStr([
  3894. 'var $impl = $mod.$impl;',
  3895. '']),
  3896. LinesToStr([ // this.$init
  3897. '$impl.d = Global.NaN;',
  3898. '$impl.d = Global.NaN;',
  3899. '$impl.d = $impl.d;',
  3900. '$i = pas.unit2.iV;',
  3901. '$i = pas.unit2.iV;',
  3902. '$i = $i;',
  3903. '']),
  3904. LinesToStr([ // implementation
  3905. '$impl.d = 0.0;',
  3906. '']) );
  3907. end;
  3908. procedure TTestModule.TestVarAbsoluteFail;
  3909. begin
  3910. StartProgram(false);
  3911. Add([
  3912. 'var',
  3913. ' a: longint;',
  3914. ' b: longword absolute a;',
  3915. 'begin']);
  3916. SetExpectedPasResolverError('Invalid variable modifier "absolute"',nInvalidVariableModifier);
  3917. ConvertProgram;
  3918. end;
  3919. procedure TTestModule.TestDouble;
  3920. begin
  3921. StartProgram(false);
  3922. Add([
  3923. 'var',
  3924. ' d: double;',
  3925. 'begin',
  3926. ' d:=1.0;',
  3927. ' d:=1.0/3.0;',
  3928. ' d:=1/3;',
  3929. ' d:=5.0E-324;',
  3930. ' d:=1.7E308;',
  3931. ' d:=10**3;',
  3932. ' d:=10 mod 3;',
  3933. ' d:=10 div 3;',
  3934. '']);
  3935. ConvertProgram;
  3936. CheckSource('TestDouble',
  3937. LinesToStr([
  3938. 'this.d=0.0;'
  3939. ]),
  3940. LinesToStr([
  3941. '$mod.d = 1.0;',
  3942. '$mod.d = 1.0 / 3.0;',
  3943. '$mod.d = 1 / 3;',
  3944. '$mod.d = 5.0E-324;',
  3945. '$mod.d = 1.7E308;',
  3946. '$mod.d = Math.pow(10, 3);',
  3947. '$mod.d = 10 % 3;',
  3948. '$mod.d = Math.floor(10 / 3);',
  3949. '']));
  3950. end;
  3951. procedure TTestModule.TestIntegerRange;
  3952. begin
  3953. StartProgram(false);
  3954. Add([
  3955. 'const',
  3956. ' MinInt = -1;',
  3957. ' MaxInt = +1;',
  3958. 'type',
  3959. ' {#TMyInt}TMyInt = MinInt..MaxInt;',
  3960. ' TInt2 = 1..3;',
  3961. 'const',
  3962. ' a = low(TMyInt)+High(TMyInt);',
  3963. ' b = low(TInt2)+High(TInt2);',
  3964. ' s1 = [1];',
  3965. ' s2 = [1,2];',
  3966. ' s3 = [1..3];',
  3967. ' s4 = [low(shortint)..high(shortint)];',
  3968. ' s5 = [succ(low(shortint))..pred(high(shortint))];',
  3969. ' s6 = 1 in s2;',
  3970. 'var',
  3971. ' i: TMyInt;',
  3972. ' i2: TInt2;',
  3973. 'begin',
  3974. ' i:=i2;',
  3975. ' if i=i2 then ;']);
  3976. ConvertProgram;
  3977. CheckSource('TestIntegerRange',
  3978. LinesToStr([
  3979. 'this.MinInt = -1;',
  3980. 'this.MaxInt = +1;',
  3981. 'this.a = -1 + 1;',
  3982. 'this.b = 1 + 3;',
  3983. 'this.s1 = rtl.createSet(1);',
  3984. 'this.s2 = rtl.createSet(1, 2);',
  3985. 'this.s3 = rtl.createSet(null, 1, 3);',
  3986. 'this.s4 = rtl.createSet(null, -128, 127);',
  3987. 'this.s5 = rtl.createSet(null, -128 + 1, 127 - 1);',
  3988. 'this.s6 = 1 in $mod.s2;',
  3989. 'this.i = -1;',
  3990. 'this.i2 = 1;',
  3991. '']),
  3992. LinesToStr([
  3993. '$mod.i = $mod.i2;',
  3994. 'if ($mod.i === $mod.i2) ;',
  3995. '']));
  3996. end;
  3997. procedure TTestModule.TestForBoolDo;
  3998. begin
  3999. StartProgram(false);
  4000. Add([
  4001. 'var b: boolean;',
  4002. 'begin',
  4003. ' for b:=false to true do ;',
  4004. ' for b:=b downto false do ;',
  4005. '']);
  4006. ConvertProgram;
  4007. CheckSource('TestForBoolDo',
  4008. LinesToStr([ // statements
  4009. 'this.b = false;']),
  4010. LinesToStr([ // this.$main
  4011. 'for (var $l1 = 0; $l1 <= 1; $l1++) $mod.b = $l1 != 0;',
  4012. 'for (var $l2 = +$mod.b; $l2 >= 0; $l2--) $mod.b = $l2 != 0;',
  4013. '']));
  4014. end;
  4015. procedure TTestModule.TestCharConst;
  4016. begin
  4017. StartProgram(false);
  4018. Add('const');
  4019. Add(' c: char = ''1'';');
  4020. Add('begin');
  4021. Add(' c:=#0;');
  4022. Add(' c:=#1;');
  4023. Add(' c:=#9;');
  4024. Add(' c:=#10;');
  4025. Add(' c:=#13;');
  4026. Add(' c:=#31;');
  4027. Add(' c:=#32;');
  4028. Add(' c:=#$A;');
  4029. Add(' c:=#$0A;');
  4030. Add(' c:=#$b;');
  4031. Add(' c:=#$0b;');
  4032. Add(' c:=^A;');
  4033. Add(' c:=''"'';');
  4034. ConvertProgram;
  4035. CheckSource('TestCharConst',
  4036. LinesToStr([
  4037. 'this.c="1";'
  4038. ]),
  4039. LinesToStr([
  4040. '$mod.c="\x00";',
  4041. '$mod.c="\x01";',
  4042. '$mod.c="\t";',
  4043. '$mod.c="\n";',
  4044. '$mod.c="\r";',
  4045. '$mod.c="\x1F";',
  4046. '$mod.c=" ";',
  4047. '$mod.c="\n";',
  4048. '$mod.c="\n";',
  4049. '$mod.c="\x0B";',
  4050. '$mod.c="\x0B";',
  4051. '$mod.c="\x01";',
  4052. '$mod.c=''"'';'
  4053. ]));
  4054. end;
  4055. procedure TTestModule.TestChar_Compare;
  4056. begin
  4057. StartProgram(false);
  4058. Add('var');
  4059. Add(' c: char;');
  4060. Add(' b: boolean;');
  4061. Add('begin');
  4062. Add(' b:=c=''1'';');
  4063. Add(' b:=''2''=c;');
  4064. Add(' b:=''3''=''4'';');
  4065. Add(' b:=c<>''5'';');
  4066. Add(' b:=''6''<>c;');
  4067. Add(' b:=c>''7'';');
  4068. Add(' b:=''8''>c;');
  4069. Add(' b:=c>=''9'';');
  4070. Add(' b:=''A''>=c;');
  4071. Add(' b:=c<''B'';');
  4072. Add(' b:=''C''<c;');
  4073. Add(' b:=c<=''D'';');
  4074. Add(' b:=''E''<=c;');
  4075. ConvertProgram;
  4076. CheckSource('TestChar_Compare',
  4077. LinesToStr([
  4078. 'this.c="";',
  4079. 'this.b = false;'
  4080. ]),
  4081. LinesToStr([
  4082. '$mod.b = $mod.c === "1";',
  4083. '$mod.b = "2" === $mod.c;',
  4084. '$mod.b = "3" === "4";',
  4085. '$mod.b = $mod.c !== "5";',
  4086. '$mod.b = "6" !== $mod.c;',
  4087. '$mod.b = $mod.c > "7";',
  4088. '$mod.b = "8" > $mod.c;',
  4089. '$mod.b = $mod.c >= "9";',
  4090. '$mod.b = "A" >= $mod.c;',
  4091. '$mod.b = $mod.c < "B";',
  4092. '$mod.b = "C" < $mod.c;',
  4093. '$mod.b = $mod.c <= "D";',
  4094. '$mod.b = "E" <= $mod.c;',
  4095. '']));
  4096. end;
  4097. procedure TTestModule.TestChar_Ord;
  4098. begin
  4099. StartProgram(false);
  4100. Add('var');
  4101. Add(' c: char;');
  4102. Add(' i: longint;');
  4103. Add(' s: string;');
  4104. Add('begin');
  4105. Add(' i:=ord(c);');
  4106. Add(' i:=ord(s[i]);');
  4107. ConvertProgram;
  4108. CheckSource('TestChar_Ord',
  4109. LinesToStr([
  4110. 'this.c = "";',
  4111. 'this.i = 0;',
  4112. 'this.s = "";'
  4113. ]),
  4114. LinesToStr([
  4115. '$mod.i = $mod.c.charCodeAt();',
  4116. '$mod.i = $mod.s.charCodeAt($mod.i-1);',
  4117. '']));
  4118. end;
  4119. procedure TTestModule.TestChar_Chr;
  4120. begin
  4121. StartProgram(false);
  4122. Add('var');
  4123. Add(' c: char;');
  4124. Add(' i: longint;');
  4125. Add('begin');
  4126. Add(' c:=chr(i);');
  4127. ConvertProgram;
  4128. CheckSource('TestChar_Chr',
  4129. LinesToStr([
  4130. 'this.c = "";',
  4131. 'this.i = 0;'
  4132. ]),
  4133. LinesToStr([
  4134. '$mod.c = String.fromCharCode($mod.i);',
  4135. '']));
  4136. end;
  4137. procedure TTestModule.TestStringConst;
  4138. begin
  4139. StartProgram(false);
  4140. Add('var');
  4141. Add(' s: string = ''abc'';');
  4142. Add('begin');
  4143. Add(' s:='''';');
  4144. Add(' s:=#13#10;');
  4145. Add(' s:=#9''foo'';');
  4146. Add(' s:=#$A9;');
  4147. Add(' s:=''foo''#13''bar'';');
  4148. Add(' s:=''"'';');
  4149. Add(' s:=''"''''"'';');
  4150. ConvertProgram;
  4151. CheckSource('TestStringConst',
  4152. LinesToStr([
  4153. 'this.s="abc";'
  4154. ]),
  4155. LinesToStr([
  4156. '$mod.s="";',
  4157. '$mod.s="\r\n";',
  4158. '$mod.s="\tfoo";',
  4159. '$mod.s="©";',
  4160. '$mod.s="foo\rbar";',
  4161. '$mod.s=''"'';',
  4162. '$mod.s=''"\''"'';'
  4163. ]));
  4164. end;
  4165. procedure TTestModule.TestString_Length;
  4166. begin
  4167. StartProgram(false);
  4168. Add('const c = ''foo'';');
  4169. Add('var');
  4170. Add(' s: string;');
  4171. Add(' i: longint;');
  4172. Add('begin');
  4173. Add(' i:=length(s);');
  4174. Add(' i:=length(s+s);');
  4175. Add(' i:=length(''abc'');');
  4176. Add(' i:=length(c);');
  4177. ConvertProgram;
  4178. CheckSource('TestString_Length',
  4179. LinesToStr([
  4180. 'this.c = "foo";',
  4181. 'this.s = "";',
  4182. 'this.i = 0;',
  4183. '']),
  4184. LinesToStr([
  4185. '$mod.i = $mod.s.length;',
  4186. '$mod.i = ($mod.s+$mod.s).length;',
  4187. '$mod.i = "abc".length;',
  4188. '$mod.i = $mod.c.length;',
  4189. '']));
  4190. end;
  4191. procedure TTestModule.TestString_Compare;
  4192. begin
  4193. StartProgram(false);
  4194. Add('var');
  4195. Add(' s, t: string;');
  4196. Add(' b: boolean;');
  4197. Add('begin');
  4198. Add(' b:=s=t;');
  4199. Add(' b:=s<>t;');
  4200. Add(' b:=s>t;');
  4201. Add(' b:=s>=t;');
  4202. Add(' b:=s<t;');
  4203. Add(' b:=s<=t;');
  4204. ConvertProgram;
  4205. CheckSource('TestString_Compare',
  4206. LinesToStr([ // statements
  4207. 'this.s = "";',
  4208. 'this.t = "";',
  4209. 'this.b =false;'
  4210. ]),
  4211. LinesToStr([ // this.$main
  4212. '$mod.b = $mod.s === $mod.t;',
  4213. '$mod.b = $mod.s !== $mod.t;',
  4214. '$mod.b = $mod.s > $mod.t;',
  4215. '$mod.b = $mod.s >= $mod.t;',
  4216. '$mod.b = $mod.s < $mod.t;',
  4217. '$mod.b = $mod.s <= $mod.t;',
  4218. '']));
  4219. end;
  4220. procedure TTestModule.TestString_SetLength;
  4221. begin
  4222. StartProgram(false);
  4223. Add([
  4224. 'procedure DoIt(var s: string);',
  4225. 'begin',
  4226. ' SetLength(s,2);',
  4227. 'end;',
  4228. 'var s: string;',
  4229. 'begin',
  4230. ' SetLength(s,3);',
  4231. '']);
  4232. ConvertProgram;
  4233. CheckSource('TestString_SetLength',
  4234. LinesToStr([ // statements
  4235. 'this.DoIt = function (s) {',
  4236. ' s.set(rtl.strSetLength(s.get(), 2));',
  4237. '};',
  4238. 'this.s = "";',
  4239. '']),
  4240. LinesToStr([ // this.$main
  4241. '$mod.s = rtl.strSetLength($mod.s, 3);'
  4242. ]));
  4243. end;
  4244. procedure TTestModule.TestString_CharAt;
  4245. begin
  4246. StartProgram(false);
  4247. Add('var');
  4248. Add(' s: string;');
  4249. Add(' c: char;');
  4250. Add(' b: boolean;');
  4251. Add('begin');
  4252. Add(' b:= s[1] = c;');
  4253. Add(' b:= c = s[1];');
  4254. Add(' b:= c <> s[1];');
  4255. Add(' b:= c > s[1];');
  4256. Add(' b:= c >= s[1];');
  4257. Add(' b:= c < s[2];');
  4258. Add(' b:= c <= s[1];');
  4259. Add(' s[1] := c;');
  4260. Add(' s[2+3] := c;');
  4261. ConvertProgram;
  4262. CheckSource('TestString_CharAt',
  4263. LinesToStr([ // statements
  4264. 'this.s = "";',
  4265. 'this.c = "";',
  4266. 'this.b = false;'
  4267. ]),
  4268. LinesToStr([ // this.$main
  4269. '$mod.b = $mod.s.charAt(0) === $mod.c;',
  4270. '$mod.b = $mod.c === $mod.s.charAt(0);',
  4271. '$mod.b = $mod.c !== $mod.s.charAt(0);',
  4272. '$mod.b = $mod.c > $mod.s.charAt(0);',
  4273. '$mod.b = $mod.c >= $mod.s.charAt(0);',
  4274. '$mod.b = $mod.c < $mod.s.charAt(1);',
  4275. '$mod.b = $mod.c <= $mod.s.charAt(0);',
  4276. '$mod.s = rtl.setCharAt($mod.s, 0, $mod.c);',
  4277. '$mod.s = rtl.setCharAt($mod.s, (2 + 3) - 1, $mod.c);',
  4278. '']));
  4279. end;
  4280. procedure TTestModule.TestStr;
  4281. begin
  4282. StartProgram(false);
  4283. Add('var');
  4284. Add(' b: boolean;');
  4285. Add(' i: longint;');
  4286. Add(' d: double;');
  4287. Add(' s: string;');
  4288. Add('begin');
  4289. Add(' str(b,s);');
  4290. Add(' str(i,s);');
  4291. Add(' str(d,s);');
  4292. Add(' str(i:3,s);');
  4293. Add(' str(d:3:2,s);');
  4294. Add(' Str(12.456:12:1,s);');
  4295. Add(' Str(12.456:12,s);');
  4296. Add(' s:=str(b);');
  4297. Add(' s:=str(i);');
  4298. Add(' s:=str(d);');
  4299. Add(' s:=str(i,i);');
  4300. Add(' s:=str(i:3);');
  4301. Add(' s:=str(d:3:2);');
  4302. Add(' s:=str(i:4,i);');
  4303. Add(' s:=str(i,i:5);');
  4304. Add(' s:=str(i:4,i:5);');
  4305. Add(' s:=str(s,s);');
  4306. Add(' s:=str(s,''foo'');');
  4307. ConvertProgram;
  4308. CheckSource('TestStr',
  4309. LinesToStr([ // statements
  4310. 'this.b = false;',
  4311. 'this.i = 0;',
  4312. 'this.d = 0.0;',
  4313. 'this.s = "";',
  4314. '']),
  4315. LinesToStr([ // this.$main
  4316. '$mod.s = ""+$mod.b;',
  4317. '$mod.s = ""+$mod.i;',
  4318. '$mod.s = rtl.floatToStr($mod.d);',
  4319. '$mod.s = rtl.spaceLeft(""+$mod.i,3);',
  4320. '$mod.s = rtl.floatToStr($mod.d,3,2);',
  4321. '$mod.s = rtl.floatToStr(12.456,12,1);',
  4322. '$mod.s = rtl.floatToStr(12.456,12);',
  4323. '$mod.s = ""+$mod.b;',
  4324. '$mod.s = ""+$mod.i;',
  4325. '$mod.s = rtl.floatToStr($mod.d);',
  4326. '$mod.s = (""+$mod.i)+$mod.i;',
  4327. '$mod.s = rtl.spaceLeft(""+$mod.i,3);',
  4328. '$mod.s = rtl.floatToStr($mod.d,3,2);',
  4329. '$mod.s = rtl.spaceLeft("" + $mod.i, 4) + $mod.i;',
  4330. '$mod.s = ("" + $mod.i) + rtl.spaceLeft("" + $mod.i, 5);',
  4331. '$mod.s = rtl.spaceLeft("" + $mod.i, 4) + rtl.spaceLeft("" + $mod.i, 5);',
  4332. '$mod.s = $mod.s + $mod.s;',
  4333. '$mod.s = $mod.s + "foo";',
  4334. '']));
  4335. end;
  4336. procedure TTestModule.TestBaseType_AnsiStringFail;
  4337. begin
  4338. StartProgram(false);
  4339. Add('var s: AnsiString');
  4340. SetExpectedPasResolverError('identifier not found "AnsiString"',PasResolveEval.nIdentifierNotFound);
  4341. ConvertProgram;
  4342. end;
  4343. procedure TTestModule.TestBaseType_WideStringFail;
  4344. begin
  4345. StartProgram(false);
  4346. Add('var s: WideString');
  4347. SetExpectedPasResolverError('identifier not found "WideString"',PasResolveEval.nIdentifierNotFound);
  4348. ConvertProgram;
  4349. end;
  4350. procedure TTestModule.TestBaseType_ShortStringFail;
  4351. begin
  4352. StartProgram(false);
  4353. Add('var s: ShortString');
  4354. SetExpectedPasResolverError('identifier not found "ShortString"',PasResolveEval.nIdentifierNotFound);
  4355. ConvertProgram;
  4356. end;
  4357. procedure TTestModule.TestBaseType_RawByteStringFail;
  4358. begin
  4359. StartProgram(false);
  4360. Add('var s: RawByteString');
  4361. SetExpectedPasResolverError('identifier not found "RawByteString"',PasResolveEval.nIdentifierNotFound);
  4362. ConvertProgram;
  4363. end;
  4364. procedure TTestModule.TestTypeShortstring_Fail;
  4365. begin
  4366. StartProgram(false);
  4367. Add('type t = string[12];');
  4368. Add('var s: t;');
  4369. Add('begin');
  4370. SetExpectedPasResolverError('illegal qualifier "["',nIllegalQualifier);
  4371. ConvertProgram;
  4372. end;
  4373. procedure TTestModule.TestCharSet_Custom;
  4374. begin
  4375. StartProgram(false);
  4376. Add([
  4377. 'type',
  4378. ' TCharRg = ''a''..''z'';',
  4379. ' TSetOfCharRg = set of TCharRg;',
  4380. ' TCharRg2 = ''m''..''p'';',
  4381. 'const',
  4382. ' crg: TCharRg = ''b'';',
  4383. 'var',
  4384. ' c: char;',
  4385. ' crg2: TCharRg2;',
  4386. ' s: TSetOfCharRg;',
  4387. 'begin',
  4388. ' c:=crg;',
  4389. ' crg:=c;',
  4390. ' crg2:=crg;',
  4391. ' if c=crg then ;',
  4392. ' if crg=c then ;',
  4393. ' if crg=crg2 then ;',
  4394. ' if c in s then ;',
  4395. ' if crg2 in s then ;',
  4396. '']);
  4397. ConvertProgram;
  4398. CheckSource('TestCharSet_Custom',
  4399. LinesToStr([ // statements
  4400. 'this.crg = "b";',
  4401. 'this.c = "";',
  4402. 'this.crg2 = "m";',
  4403. 'this.s = {};',
  4404. '']),
  4405. LinesToStr([ // this.$main
  4406. '$mod.c = $mod.crg;',
  4407. '$mod.crg = $mod.c;',
  4408. '$mod.crg2 = $mod.crg;',
  4409. 'if ($mod.c === $mod.crg) ;',
  4410. 'if ($mod.crg === $mod.c) ;',
  4411. 'if ($mod.crg === $mod.crg2) ;',
  4412. 'if ($mod.c.charCodeAt() in $mod.s) ;',
  4413. 'if ($mod.crg2.charCodeAt() in $mod.s) ;',
  4414. '']));
  4415. end;
  4416. procedure TTestModule.TestForCharDo;
  4417. begin
  4418. StartProgram(false);
  4419. Add([
  4420. 'var c: char;',
  4421. 'begin',
  4422. ' for c:=''a'' to ''c'' do ;',
  4423. ' for c:=c downto ''a'' do ;',
  4424. '']);
  4425. ConvertProgram;
  4426. CheckSource('TestForCharDo',
  4427. LinesToStr([ // statements
  4428. 'this.c = "";']),
  4429. LinesToStr([ // this.$main
  4430. 'for (var $l1 = 97; $l1 <= 99; $l1++) $mod.c = String.fromCharCode($l1);',
  4431. 'for (var $l2 = $mod.c.charCodeAt(); $l2 >= 97; $l2--) $mod.c = String.fromCharCode($l2);',
  4432. '']));
  4433. end;
  4434. procedure TTestModule.TestForCharInDo;
  4435. begin
  4436. StartProgram(false);
  4437. Add([
  4438. 'type',
  4439. ' TSetOfChar = set of char;',
  4440. ' TCharRg = ''a''..''z'';',
  4441. ' TSetOfCharRg = set of TCharRg;',
  4442. 'const Foo = ''foo'';',
  4443. 'var',
  4444. ' c: char;',
  4445. ' s: string;',
  4446. ' a1: array of char;',
  4447. ' a2: array[1..3] of char;',
  4448. ' a3: array[1..3,4..5] of char;',
  4449. ' soc: TSetOfChar;',
  4450. ' socr: TSetOfCharRg;',
  4451. ' cr: TCharRg;',
  4452. 'begin',
  4453. ' for c in foo do ;',
  4454. ' for c in s do ;',
  4455. ' for c in char do ;',
  4456. //' for c in a1 do ;',
  4457. //' for c in a2 do ;',
  4458. //' for c in a3 do ;',
  4459. //' for c in [''1''..''3''] do ;',
  4460. //' for c in TSetOfChar do ;',
  4461. //' for c in TCharRg do ;',
  4462. //' for c in soc do ;',
  4463. //' for c in TSetOfCharRg do ;',
  4464. //' for c in socr do ;',
  4465. //' for cr in TCharRg do ;',
  4466. //' for cr in TSetOfCharRg do ;',
  4467. //' for cr in socr do ;',
  4468. '']);
  4469. ConvertProgram;
  4470. CheckSource('TestForCharInDo',
  4471. LinesToStr([ // statements
  4472. 'this.Foo = "foo";',
  4473. 'this.c = "";',
  4474. 'this.s = "";',
  4475. 'this.a1 = [];',
  4476. 'this.a2 = rtl.arraySetLength(null, "", 3);',
  4477. 'this.a3 = rtl.arraySetLength(null, "", 3, 2);',
  4478. 'this.soc = {};',
  4479. 'this.socr = {};',
  4480. 'this.cr = "a";',
  4481. '']),
  4482. LinesToStr([ // this.$main
  4483. 'for (var ($in1 = $mod.Foo, $l2 = 0), $end3 = $in1.length - 1; $l2 <= $end3; $l2++) $mod.c = $in1.charAt($l2);',
  4484. 'for (var ($in4 = $mod.s, $l5 = 0), $end6 = $in4.length - 1; $l5 <= $end6; $l5++) $mod.c = $in4.charAt($l5);',
  4485. 'for (var $l7 = 0, $end8 = 65535; $l7 <= $end8; $l7++) $mod.c = String.fromCharCode($l7);',
  4486. '']));
  4487. end;
  4488. procedure TTestModule.TestProcTwoArgs;
  4489. begin
  4490. StartProgram(false);
  4491. Add('procedure Test(a,b: longint);');
  4492. Add('begin');
  4493. Add('end;');
  4494. Add('begin');
  4495. ConvertProgram;
  4496. CheckSource('TestProcTwoArgs',
  4497. LinesToStr([ // statements
  4498. 'this.Test = function (a,b) {',
  4499. '};'
  4500. ]),
  4501. LinesToStr([ // this.$main
  4502. ''
  4503. ]));
  4504. end;
  4505. procedure TTestModule.TestProc_DefaultValue;
  4506. begin
  4507. StartProgram(false);
  4508. Add('procedure p1(i: longint = 1);');
  4509. Add('begin');
  4510. Add('end;');
  4511. Add('procedure p2(i: longint = 1; c: char = ''a'');');
  4512. Add('begin');
  4513. Add('end;');
  4514. Add('procedure p3(d: double = 1.0; b: boolean = false; s: string = ''abc'');');
  4515. Add('begin');
  4516. Add('end;');
  4517. Add('begin');
  4518. Add(' p1;');
  4519. Add(' p1();');
  4520. Add(' p1(11);');
  4521. Add(' p2;');
  4522. Add(' p2();');
  4523. Add(' p2(12);');
  4524. Add(' p2(13,''b'');');
  4525. Add(' p3();');
  4526. ConvertProgram;
  4527. CheckSource('TestProc_DefaultValue',
  4528. LinesToStr([ // statements
  4529. 'this.p1 = function (i) {',
  4530. '};',
  4531. 'this.p2 = function (i,c) {',
  4532. '};',
  4533. 'this.p3 = function (d,b,s) {',
  4534. '};'
  4535. ]),
  4536. LinesToStr([ // this.$main
  4537. ' $mod.p1(1);',
  4538. ' $mod.p1(1);',
  4539. ' $mod.p1(11);',
  4540. ' $mod.p2(1,"a");',
  4541. ' $mod.p2(1,"a");',
  4542. ' $mod.p2(12,"a");',
  4543. ' $mod.p2(13,"b");',
  4544. ' $mod.p3(1.0,false,"abc");'
  4545. ]));
  4546. end;
  4547. procedure TTestModule.TestFunctionInt;
  4548. begin
  4549. StartProgram(false);
  4550. Add('function MyTest(Bar: longint): longint;');
  4551. Add('begin');
  4552. Add(' Result:=2*bar');
  4553. Add('end;');
  4554. Add('begin');
  4555. ConvertProgram;
  4556. CheckSource('TestFunctionInt',
  4557. LinesToStr([ // statements
  4558. 'this.MyTest = function (Bar) {',
  4559. ' var Result = 0;',
  4560. ' Result = 2*Bar;',
  4561. ' return Result;',
  4562. '};'
  4563. ]),
  4564. LinesToStr([ // this.$main
  4565. ''
  4566. ]));
  4567. end;
  4568. procedure TTestModule.TestFunctionString;
  4569. begin
  4570. StartProgram(false);
  4571. Add('function Test(Bar: string): string;');
  4572. Add('begin');
  4573. Add(' Result:=bar+BAR');
  4574. Add('end;');
  4575. Add('begin');
  4576. ConvertProgram;
  4577. CheckSource('TestFunctionString',
  4578. LinesToStr([ // statements
  4579. 'this.Test = function (Bar) {',
  4580. ' var Result = "";',
  4581. ' Result = Bar+Bar;',
  4582. ' return Result;',
  4583. '};'
  4584. ]),
  4585. LinesToStr([ // this.$main
  4586. ''
  4587. ]));
  4588. end;
  4589. procedure TTestModule.TestForLoop;
  4590. begin
  4591. StartProgram(false);
  4592. Add('var');
  4593. Add(' vI, vJ, vN: longint;');
  4594. Add('begin');
  4595. Add(' VJ:=0;');
  4596. Add(' VN:=3;');
  4597. Add(' for VI:=1 to VN do');
  4598. Add(' begin');
  4599. Add(' VJ:=VJ+VI;');
  4600. Add(' end;');
  4601. ConvertProgram;
  4602. CheckSource('TestForLoop',
  4603. LinesToStr([ // statements
  4604. 'this.vI = 0;',
  4605. 'this.vJ = 0;',
  4606. 'this.vN = 0;'
  4607. ]),
  4608. LinesToStr([ // this.$main
  4609. ' $mod.vJ = 0;',
  4610. ' $mod.vN = 3;',
  4611. ' for (var $l1 = 1, $end2 = $mod.vN; $l1 <= $end2; $l1++) {',
  4612. ' $mod.vI = $l1;',
  4613. ' $mod.vJ = $mod.vJ + $mod.vI;',
  4614. ' };',
  4615. '']));
  4616. end;
  4617. procedure TTestModule.TestForLoopInsideFunction;
  4618. begin
  4619. StartProgram(false);
  4620. Add('function SumNumbers(Count: longint): longint;');
  4621. Add('var');
  4622. Add(' vI, vJ: longint;');
  4623. Add('begin');
  4624. Add(' vj:=0;');
  4625. Add(' for vi:=1 to count do');
  4626. Add(' begin');
  4627. Add(' vj:=vj+vi;');
  4628. Add(' end;');
  4629. Add('end;');
  4630. Add('begin');
  4631. Add(' sumnumbers(3);');
  4632. ConvertProgram;
  4633. CheckSource('TestForLoopInsideFunction',
  4634. LinesToStr([ // statements
  4635. 'this.SumNumbers = function (Count) {',
  4636. ' var Result = 0;',
  4637. ' var vI = 0;',
  4638. ' var vJ = 0;',
  4639. ' vJ = 0;',
  4640. ' for (var $l1 = 1, $end2 = Count; $l1 <= $end2; $l1++) {',
  4641. ' vI = $l1;',
  4642. ' vJ = vJ + vI;',
  4643. ' };',
  4644. ' return Result;',
  4645. '};'
  4646. ]),
  4647. LinesToStr([ // $mod.$main
  4648. ' $mod.SumNumbers(3);'
  4649. ]));
  4650. end;
  4651. procedure TTestModule.TestForLoop_ReadVarAfter;
  4652. begin
  4653. StartProgram(false);
  4654. Add('var');
  4655. Add(' vI: longint;');
  4656. Add('begin');
  4657. Add(' for vi:=1 to 2 do ;');
  4658. Add(' if vi=3 then ;');
  4659. ConvertProgram;
  4660. CheckSource('TestForLoop',
  4661. LinesToStr([ // statements
  4662. 'this.vI = 0;'
  4663. ]),
  4664. LinesToStr([ // this.$main
  4665. ' for ($mod.vI = 1; $mod.vI <= 2; $mod.vI++) ;',
  4666. ' if ($mod.vI===3) ;'
  4667. ]));
  4668. end;
  4669. procedure TTestModule.TestForLoop_Nested;
  4670. begin
  4671. StartProgram(false);
  4672. Add('function SumNumbers(Count: longint): longint;');
  4673. Add('var');
  4674. Add(' vI, vJ, vK: longint;');
  4675. Add('begin');
  4676. Add(' VK:=0;');
  4677. Add(' for VI:=1 to count do');
  4678. Add(' begin');
  4679. Add(' for vj:=1 to vi do');
  4680. Add(' begin');
  4681. Add(' vk:=VK+VI;');
  4682. Add(' end;');
  4683. Add(' end;');
  4684. Add('end;');
  4685. Add('begin');
  4686. Add(' sumnumbers(3);');
  4687. ConvertProgram;
  4688. CheckSource('TestForLoopInFunction',
  4689. LinesToStr([ // statements
  4690. 'this.SumNumbers = function (Count) {',
  4691. ' var Result = 0;',
  4692. ' var vI = 0;',
  4693. ' var vJ = 0;',
  4694. ' var vK = 0;',
  4695. ' vK = 0;',
  4696. ' for (var $l1 = 1, $end2 = Count; $l1 <= $end2; $l1++) {',
  4697. ' vI = $l1;',
  4698. ' for (var $l3 = 1, $end4 = vI; $l3 <= $end4; $l3++) {',
  4699. ' vJ = $l3;',
  4700. ' vK = vK + vI;',
  4701. ' };',
  4702. ' };',
  4703. ' return Result;',
  4704. '};'
  4705. ]),
  4706. LinesToStr([ // $mod.$main
  4707. ' $mod.SumNumbers(3);'
  4708. ]));
  4709. end;
  4710. procedure TTestModule.TestRepeatUntil;
  4711. begin
  4712. StartProgram(false);
  4713. Add('var');
  4714. Add(' vI, vJ, vN: longint;');
  4715. Add('begin');
  4716. Add(' vn:=3;');
  4717. Add(' vj:=0;');
  4718. Add(' VI:=0;');
  4719. Add(' repeat');
  4720. Add(' VI:=vi+1;');
  4721. Add(' vj:=VJ+vI;');
  4722. Add(' until vi>=vn');
  4723. ConvertProgram;
  4724. CheckSource('TestRepeatUntil',
  4725. LinesToStr([ // statements
  4726. 'this.vI = 0;',
  4727. 'this.vJ = 0;',
  4728. 'this.vN = 0;'
  4729. ]),
  4730. LinesToStr([ // $mod.$main
  4731. ' $mod.vN = 3;',
  4732. ' $mod.vJ = 0;',
  4733. ' $mod.vI = 0;',
  4734. ' do{',
  4735. ' $mod.vI = $mod.vI + 1;',
  4736. ' $mod.vJ = $mod.vJ + $mod.vI;',
  4737. ' }while(!($mod.vI>=$mod.vN));'
  4738. ]));
  4739. end;
  4740. procedure TTestModule.TestAsmBlock;
  4741. begin
  4742. StartProgram(false);
  4743. Add('var');
  4744. Add(' vI: longint;');
  4745. Add('begin');
  4746. Add(' vi:=1;');
  4747. Add(' asm');
  4748. Add(' if (vI===1) {');
  4749. Add(' vI=2;');
  4750. Add(' }');
  4751. Add(' if (vI===2){ vI=3; }');
  4752. Add(' end;');
  4753. Add(' VI:=4;');
  4754. ConvertProgram;
  4755. CheckSource('TestAsmBlock',
  4756. LinesToStr([ // statements
  4757. 'this.vI = 0;'
  4758. ]),
  4759. LinesToStr([ // $mod.$main
  4760. '$mod.vI = 1;',
  4761. 'if (vI===1) {',
  4762. ' vI=2;',
  4763. '}',
  4764. 'if (vI===2){ vI=3; }',
  4765. ';',
  4766. '$mod.vI = 4;'
  4767. ]));
  4768. end;
  4769. procedure TTestModule.TestAsmPas_Impl;
  4770. begin
  4771. StartUnit(false);
  4772. Add('interface');
  4773. Add('const cIntf: longint = 1;');
  4774. Add('var vIntf: longint;');
  4775. Add('implementation');
  4776. Add('const cImpl: longint = 2;');
  4777. Add('var vImpl: longint;');
  4778. Add('procedure DoIt;');
  4779. Add('const cLoc: longint = 3;');
  4780. Add('var vLoc: longint;');
  4781. Add('begin;');
  4782. Add(' asm');
  4783. //Add(' pas(vIntf)=pas(cIntf);');
  4784. //Add(' pas(vImpl)=pas(cImpl);');
  4785. //Add(' pas(vLoc)=pas(cLoc);');
  4786. Add(' end;');
  4787. Add('end;');
  4788. ConvertUnit;
  4789. // ToDo: check use analyzer
  4790. CheckSource('TestAsmPas_Impl',
  4791. LinesToStr([
  4792. 'var $impl = $mod.$impl;',
  4793. 'this.cIntf = 1;',
  4794. 'this.vIntf = 0;',
  4795. '']),
  4796. '', // this.$init
  4797. LinesToStr([ // implementation
  4798. '$impl.cImpl = 2;',
  4799. '$impl.vImpl = 0;',
  4800. 'var cLoc = 3;',
  4801. '$impl.DoIt = function () {',
  4802. ' var vLoc = 0;',
  4803. '};',
  4804. '']) );
  4805. end;
  4806. procedure TTestModule.TestTryFinally;
  4807. begin
  4808. StartProgram(false);
  4809. Add('var i: longint;');
  4810. Add('begin');
  4811. Add(' try');
  4812. Add(' i:=0; i:=2 div i;');
  4813. Add(' finally');
  4814. Add(' i:=3');
  4815. Add(' end;');
  4816. ConvertProgram;
  4817. CheckSource('TestTryFinally',
  4818. LinesToStr([ // statements
  4819. 'this.i = 0;'
  4820. ]),
  4821. LinesToStr([ // $mod.$main
  4822. 'try {',
  4823. ' $mod.i = 0;',
  4824. ' $mod.i = Math.floor(2 / $mod.i);',
  4825. '} finally {',
  4826. ' $mod.i = 3;',
  4827. '};'
  4828. ]));
  4829. end;
  4830. procedure TTestModule.TestTryExcept;
  4831. begin
  4832. StartProgram(false);
  4833. Add('type');
  4834. Add(' TObject = class end;');
  4835. Add(' Exception = class Msg: string; end;');
  4836. Add(' EInvalidCast = class(Exception) end;');
  4837. Add('var vI: longint;');
  4838. Add('begin');
  4839. Add(' try');
  4840. Add(' vi:=1;');
  4841. Add(' except');
  4842. Add(' vi:=2');
  4843. Add(' end;');
  4844. Add(' try');
  4845. Add(' vi:=3;');
  4846. Add(' except');
  4847. Add(' raise;');
  4848. Add(' end;');
  4849. Add(' try');
  4850. Add(' VI:=4;');
  4851. Add(' except');
  4852. Add(' on einvalidcast do');
  4853. Add(' raise;');
  4854. Add(' on E: exception do');
  4855. Add(' if e.msg='''' then');
  4856. Add(' raise e;');
  4857. Add(' else');
  4858. Add(' vi:=5');
  4859. Add(' end;');
  4860. Add(' try');
  4861. Add(' VI:=6;');
  4862. Add(' except');
  4863. Add(' on einvalidcast do ;');
  4864. Add(' end;');
  4865. ConvertProgram;
  4866. CheckSource('TestTryExcept',
  4867. LinesToStr([ // statements
  4868. 'rtl.createClass($mod, "TObject", null, function () {',
  4869. ' this.$init = function () {',
  4870. ' };',
  4871. ' this.$final = function () {',
  4872. ' };',
  4873. '});',
  4874. 'rtl.createClass($mod, "Exception", $mod.TObject, function () {',
  4875. ' this.$init = function () {',
  4876. ' $mod.TObject.$init.call(this);',
  4877. ' this.Msg = "";',
  4878. ' };',
  4879. '});',
  4880. 'rtl.createClass($mod, "EInvalidCast", $mod.Exception, function () {',
  4881. '});',
  4882. 'this.vI = 0;'
  4883. ]),
  4884. LinesToStr([ // $mod.$main
  4885. 'try {',
  4886. ' $mod.vI = 1;',
  4887. '} catch ($e) {',
  4888. ' $mod.vI = 2;',
  4889. '};',
  4890. 'try {',
  4891. ' $mod.vI = 3;',
  4892. '} catch ($e) {',
  4893. ' throw $e;',
  4894. '};',
  4895. 'try {',
  4896. ' $mod.vI = 4;',
  4897. '} catch ($e) {',
  4898. ' if ($mod.EInvalidCast.isPrototypeOf($e)){',
  4899. ' throw $e',
  4900. ' } else if ($mod.Exception.isPrototypeOf($e)) {',
  4901. ' var E = $e;',
  4902. ' if (E.Msg === "") throw E;',
  4903. ' } else {',
  4904. ' $mod.vI = 5;',
  4905. ' }',
  4906. '};',
  4907. 'try {',
  4908. ' $mod.vI = 6;',
  4909. '} catch ($e) {',
  4910. ' if ($mod.EInvalidCast.isPrototypeOf($e)){' ,
  4911. ' } else throw $e',
  4912. '};',
  4913. '']));
  4914. end;
  4915. procedure TTestModule.TestCaseOf;
  4916. begin
  4917. StartProgram(false);
  4918. Add('var vI: longint;');
  4919. Add('begin');
  4920. Add(' case vi of');
  4921. Add(' 1: ;');
  4922. Add(' 2: vi:=3;');
  4923. Add(' else');
  4924. Add(' VI:=4');
  4925. Add(' end;');
  4926. ConvertProgram;
  4927. CheckSource('TestCaseOf',
  4928. LinesToStr([ // statements
  4929. 'this.vI = 0;'
  4930. ]),
  4931. LinesToStr([ // $mod.$main
  4932. 'var $tmp1 = $mod.vI;',
  4933. 'if ($tmp1 === 1) {} else if ($tmp1 === 2){ $mod.vI = 3 }else {',
  4934. ' $mod.vI = 4;',
  4935. '};'
  4936. ]));
  4937. end;
  4938. procedure TTestModule.TestCaseOf_UseSwitch;
  4939. begin
  4940. StartProgram(false);
  4941. Converter.UseSwitchStatement:=true;
  4942. Add('var Vi: longint;');
  4943. Add('begin');
  4944. Add(' case vi of');
  4945. Add(' 1: ;');
  4946. Add(' 2: VI:=3;');
  4947. Add(' else');
  4948. Add(' vi:=4');
  4949. Add(' end;');
  4950. ConvertProgram;
  4951. CheckSource('TestCaseOf_UseSwitch',
  4952. LinesToStr([ // statements
  4953. 'this.Vi = 0;'
  4954. ]),
  4955. LinesToStr([ // $mod.$main
  4956. 'switch ($mod.Vi) {',
  4957. 'case 1:',
  4958. ' break;',
  4959. 'case 2:',
  4960. ' $mod.Vi = 3;',
  4961. ' break;',
  4962. 'default:',
  4963. ' $mod.Vi = 4;',
  4964. '};'
  4965. ]));
  4966. end;
  4967. procedure TTestModule.TestCaseOfNoElse;
  4968. begin
  4969. StartProgram(false);
  4970. Add('var Vi: longint;');
  4971. Add('begin');
  4972. Add(' case vi of');
  4973. Add(' 1: begin vi:=2; VI:=3; end;');
  4974. Add(' end;');
  4975. ConvertProgram;
  4976. CheckSource('TestCaseOfNoElse',
  4977. LinesToStr([ // statements
  4978. 'this.Vi = 0;'
  4979. ]),
  4980. LinesToStr([ // $mod.$main
  4981. 'var $tmp1 = $mod.Vi;',
  4982. 'if ($tmp1 === 1) {',
  4983. ' $mod.Vi = 2;',
  4984. ' $mod.Vi = 3;',
  4985. '};'
  4986. ]));
  4987. end;
  4988. procedure TTestModule.TestCaseOfNoElse_UseSwitch;
  4989. begin
  4990. StartProgram(false);
  4991. Converter.UseSwitchStatement:=true;
  4992. Add('var vI: longint;');
  4993. Add('begin');
  4994. Add(' case vi of');
  4995. Add(' 1: begin VI:=2; vi:=3; end;');
  4996. Add(' end;');
  4997. ConvertProgram;
  4998. CheckSource('TestCaseOfNoElse_UseSwitch',
  4999. LinesToStr([ // statements
  5000. 'this.vI = 0;'
  5001. ]),
  5002. LinesToStr([ // $mod.$main
  5003. 'switch ($mod.vI) {',
  5004. 'case 1:',
  5005. ' $mod.vI = 2;',
  5006. ' $mod.vI = 3;',
  5007. ' break;',
  5008. '};'
  5009. ]));
  5010. end;
  5011. procedure TTestModule.TestCaseOfRange;
  5012. begin
  5013. StartProgram(false);
  5014. Add('var vI: longint;');
  5015. Add('begin');
  5016. Add(' case vi of');
  5017. Add(' 1..3: vi:=14;');
  5018. Add(' 4,5: vi:=16;');
  5019. Add(' 6..7,9..10: ;');
  5020. Add(' else ;');
  5021. Add(' end;');
  5022. ConvertProgram;
  5023. CheckSource('TestCaseOfRange',
  5024. LinesToStr([ // statements
  5025. 'this.vI = 0;'
  5026. ]),
  5027. LinesToStr([ // $mod.$main
  5028. 'var $tmp1 = $mod.vI;',
  5029. 'if (($tmp1 >= 1) && ($tmp1 <= 3)){',
  5030. ' $mod.vI = 14',
  5031. '} else if (($tmp1 === 4) || ($tmp1 === 5)){',
  5032. ' $mod.vI = 16',
  5033. '} else if ((($tmp1 >= 6) && ($tmp1 <= 7)) || (($tmp1 >= 9) && ($tmp1 <= 10))) ;'
  5034. ]));
  5035. end;
  5036. procedure TTestModule.TestArray_Dynamic;
  5037. begin
  5038. StartProgram(false);
  5039. Add('type');
  5040. Add(' TArrayInt = array of longint;');
  5041. Add('var');
  5042. Add(' Arr: TArrayInt;');
  5043. Add(' i: longint;');
  5044. Add(' b: boolean;');
  5045. Add('begin');
  5046. Add(' SetLength(arr,3);');
  5047. Add(' arr[0]:=4;');
  5048. Add(' arr[1]:=length(arr)+arr[0];');
  5049. Add(' arr[i]:=5;');
  5050. Add(' arr[arr[i]]:=arr[6];');
  5051. Add(' i:=low(arr);');
  5052. Add(' i:=high(arr);');
  5053. Add(' b:=Assigned(arr);');
  5054. ConvertProgram;
  5055. CheckSource('TestArray_Dynamic',
  5056. LinesToStr([ // statements
  5057. 'this.Arr = [];',
  5058. 'this.i = 0;',
  5059. 'this.b = false;'
  5060. ]),
  5061. LinesToStr([ // $mod.$main
  5062. '$mod.Arr = rtl.arraySetLength($mod.Arr,0,3);',
  5063. '$mod.Arr[0] = 4;',
  5064. '$mod.Arr[1] = rtl.length($mod.Arr) + $mod.Arr[0];',
  5065. '$mod.Arr[$mod.i] = 5;',
  5066. '$mod.Arr[$mod.Arr[$mod.i]] = $mod.Arr[6];',
  5067. '$mod.i = 0;',
  5068. '$mod.i = rtl.length($mod.Arr) - 1;',
  5069. '$mod.b = rtl.length($mod.Arr) > 0;',
  5070. '']));
  5071. end;
  5072. procedure TTestModule.TestArray_Dynamic_Nil;
  5073. begin
  5074. StartProgram(false);
  5075. Add('type');
  5076. Add(' TArrayInt = array of longint;');
  5077. Add('var');
  5078. Add(' Arr: TArrayInt;');
  5079. Add('procedure DoIt(const i: TArrayInt; j: TArrayInt); begin end;');
  5080. Add('begin');
  5081. Add(' arr:=nil;');
  5082. Add(' if arr=nil then;');
  5083. Add(' if nil=arr then;');
  5084. Add(' if arr<>nil then;');
  5085. Add(' if nil<>arr then;');
  5086. Add(' DoIt(nil,nil);');
  5087. ConvertProgram;
  5088. CheckSource('TestArray_Dynamic',
  5089. LinesToStr([ // statements
  5090. 'this.Arr = [];',
  5091. 'this.DoIt = function(i,j){',
  5092. '};'
  5093. ]),
  5094. LinesToStr([ // $mod.$main
  5095. '$mod.Arr = [];',
  5096. 'if (rtl.length($mod.Arr) === 0) ;',
  5097. 'if (rtl.length($mod.Arr) === 0) ;',
  5098. 'if (rtl.length($mod.Arr) > 0) ;',
  5099. 'if (rtl.length($mod.Arr) > 0) ;',
  5100. '$mod.DoIt([],[]);',
  5101. '']));
  5102. end;
  5103. procedure TTestModule.TestArray_DynMultiDimensional;
  5104. begin
  5105. StartProgram(false);
  5106. Add('type');
  5107. Add(' TArrayInt = array of longint;');
  5108. Add(' TArrayArrayInt = array of TArrayInt;');
  5109. Add('var');
  5110. Add(' Arr: TArrayInt;');
  5111. Add(' Arr2: TArrayArrayInt;');
  5112. Add(' i: longint;');
  5113. Add('begin');
  5114. Add(' arr2:=nil;');
  5115. Add(' if arr2=nil then;');
  5116. Add(' if nil=arr2 then;');
  5117. Add(' i:=low(arr2);');
  5118. Add(' i:=low(arr2[1]);');
  5119. Add(' i:=high(arr2);');
  5120. Add(' i:=high(arr2[2]);');
  5121. Add(' arr2[3]:=arr;');
  5122. Add(' arr2[4][5]:=i;');
  5123. Add(' i:=arr2[6][7];');
  5124. Add(' arr2[8,9]:=i;');
  5125. Add(' i:=arr2[10,11];');
  5126. Add(' SetLength(arr2,14);');
  5127. Add(' SetLength(arr2[15],16);');
  5128. ConvertProgram;
  5129. CheckSource('TestArray_Dynamic',
  5130. LinesToStr([ // statements
  5131. 'this.Arr = [];',
  5132. 'this.Arr2 = [];',
  5133. 'this.i = 0;'
  5134. ]),
  5135. LinesToStr([ // $mod.$main
  5136. '$mod.Arr2 = [];',
  5137. 'if (rtl.length($mod.Arr2) === 0) ;',
  5138. 'if (rtl.length($mod.Arr2) === 0) ;',
  5139. '$mod.i = 0;',
  5140. '$mod.i = 0;',
  5141. '$mod.i = rtl.length($mod.Arr2) - 1;',
  5142. '$mod.i = rtl.length($mod.Arr2[2]) - 1;',
  5143. '$mod.Arr2[3] = $mod.Arr;',
  5144. '$mod.Arr2[4][5] = $mod.i;',
  5145. '$mod.i = $mod.Arr2[6][7];',
  5146. '$mod.Arr2[8][9] = $mod.i;',
  5147. '$mod.i = $mod.Arr2[10][11];',
  5148. '$mod.Arr2 = rtl.arraySetLength($mod.Arr2, [], 14);',
  5149. '$mod.Arr2[15] = rtl.arraySetLength($mod.Arr2[15], 0, 16);',
  5150. '']));
  5151. end;
  5152. procedure TTestModule.TestArray_StaticInt;
  5153. begin
  5154. StartProgram(false);
  5155. Add('type');
  5156. Add(' TArrayInt = array[2..4] of longint;');
  5157. Add('var');
  5158. Add(' Arr: TArrayInt;');
  5159. Add(' Arr2: TArrayInt = (5,6,7);');
  5160. Add(' i: longint;');
  5161. Add(' b: boolean;');
  5162. Add('begin');
  5163. Add(' arr[2]:=4;');
  5164. Add(' arr[3]:=arr[2]+arr[3];');
  5165. Add(' arr[i]:=5;');
  5166. Add(' arr[arr[i]]:=arr[high(arr)];');
  5167. Add(' i:=low(arr);');
  5168. Add(' i:=high(arr);');
  5169. Add(' b:=arr[2]=arr[3];');
  5170. ConvertProgram;
  5171. CheckSource('TestArray_StaticInt',
  5172. LinesToStr([ // statements
  5173. 'this.Arr = rtl.arraySetLength(null,0,3);',
  5174. 'this.Arr2 = [5, 6, 7];',
  5175. 'this.i = 0;',
  5176. 'this.b = false;'
  5177. ]),
  5178. LinesToStr([ // $mod.$main
  5179. '$mod.Arr[0] = 4;',
  5180. '$mod.Arr[1] = $mod.Arr[0] + $mod.Arr[1];',
  5181. '$mod.Arr[$mod.i-2] = 5;',
  5182. '$mod.Arr[$mod.Arr[$mod.i-2]-2] = $mod.Arr[2];',
  5183. '$mod.i = 2;',
  5184. '$mod.i = 4;',
  5185. '$mod.b = $mod.Arr[0] === $mod.Arr[1];',
  5186. '']));
  5187. end;
  5188. procedure TTestModule.TestArray_StaticBool;
  5189. begin
  5190. StartProgram(false);
  5191. Add('type');
  5192. Add(' TBools = array[boolean] of boolean;');
  5193. Add(' TBool2 = array[true..true] of boolean;');
  5194. Add('var');
  5195. Add(' Arr: TBools;');
  5196. Add(' Arr2: TBool2;');
  5197. Add(' Arr3: TBools = (true,false);');
  5198. Add(' b: boolean;');
  5199. Add('begin');
  5200. Add(' b:=low(arr);');
  5201. Add(' b:=high(arr);');
  5202. Add(' arr[true]:=false;');
  5203. Add(' arr[false]:=arr[b] or arr[true];');
  5204. Add(' arr[b]:=true;');
  5205. Add(' arr[arr[b]]:=arr[high(arr)];');
  5206. Add(' b:=arr[false]=arr[true];');
  5207. Add(' b:=low(arr2);');
  5208. Add(' b:=high(arr2);');
  5209. Add(' arr2[true]:=true;');
  5210. Add(' arr2[true]:=arr2[true] and arr2[b];');
  5211. Add(' arr2[b]:=false;');
  5212. ConvertProgram;
  5213. CheckSource('TestArray_StaticBool',
  5214. LinesToStr([ // statements
  5215. 'this.Arr = rtl.arraySetLength(null,false,2);',
  5216. 'this.Arr2 = rtl.arraySetLength(null,false,1);',
  5217. 'this.Arr3 = [true, false];',
  5218. 'this.b = false;'
  5219. ]),
  5220. LinesToStr([ // $mod.$main
  5221. '$mod.b = false;',
  5222. '$mod.b = true;',
  5223. '$mod.Arr[1] = false;',
  5224. '$mod.Arr[0] = $mod.Arr[+$mod.b] || $mod.Arr[1];',
  5225. '$mod.Arr[+$mod.b] = true;',
  5226. '$mod.Arr[+$mod.Arr[+$mod.b]] = $mod.Arr[1];',
  5227. '$mod.b = $mod.Arr[0] === $mod.Arr[1];',
  5228. '$mod.b = true;',
  5229. '$mod.b = true;',
  5230. '$mod.Arr2[0] = true;',
  5231. '$mod.Arr2[0] = $mod.Arr2[0] && $mod.Arr2[1-$mod.b];',
  5232. '$mod.Arr2[1-$mod.b] = false;',
  5233. '']));
  5234. end;
  5235. procedure TTestModule.TestArray_StaticChar;
  5236. begin
  5237. StartProgram(false);
  5238. Add('type');
  5239. Add(' TChars = array[char] of char;');
  5240. Add(' TChars2 = array[''a''..''z''] of char;');
  5241. Add('var');
  5242. Add(' Arr: TChars;');
  5243. Add(' Arr2: TChars2;');
  5244. Add(' Arr3: array[2..4] of char = (''p'',''a'',''s'');');
  5245. Add(' Arr4: array[11..13] of char = ''pas'';');
  5246. Add(' Arr5: array[21..22] of char = ''äö'';');
  5247. Add(' c: char;');
  5248. Add(' b: boolean;');
  5249. Add('begin');
  5250. Add(' c:=low(arr);');
  5251. Add(' c:=high(arr);');
  5252. Add(' arr[''B'']:=''a'';');
  5253. Add(' arr[''D'']:=arr[c];');
  5254. Add(' arr[c]:=arr[''d''];');
  5255. Add(' arr[arr[c]]:=arr[high(arr)];');
  5256. Add(' b:=arr[low(arr)]=arr[''e''];');
  5257. Add(' c:=low(arr2);');
  5258. Add(' c:=high(arr2);');
  5259. Add(' arr2[''b'']:=''f'';');
  5260. Add(' arr2[''a'']:=arr2[c];');
  5261. Add(' arr2[c]:=arr2[''g''];');
  5262. ConvertProgram;
  5263. CheckSource('TestArray_StaticChar',
  5264. LinesToStr([ // statements
  5265. 'this.Arr = rtl.arraySetLength(null, "", 65536);',
  5266. 'this.Arr2 = rtl.arraySetLength(null, "", 26);',
  5267. 'this.Arr3 = ["p", "a", "s"];',
  5268. 'this.Arr4 = ["p", "a", "s"];',
  5269. 'this.Arr5 = ["ä", "ö"];',
  5270. 'this.c = "";',
  5271. 'this.b = false;',
  5272. '']),
  5273. LinesToStr([ // $mod.$main
  5274. '$mod.c = "\x00";',
  5275. '$mod.c = "'#$EF#$BF#$BF'";',
  5276. '$mod.Arr[66] = "a";',
  5277. '$mod.Arr[68] = $mod.Arr[$mod.c.charCodeAt()];',
  5278. '$mod.Arr[$mod.c.charCodeAt()] = $mod.Arr[100];',
  5279. '$mod.Arr[$mod.Arr[$mod.c.charCodeAt()].charCodeAt()] = $mod.Arr[65535];',
  5280. '$mod.b = $mod.Arr[0] === $mod.Arr[101];',
  5281. '$mod.c = "a";',
  5282. '$mod.c = "z";',
  5283. '$mod.Arr2[1] = "f";',
  5284. '$mod.Arr2[0] = $mod.Arr2[$mod.c.charCodeAt() - 97];',
  5285. '$mod.Arr2[$mod.c.charCodeAt() - 97] = $mod.Arr2[6];',
  5286. '']));
  5287. end;
  5288. procedure TTestModule.TestArray_StaticMultiDim;
  5289. begin
  5290. exit;
  5291. StartProgram(false);
  5292. Add('type');
  5293. Add(' TArrayInt = array[1..3] of longint;');
  5294. Add(' TArrayArrayInt = array[5..6] of TArrayInt;');
  5295. Add('var');
  5296. Add(' Arr: TArrayInt;');
  5297. Add(' Arr2: TArrayArrayInt;');
  5298. Add(' i: longint;');
  5299. Add('begin');
  5300. Add(' i:=low(arr);');
  5301. Add(' i:=low(arr2);');
  5302. Add(' i:=low(arr2[5]);');
  5303. Add(' i:=high(arr);');
  5304. Add(' i:=high(arr2);');
  5305. Add(' i:=high(arr2[6]);');
  5306. Add(' arr2[3]:=arr;');
  5307. Add(' arr2[4][5]:=i;');
  5308. Add(' i:=arr2[6][7];');
  5309. Add(' arr2[8,9]:=i;');
  5310. Add(' i:=arr2[10,11];');
  5311. Add(' SetLength(arr2,14);');
  5312. Add(' SetLength(arr2[15],16);');
  5313. ConvertProgram;
  5314. CheckSource('TestArray_StaticMultiDim',
  5315. LinesToStr([ // statements
  5316. 'this.Arr = [];',
  5317. 'this.Arr2 = [];',
  5318. 'this.i = 0;'
  5319. ]),
  5320. LinesToStr([ // $mod.$main
  5321. '$mod.Arr2 = [];',
  5322. 'if (rtl.length($mod.Arr2) === 0) ;',
  5323. 'if (rtl.length($mod.Arr2) === 0) ;',
  5324. '$mod.i = 0;',
  5325. '$mod.i = 0;',
  5326. '$mod.i = rtl.length($mod.Arr2) - 1;',
  5327. '$mod.i = rtl.length($mod.Arr2[2]) - 1;',
  5328. '$mod.Arr2[3] = $mod.Arr;',
  5329. '$mod.Arr2[4][5] = $mod.i;',
  5330. '$mod.i = $mod.Arr2[6][7];',
  5331. '$mod.Arr2[8][9] = $mod.i;',
  5332. '$mod.i = $mod.Arr2[10][11];',
  5333. '$mod.Arr2 = rtl.arraySetLength($mod.Arr2, [], 14);',
  5334. '$mod.Arr2[15] = rtl.arraySetLength($mod.Arr2[15], 0, 16);',
  5335. '']));
  5336. end;
  5337. procedure TTestModule.TestArrayOfRecord;
  5338. begin
  5339. StartProgram(false);
  5340. Add('type');
  5341. Add(' TRec = record');
  5342. Add(' Int: longint;');
  5343. Add(' end;');
  5344. Add(' TArrayRec = array of TRec;');
  5345. Add('var');
  5346. Add(' Arr: TArrayRec;');
  5347. Add(' r: TRec;');
  5348. Add(' i: longint;');
  5349. Add('begin');
  5350. Add(' SetLength(arr,3);');
  5351. Add(' arr[0].int:=4;');
  5352. Add(' arr[1].int:=length(arr)+arr[2].int;');
  5353. Add(' arr[arr[i].int].int:=arr[5].int;');
  5354. Add(' arr[7]:=r;');
  5355. Add(' r:=arr[8];');
  5356. Add(' i:=low(arr);');
  5357. Add(' i:=high(arr);');
  5358. ConvertProgram;
  5359. CheckSource('TestArrayOfRecord',
  5360. LinesToStr([ // statements
  5361. 'this.TRec = function (s) {',
  5362. ' if (s) {',
  5363. ' this.Int = s.Int;',
  5364. ' } else {',
  5365. ' this.Int = 0;',
  5366. ' };',
  5367. ' this.$equal = function (b) {',
  5368. ' return this.Int === b.Int;',
  5369. ' };',
  5370. '};',
  5371. 'this.Arr = [];',
  5372. 'this.r = new $mod.TRec();',
  5373. 'this.i = 0;'
  5374. ]),
  5375. LinesToStr([ // $mod.$main
  5376. '$mod.Arr = rtl.arraySetLength($mod.Arr,$mod.TRec,3);',
  5377. '$mod.Arr[0].Int = 4;',
  5378. '$mod.Arr[1].Int = rtl.length($mod.Arr)+$mod.Arr[2].Int;',
  5379. '$mod.Arr[$mod.Arr[$mod.i].Int].Int = $mod.Arr[5].Int;',
  5380. '$mod.Arr[7] = new $mod.TRec($mod.r);',
  5381. '$mod.r = new $mod.TRec($mod.Arr[8]);',
  5382. '$mod.i = 0;',
  5383. '$mod.i = rtl.length($mod.Arr)-1;',
  5384. '']));
  5385. end;
  5386. procedure TTestModule.TestArray_AsParams;
  5387. begin
  5388. StartProgram(false);
  5389. Add('type integer = longint;');
  5390. Add('type TArrInt = array of integer;');
  5391. Add('procedure DoIt(vG: TArrInt; const vH: TArrInt; var vI: TArrInt);');
  5392. Add('var vJ: TArrInt;');
  5393. Add('begin');
  5394. Add(' vg:=vg;');
  5395. Add(' vj:=vh;');
  5396. Add(' vi:=vi;');
  5397. Add(' doit(vg,vg,vg);');
  5398. Add(' doit(vh,vh,vj);');
  5399. Add(' doit(vi,vi,vi);');
  5400. Add(' doit(vj,vj,vj);');
  5401. Add('end;');
  5402. Add('var i: TArrInt;');
  5403. Add('begin');
  5404. Add(' doit(i,i,i);');
  5405. ConvertProgram;
  5406. CheckSource('TestArray_AsParams',
  5407. LinesToStr([ // statements
  5408. 'this.DoIt = function (vG,vH,vI) {',
  5409. ' var vJ = [];',
  5410. ' vG = vG;',
  5411. ' vJ = vH;',
  5412. ' vI.set(vI.get());',
  5413. ' $mod.DoIt(vG, vG, {',
  5414. ' get: function () {',
  5415. ' return vG;',
  5416. ' },',
  5417. ' set: function (v) {',
  5418. ' vG = v;',
  5419. ' }',
  5420. ' });',
  5421. ' $mod.DoIt(vH, vH, {',
  5422. ' get: function () {',
  5423. ' return vJ;',
  5424. ' },',
  5425. ' set: function (v) {',
  5426. ' vJ = v;',
  5427. ' }',
  5428. ' });',
  5429. ' $mod.DoIt(vI.get(), vI.get(), vI);',
  5430. ' $mod.DoIt(vJ, vJ, {',
  5431. ' get: function () {',
  5432. ' return vJ;',
  5433. ' },',
  5434. ' set: function (v) {',
  5435. ' vJ = v;',
  5436. ' }',
  5437. ' });',
  5438. '};',
  5439. 'this.i = [];'
  5440. ]),
  5441. LinesToStr([
  5442. '$mod.DoIt($mod.i,$mod.i,{',
  5443. ' p: $mod,',
  5444. ' get: function () {',
  5445. ' return this.p.i;',
  5446. ' },',
  5447. ' set: function (v) {',
  5448. ' this.p.i = v;',
  5449. ' }',
  5450. '});'
  5451. ]));
  5452. end;
  5453. procedure TTestModule.TestArrayElement_AsParams;
  5454. begin
  5455. StartProgram(false);
  5456. Add('type integer = longint;');
  5457. Add('type TArrayInt = array of integer;');
  5458. Add('procedure DoIt(vG: Integer; const vH: Integer; var vI: Integer);');
  5459. Add('var vJ: tarrayint;');
  5460. Add('begin');
  5461. Add(' vi:=vi;');
  5462. Add(' doit(vi,vi,vi);');
  5463. Add(' doit(vj[1+1],vj[1+2],vj[1+3]);');
  5464. Add('end;');
  5465. Add('var a: TArrayInt;');
  5466. Add('begin');
  5467. Add(' doit(a[1+4],a[1+5],a[1+6]);');
  5468. ConvertProgram;
  5469. CheckSource('TestArrayElement_AsParams',
  5470. LinesToStr([ // statements
  5471. 'this.DoIt = function (vG,vH,vI) {',
  5472. ' var vJ = [];',
  5473. ' vI.set(vI.get());',
  5474. ' $mod.DoIt(vI.get(), vI.get(), vI);',
  5475. ' $mod.DoIt(vJ[1+1], vJ[1+2], {',
  5476. ' a:1+3,',
  5477. ' p:vJ,',
  5478. ' get: function () {',
  5479. ' return this.p[this.a];',
  5480. ' },',
  5481. ' set: function (v) {',
  5482. ' this.p[this.a] = v;',
  5483. ' }',
  5484. ' });',
  5485. '};',
  5486. 'this.a = [];'
  5487. ]),
  5488. LinesToStr([
  5489. '$mod.DoIt($mod.a[1+4],$mod.a[1+5],{',
  5490. ' a: 1+6,',
  5491. ' p: $mod.a,',
  5492. ' get: function () {',
  5493. ' return this.p[this.a];',
  5494. ' },',
  5495. ' set: function (v) {',
  5496. ' this.p[this.a] = v;',
  5497. ' }',
  5498. '});'
  5499. ]));
  5500. end;
  5501. procedure TTestModule.TestArrayElementFromFuncResult_AsParams;
  5502. begin
  5503. StartProgram(false);
  5504. Add('type Integer = longint;');
  5505. Add('type TArrayInt = array of integer;');
  5506. Add('function GetArr(vB: integer = 0): tarrayint;');
  5507. Add('begin');
  5508. Add('end;');
  5509. Add('procedure DoIt(vG: integer; const vH: integer; var vI: integer);');
  5510. Add('begin');
  5511. Add('end;');
  5512. Add('begin');
  5513. Add(' doit(getarr[1+1],getarr[1+2],getarr[1+3]);');
  5514. Add(' doit(getarr()[2+1],getarr()[2+2],getarr()[2+3]);');
  5515. Add(' doit(getarr(7)[3+1],getarr(8)[3+2],getarr(9)[3+3]);');
  5516. ConvertProgram;
  5517. CheckSource('TestArrayElementFromFuncResult_AsParams',
  5518. LinesToStr([ // statements
  5519. 'this.GetArr = function (vB) {',
  5520. ' var Result = [];',
  5521. ' return Result;',
  5522. '};',
  5523. 'this.DoIt = function (vG,vH,vI) {',
  5524. '};'
  5525. ]),
  5526. LinesToStr([
  5527. '$mod.DoIt($mod.GetArr(0)[1+1],$mod.GetArr(0)[1+2],{',
  5528. ' a: 1+3,',
  5529. ' p: $mod.GetArr(0),',
  5530. ' get: function () {',
  5531. ' return this.p[this.a];',
  5532. ' },',
  5533. ' set: function (v) {',
  5534. ' this.p[this.a] = v;',
  5535. ' }',
  5536. '});',
  5537. '$mod.DoIt($mod.GetArr(0)[2+1],$mod.GetArr(0)[2+2],{',
  5538. ' a: 2+3,',
  5539. ' p: $mod.GetArr(0),',
  5540. ' get: function () {',
  5541. ' return this.p[this.a];',
  5542. ' },',
  5543. ' set: function (v) {',
  5544. ' this.p[this.a] = v;',
  5545. ' }',
  5546. '});',
  5547. '$mod.DoIt($mod.GetArr(7)[3+1],$mod.GetArr(8)[3+2],{',
  5548. ' a: 3+3,',
  5549. ' p: $mod.GetArr(9),',
  5550. ' get: function () {',
  5551. ' return this.p[this.a];',
  5552. ' },',
  5553. ' set: function (v) {',
  5554. ' this.p[this.a] = v;',
  5555. ' }',
  5556. '});',
  5557. '']));
  5558. end;
  5559. procedure TTestModule.TestArrayEnumTypeRange;
  5560. begin
  5561. StartProgram(false);
  5562. Add('type');
  5563. Add(' TEnum = (red,blue);');
  5564. Add(' TEnumArray = array[TEnum] of longint;');
  5565. Add('var');
  5566. Add(' e: TEnum;');
  5567. Add(' i: longint;');
  5568. Add(' a: TEnumArray;');
  5569. Add(' numbers: TEnumArray = (1,2);');
  5570. Add(' names: array[TEnum] of string = (''red'',''blue'');');
  5571. Add('begin');
  5572. Add(' e:=low(a);');
  5573. Add(' e:=high(a);');
  5574. Add(' i:=a[red];');
  5575. Add(' a[e]:=a[e];');
  5576. ConvertProgram;
  5577. CheckSource('TestArrayEnumTypeRange',
  5578. LinesToStr([ // statements
  5579. ' this.TEnum = {',
  5580. ' "0": "red",',
  5581. ' red: 0,',
  5582. ' "1": "blue",',
  5583. ' blue: 1',
  5584. '};',
  5585. 'this.e = 0;',
  5586. 'this.i = 0;',
  5587. 'this.a = rtl.arraySetLength(null,0,2);',
  5588. 'this.numbers = [1, 2];',
  5589. 'this.names = ["red", "blue"];',
  5590. '']),
  5591. LinesToStr([ // $mod.$main
  5592. '$mod.e = $mod.TEnum.red;',
  5593. '$mod.e = $mod.TEnum.blue;',
  5594. '$mod.i = $mod.a[$mod.TEnum.red];',
  5595. '$mod.a[$mod.e] = $mod.a[$mod.e];',
  5596. '']));
  5597. end;
  5598. procedure TTestModule.TestArray_SetLengthOutArg;
  5599. begin
  5600. StartProgram(false);
  5601. Add([
  5602. 'type TArrInt = array of longint;',
  5603. 'procedure DoIt(out a: TArrInt);',
  5604. 'begin',
  5605. ' SetLength(a,2);',
  5606. 'end;',
  5607. 'begin',
  5608. '']);
  5609. ConvertProgram;
  5610. CheckSource('TestArray_SetLengthOutArg',
  5611. LinesToStr([ // statements
  5612. 'this.DoIt = function (a) {',
  5613. ' a.set(rtl.arraySetLength(a.get(), 0, 2));',
  5614. '};',
  5615. '']),
  5616. LinesToStr([
  5617. '']));
  5618. end;
  5619. procedure TTestModule.TestArray_SetLengthProperty;
  5620. begin
  5621. StartProgram(false);
  5622. Add('type');
  5623. Add(' TArrInt = array of longint;');
  5624. Add(' TObject = class');
  5625. Add(' function GetColors: TArrInt; external name ''GetColors'';');
  5626. Add(' procedure SetColors(const Value: TArrInt); external name ''SetColors'';');
  5627. Add(' property Colors: TArrInt read GetColors write SetColors;');
  5628. Add(' end;');
  5629. Add('var Obj: TObject;');
  5630. Add('begin');
  5631. Add(' SetLength(Obj.Colors,2);');
  5632. ConvertProgram;
  5633. CheckSource('TestArray_SetLengthProperty',
  5634. LinesToStr([ // statements
  5635. 'rtl.createClass($mod, "TObject", null, function () {',
  5636. ' this.$init = function () {',
  5637. ' };',
  5638. ' this.$final = function () {',
  5639. ' };',
  5640. '});',
  5641. 'this.Obj = null;',
  5642. '']),
  5643. LinesToStr([
  5644. '$mod.Obj.SetColors(rtl.arraySetLength($mod.Obj.GetColors(), 0, 2));',
  5645. '']));
  5646. end;
  5647. procedure TTestModule.TestArray_SetLengthMultiDim;
  5648. begin
  5649. StartProgram(false);
  5650. Add([
  5651. 'type',
  5652. ' TArrArrInt = array of array of longint;',
  5653. 'var',
  5654. ' a: TArrArrInt;',
  5655. 'begin',
  5656. ' SetLength(a,2);',
  5657. ' SetLength(a,3,4);',
  5658. '']);
  5659. ConvertProgram;
  5660. CheckSource('TestArray_SetLengthMultiDim',
  5661. LinesToStr([ // statements
  5662. 'this.a = [];']),
  5663. LinesToStr([
  5664. '$mod.a = rtl.arraySetLength($mod.a, [], 2);',
  5665. '$mod.a = rtl.arraySetLength($mod.a, 0, 3, 4);',
  5666. '']));
  5667. end;
  5668. procedure TTestModule.TestArray_OpenArrayOfString;
  5669. begin
  5670. StartProgram(false);
  5671. Add('procedure DoIt(const a: array of String);');
  5672. Add('var');
  5673. Add(' i: longint;');
  5674. Add(' s: string;');
  5675. Add('begin');
  5676. Add(' for i:=low(a) to high(a) do s:=a[length(a)-i-1];');
  5677. Add('end;');
  5678. Add('var s: string;');
  5679. Add('begin');
  5680. Add(' DoIt([]);');
  5681. Add(' DoIt([s,''foo'','''',s+s]);');
  5682. ConvertProgram;
  5683. CheckSource('TestArray_OpenArrayOfString',
  5684. LinesToStr([ // statements
  5685. 'this.DoIt = function (a) {',
  5686. ' var i = 0;',
  5687. ' var s = "";',
  5688. ' for (var $l1 = 0, $end2 = rtl.length(a) - 1; $l1 <= $end2; $l1++) {',
  5689. ' i = $l1;',
  5690. ' s = a[(rtl.length(a) - i) - 1];',
  5691. ' };',
  5692. '};',
  5693. 'this.s = "";',
  5694. '']),
  5695. LinesToStr([
  5696. '$mod.DoIt([]);',
  5697. '$mod.DoIt([$mod.s, "foo", "", $mod.s + $mod.s]);',
  5698. '']));
  5699. end;
  5700. procedure TTestModule.TestArray_Concat;
  5701. begin
  5702. StartProgram(false);
  5703. Add('type');
  5704. Add(' integer = longint;');
  5705. Add(' TFlag = (big,small);');
  5706. Add(' TFlags = set of TFlag;');
  5707. Add(' TRec = record');
  5708. Add(' i: integer;');
  5709. Add(' end;');
  5710. Add(' TArrInt = array of integer;');
  5711. Add(' TArrRec = array of TRec;');
  5712. Add(' TArrSet = array of TFlags;');
  5713. Add(' TArrJSValue = array of jsvalue;');
  5714. Add('var');
  5715. Add(' ArrInt: tarrint;');
  5716. Add(' ArrRec: tarrrec;');
  5717. Add(' ArrSet: tarrset;');
  5718. Add(' ArrJSValue: tarrjsvalue;');
  5719. Add('begin');
  5720. Add(' arrint:=concat(arrint);');
  5721. Add(' arrint:=concat(arrint,arrint);');
  5722. Add(' arrint:=concat(arrint,arrint,arrint);');
  5723. Add(' arrrec:=concat(arrrec);');
  5724. Add(' arrrec:=concat(arrrec,arrrec);');
  5725. Add(' arrrec:=concat(arrrec,arrrec,arrrec);');
  5726. Add(' arrset:=concat(arrset);');
  5727. Add(' arrset:=concat(arrset,arrset);');
  5728. Add(' arrset:=concat(arrset,arrset,arrset);');
  5729. Add(' arrjsvalue:=concat(arrjsvalue);');
  5730. Add(' arrjsvalue:=concat(arrjsvalue,arrjsvalue);');
  5731. Add(' arrjsvalue:=concat(arrjsvalue,arrjsvalue,arrjsvalue);');
  5732. ConvertProgram;
  5733. CheckSource('TestArray_Concat',
  5734. LinesToStr([ // statements
  5735. 'this.TFlag = {',
  5736. ' "0": "big",',
  5737. ' big: 0,',
  5738. ' "1": "small",',
  5739. ' small: 1',
  5740. '};',
  5741. 'this.TRec = function (s) {',
  5742. ' if (s) {',
  5743. ' this.i = s.i;',
  5744. ' } else {',
  5745. ' this.i = 0;',
  5746. ' };',
  5747. ' this.$equal = function (b) {',
  5748. ' return this.i === b.i;',
  5749. ' };',
  5750. '};',
  5751. 'this.ArrInt = [];',
  5752. 'this.ArrRec = [];',
  5753. 'this.ArrSet = [];',
  5754. 'this.ArrJSValue = [];',
  5755. '']),
  5756. LinesToStr([ // $mod.$main
  5757. '$mod.ArrInt = $mod.ArrInt;',
  5758. '$mod.ArrInt = $mod.ArrInt.concat($mod.ArrInt);',
  5759. '$mod.ArrInt = $mod.ArrInt.concat($mod.ArrInt,$mod.ArrInt);',
  5760. '$mod.ArrRec = $mod.ArrRec;',
  5761. '$mod.ArrRec = rtl.arrayConcat($mod.TRec, $mod.ArrRec);',
  5762. '$mod.ArrRec = rtl.arrayConcat($mod.TRec, $mod.ArrRec, $mod.ArrRec);',
  5763. '$mod.ArrSet = $mod.ArrSet;',
  5764. '$mod.ArrSet = rtl.arrayConcat("refSet", $mod.ArrSet);',
  5765. '$mod.ArrSet = rtl.arrayConcat("refSet", $mod.ArrSet, $mod.ArrSet);',
  5766. '$mod.ArrJSValue = $mod.ArrJSValue;',
  5767. '$mod.ArrJSValue = $mod.ArrJSValue.concat($mod.ArrJSValue);',
  5768. '$mod.ArrJSValue = $mod.ArrJSValue.concat($mod.ArrJSValue, $mod.ArrJSValue);',
  5769. '']));
  5770. end;
  5771. procedure TTestModule.TestArray_Copy;
  5772. begin
  5773. StartProgram(false);
  5774. Add('type');
  5775. Add(' integer = longint;');
  5776. Add(' TFlag = (big,small);');
  5777. Add(' TFlags = set of TFlag;');
  5778. Add(' TRec = record');
  5779. Add(' i: integer;');
  5780. Add(' end;');
  5781. Add(' TArrInt = array of integer;');
  5782. Add(' TArrRec = array of TRec;');
  5783. Add(' TArrSet = array of TFlags;');
  5784. Add(' TArrJSValue = array of jsvalue;');
  5785. Add('var');
  5786. Add(' ArrInt: tarrint;');
  5787. Add(' ArrRec: tarrrec;');
  5788. Add(' ArrSet: tarrset;');
  5789. Add(' ArrJSValue: tarrjsvalue;');
  5790. Add('begin');
  5791. Add(' arrint:=copy(arrint);');
  5792. Add(' arrint:=copy(arrint,2);');
  5793. Add(' arrint:=copy(arrint,3,4);');
  5794. Add(' arrrec:=copy(arrrec);');
  5795. Add(' arrrec:=copy(arrrec,5);');
  5796. Add(' arrrec:=copy(arrrec,6,7);');
  5797. Add(' arrset:=copy(arrset);');
  5798. Add(' arrset:=copy(arrset,8);');
  5799. Add(' arrset:=copy(arrset,9,10);');
  5800. Add(' arrjsvalue:=copy(arrjsvalue);');
  5801. Add(' arrjsvalue:=copy(arrjsvalue,11);');
  5802. Add(' arrjsvalue:=copy(arrjsvalue,12,13);');
  5803. ConvertProgram;
  5804. CheckSource('TestArray_Copy',
  5805. LinesToStr([ // statements
  5806. 'this.TFlag = {',
  5807. ' "0": "big",',
  5808. ' big: 0,',
  5809. ' "1": "small",',
  5810. ' small: 1',
  5811. '};',
  5812. 'this.TRec = function (s) {',
  5813. ' if (s) {',
  5814. ' this.i = s.i;',
  5815. ' } else {',
  5816. ' this.i = 0;',
  5817. ' };',
  5818. ' this.$equal = function (b) {',
  5819. ' return this.i === b.i;',
  5820. ' };',
  5821. '};',
  5822. 'this.ArrInt = [];',
  5823. 'this.ArrRec = [];',
  5824. 'this.ArrSet = [];',
  5825. 'this.ArrJSValue = [];',
  5826. '']),
  5827. LinesToStr([ // $mod.$main
  5828. '$mod.ArrInt = rtl.arrayCopy(0, $mod.ArrInt, 0);',
  5829. '$mod.ArrInt = rtl.arrayCopy(0, $mod.ArrInt, 2);',
  5830. '$mod.ArrInt = rtl.arrayCopy(0, $mod.ArrInt, 3, 4);',
  5831. '$mod.ArrRec = rtl.arrayCopy($mod.TRec, $mod.ArrRec, 0);',
  5832. '$mod.ArrRec = rtl.arrayCopy($mod.TRec, $mod.ArrRec, 5);',
  5833. '$mod.ArrRec = rtl.arrayCopy($mod.TRec, $mod.ArrRec, 6, 7);',
  5834. '$mod.ArrSet = rtl.arrayCopy("refSet", $mod.ArrSet, 0);',
  5835. '$mod.ArrSet = rtl.arrayCopy("refSet", $mod.ArrSet, 8);',
  5836. '$mod.ArrSet = rtl.arrayCopy("refSet", $mod.ArrSet, 9, 10);',
  5837. '$mod.ArrJSValue = rtl.arrayCopy(0, $mod.ArrJSValue, 0);',
  5838. '$mod.ArrJSValue = rtl.arrayCopy(0, $mod.ArrJSValue, 11);',
  5839. '$mod.ArrJSValue = rtl.arrayCopy(0, $mod.ArrJSValue, 12, 13);',
  5840. '']));
  5841. end;
  5842. procedure TTestModule.TestArray_InsertDelete;
  5843. begin
  5844. StartProgram(false);
  5845. Add('type');
  5846. Add(' integer = longint;');
  5847. Add(' TFlag = (big,small);');
  5848. Add(' TFlags = set of TFlag;');
  5849. Add(' TRec = record');
  5850. Add(' i: integer;');
  5851. Add(' end;');
  5852. Add(' TArrInt = array of integer;');
  5853. Add(' TArrRec = array of TRec;');
  5854. Add(' TArrSet = array of TFlags;');
  5855. Add(' TArrJSValue = array of jsvalue;');
  5856. Add('var');
  5857. Add(' ArrInt: tarrint;');
  5858. Add(' ArrRec: tarrrec;');
  5859. Add(' ArrSet: tarrset;');
  5860. Add(' ArrJSValue: tarrjsvalue;');
  5861. Add('begin');
  5862. Add(' Insert(1,arrint,2);');
  5863. Add(' Insert(arrint[3],arrint,4);');
  5864. Add(' Insert(arrrec[5],arrrec,6);');
  5865. Add(' Insert(arrset[7],arrset,7);');
  5866. Add(' Insert(arrjsvalue[8],arrjsvalue,9);');
  5867. Add(' Insert(10,arrjsvalue,11);');
  5868. Add(' Delete(arrint,12,13);');
  5869. Add(' Delete(arrrec,14,15);');
  5870. Add(' Delete(arrset,17,18);');
  5871. Add(' Delete(arrjsvalue,19,10);');
  5872. ConvertProgram;
  5873. CheckSource('TestArray_InsertDelete',
  5874. LinesToStr([ // statements
  5875. 'this.TFlag = {',
  5876. ' "0": "big",',
  5877. ' big: 0,',
  5878. ' "1": "small",',
  5879. ' small: 1',
  5880. '};',
  5881. 'this.TRec = function (s) {',
  5882. ' if (s) {',
  5883. ' this.i = s.i;',
  5884. ' } else {',
  5885. ' this.i = 0;',
  5886. ' };',
  5887. ' this.$equal = function (b) {',
  5888. ' return this.i === b.i;',
  5889. ' };',
  5890. '};',
  5891. 'this.ArrInt = [];',
  5892. 'this.ArrRec = [];',
  5893. 'this.ArrSet = [];',
  5894. 'this.ArrJSValue = [];',
  5895. '']),
  5896. LinesToStr([ // $mod.$main
  5897. '$mod.ArrInt.splice(2, 0, 1);',
  5898. '$mod.ArrInt.splice(4, 0, $mod.ArrInt[3]);',
  5899. '$mod.ArrRec.splice(6, 0, $mod.ArrRec[5]);',
  5900. '$mod.ArrSet.splice(7, 0, $mod.ArrSet[7]);',
  5901. '$mod.ArrJSValue.splice(9, 0, $mod.ArrJSValue[8]);',
  5902. '$mod.ArrJSValue.splice(11, 0, 10);',
  5903. '$mod.ArrInt.splice(12, 13);',
  5904. '$mod.ArrRec.splice(14, 15);',
  5905. '$mod.ArrSet.splice(17, 18);',
  5906. '$mod.ArrJSValue.splice(19, 10);',
  5907. '']));
  5908. end;
  5909. procedure TTestModule.TestArray_DynArrayConst;
  5910. begin
  5911. StartProgram(false);
  5912. Add([
  5913. 'type',
  5914. ' integer = longint;',
  5915. ' TArrInt = array of integer;',
  5916. ' TArrStr = array of string;',
  5917. 'const',
  5918. ' Ints: TArrInt = (1,2,3);',
  5919. ' Names: array of string = (''a'',''foo'');',
  5920. ' Aliases: TarrStr = (''foo'',''b'');',
  5921. ' OneInt: TArrInt = (7);',
  5922. ' OneStr: array of integer = (7);',
  5923. //' Chars: array of char = ''aoc'';',
  5924. ' NameCount = low(Names)+high(Names)+length(Names);',
  5925. 'begin',
  5926. '']);
  5927. ConvertProgram;
  5928. CheckSource('TestArray_DynArrayConst',
  5929. LinesToStr([ // statements
  5930. 'this.Ints = [1, 2, 3];',
  5931. 'this.Names = ["a", "foo"];',
  5932. 'this.Aliases = ["foo", "b"];',
  5933. 'this.OneInt = [7];',
  5934. 'this.OneStr = [7];',
  5935. 'this.NameCount = (0 + (rtl.length($mod.Names) - 1)) + rtl.length($mod.Names);',
  5936. '']),
  5937. LinesToStr([ // $mod.$main
  5938. '']));
  5939. end;
  5940. procedure TTestModule.TestExternalClass_TypeCastArrayToExternalArray;
  5941. begin
  5942. StartProgram(false);
  5943. Add('{$modeswitch externalclass}');
  5944. Add('type');
  5945. Add(' TJSArray = class external name ''Array''');
  5946. Add(' class function isArray(Value: JSValue) : boolean;');
  5947. Add(' function concat() : TJSArray; varargs;');
  5948. Add(' end;');
  5949. Add('var');
  5950. Add(' aObj: TJSArray;');
  5951. Add(' a: array of longint;');
  5952. Add('begin');
  5953. Add(' if TJSArray.isArray(65) then ;');
  5954. Add(' aObj:=TJSArray(a).concat(a);');
  5955. ConvertProgram;
  5956. CheckSource('TestExternalClass_TypeCastArrayToExternalArray',
  5957. LinesToStr([ // statements
  5958. 'this.aObj = null;',
  5959. 'this.a = [];',
  5960. '']),
  5961. LinesToStr([ // $mod.$main
  5962. 'if (Array.isArray(65)) ;',
  5963. '$mod.aObj = $mod.a.concat($mod.a);',
  5964. '']));
  5965. end;
  5966. procedure TTestModule.TestExternalClass_TypeCastArrayFromExternalArray;
  5967. begin
  5968. StartProgram(false);
  5969. Add('{$modeswitch externalclass}');
  5970. Add('type');
  5971. Add(' TArrStr = array of string;');
  5972. Add(' TJSArray = class external name ''Array''');
  5973. Add(' end;');
  5974. Add('var');
  5975. Add(' aObj: TJSArray;');
  5976. Add(' a: TArrStr;');
  5977. Add('begin');
  5978. Add(' a:=TArrStr(aObj);');
  5979. Add(' TArrStr(aObj)[1]:=TArrStr(aObj)[2];');
  5980. ConvertProgram;
  5981. CheckSource('TestExternalClass_TypeCastArrayFromExternalArray',
  5982. LinesToStr([ // statements
  5983. 'this.aObj = null;',
  5984. 'this.a = [];',
  5985. '']),
  5986. LinesToStr([ // $mod.$main
  5987. '$mod.a = $mod.aObj;',
  5988. '$mod.aObj[1] = $mod.aObj[2];',
  5989. '']));
  5990. end;
  5991. procedure TTestModule.TestRecord_Var;
  5992. begin
  5993. StartProgram(false);
  5994. Add('type');
  5995. Add(' TRecA = record');
  5996. Add(' Bold: longint;');
  5997. Add(' end;');
  5998. Add('var Rec: TRecA;');
  5999. Add('begin');
  6000. Add(' rec.bold:=123');
  6001. ConvertProgram;
  6002. CheckSource('TestRecord_Var',
  6003. LinesToStr([ // statements
  6004. 'this.TRecA = function (s) {',
  6005. ' if (s) {',
  6006. ' this.Bold = s.Bold;',
  6007. ' } else {',
  6008. ' this.Bold = 0;',
  6009. ' };',
  6010. ' this.$equal = function (b) {',
  6011. ' return this.Bold === b.Bold;',
  6012. ' };',
  6013. '};',
  6014. 'this.Rec = new $mod.TRecA();'
  6015. ]),
  6016. LinesToStr([ // $mod.$main
  6017. '$mod.Rec.Bold = 123;'
  6018. ]));
  6019. end;
  6020. procedure TTestModule.TestWithRecordDo;
  6021. begin
  6022. StartProgram(false);
  6023. Add('type');
  6024. Add(' TRec = record');
  6025. Add(' vI: longint;');
  6026. Add(' end;');
  6027. Add('var');
  6028. Add(' Int: longint;');
  6029. Add(' r: TRec;');
  6030. Add('begin');
  6031. Add(' with r do');
  6032. Add(' int:=vi;');
  6033. Add(' with r do begin');
  6034. Add(' int:=vi;');
  6035. Add(' vi:=int;');
  6036. Add(' end;');
  6037. ConvertProgram;
  6038. CheckSource('TestWithRecordDo',
  6039. LinesToStr([ // statements
  6040. 'this.TRec = function (s) {',
  6041. ' if (s) {',
  6042. ' this.vI = s.vI;',
  6043. ' } else {',
  6044. ' this.vI = 0;',
  6045. ' };',
  6046. ' this.$equal = function (b) {',
  6047. ' return this.vI === b.vI;',
  6048. ' };',
  6049. '};',
  6050. 'this.Int = 0;',
  6051. 'this.r = new $mod.TRec();'
  6052. ]),
  6053. LinesToStr([ // $mod.$main
  6054. 'var $with1 = $mod.r;',
  6055. '$mod.Int = $with1.vI;',
  6056. 'var $with2 = $mod.r;',
  6057. '$mod.Int = $with2.vI;',
  6058. '$with2.vI = $mod.Int;'
  6059. ]));
  6060. end;
  6061. procedure TTestModule.TestRecord_Assign;
  6062. begin
  6063. StartProgram(false);
  6064. Add('type');
  6065. Add(' TEnum = (red,green);');
  6066. Add(' TEnums = set of TEnum;');
  6067. Add(' TSmallRec = record');
  6068. Add(' N: longint;');
  6069. Add(' end;');
  6070. Add(' TBigRec = record');
  6071. Add(' Int: longint;');
  6072. Add(' D: double;');
  6073. Add(' Arr: array of longint;');
  6074. Add(' Small: TSmallRec;');
  6075. Add(' Enums: TEnums;');
  6076. Add(' end;');
  6077. Add('var');
  6078. Add(' r, s: TBigRec;');
  6079. Add('begin');
  6080. Add(' r:=s;');
  6081. ConvertProgram;
  6082. CheckSource('TestRecord_Assign',
  6083. LinesToStr([ // statements
  6084. 'this.TEnum = {',
  6085. ' "0": "red",',
  6086. ' red: 0,',
  6087. ' "1": "green",',
  6088. ' green: 1',
  6089. '};',
  6090. 'this.TSmallRec = function (s) {',
  6091. ' if(s){',
  6092. ' this.N = s.N;',
  6093. ' } else {',
  6094. ' this.N = 0;',
  6095. ' };',
  6096. ' this.$equal = function (b) {',
  6097. ' return this.N === b.N;',
  6098. ' };',
  6099. '};',
  6100. 'this.TBigRec = function (s) {',
  6101. ' if(s){',
  6102. ' this.Int = s.Int;',
  6103. ' this.D = s.D;',
  6104. ' this.Arr = s.Arr;',
  6105. ' this.Small = new $mod.TSmallRec(s.Small);',
  6106. ' this.Enums = rtl.refSet(s.Enums);',
  6107. ' } else {',
  6108. ' this.Int = 0;',
  6109. ' this.D = 0.0;',
  6110. ' this.Arr = [];',
  6111. ' this.Small = new $mod.TSmallRec();',
  6112. ' this.Enums = {};',
  6113. ' };',
  6114. ' this.$equal = function (b) {',
  6115. ' return (this.Int === b.Int) && ((this.D === b.D) && ((this.Arr === b.Arr)',
  6116. ' && (this.Small.$equal(b.Small) && rtl.eqSet(this.Enums, b.Enums))));',
  6117. ' };',
  6118. '};',
  6119. 'this.r = new $mod.TBigRec();',
  6120. 'this.s = new $mod.TBigRec();'
  6121. ]),
  6122. LinesToStr([ // $mod.$main
  6123. '$mod.r = new $mod.TBigRec($mod.s);',
  6124. '']));
  6125. end;
  6126. procedure TTestModule.TestRecord_PassAsArgClone;
  6127. begin
  6128. StartProgram(false);
  6129. Add('type');
  6130. Add(' TRecA = record');
  6131. Add(' Bold: longint;');
  6132. Add(' end;');
  6133. Add('procedure DoDefault(r: treca); begin end;');
  6134. Add('procedure DoConst(const r: treca); begin end;');
  6135. Add('var Rec: treca;');
  6136. Add('begin');
  6137. Add(' dodefault(rec);');
  6138. Add(' doconst(rec);');
  6139. ConvertProgram;
  6140. CheckSource('TestRecord_PassAsArgClone',
  6141. LinesToStr([ // statements
  6142. 'this.TRecA = function (s) {',
  6143. ' if (s) {',
  6144. ' this.Bold = s.Bold;',
  6145. ' } else {',
  6146. ' this.Bold = 0;',
  6147. ' };',
  6148. ' this.$equal = function (b) {',
  6149. ' return this.Bold === b.Bold;',
  6150. ' };',
  6151. '};',
  6152. 'this.DoDefault = function (r) {',
  6153. '};',
  6154. 'this.DoConst = function (r) {',
  6155. '};',
  6156. 'this.Rec = new $mod.TRecA();'
  6157. ]),
  6158. LinesToStr([ // $mod.$main
  6159. '$mod.DoDefault(new $mod.TRecA($mod.Rec));',
  6160. '$mod.DoConst($mod.Rec);',
  6161. '']));
  6162. end;
  6163. procedure TTestModule.TestRecord_AsParams;
  6164. begin
  6165. StartProgram(false);
  6166. Add('type');
  6167. Add(' integer = longint;');
  6168. Add(' TRecord = record');
  6169. Add(' i: integer;');
  6170. Add(' end;');
  6171. Add('procedure DoIt(vG: TRecord; const vH: TRecord; var vI: TRecord);');
  6172. Add('var vJ: TRecord;');
  6173. Add('begin');
  6174. Add(' vg:=vg;');
  6175. Add(' vj:=vh;');
  6176. Add(' vi:=vi;');
  6177. Add(' doit(vg,vg,vg);');
  6178. Add(' doit(vh,vh,vj);');
  6179. Add(' doit(vi,vi,vi);');
  6180. Add(' doit(vj,vj,vj);');
  6181. Add('end;');
  6182. Add('var i: TRecord;');
  6183. Add('begin');
  6184. Add(' doit(i,i,i);');
  6185. ConvertProgram;
  6186. CheckSource('TestRecord_AsParams',
  6187. LinesToStr([ // statements
  6188. 'this.TRecord = function (s) {',
  6189. ' if (s) {',
  6190. ' this.i = s.i;',
  6191. ' } else {',
  6192. ' this.i = 0;',
  6193. ' };',
  6194. ' this.$equal = function (b) {',
  6195. ' return this.i === b.i;',
  6196. ' };',
  6197. '};',
  6198. 'this.DoIt = function (vG,vH,vI) {',
  6199. ' var vJ = new $mod.TRecord();',
  6200. ' vG = new $mod.TRecord(vG);',
  6201. ' vJ = new $mod.TRecord(vH);',
  6202. ' vI.set(new $mod.TRecord(vI.get()));',
  6203. ' $mod.DoIt(new $mod.TRecord(vG), vG, {',
  6204. ' get: function () {',
  6205. ' return vG;',
  6206. ' },',
  6207. ' set: function (v) {',
  6208. ' vG = v;',
  6209. ' }',
  6210. ' });',
  6211. ' $mod.DoIt(new $mod.TRecord(vH), vH, {',
  6212. ' get: function () {',
  6213. ' return vJ;',
  6214. ' },',
  6215. ' set: function (v) {',
  6216. ' vJ = v;',
  6217. ' }',
  6218. ' });',
  6219. ' $mod.DoIt(new $mod.TRecord(vI.get()), vI.get(), vI);',
  6220. ' $mod.DoIt(new $mod.TRecord(vJ), vJ, {',
  6221. ' get: function () {',
  6222. ' return vJ;',
  6223. ' },',
  6224. ' set: function (v) {',
  6225. ' vJ = v;',
  6226. ' }',
  6227. ' });',
  6228. '};',
  6229. 'this.i = new $mod.TRecord();'
  6230. ]),
  6231. LinesToStr([
  6232. '$mod.DoIt(new $mod.TRecord($mod.i),$mod.i,{',
  6233. ' p: $mod,',
  6234. ' get: function () {',
  6235. ' return this.p.i;',
  6236. ' },',
  6237. ' set: function (v) {',
  6238. ' this.p.i = v;',
  6239. ' }',
  6240. '});'
  6241. ]));
  6242. end;
  6243. procedure TTestModule.TestRecordElement_AsParams;
  6244. begin
  6245. StartProgram(false);
  6246. Add('type');
  6247. Add(' integer = longint;');
  6248. Add(' TRecord = record');
  6249. Add(' i: integer;');
  6250. Add(' end;');
  6251. Add('procedure DoIt(vG: integer; const vH: integer; var vI: integer);');
  6252. Add('var vJ: TRecord;');
  6253. Add('begin');
  6254. Add(' doit(vj.i,vj.i,vj.i);');
  6255. Add('end;');
  6256. Add('var r: TRecord;');
  6257. Add('begin');
  6258. Add(' doit(r.i,r.i,r.i);');
  6259. ConvertProgram;
  6260. CheckSource('TestRecordElement_AsParams',
  6261. LinesToStr([ // statements
  6262. 'this.TRecord = function (s) {',
  6263. ' if (s) {',
  6264. ' this.i = s.i;',
  6265. ' } else {',
  6266. ' this.i = 0;',
  6267. ' };',
  6268. ' this.$equal = function (b) {',
  6269. ' return this.i === b.i;',
  6270. ' };',
  6271. '};',
  6272. 'this.DoIt = function (vG,vH,vI) {',
  6273. ' var vJ = new $mod.TRecord();',
  6274. ' $mod.DoIt(vJ.i, vJ.i, {',
  6275. ' p: vJ,',
  6276. ' get: function () {',
  6277. ' return this.p.i;',
  6278. ' },',
  6279. ' set: function (v) {',
  6280. ' this.p.i = v;',
  6281. ' }',
  6282. ' });',
  6283. '};',
  6284. 'this.r = new $mod.TRecord();'
  6285. ]),
  6286. LinesToStr([
  6287. '$mod.DoIt($mod.r.i,$mod.r.i,{',
  6288. ' p: $mod.r,',
  6289. ' get: function () {',
  6290. ' return this.p.i;',
  6291. ' },',
  6292. ' set: function (v) {',
  6293. ' this.p.i = v;',
  6294. ' }',
  6295. '});'
  6296. ]));
  6297. end;
  6298. procedure TTestModule.TestRecordElementFromFuncResult_AsParams;
  6299. begin
  6300. StartProgram(false);
  6301. Add('type');
  6302. Add(' integer = longint;');
  6303. Add(' TRecord = record');
  6304. Add(' i: integer;');
  6305. Add(' end;');
  6306. Add('function GetRec(vB: integer = 0): TRecord;');
  6307. Add('begin');
  6308. Add('end;');
  6309. Add('procedure DoIt(vG: integer; const vH: integer);');
  6310. Add('begin');
  6311. Add('end;');
  6312. Add('begin');
  6313. Add(' doit(getrec.i,getrec.i);');
  6314. Add(' doit(getrec().i,getrec().i);');
  6315. Add(' doit(getrec(1).i,getrec(2).i);');
  6316. ConvertProgram;
  6317. CheckSource('TestRecordElementFromFuncResult_AsParams',
  6318. LinesToStr([ // statements
  6319. 'this.TRecord = function (s) {',
  6320. ' if (s) {',
  6321. ' this.i = s.i;',
  6322. ' } else {',
  6323. ' this.i = 0;',
  6324. ' };',
  6325. ' this.$equal = function (b) {',
  6326. ' return this.i === b.i;',
  6327. ' };',
  6328. '};',
  6329. 'this.GetRec = function (vB) {',
  6330. ' var Result = new $mod.TRecord();',
  6331. ' return Result;',
  6332. '};',
  6333. 'this.DoIt = function (vG,vH) {',
  6334. '};'
  6335. ]),
  6336. LinesToStr([
  6337. '$mod.DoIt($mod.GetRec(0).i,$mod.GetRec(0).i);',
  6338. '$mod.DoIt($mod.GetRec(0).i,$mod.GetRec(0).i);',
  6339. '$mod.DoIt($mod.GetRec(1).i,$mod.GetRec(2).i);',
  6340. '']));
  6341. end;
  6342. procedure TTestModule.TestRecordElementFromWith_AsParams;
  6343. begin
  6344. StartProgram(false);
  6345. Add('type');
  6346. Add(' integer = longint;');
  6347. Add(' TRecord = record');
  6348. Add(' i: integer;');
  6349. Add(' end;');
  6350. Add('procedure DoIt(vG: integer; const vH: integer; var vI: integer);');
  6351. Add('begin');
  6352. Add('end;');
  6353. Add('var r: trecord;');
  6354. Add('begin');
  6355. Add(' with r do ');
  6356. Add(' doit(i,i,i);');
  6357. ConvertProgram;
  6358. CheckSource('TestRecordElementFromWith_AsParams',
  6359. LinesToStr([ // statements
  6360. 'this.TRecord = function (s) {',
  6361. ' if (s) {',
  6362. ' this.i = s.i;',
  6363. ' } else {',
  6364. ' this.i = 0;',
  6365. ' };',
  6366. ' this.$equal = function (b) {',
  6367. ' return this.i === b.i;',
  6368. ' };',
  6369. '};',
  6370. 'this.DoIt = function (vG,vH,vI) {',
  6371. '};',
  6372. 'this.r = new $mod.TRecord();'
  6373. ]),
  6374. LinesToStr([
  6375. 'var $with1 = $mod.r;',
  6376. '$mod.DoIt($with1.i,$with1.i,{',
  6377. ' p: $with1,',
  6378. ' get: function () {',
  6379. ' return this.p.i;',
  6380. ' },',
  6381. ' set: function (v) {',
  6382. ' this.p.i = v;',
  6383. ' }',
  6384. '});',
  6385. '']));
  6386. end;
  6387. procedure TTestModule.TestRecord_Equal;
  6388. begin
  6389. StartProgram(false);
  6390. Add('type');
  6391. Add(' integer = longint;');
  6392. Add(' TFlag = (red,blue);');
  6393. Add(' TFlags = set of TFlag;');
  6394. Add(' TProc = procedure;');
  6395. Add(' TRecord = record');
  6396. Add(' i: integer;');
  6397. Add(' Event: TProc;');
  6398. Add(' f: TFlags;');
  6399. Add(' end;');
  6400. Add(' TNested = record');
  6401. Add(' r: TRecord;');
  6402. Add(' end;');
  6403. Add('var');
  6404. Add(' b: boolean;');
  6405. Add(' r,s: trecord;');
  6406. Add('begin');
  6407. Add(' b:=r=s;');
  6408. Add(' b:=r<>s;');
  6409. ConvertProgram;
  6410. CheckSource('TestRecord_Equal',
  6411. LinesToStr([ // statements
  6412. 'this.TFlag = {',
  6413. ' "0": "red",',
  6414. ' red: 0,',
  6415. ' "1": "blue",',
  6416. ' blue: 1',
  6417. '};',
  6418. 'this.TRecord = function (s) {',
  6419. ' if (s) {',
  6420. ' this.i = s.i;',
  6421. ' this.Event = s.Event;',
  6422. ' this.f = rtl.refSet(s.f);',
  6423. ' } else {',
  6424. ' this.i = 0;',
  6425. ' this.Event = null;',
  6426. ' this.f = {};',
  6427. ' };',
  6428. ' this.$equal = function (b) {',
  6429. ' return (this.i === b.i) && (rtl.eqCallback(this.Event, b.Event) && rtl.eqSet(this.f, b.f));',
  6430. ' };',
  6431. '};',
  6432. 'this.TNested = function (s) {',
  6433. ' if (s) {',
  6434. ' this.r = new $mod.TRecord(s.r);',
  6435. ' } else {',
  6436. ' this.r = new $mod.TRecord();',
  6437. ' };',
  6438. ' this.$equal = function (b) {',
  6439. ' return this.r.$equal(b.r);',
  6440. ' };',
  6441. '};',
  6442. 'this.b = false;',
  6443. 'this.r = new $mod.TRecord();',
  6444. 'this.s = new $mod.TRecord();'
  6445. ]),
  6446. LinesToStr([
  6447. '$mod.b = $mod.r.$equal($mod.s);',
  6448. '$mod.b = !$mod.r.$equal($mod.s);',
  6449. '']));
  6450. end;
  6451. procedure TTestModule.TestRecord_TypeCastJSValueToRecord;
  6452. begin
  6453. StartProgram(false);
  6454. Add('type');
  6455. Add(' TRecord = record');
  6456. Add(' i: longint;');
  6457. Add(' end;');
  6458. Add('var');
  6459. Add(' Jv: jsvalue;');
  6460. Add(' Rec: trecord;');
  6461. Add('begin');
  6462. Add(' rec:=trecord(jv);');
  6463. ConvertProgram;
  6464. CheckSource('TestRecord_TypeCastJSValueToRecord',
  6465. LinesToStr([ // statements
  6466. 'this.TRecord = function (s) {',
  6467. ' if (s) {',
  6468. ' this.i = s.i;',
  6469. ' } else {',
  6470. ' this.i = 0;',
  6471. ' };',
  6472. ' this.$equal = function (b) {',
  6473. ' return this.i === b.i;',
  6474. ' };',
  6475. '};',
  6476. 'this.Jv = undefined;',
  6477. 'this.Rec = new $mod.TRecord();'
  6478. ]),
  6479. LinesToStr([
  6480. '$mod.Rec = new $mod.TRecord(rtl.getObject($mod.Jv));',
  6481. '']));
  6482. end;
  6483. procedure TTestModule.TestClass_TObjectDefaultConstructor;
  6484. begin
  6485. StartProgram(false);
  6486. Add('type');
  6487. Add(' TObject = class');
  6488. Add(' public');
  6489. Add(' constructor Create;');
  6490. Add(' destructor Destroy;');
  6491. Add(' end;');
  6492. Add(' TBird = TObject;');
  6493. Add('constructor tobject.create;');
  6494. Add('begin end;');
  6495. Add('destructor tobject.destroy;');
  6496. Add('begin end;');
  6497. Add('var Obj: tobject;');
  6498. Add('begin');
  6499. Add(' obj:=tobject.create;');
  6500. Add(' obj:=tbird.create;');
  6501. Add(' obj.destroy;');
  6502. ConvertProgram;
  6503. CheckSource('TestClass_TObjectDefaultConstructor',
  6504. LinesToStr([ // statements
  6505. 'rtl.createClass($mod,"TObject",null,function(){',
  6506. ' this.$init = function () {',
  6507. ' };',
  6508. ' this.$final = function () {',
  6509. ' };',
  6510. ' this.Create = function(){',
  6511. ' };',
  6512. ' this.Destroy = function(){',
  6513. ' };',
  6514. '});',
  6515. 'this.Obj = null;'
  6516. ]),
  6517. LinesToStr([ // $mod.$main
  6518. '$mod.Obj = $mod.TObject.$create("Create");',
  6519. '$mod.Obj = $mod.TObject.$create("Create");',
  6520. '$mod.Obj.$destroy("Destroy");',
  6521. '']));
  6522. end;
  6523. procedure TTestModule.TestClass_TObjectConstructorWithParams;
  6524. begin
  6525. StartProgram(false);
  6526. Add('type');
  6527. Add(' TObject = class');
  6528. Add(' public');
  6529. Add(' constructor Create(Par: longint);');
  6530. Add(' end;');
  6531. Add('constructor tobject.create(par: longint);');
  6532. Add('begin end;');
  6533. Add('var Obj: tobject;');
  6534. Add('begin');
  6535. Add(' obj:=tobject.create(3);');
  6536. ConvertProgram;
  6537. CheckSource('TestClass_TObjectConstructorWithParams',
  6538. LinesToStr([ // statements
  6539. 'rtl.createClass($mod,"TObject",null,function(){',
  6540. ' this.$init = function () {',
  6541. ' };',
  6542. ' this.$final = function () {',
  6543. ' };',
  6544. ' this.Create = function(Par){',
  6545. ' };',
  6546. '});',
  6547. 'this.Obj = null;'
  6548. ]),
  6549. LinesToStr([ // $mod.$main
  6550. '$mod.Obj = $mod.TObject.$create("Create",[3]);'
  6551. ]));
  6552. end;
  6553. procedure TTestModule.TestClass_TObjectConstructorWithDefaultParam;
  6554. begin
  6555. StartProgram(false);
  6556. Add('type');
  6557. Add(' TObject = class');
  6558. Add(' public');
  6559. Add(' constructor Create;');
  6560. Add(' end;');
  6561. Add(' TTest = class(TObject)');
  6562. Add(' public');
  6563. Add(' constructor Create(const Par: longint = 1);');
  6564. Add(' end;');
  6565. Add('constructor tobject.create;');
  6566. Add('begin end;');
  6567. Add('constructor ttest.create(const par: longint);');
  6568. Add('begin end;');
  6569. Add('var t: ttest;');
  6570. Add('begin');
  6571. Add(' t:=ttest.create;');
  6572. Add(' t:=ttest.create(2);');
  6573. ConvertProgram;
  6574. CheckSource('TestClass_TObjectConstructorWithDefaultParam',
  6575. LinesToStr([ // statements
  6576. 'rtl.createClass($mod,"TObject",null,function(){',
  6577. ' this.$init = function () {',
  6578. ' };',
  6579. ' this.$final = function () {',
  6580. ' };',
  6581. ' this.Create = function(){',
  6582. ' };',
  6583. '});',
  6584. 'rtl.createClass($mod, "TTest", $mod.TObject, function () {',
  6585. ' this.Create$1 = function (Par) {',
  6586. ' };',
  6587. '});',
  6588. 'this.t = null;'
  6589. ]),
  6590. LinesToStr([ // $mod.$main
  6591. '$mod.t = $mod.TTest.$create("Create$1", [1]);',
  6592. '$mod.t = $mod.TTest.$create("Create$1", [2]);'
  6593. ]));
  6594. end;
  6595. procedure TTestModule.TestClass_Var;
  6596. begin
  6597. StartProgram(false);
  6598. Add('type');
  6599. Add(' TObject = class');
  6600. Add(' public');
  6601. Add(' vI: longint;');
  6602. Add(' constructor Create(Par: longint);');
  6603. Add(' end;');
  6604. Add('constructor tobject.create(par: longint);');
  6605. Add('begin');
  6606. Add(' vi:=par+3');
  6607. Add('end;');
  6608. Add('var Obj: tobject;');
  6609. Add('begin');
  6610. Add(' obj:=tobject.create(4);');
  6611. Add(' obj.vi:=obj.VI+5;');
  6612. ConvertProgram;
  6613. CheckSource('TestClass_Var',
  6614. LinesToStr([ // statements
  6615. 'rtl.createClass($mod,"TObject",null,function(){',
  6616. ' this.$init = function () {',
  6617. ' this.vI = 0;',
  6618. ' };',
  6619. ' this.$final = function () {',
  6620. ' };',
  6621. ' this.Create = function(Par){',
  6622. ' this.vI = Par+3;',
  6623. ' };',
  6624. '});',
  6625. 'this.Obj = null;'
  6626. ]),
  6627. LinesToStr([ // $mod.$main
  6628. '$mod.Obj = $mod.TObject.$create("Create",[4]);',
  6629. '$mod.Obj.vI = $mod.Obj.vI + 5;'
  6630. ]));
  6631. end;
  6632. procedure TTestModule.TestClass_Method;
  6633. begin
  6634. StartProgram(false);
  6635. Add('type');
  6636. Add(' TObject = class');
  6637. Add(' public');
  6638. Add(' vI: longint;');
  6639. Add(' Sub: TObject;');
  6640. Add(' constructor Create;');
  6641. Add(' function GetIt(Par: longint): tobject;');
  6642. Add(' end;');
  6643. Add('constructor tobject.create; begin end;');
  6644. Add('function tobject.getit(par: longint): tobject;');
  6645. Add('begin');
  6646. Add(' Self.vi:=par+3;');
  6647. Add(' Result:=self.sub;');
  6648. Add('end;');
  6649. Add('var Obj: tobject;');
  6650. Add('begin');
  6651. Add(' obj:=tobject.create;');
  6652. Add(' obj.getit(4);');
  6653. Add(' obj.sub.sub:=nil;');
  6654. Add(' obj.sub.getit(5);');
  6655. Add(' obj.sub.getit(6).SUB:=nil;');
  6656. Add(' obj.sub.getit(7).GETIT(8);');
  6657. Add(' obj.sub.getit(9).SuB.getit(10);');
  6658. ConvertProgram;
  6659. CheckSource('TestClass_Method',
  6660. LinesToStr([ // statements
  6661. 'rtl.createClass($mod,"TObject",null,function(){',
  6662. ' this.$init = function () {',
  6663. ' this.vI = 0;',
  6664. ' this.Sub = null;',
  6665. ' };',
  6666. ' this.$final = function () {',
  6667. ' this.Sub = undefined;',
  6668. ' };',
  6669. ' this.Create = function(){',
  6670. ' };',
  6671. ' this.GetIt = function(Par){',
  6672. ' var Result = null;',
  6673. ' this.vI = Par + 3;',
  6674. ' Result = this.Sub;',
  6675. ' return Result;',
  6676. ' };',
  6677. '});',
  6678. 'this.Obj = null;'
  6679. ]),
  6680. LinesToStr([ // $mod.$main
  6681. '$mod.Obj = $mod.TObject.$create("Create");',
  6682. '$mod.Obj.GetIt(4);',
  6683. '$mod.Obj.Sub.Sub=null;',
  6684. '$mod.Obj.Sub.GetIt(5);',
  6685. '$mod.Obj.Sub.GetIt(6).Sub=null;',
  6686. '$mod.Obj.Sub.GetIt(7).GetIt(8);',
  6687. '$mod.Obj.Sub.GetIt(9).Sub.GetIt(10);'
  6688. ]));
  6689. end;
  6690. procedure TTestModule.TestClass_Implementation;
  6691. begin
  6692. StartUnit(false);
  6693. Add([
  6694. 'interface',
  6695. 'type',
  6696. ' TObject = class',
  6697. ' constructor Create;',
  6698. ' end;',
  6699. 'implementation',
  6700. 'type',
  6701. ' TIntClass = class',
  6702. ' constructor Create; reintroduce;',
  6703. ' class procedure DoGlob;',
  6704. ' end;',
  6705. 'constructor tintclass.create;',
  6706. 'begin',
  6707. ' inherited;',
  6708. ' inherited create;',
  6709. ' doglob;',
  6710. 'end;',
  6711. 'class procedure tintclass.doglob;',
  6712. 'begin',
  6713. 'end;',
  6714. 'constructor tobject.create;',
  6715. 'var',
  6716. ' iC: tintclass;',
  6717. 'begin',
  6718. ' ic:=tintclass.create;',
  6719. ' tintclass.doglob;',
  6720. ' ic.doglob;',
  6721. 'end;',
  6722. 'initialization',
  6723. ' tintclass.doglob;',
  6724. '']);
  6725. ConvertUnit;
  6726. CheckSource('TestClass_Implementation',
  6727. LinesToStr([ // statements
  6728. 'var $impl = $mod.$impl;',
  6729. 'rtl.createClass($mod, "TObject", null, function () {',
  6730. ' this.$init = function () {',
  6731. ' };',
  6732. ' this.$final = function () {',
  6733. ' };',
  6734. ' this.Create = function () {',
  6735. ' var iC = null;',
  6736. ' iC = $impl.TIntClass.$create("Create$1");',
  6737. ' $impl.TIntClass.DoGlob();',
  6738. ' iC.$class.DoGlob();',
  6739. ' };',
  6740. '});',
  6741. '']),
  6742. LinesToStr([ // $mod.$main
  6743. '$impl.TIntClass.DoGlob();',
  6744. '']),
  6745. LinesToStr([
  6746. 'rtl.createClass($impl, "TIntClass", $mod.TObject, function () {',
  6747. ' this.Create$1 = function () {',
  6748. ' $mod.TObject.Create.apply(this, arguments);',
  6749. ' $mod.TObject.Create.call(this);',
  6750. ' this.$class.DoGlob();',
  6751. ' };',
  6752. ' this.DoGlob = function () {',
  6753. ' };',
  6754. '});',
  6755. '']));
  6756. end;
  6757. procedure TTestModule.TestClass_Inheritance;
  6758. begin
  6759. StartProgram(false);
  6760. Add('type');
  6761. Add(' TObject = class');
  6762. Add(' public');
  6763. Add(' constructor Create;');
  6764. Add(' end;');
  6765. Add(' TClassA = class');
  6766. Add(' end;');
  6767. Add(' TClassB = class(TObject)');
  6768. Add(' procedure ProcB;');
  6769. Add(' end;');
  6770. Add('constructor tobject.create; begin end;');
  6771. Add('procedure tclassb.procb; begin end;');
  6772. Add('var');
  6773. Add(' oO: TObject;');
  6774. Add(' oA: TClassA;');
  6775. Add(' oB: TClassB;');
  6776. Add('begin');
  6777. Add(' oO:=tobject.Create;');
  6778. Add(' oA:=tclassa.Create;');
  6779. Add(' ob:=tclassb.Create;');
  6780. Add(' if oo is tclassa then ;');
  6781. Add(' ob:=oo as tclassb;');
  6782. Add(' (oo as tclassb).procb;');
  6783. ConvertProgram;
  6784. CheckSource('TestClass_Inheritance',
  6785. LinesToStr([ // statements
  6786. 'rtl.createClass($mod,"TObject",null,function(){',
  6787. ' this.$init = function () {',
  6788. ' };',
  6789. ' this.$final = function () {',
  6790. ' };',
  6791. ' this.Create = function () {',
  6792. ' };',
  6793. '});',
  6794. 'rtl.createClass($mod,"TClassA",$mod.TObject,function(){',
  6795. '});',
  6796. 'rtl.createClass($mod,"TClassB",$mod.TObject,function(){',
  6797. ' this.ProcB = function () {',
  6798. ' };',
  6799. '});',
  6800. 'this.oO = null;',
  6801. 'this.oA = null;',
  6802. 'this.oB = null;'
  6803. ]),
  6804. LinesToStr([ // $mod.$main
  6805. '$mod.oO = $mod.TObject.$create("Create");',
  6806. '$mod.oA = $mod.TClassA.$create("Create");',
  6807. '$mod.oB = $mod.TClassB.$create("Create");',
  6808. 'if ($mod.TClassA.isPrototypeOf($mod.oO));',
  6809. '$mod.oB = rtl.as($mod.oO, $mod.TClassB);',
  6810. 'rtl.as($mod.oO, $mod.TClassB).ProcB();'
  6811. ]));
  6812. end;
  6813. procedure TTestModule.TestClass_AbstractMethod;
  6814. begin
  6815. StartProgram(false);
  6816. Add('type');
  6817. Add(' TObject = class');
  6818. Add(' public');
  6819. Add(' procedure DoIt; virtual; abstract;');
  6820. Add(' end;');
  6821. Add('begin');
  6822. ConvertProgram;
  6823. CheckSource('TestClass_AbstractMethod',
  6824. LinesToStr([ // statements
  6825. 'rtl.createClass($mod,"TObject",null,function(){',
  6826. ' this.$init = function () {',
  6827. ' };',
  6828. ' this.$final = function () {',
  6829. ' };',
  6830. '});'
  6831. ]),
  6832. LinesToStr([ // this.$main
  6833. ''
  6834. ]));
  6835. end;
  6836. procedure TTestModule.TestClass_CallInherited_NoParams;
  6837. begin
  6838. StartProgram(false);
  6839. Add('type');
  6840. Add(' TObject = class');
  6841. Add(' procedure DoAbstract; virtual; abstract;');
  6842. Add(' procedure DoVirtual; virtual;');
  6843. Add(' procedure DoIt;');
  6844. Add(' end;');
  6845. Add(' TA = class');
  6846. Add(' procedure doabstract; override;');
  6847. Add(' procedure dovirtual; override;');
  6848. Add(' procedure DoSome;');
  6849. Add(' end;');
  6850. Add('procedure tobject.dovirtual;');
  6851. Add('begin');
  6852. Add(' inherited; // call non existing ancestor -> ignore silently');
  6853. Add('end;');
  6854. Add('procedure tobject.doit;');
  6855. Add('begin');
  6856. Add('end;');
  6857. Add('procedure ta.doabstract;');
  6858. Add('begin');
  6859. Add(' inherited dovirtual; // call TObject.DoVirtual');
  6860. Add('end;');
  6861. Add('procedure ta.dovirtual;');
  6862. Add('begin');
  6863. Add(' inherited; // call TObject.DoVirtual');
  6864. Add(' inherited dovirtual; // call TObject.DoVirtual');
  6865. Add(' inherited dovirtual(); // call TObject.DoVirtual');
  6866. Add(' doit;');
  6867. Add(' doit();');
  6868. Add('end;');
  6869. Add('procedure ta.dosome;');
  6870. Add('begin');
  6871. Add(' inherited; // call non existing ancestor method -> silently ignore');
  6872. Add('end;');
  6873. Add('begin');
  6874. ConvertProgram;
  6875. CheckSource('TestClass_CallInherited_NoParams',
  6876. LinesToStr([ // statements
  6877. 'rtl.createClass($mod,"TObject",null,function(){',
  6878. ' this.$init = function () {',
  6879. ' };',
  6880. ' this.$final = function () {',
  6881. ' };',
  6882. ' this.DoVirtual = function () {',
  6883. ' };',
  6884. ' this.DoIt = function () {',
  6885. ' };',
  6886. '});',
  6887. 'rtl.createClass($mod, "TA", $mod.TObject, function () {',
  6888. ' this.DoAbstract = function () {',
  6889. ' $mod.TObject.DoVirtual.call(this);',
  6890. ' };',
  6891. ' this.DoVirtual = function () {',
  6892. ' $mod.TObject.DoVirtual.apply(this, arguments);',
  6893. ' $mod.TObject.DoVirtual.call(this);',
  6894. ' $mod.TObject.DoVirtual.call(this);',
  6895. ' this.DoIt();',
  6896. ' this.DoIt();',
  6897. ' };',
  6898. ' this.DoSome = function () {',
  6899. ' };',
  6900. '});'
  6901. ]),
  6902. LinesToStr([ // this.$main
  6903. ''
  6904. ]));
  6905. end;
  6906. procedure TTestModule.TestClass_CallInherited_WithParams;
  6907. begin
  6908. StartProgram(false);
  6909. Add('type');
  6910. Add(' TObject = class');
  6911. Add(' procedure DoAbstract(pA: longint; pB: longint = 0); virtual; abstract;');
  6912. Add(' procedure DoVirtual(pA: longint; pB: longint = 0); virtual;');
  6913. Add(' procedure DoIt(pA: longint; pB: longint = 0);');
  6914. Add(' procedure DoIt2(pA: longint = 1; pB: longint = 2);');
  6915. Add(' end;');
  6916. Add(' TClassA = class');
  6917. Add(' procedure DoAbstract(pA: longint; pB: longint = 0); override;');
  6918. Add(' procedure DoVirtual(pA: longint; pB: longint = 0); override;');
  6919. Add(' end;');
  6920. Add('procedure tobject.dovirtual(pa: longint; pb: longint = 0);');
  6921. Add('begin');
  6922. Add('end;');
  6923. Add('procedure tobject.doit(pa: longint; pb: longint = 0);');
  6924. Add('begin');
  6925. Add('end;');
  6926. Add('procedure tobject.doit2(pa: longint; pb: longint = 0);');
  6927. Add('begin');
  6928. Add('end;');
  6929. Add('procedure tclassa.doabstract(pa: longint; pb: longint = 0);');
  6930. Add('begin');
  6931. Add(' inherited dovirtual(pa,pb); // call TObject.DoVirtual(pA,pB)');
  6932. Add(' inherited dovirtual(pa); // call TObject.DoVirtual(pA,0)');
  6933. Add('end;');
  6934. Add('procedure tclassa.dovirtual(pa: longint; pb: longint = 0);');
  6935. Add('begin');
  6936. Add(' inherited; // call TObject.DoVirtual(pA,pB)');
  6937. Add(' inherited dovirtual(pa,pb); // call TObject.DoVirtual(pA,pB)');
  6938. Add(' inherited dovirtual(pa); // call TObject.DoVirtual(pA,0)');
  6939. Add(' doit(pa,pb);');
  6940. Add(' doit(pa);');
  6941. Add(' doit2(pa);');
  6942. Add(' doit2;');
  6943. Add('end;');
  6944. Add('begin');
  6945. ConvertProgram;
  6946. CheckSource('TestClass_CallInherited_WithParams',
  6947. LinesToStr([ // statements
  6948. 'rtl.createClass($mod,"TObject",null,function(){',
  6949. ' this.$init = function () {',
  6950. ' };',
  6951. ' this.$final = function () {',
  6952. ' };',
  6953. ' this.DoVirtual = function (pA,pB) {',
  6954. ' };',
  6955. ' this.DoIt = function (pA,pB) {',
  6956. ' };',
  6957. ' this.DoIt2 = function (pA,pB) {',
  6958. ' };',
  6959. '});',
  6960. 'rtl.createClass($mod, "TClassA", $mod.TObject, function () {',
  6961. ' this.DoAbstract = function (pA,pB) {',
  6962. ' $mod.TObject.DoVirtual.call(this,pA,pB);',
  6963. ' $mod.TObject.DoVirtual.call(this,pA,0);',
  6964. ' };',
  6965. ' this.DoVirtual = function (pA,pB) {',
  6966. ' $mod.TObject.DoVirtual.apply(this, arguments);',
  6967. ' $mod.TObject.DoVirtual.call(this,pA,pB);',
  6968. ' $mod.TObject.DoVirtual.call(this,pA,0);',
  6969. ' this.DoIt(pA,pB);',
  6970. ' this.DoIt(pA,0);',
  6971. ' this.DoIt2(pA,2);',
  6972. ' this.DoIt2(1,2);',
  6973. ' };',
  6974. '});'
  6975. ]),
  6976. LinesToStr([ // this.$main
  6977. ''
  6978. ]));
  6979. end;
  6980. procedure TTestModule.TestClasS_CallInheritedConstructor;
  6981. begin
  6982. StartProgram(false);
  6983. Add('type');
  6984. Add(' TObject = class');
  6985. Add(' constructor Create; virtual;');
  6986. Add(' constructor CreateWithB(b: boolean);');
  6987. Add(' end;');
  6988. Add(' TA = class');
  6989. Add(' constructor Create; override;');
  6990. Add(' constructor CreateWithC(c: char);');
  6991. Add(' procedure DoIt;');
  6992. Add(' class function DoSome: TObject;');
  6993. Add(' end;');
  6994. Add('constructor tobject.create;');
  6995. Add('begin');
  6996. Add(' inherited; // call non existing ancestor -> ignore silently');
  6997. Add('end;');
  6998. Add('constructor tobject.createwithb(b: boolean);');
  6999. Add('begin');
  7000. Add(' inherited; // call non existing ancestor -> ignore silently');
  7001. Add(' create; // normal call');
  7002. Add('end;');
  7003. Add('constructor ta.create;');
  7004. Add('begin');
  7005. Add(' inherited; // normal call TObject.Create');
  7006. Add(' inherited create; // normal call TObject.Create');
  7007. Add(' inherited createwithb(false); // normal call TObject.CreateWithB');
  7008. Add('end;');
  7009. Add('constructor ta.createwithc(c: char);');
  7010. Add('begin');
  7011. Add(' inherited create; // call TObject.Create');
  7012. Add(' inherited createwithb(true); // call TObject.CreateWithB');
  7013. Add(' doit;');
  7014. Add(' doit();');
  7015. Add(' dosome;');
  7016. Add('end;');
  7017. Add('procedure ta.doit;');
  7018. Add('begin');
  7019. Add(' create; // normal call');
  7020. Add(' createwithb(false); // normal call');
  7021. Add(' createwithc(''c''); // normal call');
  7022. Add('end;');
  7023. Add('class function ta.dosome: TObject;');
  7024. Add('begin');
  7025. Add(' Result:=create; // constructor');
  7026. Add(' Result:=createwithb(true); // constructor');
  7027. Add(' Result:=createwithc(''c''); // constructor');
  7028. Add('end;');
  7029. Add('begin');
  7030. ConvertProgram;
  7031. CheckSource('TestClass_CallInheritedConstructor',
  7032. LinesToStr([ // statements
  7033. 'rtl.createClass($mod,"TObject",null,function(){',
  7034. ' this.$init = function () {',
  7035. ' };',
  7036. ' this.$final = function () {',
  7037. ' };',
  7038. ' this.Create = function () {',
  7039. ' };',
  7040. ' this.CreateWithB = function (b) {',
  7041. ' this.Create();',
  7042. ' };',
  7043. '});',
  7044. 'rtl.createClass($mod, "TA", $mod.TObject, function () {',
  7045. ' this.Create = function () {',
  7046. ' $mod.TObject.Create.apply(this, arguments);',
  7047. ' $mod.TObject.Create.call(this);',
  7048. ' $mod.TObject.CreateWithB.call(this, false);',
  7049. ' };',
  7050. ' this.CreateWithC = function (c) {',
  7051. ' $mod.TObject.Create.call(this);',
  7052. ' $mod.TObject.CreateWithB.call(this, true);',
  7053. ' this.DoIt();',
  7054. ' this.DoIt();',
  7055. ' this.$class.DoSome();',
  7056. ' };',
  7057. ' this.DoIt = function () {',
  7058. ' this.Create();',
  7059. ' this.CreateWithB(false);',
  7060. ' this.CreateWithC("c");',
  7061. ' };',
  7062. ' this.DoSome = function () {',
  7063. ' var Result = null;',
  7064. ' Result = this.$create("Create");',
  7065. ' Result = this.$create("CreateWithB", [true]);',
  7066. ' Result = this.$create("CreateWithC", ["c"]);',
  7067. ' return Result;',
  7068. ' };',
  7069. '});'
  7070. ]),
  7071. LinesToStr([ // this.$main
  7072. ''
  7073. ]));
  7074. end;
  7075. procedure TTestModule.TestClass_ClassVar;
  7076. begin
  7077. StartProgram(false);
  7078. Add('type');
  7079. Add(' TObject = class');
  7080. Add(' public');
  7081. Add(' class var vI: longint;');
  7082. Add(' class var Sub: TObject;');
  7083. Add(' constructor Create;');
  7084. Add(' class function GetIt(Par: longint): tobject;');
  7085. Add(' end;');
  7086. Add('constructor tobject.create;');
  7087. Add('begin');
  7088. Add(' vi:=vi+1;');
  7089. Add(' Self.vi:=Self.vi+1;');
  7090. Add('end;');
  7091. Add('class function tobject.getit(par: longint): tobject;');
  7092. Add('begin');
  7093. Add(' vi:=vi+par;');
  7094. Add(' Self.vi:=Self.vi+par;');
  7095. Add(' Result:=self.sub;');
  7096. Add('end;');
  7097. Add('var Obj: tobject;');
  7098. Add('begin');
  7099. Add(' obj:=tobject.create;');
  7100. Add(' tobject.vi:=3;');
  7101. Add(' if tobject.vi=4 then ;');
  7102. Add(' tobject.sub:=nil;');
  7103. Add(' obj.sub:=nil;');
  7104. Add(' obj.sub.sub:=nil;');
  7105. ConvertProgram;
  7106. CheckSource('TestClass_ClassVar',
  7107. LinesToStr([ // statements
  7108. 'rtl.createClass($mod,"TObject",null,function(){',
  7109. ' this.vI = 0;',
  7110. ' this.Sub = null;',
  7111. ' this.$init = function () {',
  7112. ' };',
  7113. ' this.$final = function () {',
  7114. ' };',
  7115. ' this.Create = function(){',
  7116. ' this.$class.vI = this.vI+1;',
  7117. ' this.$class.vI = this.vI+1;',
  7118. ' };',
  7119. ' this.GetIt = function(Par){',
  7120. ' var Result = null;',
  7121. ' this.vI = this.vI + Par;',
  7122. ' this.vI = this.vI + Par;',
  7123. ' Result = this.Sub;',
  7124. ' return Result;',
  7125. ' };',
  7126. '});',
  7127. 'this.Obj = null;'
  7128. ]),
  7129. LinesToStr([ // $mod.$main
  7130. '$mod.Obj = $mod.TObject.$create("Create");',
  7131. '$mod.TObject.vI = 3;',
  7132. 'if ($mod.TObject.vI === 4);',
  7133. '$mod.TObject.Sub=null;',
  7134. '$mod.Obj.$class.Sub=null;',
  7135. '$mod.Obj.Sub.$class.Sub=null;',
  7136. '']));
  7137. end;
  7138. procedure TTestModule.TestClass_CallClassMethod;
  7139. begin
  7140. StartProgram(false);
  7141. Add('type');
  7142. Add(' TObject = class');
  7143. Add(' public');
  7144. Add(' class var vI: longint;');
  7145. Add(' class var Sub: TObject;');
  7146. Add(' constructor Create;');
  7147. Add(' function GetMore(Par: longint): longint;');
  7148. Add(' class function GetIt(Par: longint): tobject;');
  7149. Add(' end;');
  7150. Add('constructor tobject.create;');
  7151. Add('begin');
  7152. Add(' sub:=getit(3);');
  7153. Add(' vi:=getmore(4);');
  7154. Add(' sub:=Self.getit(5);');
  7155. Add(' vi:=Self.getmore(6);');
  7156. Add('end;');
  7157. Add('function tobject.getmore(par: longint): longint;');
  7158. Add('begin');
  7159. Add(' sub:=getit(11);');
  7160. Add(' vi:=getmore(12);');
  7161. Add(' sub:=self.getit(13);');
  7162. Add(' vi:=self.getmore(14);');
  7163. Add('end;');
  7164. Add('class function tobject.getit(par: longint): tobject;');
  7165. Add('begin');
  7166. Add(' sub:=getit(21);');
  7167. Add(' vi:=sub.getmore(22);');
  7168. Add(' sub:=self.getit(23);');
  7169. Add(' vi:=self.sub.getmore(24);');
  7170. Add('end;');
  7171. Add('var Obj: tobject;');
  7172. Add('begin');
  7173. Add(' obj:=tobject.create;');
  7174. Add(' tobject.getit(5);');
  7175. Add(' obj.getit(6);');
  7176. Add(' obj.sub.getit(7);');
  7177. Add(' obj.sub.getit(8).SUB:=nil;');
  7178. Add(' obj.sub.getit(9).GETIT(10);');
  7179. Add(' obj.sub.getit(11).SuB.getit(12);');
  7180. ConvertProgram;
  7181. CheckSource('TestClass_CallClassMethod',
  7182. LinesToStr([ // statements
  7183. 'rtl.createClass($mod,"TObject",null,function(){',
  7184. ' this.vI = 0;',
  7185. ' this.Sub = null;',
  7186. ' this.$init = function () {',
  7187. ' };',
  7188. ' this.$final = function () {',
  7189. ' };',
  7190. ' this.Create = function(){',
  7191. ' this.$class.Sub = this.$class.GetIt(3);',
  7192. ' this.$class.vI = this.GetMore(4);',
  7193. ' this.$class.Sub = this.$class.GetIt(5);',
  7194. ' this.$class.vI = this.GetMore(6);',
  7195. ' };',
  7196. ' this.GetMore = function(Par){',
  7197. ' var Result = 0;',
  7198. ' this.$class.Sub = this.$class.GetIt(11);',
  7199. ' this.$class.vI = this.GetMore(12);',
  7200. ' this.$class.Sub = this.$class.GetIt(13);',
  7201. ' this.$class.vI = this.GetMore(14);',
  7202. ' return Result;',
  7203. ' };',
  7204. ' this.GetIt = function(Par){',
  7205. ' var Result = null;',
  7206. ' this.Sub = this.GetIt(21);',
  7207. ' this.vI = this.Sub.GetMore(22);',
  7208. ' this.Sub = this.GetIt(23);',
  7209. ' this.vI = this.Sub.GetMore(24);',
  7210. ' return Result;',
  7211. ' };',
  7212. '});',
  7213. 'this.Obj = null;'
  7214. ]),
  7215. LinesToStr([ // $mod.$main
  7216. '$mod.Obj = $mod.TObject.$create("Create");',
  7217. '$mod.TObject.GetIt(5);',
  7218. '$mod.Obj.$class.GetIt(6);',
  7219. '$mod.Obj.Sub.$class.GetIt(7);',
  7220. '$mod.Obj.Sub.$class.GetIt(8).$class.Sub=null;',
  7221. '$mod.Obj.Sub.$class.GetIt(9).$class.GetIt(10);',
  7222. '$mod.Obj.Sub.$class.GetIt(11).Sub.$class.GetIt(12);',
  7223. '']));
  7224. end;
  7225. procedure TTestModule.TestClass_Property;
  7226. begin
  7227. StartProgram(false);
  7228. Add('type');
  7229. Add(' TObject = class');
  7230. Add(' Fx: longint;');
  7231. Add(' Fy: longint;');
  7232. Add(' function GetInt: longint;');
  7233. Add(' procedure SetInt(Value: longint);');
  7234. Add(' procedure DoIt;');
  7235. Add(' property IntA: longint read Fx write Fy;');
  7236. Add(' property IntB: longint read GetInt write SetInt;');
  7237. Add(' end;');
  7238. Add('function tobject.getint: longint;');
  7239. Add('begin');
  7240. Add(' result:=fx;');
  7241. Add('end;');
  7242. Add('procedure tobject.setint(value: longint);');
  7243. Add('begin');
  7244. Add(' if value=fy then exit;');
  7245. Add(' fy:=value;');
  7246. Add('end;');
  7247. Add('procedure tobject.doit;');
  7248. Add('begin');
  7249. Add(' IntA:=IntA+1;');
  7250. Add(' Self.IntA:=Self.IntA+1;');
  7251. Add(' IntB:=IntB+1;');
  7252. Add(' Self.IntB:=Self.IntB+1;');
  7253. Add('end;');
  7254. Add('var Obj: tobject;');
  7255. Add('begin');
  7256. Add(' obj.inta:=obj.inta+1;');
  7257. Add(' if obj.intb=2 then;');
  7258. Add(' obj.intb:=obj.intb+2;');
  7259. Add(' obj.setint(obj.inta);');
  7260. ConvertProgram;
  7261. CheckSource('TestClass_Property',
  7262. LinesToStr([ // statements
  7263. 'rtl.createClass($mod, "TObject", null, function () {',
  7264. ' this.$init = function () {',
  7265. ' this.Fx = 0;',
  7266. ' this.Fy = 0;',
  7267. ' };',
  7268. ' this.$final = function () {',
  7269. ' };',
  7270. ' this.GetInt = function () {',
  7271. ' var Result = 0;',
  7272. ' Result = this.Fx;',
  7273. ' return Result;',
  7274. ' };',
  7275. ' this.SetInt = function (Value) {',
  7276. ' if (Value === this.Fy) return;',
  7277. ' this.Fy = Value;',
  7278. ' };',
  7279. ' this.DoIt = function () {',
  7280. ' this.Fy = this.Fx + 1;',
  7281. ' this.Fy = this.Fx + 1;',
  7282. ' this.SetInt(this.GetInt() + 1);',
  7283. ' this.SetInt(this.GetInt() + 1);',
  7284. ' };',
  7285. '});',
  7286. 'this.Obj = null;'
  7287. ]),
  7288. LinesToStr([ // $mod.$main
  7289. '$mod.Obj.Fy = $mod.Obj.Fx + 1;',
  7290. 'if ($mod.Obj.GetInt() === 2);',
  7291. '$mod.Obj.SetInt($mod.Obj.GetInt() + 2);',
  7292. '$mod.Obj.SetInt($mod.Obj.Fx);'
  7293. ]));
  7294. end;
  7295. procedure TTestModule.TestClass_Property_ClassMethod;
  7296. begin
  7297. StartProgram(false);
  7298. Add('type');
  7299. Add(' TObject = class');
  7300. Add(' class var Fx: longint;');
  7301. Add(' class var Fy: longint;');
  7302. Add(' class function GetInt: longint;');
  7303. Add(' class procedure SetInt(Value: longint);');
  7304. Add(' class procedure DoIt;');
  7305. Add(' class property IntA: longint read Fx write Fy;');
  7306. Add(' class property IntB: longint read GetInt write SetInt;');
  7307. Add(' end;');
  7308. Add('class function tobject.getint: longint;');
  7309. Add('begin');
  7310. Add(' result:=fx;');
  7311. Add('end;');
  7312. Add('class procedure tobject.setint(value: longint);');
  7313. Add('begin');
  7314. Add('end;');
  7315. Add('class procedure tobject.doit;');
  7316. Add('begin');
  7317. Add(' IntA:=IntA+1;');
  7318. Add(' Self.IntA:=Self.IntA+1;');
  7319. Add(' IntB:=IntB+1;');
  7320. Add(' Self.IntB:=Self.IntB+1;');
  7321. Add('end;');
  7322. Add('var Obj: tobject;');
  7323. Add('begin');
  7324. Add(' tobject.inta:=tobject.inta+1;');
  7325. Add(' if tobject.intb=2 then;');
  7326. Add(' tobject.intb:=tobject.intb+2;');
  7327. Add(' tobject.setint(tobject.inta);');
  7328. Add(' obj.inta:=obj.inta+1;');
  7329. Add(' if obj.intb=2 then;');
  7330. Add(' obj.intb:=obj.intb+2;');
  7331. Add(' obj.setint(obj.inta);');
  7332. ConvertProgram;
  7333. CheckSource('TestClass_Property_ClassMethod',
  7334. LinesToStr([ // statements
  7335. 'rtl.createClass($mod, "TObject", null, function () {',
  7336. ' this.Fx = 0;',
  7337. ' this.Fy = 0;',
  7338. ' this.$init = function () {',
  7339. ' };',
  7340. ' this.$final = function () {',
  7341. ' };',
  7342. ' this.GetInt = function () {',
  7343. ' var Result = 0;',
  7344. ' Result = this.Fx;',
  7345. ' return Result;',
  7346. ' };',
  7347. ' this.SetInt = function (Value) {',
  7348. ' };',
  7349. ' this.DoIt = function () {',
  7350. ' this.Fy = this.Fx + 1;',
  7351. ' this.Fy = this.Fx + 1;',
  7352. ' this.SetInt(this.GetInt() + 1);',
  7353. ' this.SetInt(this.GetInt() + 1);',
  7354. ' };',
  7355. '});',
  7356. 'this.Obj = null;'
  7357. ]),
  7358. LinesToStr([ // $mod.$main
  7359. '$mod.TObject.Fy = $mod.TObject.Fx + 1;',
  7360. 'if ($mod.TObject.GetInt() === 2);',
  7361. '$mod.TObject.SetInt($mod.TObject.GetInt() + 2);',
  7362. '$mod.TObject.SetInt($mod.TObject.Fx);',
  7363. '$mod.Obj.$class.Fy = $mod.Obj.Fx + 1;',
  7364. 'if ($mod.Obj.$class.GetInt() === 2);',
  7365. '$mod.Obj.$class.SetInt($mod.Obj.$class.GetInt() + 2);',
  7366. '$mod.Obj.$class.SetInt($mod.Obj.Fx);'
  7367. ]));
  7368. end;
  7369. procedure TTestModule.TestClass_Property_Indexed;
  7370. begin
  7371. StartProgram(false);
  7372. Add('type');
  7373. Add(' TObject = class');
  7374. Add(' FItems: array of longint;');
  7375. Add(' function GetItems(Index: longint): longint;');
  7376. Add(' procedure SetItems(Index: longint; Value: longint);');
  7377. Add(' procedure DoIt;');
  7378. Add(' property Items[Index: longint]: longint read getitems write setitems;');
  7379. Add(' end;');
  7380. Add('function tobject.getitems(index: longint): longint;');
  7381. Add('begin');
  7382. Add(' Result:=fitems[index];');
  7383. Add('end;');
  7384. Add('procedure tobject.setitems(index: longint; value: longint);');
  7385. Add('begin');
  7386. Add(' fitems[index]:=value;');
  7387. Add('end;');
  7388. Add('procedure tobject.doit;');
  7389. Add('begin');
  7390. Add(' items[1]:=2;');
  7391. Add(' items[3]:=items[4];');
  7392. Add(' self.items[5]:=self.items[6];');
  7393. Add(' items[items[7]]:=items[items[8]];');
  7394. Add('end;');
  7395. Add('var Obj: tobject;');
  7396. Add('begin');
  7397. Add(' obj.Items[11]:=obj.Items[12];');
  7398. ConvertProgram;
  7399. CheckSource('TestClass_Property_Indexed',
  7400. LinesToStr([ // statements
  7401. 'rtl.createClass($mod, "TObject", null, function () {',
  7402. ' this.$init = function () {',
  7403. ' this.FItems = [];',
  7404. ' };',
  7405. ' this.$final = function () {',
  7406. ' this.FItems = undefined;',
  7407. ' };',
  7408. ' this.GetItems = function (Index) {',
  7409. ' var Result = 0;',
  7410. ' Result = this.FItems[Index];',
  7411. ' return Result;',
  7412. ' };',
  7413. ' this.SetItems = function (Index, Value) {',
  7414. ' this.FItems[Index] = Value;',
  7415. ' };',
  7416. ' this.DoIt = function () {',
  7417. ' this.SetItems(1, 2);',
  7418. ' this.SetItems(3,this.GetItems(4));',
  7419. ' this.SetItems(5,this.GetItems(6));',
  7420. ' this.SetItems(this.GetItems(7), this.GetItems(this.GetItems(8)));',
  7421. ' };',
  7422. '});',
  7423. 'this.Obj = null;'
  7424. ]),
  7425. LinesToStr([ // $mod.$main
  7426. '$mod.Obj.SetItems(11,$mod.Obj.GetItems(12));'
  7427. ]));
  7428. end;
  7429. procedure TTestModule.TestClass_Property_IndexSpec;
  7430. begin
  7431. StartProgram(false);
  7432. Add([
  7433. 'type',
  7434. ' TEnum = (red, blue);',
  7435. ' TObject = class',
  7436. ' function GetIntBool(Index: longint): boolean; virtual; abstract;',
  7437. ' procedure SetIntBool(Index: longint; b: boolean); virtual; abstract;',
  7438. ' function GetEnumBool(Index: TEnum): boolean; virtual; abstract;',
  7439. ' procedure SetEnumBool(Index: TEnum; b: boolean); virtual; abstract;',
  7440. ' function GetStrIntBool(A: String; I: longint): boolean; virtual; abstract;',
  7441. ' procedure SetStrIntBool(A: String; I: longint; b: boolean); virtual; abstract;',
  7442. ' property B1: boolean index 1 read GetIntBool write SetIntBool;',
  7443. ' property B2: boolean index TEnum.blue read GetEnumBool write SetEnumBool;',
  7444. ' property B3: boolean index ord(red) read GetIntBool write SetIntBool;',
  7445. ' property I1[A: String]: boolean index ord(blue) read GetStrIntBool write SetStrIntBool;',
  7446. ' end;',
  7447. 'procedure DoIt(b: boolean); begin end;',
  7448. 'var',
  7449. ' o: TObject;',
  7450. 'begin',
  7451. ' o.B1:=o.B1;',
  7452. ' o.B2:=o.B2;',
  7453. ' o.B3:=o.B3;',
  7454. ' o.I1[''a'']:=o.I1[''b''];',
  7455. ' doit(o.b1);',
  7456. ' doit(o.b2);',
  7457. ' doit(o.i1[''c'']);',
  7458. '']);
  7459. ConvertProgram;
  7460. CheckSource('TestClass_Property_IndexSpec',
  7461. LinesToStr([ // statements
  7462. 'this.TEnum = {',
  7463. ' "0": "red",',
  7464. ' red: 0,',
  7465. ' "1": "blue",',
  7466. ' blue: 1',
  7467. '};',
  7468. 'rtl.createClass($mod, "TObject", null, function () {',
  7469. ' this.$init = function () {',
  7470. ' };',
  7471. ' this.$final = function () {',
  7472. ' };',
  7473. '});',
  7474. 'this.DoIt = function (b) {',
  7475. '};',
  7476. 'this.o = null;',
  7477. '']),
  7478. LinesToStr([ // $mod.$main
  7479. '$mod.o.SetIntBool(1, $mod.o.GetIntBool(1));',
  7480. '$mod.o.SetEnumBool($mod.TEnum.blue, $mod.o.GetEnumBool($mod.TEnum.blue));',
  7481. '$mod.o.SetIntBool(0, $mod.o.GetIntBool(0));',
  7482. '$mod.o.SetStrIntBool("a", 1, $mod.o.GetStrIntBool("b", 1));',
  7483. '$mod.DoIt($mod.o.GetIntBool(1));',
  7484. '$mod.DoIt($mod.o.GetEnumBool($mod.TEnum.blue));',
  7485. '$mod.DoIt($mod.o.GetStrIntBool("c", 1));',
  7486. '']));
  7487. end;
  7488. procedure TTestModule.TestClass_PropertyOfTypeArray;
  7489. begin
  7490. StartProgram(false);
  7491. Add('type');
  7492. Add(' TArray = array of longint;');
  7493. Add(' TObject = class');
  7494. Add(' FItems: TArray;');
  7495. Add(' function GetItems: tarray;');
  7496. Add(' procedure SetItems(Value: tarray);');
  7497. Add(' property Items: tarray read getitems write setitems;');
  7498. Add(' end;');
  7499. Add('function tobject.getitems: tarray;');
  7500. Add('begin');
  7501. Add(' Result:=fitems;');
  7502. Add('end;');
  7503. Add('procedure tobject.setitems(value: tarray);');
  7504. Add('begin');
  7505. Add(' fitems:=value;');
  7506. Add(' fitems:=nil;');
  7507. Add(' Items:=nil;');
  7508. Add(' Items:=Items;');
  7509. Add(' Items[1]:=2;');
  7510. Add(' fitems[3]:=Items[4];');
  7511. Add(' Items[5]:=Items[6];');
  7512. Add(' Self.Items[7]:=8;');
  7513. Add(' Self.Items[9]:=Self.Items[10];');
  7514. Add(' Items[Items[11]]:=Items[Items[12]];');
  7515. Add('end;');
  7516. Add('var Obj: tobject;');
  7517. Add('begin');
  7518. Add(' obj.items:=nil;');
  7519. Add(' obj.items:=obj.items;');
  7520. Add(' obj.items[11]:=obj.items[12];');
  7521. ConvertProgram;
  7522. CheckSource('TestClass_PropertyOfTypeArray',
  7523. LinesToStr([ // statements
  7524. 'rtl.createClass($mod, "TObject", null, function () {',
  7525. ' this.$init = function () {',
  7526. ' this.FItems = [];',
  7527. ' };',
  7528. ' this.$final = function () {',
  7529. ' this.FItems = undefined;',
  7530. ' };',
  7531. ' this.GetItems = function () {',
  7532. ' var Result = [];',
  7533. ' Result = this.FItems;',
  7534. ' return Result;',
  7535. ' };',
  7536. ' this.SetItems = function (Value) {',
  7537. ' this.FItems = Value;',
  7538. ' this.FItems = [];',
  7539. ' this.SetItems([]);',
  7540. ' this.SetItems(this.GetItems());',
  7541. ' this.GetItems()[1] = 2;',
  7542. ' this.FItems[3] = this.GetItems()[4];',
  7543. ' this.GetItems()[5] = this.GetItems()[6];',
  7544. ' this.GetItems()[7] = 8;',
  7545. ' this.GetItems()[9] = this.GetItems()[10];',
  7546. ' this.GetItems()[this.GetItems()[11]] = this.GetItems()[this.GetItems()[12]];',
  7547. ' };',
  7548. '});',
  7549. 'this.Obj = null;'
  7550. ]),
  7551. LinesToStr([ // $mod.$main
  7552. '$mod.Obj.SetItems([]);',
  7553. '$mod.Obj.SetItems($mod.Obj.GetItems());',
  7554. '$mod.Obj.GetItems()[11] = $mod.Obj.GetItems()[12];'
  7555. ]));
  7556. end;
  7557. procedure TTestModule.TestClass_PropertyDefault;
  7558. begin
  7559. StartProgram(false);
  7560. Add('type');
  7561. Add(' TArray = array of longint;');
  7562. Add(' TObject = class');
  7563. Add(' FItems: TArray;');
  7564. Add(' function GetItems(Index: longint): longint;');
  7565. Add(' procedure SetItems(Index, Value: longint);');
  7566. Add(' property Items[Index: longint]: longint read getitems write setitems; default;');
  7567. Add(' end;');
  7568. Add('function tobject.getitems(index: longint): longint;');
  7569. Add('begin');
  7570. Add('end;');
  7571. Add('procedure tobject.setitems(index, value: longint);');
  7572. Add('begin');
  7573. Add(' Self[1]:=2;');
  7574. Add(' Self[3]:=Self[index];');
  7575. Add(' Self[index]:=Self[Self[value]];');
  7576. Add(' Self[Self[4]]:=value;');
  7577. Add('end;');
  7578. Add('var Obj: tobject;');
  7579. Add('begin');
  7580. Add(' obj[11]:=12;');
  7581. Add(' obj[13]:=obj[14];');
  7582. Add(' obj[obj[15]]:=obj[obj[15]];');
  7583. ConvertProgram;
  7584. CheckSource('TestClass_PropertyDefault',
  7585. LinesToStr([ // statements
  7586. 'rtl.createClass($mod, "TObject", null, function () {',
  7587. ' this.$init = function () {',
  7588. ' this.FItems = [];',
  7589. ' };',
  7590. ' this.$final = function () {',
  7591. ' this.FItems = undefined;',
  7592. ' };',
  7593. ' this.GetItems = function (Index) {',
  7594. ' var Result = 0;',
  7595. ' return Result;',
  7596. ' };',
  7597. ' this.SetItems = function (Index, Value) {',
  7598. ' this.SetItems(1, 2);',
  7599. ' this.SetItems(3, this.GetItems(Index));',
  7600. ' this.SetItems(Index, this.GetItems(this.GetItems(Value)));',
  7601. ' this.SetItems(this.GetItems(4), Value);',
  7602. ' };',
  7603. '});',
  7604. 'this.Obj = null;'
  7605. ]),
  7606. LinesToStr([ // $mod.$main
  7607. '$mod.Obj.SetItems(11, 12);',
  7608. '$mod.Obj.SetItems(13, $mod.Obj.GetItems(14));',
  7609. '$mod.Obj.SetItems($mod.Obj.GetItems(15), $mod.Obj.GetItems($mod.Obj.GetItems(15)));'
  7610. ]));
  7611. end;
  7612. procedure TTestModule.TestClass_PropertyOverride;
  7613. begin
  7614. StartProgram(false);
  7615. Add('type');
  7616. Add(' integer = longint;');
  7617. Add(' TObject = class');
  7618. Add(' FItem: integer;');
  7619. Add(' function GetItem: integer; external name ''GetItem'';');
  7620. Add(' procedure SetItem(Value: integer); external name ''SetItem'';');
  7621. Add(' property Item: integer read getitem write setitem;');
  7622. Add(' end;');
  7623. Add(' TCar = class');
  7624. Add(' FBag: integer;');
  7625. Add(' function GetBag: integer; external name ''GetBag'';');
  7626. Add(' property Item read getbag;');
  7627. Add(' end;');
  7628. Add('var');
  7629. Add(' Obj: tobject;');
  7630. Add(' Car: tcar;');
  7631. Add('begin');
  7632. Add(' Obj.Item:=Obj.Item;');
  7633. Add(' Car.Item:=Car.Item;');
  7634. ConvertProgram;
  7635. CheckSource('TestClass_PropertyOverride',
  7636. LinesToStr([ // statements
  7637. 'rtl.createClass($mod, "TObject", null, function () {',
  7638. ' this.$init = function () {',
  7639. ' this.FItem = 0;',
  7640. ' };',
  7641. ' this.$final = function () {',
  7642. ' };',
  7643. '});',
  7644. 'rtl.createClass($mod, "TCar", $mod.TObject, function () {',
  7645. ' this.$init = function () {',
  7646. ' $mod.TObject.$init.call(this);',
  7647. ' this.FBag = 0;',
  7648. ' };',
  7649. '});',
  7650. 'this.Obj = null;',
  7651. 'this.Car = null;',
  7652. '']),
  7653. LinesToStr([ // $mod.$main
  7654. '$mod.Obj.SetItem($mod.Obj.GetItem());',
  7655. '$mod.Car.SetItem($mod.Car.GetBag());',
  7656. '']));
  7657. end;
  7658. procedure TTestModule.TestClass_Assigned;
  7659. begin
  7660. StartProgram(false);
  7661. Add('type');
  7662. Add(' TObject = class');
  7663. Add(' end;');
  7664. Add('var');
  7665. Add(' Obj: tobject;');
  7666. Add(' b: boolean;');
  7667. Add('begin');
  7668. Add(' if Assigned(obj) then ;');
  7669. Add(' b:=Assigned(obj) or false;');
  7670. ConvertProgram;
  7671. CheckSource('TestClass_Assigned',
  7672. LinesToStr([ // statements
  7673. 'rtl.createClass($mod, "TObject", null, function () {',
  7674. ' this.$init = function () {',
  7675. ' };',
  7676. ' this.$final = function () {',
  7677. ' };',
  7678. '});',
  7679. 'this.Obj = null;',
  7680. 'this.b = false;'
  7681. ]),
  7682. LinesToStr([ // $mod.$main
  7683. 'if ($mod.Obj != null);',
  7684. '$mod.b = ($mod.Obj != null) || false;'
  7685. ]));
  7686. end;
  7687. procedure TTestModule.TestClass_WithClassDoCreate;
  7688. begin
  7689. StartProgram(false);
  7690. Add('type');
  7691. Add(' TObject = class');
  7692. Add(' aBool: boolean;');
  7693. Add(' Arr: array of boolean;');
  7694. Add(' constructor Create;');
  7695. Add(' end;');
  7696. Add('constructor TObject.Create; begin end;');
  7697. Add('var');
  7698. Add(' Obj: tobject;');
  7699. Add(' b: boolean;');
  7700. Add('begin');
  7701. Add(' with tobject.create do begin');
  7702. Add(' b:=abool;');
  7703. Add(' abool:=b;');
  7704. Add(' b:=arr[1];');
  7705. Add(' arr[2]:=b;');
  7706. Add(' end;');
  7707. Add(' with tobject do');
  7708. Add(' obj:=create;');
  7709. Add(' with obj do begin');
  7710. Add(' create;');
  7711. Add(' b:=abool;');
  7712. Add(' abool:=b;');
  7713. Add(' b:=arr[3];');
  7714. Add(' arr[4]:=b;');
  7715. Add(' end;');
  7716. ConvertProgram;
  7717. CheckSource('TestClass_WithClassDoCreate',
  7718. LinesToStr([ // statements
  7719. 'rtl.createClass($mod, "TObject", null, function () {',
  7720. ' this.$init = function () {',
  7721. ' this.aBool = false;',
  7722. ' this.Arr = [];',
  7723. ' };',
  7724. ' this.$final = function () {',
  7725. ' this.Arr = undefined;',
  7726. ' };',
  7727. ' this.Create = function () {',
  7728. ' };',
  7729. '});',
  7730. 'this.Obj = null;',
  7731. 'this.b = false;'
  7732. ]),
  7733. LinesToStr([ // $mod.$main
  7734. 'var $with1 = $mod.TObject.$create("Create");',
  7735. '$mod.b = $with1.aBool;',
  7736. '$with1.aBool = $mod.b;',
  7737. '$mod.b = $with1.Arr[1];',
  7738. '$with1.Arr[2] = $mod.b;',
  7739. 'var $with2 = $mod.TObject;',
  7740. '$mod.Obj = $with2.$create("Create");',
  7741. 'var $with3 = $mod.Obj;',
  7742. '$with3.Create();',
  7743. '$mod.b = $with3.aBool;',
  7744. '$with3.aBool = $mod.b;',
  7745. '$mod.b = $with3.Arr[3];',
  7746. '$with3.Arr[4] = $mod.b;',
  7747. '']));
  7748. end;
  7749. procedure TTestModule.TestClass_WithClassInstDoProperty;
  7750. begin
  7751. StartProgram(false);
  7752. Add('type');
  7753. Add(' TObject = class');
  7754. Add(' FInt: longint;');
  7755. Add(' constructor Create;');
  7756. Add(' function GetSize: longint;');
  7757. Add(' procedure SetSize(Value: longint);');
  7758. Add(' property Int: longint read FInt write FInt;');
  7759. Add(' property Size: longint read GetSize write SetSize;');
  7760. Add(' end;');
  7761. Add('constructor TObject.Create; begin end;');
  7762. Add('function TObject.GetSize: longint; begin; end;');
  7763. Add('procedure TObject.SetSize(Value: longint); begin; end;');
  7764. Add('var');
  7765. Add(' Obj: tobject;');
  7766. Add(' i: longint;');
  7767. Add('begin');
  7768. Add(' with TObject.Create do begin');
  7769. Add(' i:=int;');
  7770. Add(' int:=i;');
  7771. Add(' i:=size;');
  7772. Add(' size:=i;');
  7773. Add(' end;');
  7774. Add(' with obj do begin');
  7775. Add(' i:=int;');
  7776. Add(' int:=i;');
  7777. Add(' i:=size;');
  7778. Add(' size:=i;');
  7779. Add(' end;');
  7780. ConvertProgram;
  7781. CheckSource('TestClass_WithClassInstDoProperty',
  7782. LinesToStr([ // statements
  7783. 'rtl.createClass($mod, "TObject", null, function () {',
  7784. ' this.$init = function () {',
  7785. ' this.FInt = 0;',
  7786. ' };',
  7787. ' this.$final = function () {',
  7788. ' };',
  7789. ' this.Create = function () {',
  7790. ' };',
  7791. ' this.GetSize = function () {',
  7792. ' var Result = 0;',
  7793. ' return Result;',
  7794. ' };',
  7795. ' this.SetSize = function (Value) {',
  7796. ' };',
  7797. '});',
  7798. 'this.Obj = null;',
  7799. 'this.i = 0;'
  7800. ]),
  7801. LinesToStr([ // $mod.$main
  7802. 'var $with1 = $mod.TObject.$create("Create");',
  7803. '$mod.i = $with1.FInt;',
  7804. '$with1.FInt = $mod.i;',
  7805. '$mod.i = $with1.GetSize();',
  7806. '$with1.SetSize($mod.i);',
  7807. 'var $with2 = $mod.Obj;',
  7808. '$mod.i = $with2.FInt;',
  7809. '$with2.FInt = $mod.i;',
  7810. '$mod.i = $with2.GetSize();',
  7811. '$with2.SetSize($mod.i);',
  7812. '']));
  7813. end;
  7814. procedure TTestModule.TestClass_WithClassInstDoPropertyWithParams;
  7815. begin
  7816. StartProgram(false);
  7817. Add('type');
  7818. Add(' TObject = class');
  7819. Add(' constructor Create;');
  7820. Add(' function GetItems(Index: longint): longint;');
  7821. Add(' procedure SetItems(Index, Value: longint);');
  7822. Add(' property Items[Index: longint]: longint read GetItems write SetItems;');
  7823. Add(' end;');
  7824. Add('constructor TObject.Create; begin end;');
  7825. Add('function tobject.getitems(index: longint): longint; begin; end;');
  7826. Add('procedure tobject.setitems(index, value: longint); begin; end;');
  7827. Add('var');
  7828. Add(' Obj: tobject;');
  7829. Add(' i: longint;');
  7830. Add('begin');
  7831. Add(' with TObject.Create do begin');
  7832. Add(' i:=Items[1];');
  7833. Add(' Items[2]:=i;');
  7834. Add(' end;');
  7835. Add(' with obj do begin');
  7836. Add(' i:=Items[3];');
  7837. Add(' Items[4]:=i;');
  7838. Add(' end;');
  7839. ConvertProgram;
  7840. CheckSource('TestClass_WithClassInstDoPropertyWithParams',
  7841. LinesToStr([ // statements
  7842. 'rtl.createClass($mod, "TObject", null, function () {',
  7843. ' this.$init = function () {',
  7844. ' };',
  7845. ' this.$final = function () {',
  7846. ' };',
  7847. ' this.Create = function () {',
  7848. ' };',
  7849. ' this.GetItems = function (Index) {',
  7850. ' var Result = 0;',
  7851. ' return Result;',
  7852. ' };',
  7853. ' this.SetItems = function (Index, Value) {',
  7854. ' };',
  7855. '});',
  7856. 'this.Obj = null;',
  7857. 'this.i = 0;'
  7858. ]),
  7859. LinesToStr([ // $mod.$main
  7860. 'var $with1 = $mod.TObject.$create("Create");',
  7861. '$mod.i = $with1.GetItems(1);',
  7862. '$with1.SetItems(2, $mod.i);',
  7863. 'var $with2 = $mod.Obj;',
  7864. '$mod.i = $with2.GetItems(3);',
  7865. '$with2.SetItems(4, $mod.i);',
  7866. '']));
  7867. end;
  7868. procedure TTestModule.TestClass_WithClassInstDoFunc;
  7869. begin
  7870. StartProgram(false);
  7871. Add('type');
  7872. Add(' TObject = class');
  7873. Add(' constructor Create;');
  7874. Add(' function GetSize: longint;');
  7875. Add(' procedure SetSize(Value: longint);');
  7876. Add(' end;');
  7877. Add('constructor TObject.Create; begin end;');
  7878. Add('function TObject.GetSize: longint; begin; end;');
  7879. Add('procedure TObject.SetSize(Value: longint); begin; end;');
  7880. Add('var');
  7881. Add(' Obj: tobject;');
  7882. Add(' i: longint;');
  7883. Add('begin');
  7884. Add(' with TObject.Create do begin');
  7885. Add(' i:=GetSize;');
  7886. Add(' i:=GetSize();');
  7887. Add(' SetSize(i);');
  7888. Add(' end;');
  7889. Add(' with obj do begin');
  7890. Add(' i:=GetSize;');
  7891. Add(' i:=GetSize();');
  7892. Add(' SetSize(i);');
  7893. Add(' end;');
  7894. ConvertProgram;
  7895. CheckSource('TestClass_WithClassInstDoFunc',
  7896. LinesToStr([ // statements
  7897. 'rtl.createClass($mod, "TObject", null, function () {',
  7898. ' this.$init = function () {',
  7899. ' };',
  7900. ' this.$final = function () {',
  7901. ' };',
  7902. ' this.Create = function () {',
  7903. ' };',
  7904. ' this.GetSize = function () {',
  7905. ' var Result = 0;',
  7906. ' return Result;',
  7907. ' };',
  7908. ' this.SetSize = function (Value) {',
  7909. ' };',
  7910. '});',
  7911. 'this.Obj = null;',
  7912. 'this.i = 0;'
  7913. ]),
  7914. LinesToStr([ // $mod.$main
  7915. 'var $with1 = $mod.TObject.$create("Create");',
  7916. '$mod.i = $with1.GetSize();',
  7917. '$mod.i = $with1.GetSize();',
  7918. '$with1.SetSize($mod.i);',
  7919. 'var $with2 = $mod.Obj;',
  7920. '$mod.i = $with2.GetSize();',
  7921. '$mod.i = $with2.GetSize();',
  7922. '$with2.SetSize($mod.i);',
  7923. '']));
  7924. end;
  7925. procedure TTestModule.TestClass_TypeCast;
  7926. begin
  7927. StartProgram(false);
  7928. Add('type');
  7929. Add(' TObject = class');
  7930. Add(' Next: TObject;');
  7931. Add(' constructor Create;');
  7932. Add(' end;');
  7933. Add(' TControl = class(TObject)');
  7934. Add(' Arr: array of TObject;');
  7935. Add(' function GetIt(vI: longint = 0): TObject;');
  7936. Add(' end;');
  7937. Add('constructor tobject.create; begin end;');
  7938. Add('function tcontrol.getit(vi: longint = 0): tobject; begin end;');
  7939. Add('var');
  7940. Add(' Obj: tobject;');
  7941. Add('begin');
  7942. Add(' obj:=tcontrol(obj).next;');
  7943. Add(' tcontrol(obj):=nil;');
  7944. Add(' obj:=tcontrol(obj);');
  7945. Add(' tcontrol(obj):=tcontrol(tcontrol(obj).getit);');
  7946. Add(' tcontrol(obj):=tcontrol(tcontrol(obj).getit());');
  7947. Add(' tcontrol(obj):=tcontrol(tcontrol(obj).getit(1));');
  7948. Add(' tcontrol(obj):=tcontrol(tcontrol(tcontrol(obj).getit).arr[2]);');
  7949. ConvertProgram;
  7950. CheckSource('TestClass_TypeCast',
  7951. LinesToStr([ // statements
  7952. 'rtl.createClass($mod, "TObject", null, function () {',
  7953. ' this.$init = function () {',
  7954. ' this.Next = null;',
  7955. ' };',
  7956. ' this.$final = function () {',
  7957. ' this.Next = undefined;',
  7958. ' };',
  7959. ' this.Create = function () {',
  7960. ' };',
  7961. '});',
  7962. 'rtl.createClass($mod, "TControl", $mod.TObject, function () {',
  7963. ' this.$init = function () {',
  7964. ' $mod.TObject.$init.call(this);',
  7965. ' this.Arr = [];',
  7966. ' };',
  7967. ' this.$final = function () {',
  7968. ' this.Arr = undefined;',
  7969. ' $mod.TObject.$final.call(this);',
  7970. ' };',
  7971. ' this.GetIt = function (vI) {',
  7972. ' var Result = null;',
  7973. ' return Result;',
  7974. ' };',
  7975. '});',
  7976. 'this.Obj = null;'
  7977. ]),
  7978. LinesToStr([ // $mod.$main
  7979. '$mod.Obj = $mod.Obj.Next;',
  7980. '$mod.Obj = null;',
  7981. '$mod.Obj = $mod.Obj;',
  7982. '$mod.Obj = $mod.Obj.GetIt(0);',
  7983. '$mod.Obj = $mod.Obj.GetIt(0);',
  7984. '$mod.Obj = $mod.Obj.GetIt(1);',
  7985. '$mod.Obj = $mod.Obj.GetIt(0).Arr[2];',
  7986. '']));
  7987. end;
  7988. procedure TTestModule.TestClass_TypeCastUntypedParam;
  7989. begin
  7990. StartProgram(false);
  7991. Add('type');
  7992. Add(' TObject = class end;');
  7993. Add('procedure ProcA(var A);');
  7994. Add('begin');
  7995. Add(' TObject(A):=nil;');
  7996. Add(' TObject(A):=TObject(A);');
  7997. Add(' if TObject(A)=nil then ;');
  7998. Add(' if nil=TObject(A) then ;');
  7999. Add('end;');
  8000. Add('procedure ProcB(out A);');
  8001. Add('begin');
  8002. Add(' TObject(A):=nil;');
  8003. Add(' TObject(A):=TObject(A);');
  8004. Add(' if TObject(A)=nil then ;');
  8005. Add(' if nil=TObject(A) then ;');
  8006. Add('end;');
  8007. Add('procedure ProcC(const A);');
  8008. Add('begin');
  8009. Add(' if TObject(A)=nil then ;');
  8010. Add(' if nil=TObject(A) then ;');
  8011. Add('end;');
  8012. Add('var o: TObject;');
  8013. Add('begin');
  8014. Add(' ProcA(o);');
  8015. Add(' ProcB(o);');
  8016. Add(' ProcC(o);');
  8017. ConvertProgram;
  8018. CheckSource('TestClass_TypeCastUntypedParam',
  8019. LinesToStr([ // statements
  8020. 'rtl.createClass($mod, "TObject", null, function () {',
  8021. ' this.$init = function () {',
  8022. ' };',
  8023. ' this.$final = function () {',
  8024. ' };',
  8025. '});',
  8026. 'this.ProcA = function (A) {',
  8027. ' A.set(null);',
  8028. ' A.set(A.get());',
  8029. ' if (A.get() === null);',
  8030. ' if (null === A.get());',
  8031. '};',
  8032. 'this.ProcB = function (A) {',
  8033. ' A.set(null);',
  8034. ' A.set(A.get());',
  8035. ' if (A.get() === null);',
  8036. ' if (null === A.get());',
  8037. '};',
  8038. 'this.ProcC = function (A) {',
  8039. ' if (A === null);',
  8040. ' if (null === A);',
  8041. '};',
  8042. 'this.o = null;',
  8043. '']),
  8044. LinesToStr([ // $mod.$main
  8045. '$mod.ProcA({',
  8046. ' p: $mod,',
  8047. ' get: function () {',
  8048. ' return this.p.o;',
  8049. ' },',
  8050. ' set: function (v) {',
  8051. ' this.p.o = v;',
  8052. ' }',
  8053. '});',
  8054. '$mod.ProcB({',
  8055. ' p: $mod,',
  8056. ' get: function () {',
  8057. ' return this.p.o;',
  8058. ' },',
  8059. ' set: function (v) {',
  8060. ' this.p.o = v;',
  8061. ' }',
  8062. '});',
  8063. '$mod.ProcC($mod.o);',
  8064. '']));
  8065. end;
  8066. procedure TTestModule.TestClass_Overloads;
  8067. begin
  8068. StartProgram(false);
  8069. Add('type');
  8070. Add(' TObject = class');
  8071. Add(' procedure DoIt;');
  8072. Add(' procedure DoIt(vI: longint);');
  8073. Add(' end;');
  8074. Add('procedure TObject.DoIt;');
  8075. Add('begin');
  8076. Add(' DoIt;');
  8077. Add(' DoIt(1);');
  8078. Add('end;');
  8079. Add('procedure TObject.DoIt(vI: longint); begin end;');
  8080. Add('begin');
  8081. ConvertProgram;
  8082. CheckSource('TestClass_Overloads',
  8083. LinesToStr([ // statements
  8084. 'rtl.createClass($mod, "TObject", null, function () {',
  8085. ' this.$init = function () {',
  8086. ' };',
  8087. ' this.$final = function () {',
  8088. ' };',
  8089. ' this.DoIt = function () {',
  8090. ' this.DoIt();',
  8091. ' this.DoIt$1(1);',
  8092. ' };',
  8093. ' this.DoIt$1 = function (vI) {',
  8094. ' };',
  8095. '});',
  8096. '']),
  8097. LinesToStr([ // $mod.$main
  8098. '']));
  8099. end;
  8100. procedure TTestModule.TestClass_OverloadsAncestor;
  8101. begin
  8102. StartProgram(false);
  8103. Add('type');
  8104. Add(' TObject = class;');
  8105. Add(' TObject = class');
  8106. Add(' procedure DoIt(vA: longint);');
  8107. Add(' procedure DoIt(vA, vB: longint);');
  8108. Add(' end;');
  8109. Add(' TCar = class;');
  8110. Add(' TCar = class');
  8111. Add(' procedure DoIt(vA: longint);');
  8112. Add(' procedure DoIt(vA, vB: longint);');
  8113. Add(' end;');
  8114. Add('procedure tobject.doit(va: longint);');
  8115. Add('begin');
  8116. Add(' doit(1);');
  8117. Add(' doit(1,2);');
  8118. Add('end;');
  8119. Add('procedure tobject.doit(va, vb: longint); begin end;');
  8120. Add('procedure tcar.doit(va: longint);');
  8121. Add('begin');
  8122. Add(' doit(1);');
  8123. Add(' doit(1,2);');
  8124. Add(' inherited doit(1);');
  8125. Add(' inherited doit(1,2);');
  8126. Add('end;');
  8127. Add('procedure tcar.doit(va, vb: longint); begin end;');
  8128. Add('begin');
  8129. ConvertProgram;
  8130. CheckSource('TestClass_OverloadsAncestor',
  8131. LinesToStr([ // statements
  8132. 'rtl.createClass($mod, "TObject", null, function () {',
  8133. ' this.$init = function () {',
  8134. ' };',
  8135. ' this.$final = function () {',
  8136. ' };',
  8137. ' this.DoIt = function (vA) {',
  8138. ' this.DoIt(1);',
  8139. ' this.DoIt$1(1,2);',
  8140. ' };',
  8141. ' this.DoIt$1 = function (vA, vB) {',
  8142. ' };',
  8143. '});',
  8144. 'rtl.createClass($mod, "TCar", $mod.TObject, function () {',
  8145. ' this.DoIt$2 = function (vA) {',
  8146. ' this.DoIt$2(1);',
  8147. ' this.DoIt$3(1, 2);',
  8148. ' $mod.TObject.DoIt.call(this, 1);',
  8149. ' $mod.TObject.DoIt$1.call(this, 1, 2);',
  8150. ' };',
  8151. ' this.DoIt$3 = function (vA, vB) {',
  8152. ' };',
  8153. '});',
  8154. '']),
  8155. LinesToStr([ // $mod.$main
  8156. '']));
  8157. end;
  8158. procedure TTestModule.TestClass_OverloadConstructor;
  8159. begin
  8160. StartProgram(false);
  8161. Add('type');
  8162. Add(' TObject = class');
  8163. Add(' constructor Create(vA: longint);');
  8164. Add(' constructor Create(vA, vB: longint);');
  8165. Add(' end;');
  8166. Add(' TCar = class');
  8167. Add(' constructor Create(vA: longint);');
  8168. Add(' constructor Create(vA, vB: longint);');
  8169. Add(' end;');
  8170. Add('constructor tobject.create(va: longint);');
  8171. Add('begin');
  8172. Add(' create(1);');
  8173. Add(' create(1,2);');
  8174. Add('end;');
  8175. Add('constructor tobject.create(va, vb: longint); begin end;');
  8176. Add('constructor tcar.create(va: longint);');
  8177. Add('begin');
  8178. Add(' create(1);');
  8179. Add(' create(1,2);');
  8180. Add(' inherited create(1);');
  8181. Add(' inherited create(1,2);');
  8182. Add('end;');
  8183. Add('constructor tcar.create(va, vb: longint); begin end;');
  8184. Add('begin');
  8185. Add(' tobject.create(1);');
  8186. Add(' tobject.create(1,2);');
  8187. Add(' tcar.create(1);');
  8188. Add(' tcar.create(1,2);');
  8189. ConvertProgram;
  8190. CheckSource('TestClass_OverloadConstructor',
  8191. LinesToStr([ // statements
  8192. 'rtl.createClass($mod, "TObject", null, function () {',
  8193. ' this.$init = function () {',
  8194. ' };',
  8195. ' this.$final = function () {',
  8196. ' };',
  8197. ' this.Create = function (vA) {',
  8198. ' this.Create(1);',
  8199. ' this.Create$1(1,2);',
  8200. ' };',
  8201. ' this.Create$1 = function (vA, vB) {',
  8202. ' };',
  8203. '});',
  8204. 'rtl.createClass($mod, "TCar", $mod.TObject, function () {',
  8205. ' this.Create$2 = function (vA) {',
  8206. ' this.Create$2(1);',
  8207. ' this.Create$3(1, 2);',
  8208. ' $mod.TObject.Create.call(this, 1);',
  8209. ' $mod.TObject.Create$1.call(this, 1, 2);',
  8210. ' };',
  8211. ' this.Create$3 = function (vA, vB) {',
  8212. ' };',
  8213. '});',
  8214. '']),
  8215. LinesToStr([ // $mod.$main
  8216. '$mod.TObject.$create("Create", [1]);',
  8217. '$mod.TObject.$create("Create$1", [1, 2]);',
  8218. '$mod.TCar.$create("Create$2", [1]);',
  8219. '$mod.TCar.$create("Create$3", [1, 2]);',
  8220. '']));
  8221. end;
  8222. procedure TTestModule.TestClass_OverloadDelphiOverride;
  8223. begin
  8224. StartProgram(false);
  8225. Add([
  8226. '{$mode delphi}',
  8227. 'type',
  8228. ' TObject = class end;',
  8229. ' TBird = class',
  8230. ' function {#a}GetValue: longint; overload; virtual;',
  8231. ' function {#b}GetValue(AValue: longint): longint; overload; virtual;',
  8232. ' end;',
  8233. ' TEagle = class(TBird)',
  8234. ' function {#c}GetValue: longint; overload; override;',
  8235. ' function {#d}GetValue(AValue: longint): longint; overload; override;',
  8236. ' end;',
  8237. 'function TBird.GetValue: longint;',
  8238. 'begin',
  8239. ' if 3={@a}GetValue then ;',
  8240. ' if 4={@b}GetValue(5) then ;',
  8241. 'end;',
  8242. 'function TBird.GetValue(AValue: longint): longint;',
  8243. 'begin',
  8244. 'end;',
  8245. 'function TEagle.GetValue: longint;',
  8246. 'begin',
  8247. ' if 13={@c}GetValue then ;',
  8248. ' if 14={@d}GetValue(15) then ;',
  8249. ' if 15=inherited {@a}GetValue then ;',
  8250. ' if 16=inherited {@b}GetValue(17) then ;',
  8251. 'end;',
  8252. 'function TEagle.GetValue(AValue: longint): longint;',
  8253. 'begin',
  8254. 'end;',
  8255. 'var',
  8256. ' e: TEagle;',
  8257. 'begin',
  8258. ' if 23=e.{@c}GetValue then ;',
  8259. ' if 24=e.{@d}GetValue(25) then ;']);
  8260. ConvertProgram;
  8261. CheckSource('TestClass_OverloadDelphiOverride',
  8262. LinesToStr([ // statements
  8263. 'rtl.createClass($mod, "TObject", null, function () {',
  8264. ' this.$init = function () {',
  8265. ' };',
  8266. ' this.$final = function () {',
  8267. ' };',
  8268. '});',
  8269. 'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
  8270. ' this.GetValue = function () {',
  8271. ' var Result = 0;',
  8272. ' if (3 === this.GetValue()) ;',
  8273. ' if (4 === this.GetValue$1(5)) ;',
  8274. ' return Result;',
  8275. ' };',
  8276. ' this.GetValue$1 = function (AValue) {',
  8277. ' var Result = 0;',
  8278. ' return Result;',
  8279. ' };',
  8280. '});',
  8281. 'rtl.createClass($mod, "TEagle", $mod.TBird, function () {',
  8282. ' this.GetValue = function () {',
  8283. ' var Result = 0;',
  8284. ' if (13 === this.GetValue()) ;',
  8285. ' if (14 === this.GetValue$1(15)) ;',
  8286. ' if (15 === $mod.TBird.GetValue.call(this)) ;',
  8287. ' if (16 === $mod.TBird.GetValue$1.call(this, 17)) ;',
  8288. ' return Result;',
  8289. ' };',
  8290. ' this.GetValue$1 = function (AValue) {',
  8291. ' var Result = 0;',
  8292. ' return Result;',
  8293. ' };',
  8294. '});',
  8295. 'this.e = null;',
  8296. '']),
  8297. LinesToStr([ // $mod.$main
  8298. 'if (23 === $mod.e.GetValue()) ;',
  8299. 'if (24 === $mod.e.GetValue$1(25)) ;',
  8300. '']));
  8301. end;
  8302. procedure TTestModule.TestClass_ReintroducedVar;
  8303. begin
  8304. StartProgram(false);
  8305. Add('type');
  8306. Add(' TObject = class');
  8307. Add(' strict private');
  8308. Add(' Some: longint;');
  8309. Add(' end;');
  8310. Add(' TMobile = class');
  8311. Add(' strict private');
  8312. Add(' Some: string;');
  8313. Add(' end;');
  8314. Add(' TCar = class(tmobile)');
  8315. Add(' procedure Some;');
  8316. Add(' procedure Some(vA: longint);');
  8317. Add(' end;');
  8318. Add('procedure tcar.some;');
  8319. Add('begin');
  8320. Add(' Some;');
  8321. Add(' Some(1);');
  8322. Add('end;');
  8323. Add('procedure tcar.some(va: longint); begin end;');
  8324. Add('begin');
  8325. ConvertProgram;
  8326. CheckSource('TestClass_ReintroducedVar',
  8327. LinesToStr([ // statements
  8328. 'rtl.createClass($mod, "TObject", null, function () {',
  8329. ' this.$init = function () {',
  8330. ' this.Some = 0;',
  8331. ' };',
  8332. ' this.$final = function () {',
  8333. ' };',
  8334. '});',
  8335. 'rtl.createClass($mod, "TMobile", $mod.TObject, function () {',
  8336. ' this.$init = function () {',
  8337. ' $mod.TObject.$init.call(this);',
  8338. ' this.Some$1 = "";',
  8339. ' };',
  8340. '});',
  8341. 'rtl.createClass($mod, "TCar", $mod.TMobile, function () {',
  8342. ' this.Some$2 = function () {',
  8343. ' this.Some$2();',
  8344. ' this.Some$3(1);',
  8345. ' };',
  8346. ' this.Some$3 = function (vA) {',
  8347. ' };',
  8348. '});',
  8349. '']),
  8350. LinesToStr([ // $mod.$main
  8351. '']));
  8352. end;
  8353. procedure TTestModule.TestClass_RaiseDescendant;
  8354. begin
  8355. StartProgram(false);
  8356. Add([
  8357. 'type',
  8358. ' TObject = class',
  8359. ' constructor Create(Msg: string);',
  8360. ' end;',
  8361. ' Exception = class',
  8362. ' end;',
  8363. ' EConvertError = class(Exception)',
  8364. ' end;',
  8365. 'constructor TObject.Create(Msg: string); begin end;',
  8366. 'function AssertConv(Msg: string = ''def''): EConvertError; begin end;',
  8367. 'begin',
  8368. ' raise Exception.Create(''Bar1'');',
  8369. ' raise EConvertError.Create(''Bar2'');',
  8370. ' raise AssertConv(''Bar2'');',
  8371. ' raise AssertConv;',
  8372. '']);
  8373. ConvertProgram;
  8374. CheckSource('TestClass_RaiseDescendant',
  8375. LinesToStr([ // statements
  8376. 'rtl.createClass($mod, "TObject", null, function () {',
  8377. ' this.$init = function () {',
  8378. ' };',
  8379. ' this.$final = function () {',
  8380. ' };',
  8381. ' this.Create = function (Msg) {',
  8382. ' };',
  8383. '});',
  8384. 'rtl.createClass($mod, "Exception", $mod.TObject, function () {',
  8385. '});',
  8386. 'rtl.createClass($mod, "EConvertError", $mod.Exception, function () {',
  8387. '});',
  8388. 'this.AssertConv = function (Msg) {',
  8389. ' var Result = null;',
  8390. ' return Result;',
  8391. '};',
  8392. '']),
  8393. LinesToStr([ // $mod.$main
  8394. 'throw $mod.Exception.$create("Create",["Bar1"]);',
  8395. 'throw $mod.EConvertError.$create("Create",["Bar2"]);',
  8396. 'throw $mod.AssertConv("Bar2");',
  8397. 'throw $mod.AssertConv("def");',
  8398. '']));
  8399. end;
  8400. procedure TTestModule.TestClass_ExternalMethod;
  8401. begin
  8402. AddModuleWithIntfImplSrc('unit2.pas',
  8403. LinesToStr([
  8404. 'type',
  8405. ' TObject = class',
  8406. ' public',
  8407. ' procedure Intern; external name ''$DoIntern'';',
  8408. ' end;',
  8409. '']),
  8410. LinesToStr([
  8411. '']));
  8412. StartUnit(true);
  8413. Add('interface');
  8414. Add('uses unit2;');
  8415. Add('type');
  8416. Add(' TCar = class(TObject)');
  8417. Add(' public');
  8418. Add(' procedure Intern2; external name ''$DoIntern2'';');
  8419. Add(' procedure DoIt;');
  8420. Add(' end;');
  8421. Add('implementation');
  8422. Add('procedure tcar.doit;');
  8423. Add('begin');
  8424. Add(' Intern;');
  8425. Add(' Intern();');
  8426. Add(' Intern2;');
  8427. Add(' Intern2();');
  8428. Add('end;');
  8429. Add('var Obj: TCar;');
  8430. Add('begin');
  8431. Add(' obj.intern;');
  8432. Add(' obj.intern();');
  8433. Add(' obj.intern2;');
  8434. Add(' obj.intern2();');
  8435. Add(' obj.doit;');
  8436. Add(' obj.doit();');
  8437. Add(' with obj do begin');
  8438. Add(' Intern;');
  8439. Add(' Intern();');
  8440. Add(' Intern2;');
  8441. Add(' Intern2();');
  8442. Add(' end;');
  8443. ConvertUnit;
  8444. CheckSource('TestClass_ExternalMethod',
  8445. LinesToStr([
  8446. 'var $impl = $mod.$impl;',
  8447. 'rtl.createClass($mod, "TCar", pas.unit2.TObject, function () {',
  8448. ' this.DoIt = function () {',
  8449. ' this.$DoIntern();',
  8450. ' this.$DoIntern();',
  8451. ' this.$DoIntern2();',
  8452. ' this.$DoIntern2();',
  8453. ' };',
  8454. ' });',
  8455. '']),
  8456. LinesToStr([ // this.$init
  8457. '$impl.Obj.$DoIntern();',
  8458. '$impl.Obj.$DoIntern();',
  8459. '$impl.Obj.$DoIntern2();',
  8460. '$impl.Obj.$DoIntern2();',
  8461. '$impl.Obj.DoIt();',
  8462. '$impl.Obj.DoIt();',
  8463. 'var $with1 = $impl.Obj;',
  8464. '$with1.$DoIntern();',
  8465. '$with1.$DoIntern();',
  8466. '$with1.$DoIntern2();',
  8467. '$with1.$DoIntern2();',
  8468. '']),
  8469. LinesToStr([ // implementation
  8470. '$impl.Obj = null;',
  8471. '']) );
  8472. end;
  8473. procedure TTestModule.TestClass_ExternalVirtualNameMismatchFail;
  8474. begin
  8475. StartProgram(false);
  8476. Add('type');
  8477. Add(' TObject = class');
  8478. Add(' procedure DoIt; virtual; external name ''Foo'';');
  8479. Add(' end;');
  8480. Add('begin');
  8481. SetExpectedPasResolverError('Virtual method name must match external',
  8482. nVirtualMethodNameMustMatchExternal);
  8483. ConvertProgram;
  8484. end;
  8485. procedure TTestModule.TestClass_ExternalOverrideFail;
  8486. begin
  8487. StartProgram(false);
  8488. Add('type');
  8489. Add(' TObject = class');
  8490. Add(' procedure DoIt; virtual; external name ''DoIt'';');
  8491. Add(' end;');
  8492. Add(' TCar = class');
  8493. Add(' procedure DoIt; override; external name ''DoIt'';');
  8494. Add(' end;');
  8495. Add('begin');
  8496. SetExpectedPasResolverError('Invalid procedure modifier override,external',
  8497. nInvalidXModifierY);
  8498. ConvertProgram;
  8499. end;
  8500. procedure TTestModule.TestClass_ExternalVar;
  8501. begin
  8502. AddModuleWithIntfImplSrc('unit2.pas',
  8503. LinesToStr([
  8504. '{$modeswitch externalclass}',
  8505. 'type',
  8506. ' TObject = class',
  8507. ' public',
  8508. ' Intern: longint external name ''$Intern'';',
  8509. ' end;',
  8510. '']),
  8511. LinesToStr([
  8512. '']));
  8513. StartUnit(true);
  8514. Add('interface');
  8515. Add('uses unit2;');
  8516. Add('{$modeswitch externalclass}');
  8517. Add('type');
  8518. Add(' TCar = class(tobject)');
  8519. Add(' public');
  8520. Add(' Intern2: longint external name ''$Intern2'';');
  8521. Add(' procedure DoIt;');
  8522. Add(' end;');
  8523. Add('implementation');
  8524. Add('procedure tcar.doit;');
  8525. Add('begin');
  8526. Add(' Intern:=Intern+1;');
  8527. Add(' Intern2:=Intern2+2;');
  8528. Add('end;');
  8529. Add('var Obj: TCar;');
  8530. Add('begin');
  8531. Add(' obj.intern:=obj.intern+1;');
  8532. Add(' obj.intern2:=obj.intern2+2;');
  8533. Add(' with obj do begin');
  8534. Add(' intern:=intern+1;');
  8535. Add(' intern2:=intern2+2;');
  8536. Add(' end;');
  8537. ConvertUnit;
  8538. CheckSource('TestClass_ExternalVar',
  8539. LinesToStr([
  8540. 'var $impl = $mod.$impl;',
  8541. 'rtl.createClass($mod, "TCar", pas.unit2.TObject, function () {',
  8542. ' this.DoIt = function () {',
  8543. ' this.$Intern = this.$Intern + 1;',
  8544. ' this.$Intern2 = this.$Intern2 + 2;',
  8545. ' };',
  8546. ' });',
  8547. '']),
  8548. LinesToStr([
  8549. '$impl.Obj.$Intern = $impl.Obj.$Intern + 1;',
  8550. '$impl.Obj.$Intern2 = $impl.Obj.$Intern2 + 2;',
  8551. 'var $with1 = $impl.Obj;',
  8552. '$with1.$Intern = $with1.$Intern + 1;',
  8553. '$with1.$Intern2 = $with1.$Intern2 + 2;',
  8554. '']),
  8555. LinesToStr([ // implementation
  8556. '$impl.Obj = null;',
  8557. '']));
  8558. end;
  8559. procedure TTestModule.TestClass_Const;
  8560. begin
  8561. StartProgram(false);
  8562. Add('type');
  8563. Add(' integer = longint;');
  8564. Add(' TClass = class of TObject;');
  8565. Add(' TObject = class');
  8566. Add(' public');
  8567. Add(' const cI: integer = 3;');
  8568. Add(' procedure DoIt;');
  8569. Add(' class procedure DoMore;');
  8570. Add(' end;');
  8571. Add('implementation');
  8572. Add('procedure tobject.doit;');
  8573. Add('begin');
  8574. Add(' if cI=4 then;');
  8575. Add(' if 5=cI then;');
  8576. Add(' if Self.cI=6 then;');
  8577. Add(' if 7=Self.cI then;');
  8578. Add(' with Self do begin');
  8579. Add(' if cI=11 then;');
  8580. Add(' if 12=cI then;');
  8581. Add(' end;');
  8582. Add('end;');
  8583. Add('class procedure tobject.domore;');
  8584. Add('begin');
  8585. Add(' if cI=8 then;');
  8586. Add(' if Self.cI=9 then;');
  8587. Add(' if 10=cI then;');
  8588. Add(' if 11=Self.cI then;');
  8589. Add(' with Self do begin');
  8590. Add(' if cI=13 then;');
  8591. Add(' if 14=cI then;');
  8592. Add(' end;');
  8593. Add('end;');
  8594. Add('var');
  8595. Add(' Obj: TObject;');
  8596. Add(' Cla: TClass;');
  8597. Add('begin');
  8598. Add(' if TObject.cI=21 then ;');
  8599. Add(' if Obj.cI=22 then ;');
  8600. Add(' if Cla.cI=23 then ;');
  8601. Add(' with obj do if ci=24 then;');
  8602. Add(' with TObject do if ci=25 then;');
  8603. Add(' with Cla do if ci=26 then;');
  8604. ConvertProgram;
  8605. CheckSource('TestClass_Const',
  8606. LinesToStr([
  8607. 'rtl.createClass($mod, "TObject", null, function () {',
  8608. ' this.cI = 3;',
  8609. ' this.$init = function () {',
  8610. ' };',
  8611. ' this.$final = function () {',
  8612. ' };',
  8613. ' this.DoIt = function () {',
  8614. ' if (this.cI === 4) ;',
  8615. ' if (5 === this.cI) ;',
  8616. ' if (this.cI === 6) ;',
  8617. ' if (7 === this.cI) ;',
  8618. ' if (this.cI === 11) ;',
  8619. ' if (12 === this.cI) ;',
  8620. ' };',
  8621. ' this.DoMore = function () {',
  8622. ' if (this.cI === 8) ;',
  8623. ' if (this.cI === 9) ;',
  8624. ' if (10 === this.cI) ;',
  8625. ' if (11 === this.cI) ;',
  8626. ' if (this.cI === 13) ;',
  8627. ' if (14 === this.cI) ;',
  8628. ' };',
  8629. '});',
  8630. 'this.Obj = null;',
  8631. 'this.Cla = null;',
  8632. '']),
  8633. LinesToStr([
  8634. 'if ($mod.TObject.cI === 21) ;',
  8635. 'if ($mod.Obj.cI === 22) ;',
  8636. 'if ($mod.Cla.cI === 23) ;',
  8637. 'var $with1 = $mod.Obj;',
  8638. 'if ($with1.cI === 24) ;',
  8639. 'var $with2 = $mod.TObject;',
  8640. 'if ($with2.cI === 25) ;',
  8641. 'var $with3 = $mod.Cla;',
  8642. 'if ($with3.cI === 26) ;',
  8643. '']));
  8644. end;
  8645. procedure TTestModule.TestClass_LocalVarSelfFail;
  8646. begin
  8647. StartProgram(false);
  8648. Add([
  8649. 'type',
  8650. ' TObject = class',
  8651. ' constructor Create;',
  8652. ' end;',
  8653. 'constructor tobject.create;',
  8654. 'var self: longint;',
  8655. 'begin',
  8656. 'end',
  8657. 'begin',
  8658. '']);
  8659. SetExpectedPasResolverError('Duplicate identifier "self" at (0)',nDuplicateIdentifier);
  8660. ConvertProgram;
  8661. end;
  8662. procedure TTestModule.TestClass_ArgSelfFail;
  8663. begin
  8664. StartProgram(false);
  8665. Add([
  8666. 'type',
  8667. ' TObject = class',
  8668. ' procedure DoIt(Self: longint);',
  8669. ' end;',
  8670. 'procedure tobject.doit(self: longint);',
  8671. 'begin',
  8672. 'end',
  8673. 'begin',
  8674. '']);
  8675. SetExpectedPasResolverError('Duplicate identifier "Self" at test1.pp(5,24)',nDuplicateIdentifier);
  8676. ConvertProgram;
  8677. end;
  8678. procedure TTestModule.TestClass_NestedSelf;
  8679. begin
  8680. StartProgram(false);
  8681. Add([
  8682. 'type',
  8683. ' TObject = class',
  8684. ' Key: longint;',
  8685. ' class var State: longint;',
  8686. ' procedure DoIt;',
  8687. ' function GetSize: longint; virtual; abstract;',
  8688. ' procedure SetSize(Value: longint); virtual; abstract;',
  8689. ' property Size: longint read GetSize write SetSize;',
  8690. ' end;',
  8691. 'procedure tobject.doit;',
  8692. ' procedure Sub;',
  8693. ' begin',
  8694. ' key:=key+2;',
  8695. ' self.key:=self.key+3;',
  8696. ' state:=state+4;',
  8697. ' self.state:=self.state+5;',
  8698. ' tobject.state:=tobject.state+6;',
  8699. ' size:=size+7;',
  8700. ' self.size:=self.size+8;',
  8701. ' end;',
  8702. 'begin',
  8703. ' sub;',
  8704. ' key:=key+12;',
  8705. ' self.key:=self.key+13;',
  8706. ' state:=state+14;',
  8707. ' self.state:=self.state+15;',
  8708. ' tobject.state:=tobject.state+16;',
  8709. ' size:=size+17;',
  8710. ' self.size:=self.size+18;',
  8711. 'end;',
  8712. 'begin',
  8713. '']);
  8714. ConvertProgram;
  8715. CheckSource('TestClass_NestedSelf',
  8716. LinesToStr([ // statements
  8717. 'rtl.createClass($mod, "TObject", null, function () {',
  8718. ' this.State = 0;',
  8719. ' this.$init = function () {',
  8720. ' this.Key = 0;',
  8721. ' };',
  8722. ' this.$final = function () {',
  8723. ' };',
  8724. ' this.DoIt = function () {',
  8725. ' var Self = this;',
  8726. ' function Sub() {',
  8727. ' Self.Key = Self.Key + 2;',
  8728. ' Self.Key = Self.Key + 3;',
  8729. ' Self.$class.State = Self.State + 4;',
  8730. ' Self.$class.State = Self.State + 5;',
  8731. ' $mod.TObject.State = $mod.TObject.State + 6;',
  8732. ' Self.SetSize(Self.GetSize() + 7);',
  8733. ' Self.SetSize(Self.GetSize() + 8);',
  8734. ' };',
  8735. ' Sub();',
  8736. ' Self.Key = Self.Key + 12;',
  8737. ' Self.Key = Self.Key + 13;',
  8738. ' Self.$class.State = Self.State + 14;',
  8739. ' Self.$class.State = Self.State + 15;',
  8740. ' $mod.TObject.State = $mod.TObject.State + 16;',
  8741. ' Self.SetSize(Self.GetSize() + 17);',
  8742. ' Self.SetSize(Self.GetSize() + 18);',
  8743. ' };',
  8744. '});',
  8745. '']),
  8746. LinesToStr([ // $mod.$main
  8747. '']));
  8748. end;
  8749. procedure TTestModule.TestClass_NestedClassSelf;
  8750. begin
  8751. StartProgram(false);
  8752. Add([
  8753. 'type',
  8754. ' TObject = class',
  8755. ' class var State: longint;',
  8756. ' class procedure DoIt;',
  8757. ' class function GetSize: longint; virtual; abstract;',
  8758. ' class procedure SetSize(Value: longint); virtual; abstract;',
  8759. ' class property Size: longint read GetSize write SetSize;',
  8760. ' end;',
  8761. 'class procedure tobject.doit;',
  8762. ' procedure Sub;',
  8763. ' begin',
  8764. ' state:=state+2;',
  8765. ' self.state:=self.state+3;',
  8766. ' tobject.state:=tobject.state+4;',
  8767. ' size:=size+5;',
  8768. ' self.size:=self.size+6;',
  8769. ' tobject.size:=tobject.size+7;',
  8770. ' end;',
  8771. 'begin',
  8772. ' sub;',
  8773. ' state:=state+12;',
  8774. ' self.state:=self.state+13;',
  8775. ' tobject.state:=tobject.state+14;',
  8776. ' size:=size+15;',
  8777. ' self.size:=self.size+16;',
  8778. ' tobject.size:=tobject.size+17;',
  8779. 'end;',
  8780. 'begin',
  8781. '']);
  8782. ConvertProgram;
  8783. CheckSource('TestClass_NestedClassSelf',
  8784. LinesToStr([ // statements
  8785. 'rtl.createClass($mod, "TObject", null, function () {',
  8786. ' this.State = 0;',
  8787. ' this.$init = function () {',
  8788. ' };',
  8789. ' this.$final = function () {',
  8790. ' };',
  8791. ' this.DoIt = function () {',
  8792. ' var Self = this;',
  8793. ' function Sub() {',
  8794. ' Self.State = Self.State + 2;',
  8795. ' Self.State = Self.State + 3;',
  8796. ' $mod.TObject.State = $mod.TObject.State + 4;',
  8797. ' Self.SetSize(Self.GetSize() + 5);',
  8798. ' Self.SetSize(Self.GetSize() + 6);',
  8799. ' $mod.TObject.SetSize($mod.TObject.GetSize() + 7);',
  8800. ' };',
  8801. ' Sub();',
  8802. ' Self.State = Self.State + 12;',
  8803. ' Self.State = Self.State + 13;',
  8804. ' $mod.TObject.State = $mod.TObject.State + 14;',
  8805. ' Self.SetSize(Self.GetSize() + 15);',
  8806. ' Self.SetSize(Self.GetSize() + 16);',
  8807. ' $mod.TObject.SetSize($mod.TObject.GetSize() + 17);',
  8808. ' };',
  8809. '});',
  8810. '']),
  8811. LinesToStr([ // $mod.$main
  8812. '']));
  8813. end;
  8814. procedure TTestModule.TestClass_NestedCallInherited;
  8815. begin
  8816. StartProgram(false);
  8817. Add([
  8818. 'type',
  8819. ' TObject = class',
  8820. ' function DoIt(k: boolean): longint; virtual;',
  8821. ' end;',
  8822. ' TBird = class',
  8823. ' function DoIt(k: boolean): longint; override;',
  8824. ' end;',
  8825. 'function tobject.doit(k: boolean): longint;',
  8826. 'begin',
  8827. 'end;',
  8828. 'function tbird.doit(k: boolean): longint;',
  8829. ' procedure Sub;',
  8830. ' begin',
  8831. ' inherited DoIt(true);',
  8832. //' if inherited DoIt(false)=4 then ;',
  8833. ' end;',
  8834. 'begin',
  8835. ' Sub;',
  8836. ' inherited;',
  8837. ' inherited DoIt(true);',
  8838. //' if inherited DoIt(false)=14 then ;',
  8839. 'end;',
  8840. 'begin',
  8841. '']);
  8842. ConvertProgram;
  8843. CheckSource('TestClass_NestedCallInherited',
  8844. LinesToStr([ // statements
  8845. 'rtl.createClass($mod, "TObject", null, function () {',
  8846. ' this.$init = function () {',
  8847. ' };',
  8848. ' this.$final = function () {',
  8849. ' };',
  8850. ' this.DoIt = function (k) {',
  8851. ' var Result = 0;',
  8852. ' return Result;',
  8853. ' };',
  8854. '});',
  8855. 'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
  8856. ' this.DoIt = function (k) {',
  8857. ' var Self = this;',
  8858. ' var Result = 0;',
  8859. ' function Sub() {',
  8860. ' $mod.TObject.DoIt.call(Self, true);',
  8861. ' };',
  8862. ' Sub();',
  8863. ' $mod.TObject.DoIt.apply(Self, arguments);',
  8864. ' $mod.TObject.DoIt.call(Self, true);',
  8865. ' return Result;',
  8866. ' };',
  8867. '});',
  8868. '']),
  8869. LinesToStr([ // $mod.$main
  8870. '']));
  8871. end;
  8872. procedure TTestModule.TestClass_TObjectFree;
  8873. begin
  8874. StartProgram(false);
  8875. Add([
  8876. 'type',
  8877. ' TObject = class',
  8878. ' Obj: tobject;',
  8879. ' procedure Free;',
  8880. ' end;',
  8881. 'procedure tobject.free;',
  8882. 'begin',
  8883. 'end;',
  8884. 'function DoIt(o: tobject): tobject;',
  8885. 'var l: tobject;',
  8886. 'begin',
  8887. ' o.free;',
  8888. ' o.free();',
  8889. ' l.free;',
  8890. ' l.free();',
  8891. ' o.obj.free;',
  8892. ' o.obj.free();',
  8893. ' with o do obj.free;',
  8894. ' with o do obj.free();',
  8895. ' result.Free;',
  8896. ' result.Free();',
  8897. 'end;',
  8898. 'var o: tobject;',
  8899. ' a: array of tobject;',
  8900. 'begin',
  8901. ' o.free;',
  8902. ' o.obj.free;',
  8903. ' a[1+2].free;',
  8904. '']);
  8905. ConvertProgram;
  8906. CheckSource('TestClass_TObjectFree',
  8907. LinesToStr([ // statements
  8908. 'rtl.createClass($mod, "TObject", null, function () {',
  8909. ' this.$init = function () {',
  8910. ' this.Obj = null;',
  8911. ' };',
  8912. ' this.$final = function () {',
  8913. ' this.Obj = undefined;',
  8914. ' };',
  8915. ' this.Free = function () {',
  8916. ' };',
  8917. '});',
  8918. 'this.DoIt = function (o) {',
  8919. ' var Result = null;',
  8920. ' var l = null;',
  8921. ' o = rtl.freeLoc(o);',
  8922. ' o = rtl.freeLoc(o);',
  8923. ' l = rtl.freeLoc(l);',
  8924. ' l = rtl.freeLoc(l);',
  8925. ' rtl.free(o, "Obj");',
  8926. ' rtl.free(o, "Obj");',
  8927. ' rtl.free(o, "Obj");',
  8928. ' rtl.free(o, "Obj");',
  8929. ' Result = rtl.freeLoc(Result);',
  8930. ' Result = rtl.freeLoc(Result);',
  8931. ' return Result;',
  8932. '};',
  8933. 'this.o = null;',
  8934. 'this.a = [];',
  8935. '']),
  8936. LinesToStr([ // $mod.$main
  8937. 'rtl.free($mod, "o");',
  8938. 'rtl.free($mod.o, "Obj");',
  8939. 'rtl.free($mod.a, 1 + 2);',
  8940. '']));
  8941. end;
  8942. procedure TTestModule.TestClass_TObjectFreeNewInstance;
  8943. begin
  8944. StartProgram(false);
  8945. Add([
  8946. 'type',
  8947. ' TObject = class',
  8948. ' constructor Create;',
  8949. ' procedure Free;',
  8950. ' end;',
  8951. 'constructor TObject.Create; begin end;',
  8952. 'procedure tobject.free; begin end;',
  8953. 'begin',
  8954. ' with tobject.create do free;',
  8955. '']);
  8956. ConvertProgram;
  8957. CheckSource('TestClass_TObjectFreeNewInstance',
  8958. LinesToStr([ // statements
  8959. 'rtl.createClass($mod, "TObject", null, function () {',
  8960. ' this.$init = function () {',
  8961. ' };',
  8962. ' this.$final = function () {',
  8963. ' };',
  8964. ' this.Create = function () {',
  8965. ' };',
  8966. ' this.Free = function () {',
  8967. ' };',
  8968. '});',
  8969. '']),
  8970. LinesToStr([ // $mod.$main
  8971. 'var $with1 = $mod.TObject.$create("Create");',
  8972. '$with1=rtl.freeLoc($with1);',
  8973. '']));
  8974. end;
  8975. procedure TTestModule.TestClass_TObjectFreeLowerCase;
  8976. begin
  8977. StartProgram(false);
  8978. Add([
  8979. 'type',
  8980. ' TObject = class',
  8981. ' destructor Destroy;',
  8982. ' procedure Free;',
  8983. ' end;',
  8984. 'destructor TObject.Destroy; begin end;',
  8985. 'procedure tobject.free; begin end;',
  8986. 'var o: tobject;',
  8987. 'begin',
  8988. ' o.free;',
  8989. '']);
  8990. Converter.UseLowerCase:=true;
  8991. ConvertProgram;
  8992. CheckSource('TestClass_TObjectFreeLowerCase',
  8993. LinesToStr([ // statements
  8994. 'rtl.createClass($mod, "tobject", null, function () {',
  8995. ' this.$init = function () {',
  8996. ' };',
  8997. ' this.$final = function () {',
  8998. ' };',
  8999. ' rtl.tObjectDestroy = "destroy";',
  9000. ' this.destroy = function () {',
  9001. ' };',
  9002. ' this.free = function () {',
  9003. ' };',
  9004. '});',
  9005. 'this.o = null;',
  9006. '']),
  9007. LinesToStr([ // $mod.$main
  9008. 'rtl.free($mod, "o");',
  9009. '']));
  9010. end;
  9011. procedure TTestModule.TestClass_TObjectFreeFunctionFail;
  9012. begin
  9013. StartProgram(false);
  9014. Add([
  9015. 'type',
  9016. ' TObject = class',
  9017. ' procedure Free;',
  9018. ' function GetObj: tobject; virtual; abstract;',
  9019. ' end;',
  9020. 'procedure tobject.free;',
  9021. 'begin',
  9022. 'end;',
  9023. 'var o: tobject;',
  9024. 'begin',
  9025. ' o.getobj.free;',
  9026. '']);
  9027. SetExpectedPasResolverError(sFreeNeedsVar,nFreeNeedsVar);
  9028. ConvertProgram;
  9029. end;
  9030. procedure TTestModule.TestClass_TObjectFreePropertyFail;
  9031. begin
  9032. StartProgram(false);
  9033. Add([
  9034. 'type',
  9035. ' TObject = class',
  9036. ' procedure Free;',
  9037. ' FObj: TObject;',
  9038. ' property Obj: tobject read FObj write FObj;',
  9039. ' end;',
  9040. 'procedure tobject.free;',
  9041. 'begin',
  9042. 'end;',
  9043. 'var o: tobject;',
  9044. 'begin',
  9045. ' o.obj.free;',
  9046. '']);
  9047. SetExpectedPasResolverError(sFreeNeedsVar,nFreeNeedsVar);
  9048. ConvertProgram;
  9049. end;
  9050. procedure TTestModule.TestClassOf_Create;
  9051. begin
  9052. StartProgram(false);
  9053. Add('type');
  9054. Add(' TObject = class');
  9055. Add(' constructor Create;');
  9056. Add(' end;');
  9057. Add(' TClass = class of TObject;');
  9058. Add('constructor tobject.create; begin end;');
  9059. Add('var');
  9060. Add(' Obj: tobject;');
  9061. Add(' C: tclass;');
  9062. Add('begin');
  9063. Add(' obj:=C.create;');
  9064. Add(' with c do obj:=create;');
  9065. ConvertProgram;
  9066. CheckSource('TestClassOf_Create',
  9067. LinesToStr([ // statements
  9068. 'rtl.createClass($mod, "TObject", null, function () {',
  9069. ' this.$init = function () {',
  9070. ' };',
  9071. ' this.$final = function () {',
  9072. ' };',
  9073. ' this.Create = function () {',
  9074. ' };',
  9075. '});',
  9076. 'this.Obj = null;',
  9077. 'this.C = null;'
  9078. ]),
  9079. LinesToStr([ // $mod.$main
  9080. '$mod.Obj = $mod.C.$create("Create");',
  9081. 'var $with1 = $mod.C;',
  9082. '$mod.Obj = $with1.$create("Create");',
  9083. '']));
  9084. end;
  9085. procedure TTestModule.TestClassOf_Call;
  9086. begin
  9087. StartProgram(false);
  9088. Add('type');
  9089. Add(' TObject = class');
  9090. Add(' class procedure DoIt;');
  9091. Add(' end;');
  9092. Add(' TClass = class of TObject;');
  9093. Add('class procedure tobject.doit; begin end;');
  9094. Add('var');
  9095. Add(' C: tclass;');
  9096. Add('begin');
  9097. Add(' c.doit;');
  9098. Add(' with c do doit;');
  9099. ConvertProgram;
  9100. CheckSource('TestClassOf_Call',
  9101. LinesToStr([ // statements
  9102. 'rtl.createClass($mod, "TObject", null, function () {',
  9103. ' this.$init = function () {',
  9104. ' };',
  9105. ' this.$final = function () {',
  9106. ' };',
  9107. ' this.DoIt = function () {',
  9108. ' };',
  9109. '});',
  9110. 'this.C = null;'
  9111. ]),
  9112. LinesToStr([ // $mod.$main
  9113. '$mod.C.DoIt();',
  9114. 'var $with1 = $mod.C;',
  9115. '$with1.DoIt();',
  9116. '']));
  9117. end;
  9118. procedure TTestModule.TestClassOf_Assign;
  9119. begin
  9120. StartProgram(false);
  9121. Add('type');
  9122. Add(' TClass = class of TObject;');
  9123. Add(' TObject = class');
  9124. Add(' ClassType: TClass; ');
  9125. Add(' end;');
  9126. Add('var');
  9127. Add(' Obj: tobject;');
  9128. Add(' C: tclass;');
  9129. Add('begin');
  9130. Add(' c:=nil;');
  9131. Add(' c:=obj.classtype;');
  9132. ConvertProgram;
  9133. CheckSource('TestClassOf_Assign',
  9134. LinesToStr([ // statements
  9135. 'rtl.createClass($mod, "TObject", null, function () {',
  9136. ' this.$init = function () {',
  9137. ' this.ClassType = null;',
  9138. ' };',
  9139. ' this.$final = function () {',
  9140. ' this.ClassType = undefined;',
  9141. ' };',
  9142. '});',
  9143. 'this.Obj = null;',
  9144. 'this.C = null;'
  9145. ]),
  9146. LinesToStr([ // $mod.$main
  9147. '$mod.C = null;',
  9148. '$mod.C = $mod.Obj.ClassType;',
  9149. '']));
  9150. end;
  9151. procedure TTestModule.TestClassOf_Is;
  9152. begin
  9153. StartProgram(false);
  9154. Add('type');
  9155. Add(' TClass = class of TObject;');
  9156. Add(' TObject = class');
  9157. Add(' end;');
  9158. Add(' TCar = class');
  9159. Add(' end;');
  9160. Add(' TCars = class of TCar;');
  9161. Add('var');
  9162. Add(' Obj: tobject;');
  9163. Add(' C: tclass;');
  9164. Add(' Cars: tcars;');
  9165. Add('begin');
  9166. Add(' if c is tcar then ;');
  9167. Add(' if c is tcars then ;');
  9168. ConvertProgram;
  9169. CheckSource('TestClassOf_Is',
  9170. LinesToStr([ // statements
  9171. 'rtl.createClass($mod, "TObject", null, function () {',
  9172. ' this.$init = function () {',
  9173. ' };',
  9174. ' this.$final = function () {',
  9175. ' };',
  9176. '});',
  9177. 'rtl.createClass($mod, "TCar", $mod.TObject, function () {',
  9178. '});',
  9179. 'this.Obj = null;',
  9180. 'this.C = null;',
  9181. 'this.Cars = null;'
  9182. ]),
  9183. LinesToStr([ // $mod.$main
  9184. 'if(rtl.is($mod.C,$mod.TCar));',
  9185. 'if(rtl.is($mod.C,$mod.TCar));',
  9186. '']));
  9187. end;
  9188. procedure TTestModule.TestClassOf_Compare;
  9189. begin
  9190. StartProgram(false);
  9191. Add('type');
  9192. Add(' TClass = class of TObject;');
  9193. Add(' TObject = class');
  9194. Add(' ClassType: TClass; ');
  9195. Add(' end;');
  9196. Add('var');
  9197. Add(' b: boolean;');
  9198. Add(' Obj: tobject;');
  9199. Add(' C: tclass;');
  9200. Add('begin');
  9201. Add(' b:=c=nil;');
  9202. Add(' b:=nil=c;');
  9203. Add(' b:=c=obj.classtype;');
  9204. Add(' b:=obj.classtype=c;');
  9205. Add(' b:=c=TObject;');
  9206. Add(' b:=TObject=c;');
  9207. Add(' b:=c<>nil;');
  9208. Add(' b:=nil<>c;');
  9209. Add(' b:=c<>obj.classtype;');
  9210. Add(' b:=obj.classtype<>c;');
  9211. Add(' b:=c<>TObject;');
  9212. Add(' b:=TObject<>c;');
  9213. ConvertProgram;
  9214. CheckSource('TestClassOf_Compare',
  9215. LinesToStr([ // statements
  9216. 'rtl.createClass($mod, "TObject", null, function () {',
  9217. ' this.$init = function () {',
  9218. ' this.ClassType = null;',
  9219. ' };',
  9220. ' this.$final = function () {',
  9221. ' this.ClassType = undefined;',
  9222. ' };',
  9223. '});',
  9224. 'this.b = false;',
  9225. 'this.Obj = null;',
  9226. 'this.C = null;'
  9227. ]),
  9228. LinesToStr([ // $mod.$main
  9229. '$mod.b = $mod.C === null;',
  9230. '$mod.b = null === $mod.C;',
  9231. '$mod.b = $mod.C === $mod.Obj.ClassType;',
  9232. '$mod.b = $mod.Obj.ClassType === $mod.C;',
  9233. '$mod.b = $mod.C === $mod.TObject;',
  9234. '$mod.b = $mod.TObject === $mod.C;',
  9235. '$mod.b = $mod.C !== null;',
  9236. '$mod.b = null !== $mod.C;',
  9237. '$mod.b = $mod.C !== $mod.Obj.ClassType;',
  9238. '$mod.b = $mod.Obj.ClassType !== $mod.C;',
  9239. '$mod.b = $mod.C !== $mod.TObject;',
  9240. '$mod.b = $mod.TObject !== $mod.C;',
  9241. '']));
  9242. end;
  9243. procedure TTestModule.TestClassOf_ClassVar;
  9244. begin
  9245. StartProgram(false);
  9246. Add('type');
  9247. Add(' TObject = class');
  9248. Add(' class var id: longint;');
  9249. Add(' end;');
  9250. Add(' TClass = class of TObject;');
  9251. Add('var');
  9252. Add(' C: tclass;');
  9253. Add('begin');
  9254. Add(' C.id:=C.id;');
  9255. ConvertProgram;
  9256. CheckSource('TestClassOf_ClassVar',
  9257. LinesToStr([ // statements
  9258. 'rtl.createClass($mod, "TObject", null, function () {',
  9259. ' this.id = 0;',
  9260. ' this.$init = function () {',
  9261. ' };',
  9262. ' this.$final = function () {',
  9263. ' };',
  9264. '});',
  9265. 'this.C = null;'
  9266. ]),
  9267. LinesToStr([ // $mod.$main
  9268. '$mod.C.id = $mod.C.id;',
  9269. '']));
  9270. end;
  9271. procedure TTestModule.TestClassOf_ClassMethod;
  9272. begin
  9273. StartProgram(false);
  9274. Add('type');
  9275. Add(' TObject = class');
  9276. Add(' class function DoIt(i: longint = 0): longint;');
  9277. Add(' end;');
  9278. Add(' TClass = class of TObject;');
  9279. Add('class function tobject.doit(i: longint = 0): longint; begin end;');
  9280. Add('var');
  9281. Add(' i: longint;');
  9282. Add(' C: tclass;');
  9283. Add('begin');
  9284. Add(' C.DoIt;');
  9285. Add(' C.DoIt();');
  9286. Add(' i:=C.DoIt;');
  9287. Add(' i:=C.DoIt();');
  9288. ConvertProgram;
  9289. CheckSource('TestClassOf_ClassMethod',
  9290. LinesToStr([ // statements
  9291. 'rtl.createClass($mod, "TObject", null, function () {',
  9292. ' this.$init = function () {',
  9293. ' };',
  9294. ' this.$final = function () {',
  9295. ' };',
  9296. ' this.DoIt = function (i) {',
  9297. ' var Result = 0;',
  9298. ' return Result;',
  9299. ' };',
  9300. '});',
  9301. 'this.i = 0;',
  9302. 'this.C = null;'
  9303. ]),
  9304. LinesToStr([ // $mod.$main
  9305. '$mod.C.DoIt(0);',
  9306. '$mod.C.DoIt(0);',
  9307. '$mod.i = $mod.C.DoIt(0);',
  9308. '$mod.i = $mod.C.DoIt(0);',
  9309. '']));
  9310. end;
  9311. procedure TTestModule.TestClassOf_ClassProperty;
  9312. begin
  9313. StartProgram(false);
  9314. Add('type');
  9315. Add(' TObject = class');
  9316. Add(' class var FA: longint;');
  9317. Add(' class function GetA: longint;');
  9318. Add(' class procedure SetA(Value: longint);');
  9319. Add(' class property pA: longint read fa write fa;');
  9320. Add(' class property pB: longint read geta write seta;');
  9321. Add(' end;');
  9322. Add(' TObjectClass = class of tobject;');
  9323. Add('class function tobject.geta: longint; begin end;');
  9324. Add('class procedure tobject.seta(value: longint); begin end;');
  9325. Add('var');
  9326. Add(' b: boolean;');
  9327. Add(' Obj: tobject;');
  9328. Add(' Cla: tobjectclass;');
  9329. Add('begin');
  9330. Add(' obj.pa:=obj.pa;');
  9331. Add(' obj.pb:=obj.pb;');
  9332. Add(' b:=obj.pa=4;');
  9333. Add(' b:=obj.pb=obj.pb;');
  9334. Add(' b:=5=obj.pa;');
  9335. Add(' cla.pa:=6;');
  9336. Add(' cla.pa:=cla.pa;');
  9337. Add(' cla.pb:=cla.pb;');
  9338. Add(' b:=cla.pa=7;');
  9339. Add(' b:=cla.pb=cla.pb;');
  9340. Add(' b:=8=cla.pa;');
  9341. Add(' tobject.pa:=9;');
  9342. Add(' tobject.pb:=tobject.pb;');
  9343. Add(' b:=tobject.pa=10;');
  9344. Add(' b:=11=tobject.pa;');
  9345. ConvertProgram;
  9346. CheckSource('TestClassOf_ClassProperty',
  9347. LinesToStr([ // statements
  9348. 'rtl.createClass($mod, "TObject", null, function () {',
  9349. ' this.FA = 0;',
  9350. ' this.$init = function () {',
  9351. ' };',
  9352. ' this.$final = function () {',
  9353. ' };',
  9354. ' this.GetA = function () {',
  9355. ' var Result = 0;',
  9356. ' return Result;',
  9357. ' };',
  9358. ' this.SetA = function (Value) {',
  9359. ' };',
  9360. '});',
  9361. 'this.b = false;',
  9362. 'this.Obj = null;',
  9363. 'this.Cla = null;'
  9364. ]),
  9365. LinesToStr([ // $mod.$main
  9366. '$mod.Obj.$class.FA = $mod.Obj.FA;',
  9367. '$mod.Obj.$class.SetA($mod.Obj.$class.GetA());',
  9368. '$mod.b = $mod.Obj.FA === 4;',
  9369. '$mod.b = $mod.Obj.$class.GetA() === $mod.Obj.$class.GetA();',
  9370. '$mod.b = 5 === $mod.Obj.FA;',
  9371. '$mod.Cla.FA = 6;',
  9372. '$mod.Cla.FA = $mod.Cla.FA;',
  9373. '$mod.Cla.SetA($mod.Cla.GetA());',
  9374. '$mod.b = $mod.Cla.FA === 7;',
  9375. '$mod.b = $mod.Cla.GetA() === $mod.Cla.GetA();',
  9376. '$mod.b = 8 === $mod.Cla.FA;',
  9377. '$mod.TObject.FA = 9;',
  9378. '$mod.TObject.SetA($mod.TObject.GetA());',
  9379. '$mod.b = $mod.TObject.FA === 10;',
  9380. '$mod.b = 11 === $mod.TObject.FA;',
  9381. '']));
  9382. end;
  9383. procedure TTestModule.TestClassOf_ClassMethodSelf;
  9384. begin
  9385. StartProgram(false);
  9386. Add('type');
  9387. Add(' TObject = class');
  9388. Add(' class var GlobalId: longint;');
  9389. Add(' class procedure ProcA;');
  9390. Add(' end;');
  9391. Add('class procedure tobject.proca;');
  9392. Add('var b: boolean;');
  9393. Add('begin');
  9394. Add(' b:=self=nil;');
  9395. Add(' b:=self.globalid=3;');
  9396. Add(' b:=4=self.globalid;');
  9397. Add(' self.globalid:=5;');
  9398. Add(' self.proca;');
  9399. Add('end;');
  9400. Add('begin');
  9401. ConvertProgram;
  9402. CheckSource('TestClassOf_ClassMethodSelf',
  9403. LinesToStr([ // statements
  9404. 'rtl.createClass($mod, "TObject", null, function () {',
  9405. ' this.GlobalId = 0;',
  9406. ' this.$init = function () {',
  9407. ' };',
  9408. ' this.$final = function () {',
  9409. ' };',
  9410. ' this.ProcA = function () {',
  9411. ' var b = false;',
  9412. ' b = this === null;',
  9413. ' b = this.GlobalId === 3;',
  9414. ' b = 4 === this.GlobalId;',
  9415. ' this.GlobalId = 5;',
  9416. ' this.ProcA();',
  9417. ' };',
  9418. '});'
  9419. ]),
  9420. LinesToStr([ // $mod.$main
  9421. '']));
  9422. end;
  9423. procedure TTestModule.TestClassOf_TypeCast;
  9424. begin
  9425. StartProgram(false);
  9426. Add('type');
  9427. Add(' TObject = class');
  9428. Add(' class procedure {#TObject_DoIt}DoIt;');
  9429. Add(' end;');
  9430. Add(' TClass = class of TObject;');
  9431. Add(' TMobile = class');
  9432. Add(' class procedure {#TMobile_DoIt}DoIt;');
  9433. Add(' end;');
  9434. Add(' TMobileClass = class of TMobile;');
  9435. Add(' TCar = class(TMobile)');
  9436. Add(' class procedure {#TCar_DoIt}DoIt;');
  9437. Add(' end;');
  9438. Add(' TCarClass = class of TCar;');
  9439. Add('class procedure TObject.DoIt;');
  9440. Add('begin');
  9441. Add(' TClass(Self).{@TObject_DoIt}DoIt;');
  9442. Add(' TMobileClass(Self).{@TMobile_DoIt}DoIt;');
  9443. Add('end;');
  9444. Add('class procedure TMobile.DoIt;');
  9445. Add('begin');
  9446. Add(' TClass(Self).{@TObject_DoIt}DoIt;');
  9447. Add(' TMobileClass(Self).{@TMobile_DoIt}DoIt;');
  9448. Add(' TCarClass(Self).{@TCar_DoIt}DoIt;');
  9449. Add('end;');
  9450. Add('class procedure TCar.DoIt; begin end;');
  9451. Add('var');
  9452. Add(' ObjC: TClass;');
  9453. Add(' MobileC: TMobileClass;');
  9454. Add(' CarC: TCarClass;');
  9455. Add('begin');
  9456. Add(' ObjC.{@TObject_DoIt}DoIt;');
  9457. Add(' MobileC.{@TMobile_DoIt}DoIt;');
  9458. Add(' CarC.{@TCar_DoIt}DoIt;');
  9459. Add(' TClass(ObjC).{@TObject_DoIt}DoIt;');
  9460. Add(' TMobileClass(ObjC).{@TMobile_DoIt}DoIt;');
  9461. Add(' TCarClass(ObjC).{@TCar_DoIt}DoIt;');
  9462. Add(' TClass(MobileC).{@TObject_DoIt}DoIt;');
  9463. Add(' TMobileClass(MobileC).{@TMobile_DoIt}DoIt;');
  9464. Add(' TCarClass(MobileC).{@TCar_DoIt}DoIt;');
  9465. Add(' TClass(CarC).{@TObject_DoIt}DoIt;');
  9466. Add(' TMobileClass(CarC).{@TMobile_DoIt}DoIt;');
  9467. Add(' TCarClass(CarC).{@TCar_DoIt}DoIt;');
  9468. ConvertProgram;
  9469. CheckSource('TestClassOf_TypeCast',
  9470. LinesToStr([ // statements
  9471. 'rtl.createClass($mod, "TObject", null, function () {',
  9472. ' this.$init = function () {',
  9473. ' };',
  9474. ' this.$final = function () {',
  9475. ' };',
  9476. ' this.DoIt = function () {',
  9477. ' this.DoIt();',
  9478. ' this.DoIt$1();',
  9479. ' };',
  9480. '});',
  9481. 'rtl.createClass($mod, "TMobile", $mod.TObject, function () {',
  9482. ' this.DoIt$1 = function () {',
  9483. ' this.DoIt();',
  9484. ' this.DoIt$1();',
  9485. ' this.DoIt$2();',
  9486. ' };',
  9487. '});',
  9488. 'rtl.createClass($mod, "TCar", $mod.TMobile, function () {',
  9489. ' this.DoIt$2 = function () {',
  9490. ' };',
  9491. '});',
  9492. 'this.ObjC = null;',
  9493. 'this.MobileC = null;',
  9494. 'this.CarC = null;',
  9495. '']),
  9496. LinesToStr([ // $mod.$main
  9497. '$mod.ObjC.DoIt();',
  9498. '$mod.MobileC.DoIt$1();',
  9499. '$mod.CarC.DoIt$2();',
  9500. '$mod.ObjC.DoIt();',
  9501. '$mod.ObjC.DoIt$1();',
  9502. '$mod.ObjC.DoIt$2();',
  9503. '$mod.MobileC.DoIt();',
  9504. '$mod.MobileC.DoIt$1();',
  9505. '$mod.MobileC.DoIt$2();',
  9506. '$mod.CarC.DoIt();',
  9507. '$mod.CarC.DoIt$1();',
  9508. '$mod.CarC.DoIt$2();',
  9509. '']));
  9510. end;
  9511. procedure TTestModule.TestClassOf_ImplicitFunctionCall;
  9512. begin
  9513. StartProgram(false);
  9514. Add('type');
  9515. Add(' TObject = class');
  9516. Add(' function CurNow: longint; ');
  9517. Add(' class function Now: longint; ');
  9518. Add(' end;');
  9519. Add('function TObject.CurNow: longint; begin end;');
  9520. Add('class function TObject.Now: longint; begin end;');
  9521. Add('var');
  9522. Add(' Obj: tobject;');
  9523. Add(' vI: longint;');
  9524. Add('begin');
  9525. Add(' obj.curnow;');
  9526. Add(' vi:=obj.curnow;');
  9527. Add(' tobject.now;');
  9528. Add(' vi:=tobject.now;');
  9529. ConvertProgram;
  9530. CheckSource('TestClassOf_ImplicitFunctionCall',
  9531. LinesToStr([ // statements
  9532. 'rtl.createClass($mod, "TObject", null, function () {',
  9533. ' this.$init = function () {',
  9534. ' };',
  9535. ' this.$final = function () {',
  9536. ' };',
  9537. ' this.CurNow = function () {',
  9538. ' var Result = 0;',
  9539. ' return Result;',
  9540. ' };',
  9541. ' this.Now = function () {',
  9542. ' var Result = 0;',
  9543. ' return Result;',
  9544. ' };',
  9545. '});',
  9546. 'this.Obj = null;',
  9547. 'this.vI = 0;',
  9548. '']),
  9549. LinesToStr([ // $mod.$main
  9550. '$mod.Obj.CurNow();',
  9551. '$mod.vI = $mod.Obj.CurNow();',
  9552. '$mod.TObject.Now();',
  9553. '$mod.vI = $mod.TObject.Now();',
  9554. '']));
  9555. end;
  9556. procedure TTestModule.TestClassOf_Const;
  9557. begin
  9558. StartProgram(false);
  9559. Add([
  9560. 'type',
  9561. ' TObject = class',
  9562. ' end;',
  9563. ' TBird = TObject;',
  9564. ' TBirds = class of TBird;',
  9565. ' TEagles = TBirds;',
  9566. ' THawk = class(TBird);',
  9567. 'const',
  9568. ' Hawk: TEagles = THawk;',
  9569. ' DefaultBirdClasses : Array [1..2] of TEagles = (',
  9570. ' TBird,',
  9571. ' THawk',
  9572. ' );',
  9573. 'begin']);
  9574. ConvertProgram;
  9575. CheckSource('TestClassOf_Const',
  9576. LinesToStr([ // statements
  9577. 'rtl.createClass($mod, "TObject", null, function () {',
  9578. ' this.$init = function () {',
  9579. ' };',
  9580. ' this.$final = function () {',
  9581. ' };',
  9582. '});',
  9583. 'rtl.createClass($mod, "THawk", $mod.TObject, function () {',
  9584. '});',
  9585. 'this.Hawk = $mod.THawk;',
  9586. 'this.DefaultBirdClasses = [$mod.TObject, $mod.THawk];',
  9587. '']),
  9588. LinesToStr([ // $mod.$main
  9589. '']));
  9590. end;
  9591. procedure TTestModule.TestNestedClass_Fail;
  9592. begin
  9593. StartProgram(false);
  9594. Add([
  9595. 'type',
  9596. ' TObject = class',
  9597. ' type TNested = longint;',
  9598. ' end;',
  9599. 'begin']);
  9600. SetExpectedPasResolverError('not yet implemented: TNested:TPasAliasType [20170608232534] nested types',
  9601. nNotYetImplemented);
  9602. ConvertProgram;
  9603. end;
  9604. procedure TTestModule.TestExternalClass_Var;
  9605. begin
  9606. StartProgram(false);
  9607. Add('{$modeswitch externalclass}');
  9608. Add('type');
  9609. Add(' TExtA = class external name ''ExtObj''');
  9610. Add(' Id: longint external name ''$Id'';');
  9611. Add(' B: longint;');
  9612. Add(' end;');
  9613. Add('var Obj: TExtA;');
  9614. Add('begin');
  9615. Add(' obj.id:=obj.id+1;');
  9616. Add(' obj.B:=obj.B+1;');
  9617. ConvertProgram;
  9618. CheckSource('TestExternalClass_Var',
  9619. LinesToStr([ // statements
  9620. 'this.Obj = null;',
  9621. '']),
  9622. LinesToStr([ // $mod.$main
  9623. '$mod.Obj.$Id = $mod.Obj.$Id + 1;',
  9624. '$mod.Obj.B = $mod.Obj.B + 1;',
  9625. '']));
  9626. end;
  9627. procedure TTestModule.TestExternalClass_Dollar;
  9628. begin
  9629. StartProgram(false);
  9630. Add([
  9631. '{$modeswitch externalclass}',
  9632. 'type',
  9633. ' TExtA = class external name ''$''',
  9634. ' Id: longint external name ''$'';',
  9635. ' function Bla(i: longint): longint; external name ''$'';',
  9636. ' end;',
  9637. 'function dollar(k: longint): longint; external name ''$'';',
  9638. 'var Obj: TExtA;',
  9639. 'begin',
  9640. ' dollar(1);',
  9641. ' obj.id:=obj.id+2;',
  9642. ' obj.Bla(3);',
  9643. '']);
  9644. ConvertProgram;
  9645. CheckSource('TestExternalClass_Dollar',
  9646. LinesToStr([ // statements
  9647. 'this.Obj = null;',
  9648. '']),
  9649. LinesToStr([ // $mod.$main
  9650. '$(1);',
  9651. '$mod.Obj.$ = $mod.Obj.$ + 2;',
  9652. '$mod.Obj.$(3);',
  9653. '']));
  9654. end;
  9655. procedure TTestModule.TestExternalClass_DuplicateVarFail;
  9656. begin
  9657. StartProgram(false);
  9658. Add('{$modeswitch externalclass}');
  9659. Add('type');
  9660. Add(' TExtA = class external name ''ExtA''');
  9661. Add(' Id: longint external name ''$Id'';');
  9662. Add(' end;');
  9663. Add(' TExtB = class external ''lib'' name ''ExtB''(TExtA)');
  9664. Add(' Id: longint;');
  9665. Add(' end;');
  9666. Add('begin');
  9667. SetExpectedPasResolverError('Duplicate identifier "Id" at test1.pp(6,5)',nDuplicateIdentifier);
  9668. ConvertProgram;
  9669. end;
  9670. procedure TTestModule.TestExternalClass_Method;
  9671. begin
  9672. StartProgram(false);
  9673. Add('{$modeswitch externalclass}');
  9674. Add('type');
  9675. Add(' TExtA = class external name ''ExtObj''');
  9676. Add(' procedure DoIt(Id: longint = 1); external name ''$Execute'';');
  9677. Add(' procedure DoSome(Id: longint = 1);');
  9678. Add(' end;');
  9679. Add('var Obj: texta;');
  9680. Add('begin');
  9681. Add(' obj.doit;');
  9682. Add(' obj.doit();');
  9683. Add(' obj.doit(2);');
  9684. Add(' with obj do begin');
  9685. Add(' doit;');
  9686. Add(' doit();');
  9687. Add(' doit(3);');
  9688. Add(' end;');
  9689. ConvertProgram;
  9690. CheckSource('TestExternalClass_Method',
  9691. LinesToStr([ // statements
  9692. 'this.Obj = null;',
  9693. '']),
  9694. LinesToStr([ // $mod.$main
  9695. '$mod.Obj.$Execute(1);',
  9696. '$mod.Obj.$Execute(1);',
  9697. '$mod.Obj.$Execute(2);',
  9698. 'var $with1 = $mod.Obj;',
  9699. '$with1.$Execute(1);',
  9700. '$with1.$Execute(1);',
  9701. '$with1.$Execute(3);',
  9702. '']));
  9703. end;
  9704. procedure TTestModule.TestExternalClass_NonExternalOverride;
  9705. begin
  9706. StartProgram(false);
  9707. Add('{$modeswitch externalclass}');
  9708. Add('type');
  9709. Add(' TExtA = class external name ''ExtObjA''');
  9710. Add(' procedure ProcA; virtual;');
  9711. Add(' procedure ProcB; virtual;');
  9712. Add(' end;');
  9713. Add(' TExtB = class external name ''ExtObjB'' (TExtA)');
  9714. Add(' end;');
  9715. Add(' TExtC = class (TExtB)');
  9716. Add(' procedure ProcA; override;');
  9717. Add(' end;');
  9718. Add('procedure TExtC.ProcA;');
  9719. Add('begin');
  9720. Add(' ProcA;');
  9721. Add(' Self.ProcA;');
  9722. Add(' ProcB;');
  9723. Add(' Self.ProcB;');
  9724. Add('end;');
  9725. Add('var');
  9726. Add(' A: texta;');
  9727. Add(' B: textb;');
  9728. Add(' C: textc;');
  9729. Add('begin');
  9730. Add(' a.proca;');
  9731. Add(' b.proca;');
  9732. Add(' c.proca;');
  9733. ConvertProgram;
  9734. CheckSource('TestExternalClass_NonExternalOverride',
  9735. LinesToStr([ // statements
  9736. 'rtl.createClassExt($mod, "TExtC", ExtObjB, "", function () {',
  9737. ' this.$init = function () {',
  9738. ' };',
  9739. ' this.$final = function () {',
  9740. ' };',
  9741. ' this.ProcA = function () {',
  9742. ' this.ProcA();',
  9743. ' this.ProcA();',
  9744. ' this.ProcB();',
  9745. ' this.ProcB();',
  9746. ' };',
  9747. '});',
  9748. 'this.A = null;',
  9749. 'this.B = null;',
  9750. 'this.C = null;',
  9751. '']),
  9752. LinesToStr([ // $mod.$main
  9753. '$mod.A.ProcA();',
  9754. '$mod.B.ProcA();',
  9755. '$mod.C.ProcA();',
  9756. '']));
  9757. end;
  9758. procedure TTestModule.TestExternalClass_Property;
  9759. begin
  9760. StartProgram(false);
  9761. Add('{$modeswitch externalclass}');
  9762. Add('type');
  9763. Add(' TExtA = class external name ''ExtA''');
  9764. Add(' function getYear: longint;');
  9765. Add(' procedure setYear(Value: longint);');
  9766. Add(' property Year: longint read getyear write setyear;');
  9767. Add(' end;');
  9768. Add(' TExtB = class (TExtA)');
  9769. Add(' procedure OtherSetYear(Value: longint);');
  9770. Add(' property year write othersetyear;');
  9771. Add(' end;');
  9772. Add('procedure textb.othersetyear(value: longint);');
  9773. Add('begin');
  9774. Add(' setYear(Value+4);');
  9775. Add('end;');
  9776. Add('var');
  9777. Add(' A: texta;');
  9778. Add(' B: textb;');
  9779. Add('begin');
  9780. Add(' a.year:=a.year+1;');
  9781. Add(' b.year:=b.year+2;');
  9782. ConvertProgram;
  9783. CheckSource('TestExternalClass_NonExternalOverride',
  9784. LinesToStr([ // statements
  9785. 'rtl.createClassExt($mod, "TExtB", ExtA, "", function () {',
  9786. ' this.$init = function () {',
  9787. ' };',
  9788. ' this.$final = function () {',
  9789. ' };',
  9790. ' this.OtherSetYear = function (Value) {',
  9791. ' this.setYear(Value+4);',
  9792. ' };',
  9793. '});',
  9794. 'this.A = null;',
  9795. 'this.B = null;',
  9796. '']),
  9797. LinesToStr([ // $mod.$main
  9798. '$mod.A.setYear($mod.A.getYear()+1);',
  9799. '$mod.B.OtherSetYear($mod.B.getYear()+2);',
  9800. '']));
  9801. end;
  9802. procedure TTestModule.TestExternalClass_ClassProperty;
  9803. begin
  9804. StartProgram(false);
  9805. Add('{$modeswitch externalclass}');
  9806. Add('type');
  9807. Add(' TExtA = class external name ''ExtA''');
  9808. Add(' class function getYear: longint;');
  9809. Add(' class procedure setYear(Value: longint);');
  9810. Add(' class property Year: longint read getyear write setyear;');
  9811. Add(' end;');
  9812. Add(' TExtB = class (TExtA)');
  9813. Add(' class function GetCentury: longint;');
  9814. Add(' class procedure SetCentury(Value: longint);');
  9815. Add(' class property Century: longint read getcentury write setcentury;');
  9816. Add(' end;');
  9817. Add('class function textb.getcentury: longint;');
  9818. Add('begin');
  9819. Add('end;');
  9820. Add('class procedure textb.setcentury(value: longint);');
  9821. Add('begin');
  9822. Add(' setyear(value+11);');
  9823. Add(' texta.year:=texta.year+12;');
  9824. Add(' year:=year+13;');
  9825. Add(' textb.century:=textb.century+14;');
  9826. Add(' century:=century+15;');
  9827. Add('end;');
  9828. Add('var');
  9829. Add(' A: texta;');
  9830. Add(' B: textb;');
  9831. Add('begin');
  9832. Add(' texta.year:=texta.year+1;');
  9833. Add(' textb.year:=textb.year+2;');
  9834. Add(' TextA.year:=TextA.year+3;');
  9835. Add(' b.year:=b.year+4;');
  9836. Add(' textb.century:=textb.century+5;');
  9837. Add(' b.century:=b.century+6;');
  9838. ConvertProgram;
  9839. CheckSource('TestExternalClass_ClassProperty',
  9840. LinesToStr([ // statements
  9841. 'rtl.createClassExt($mod, "TExtB", ExtA, "", function () {',
  9842. ' this.$init = function () {',
  9843. ' };',
  9844. ' this.$final = function () {',
  9845. ' };',
  9846. ' this.GetCentury = function () {',
  9847. ' var Result = 0;',
  9848. ' return Result;',
  9849. ' };',
  9850. ' this.SetCentury = function (Value) {',
  9851. ' this.setYear(Value + 11);',
  9852. ' ExtA.setYear(ExtA.getYear() + 12);',
  9853. ' this.setYear(this.getYear() + 13);',
  9854. ' $mod.TExtB.SetCentury($mod.TExtB.GetCentury() + 14);',
  9855. ' this.SetCentury(this.GetCentury() + 15);',
  9856. ' };',
  9857. '});',
  9858. 'this.A = null;',
  9859. 'this.B = null;',
  9860. '']),
  9861. LinesToStr([ // $mod.$main
  9862. 'ExtA.setYear(ExtA.getYear() + 1);',
  9863. '$mod.TExtB.setYear($mod.TExtB.getYear() + 2);',
  9864. 'ExtA.setYear(ExtA.getYear() + 3);',
  9865. '$mod.B.setYear($mod.B.getYear() + 4);',
  9866. '$mod.TExtB.SetCentury($mod.TExtB.GetCentury() + 5);',
  9867. '$mod.B.$class.SetCentury($mod.B.$class.GetCentury() + 6);',
  9868. '']));
  9869. end;
  9870. procedure TTestModule.TestExternalClass_ClassOf;
  9871. begin
  9872. StartProgram(false);
  9873. Add('{$modeswitch externalclass}');
  9874. Add('type');
  9875. Add(' TExtA = class external name ''ExtA''');
  9876. Add(' procedure ProcA; virtual;');
  9877. Add(' procedure ProcB; virtual;');
  9878. Add(' end;');
  9879. Add(' TExtAClass = class of TExtA;');
  9880. Add(' TExtB = class external name ''ExtB'' (TExtA)');
  9881. Add(' end;');
  9882. Add(' TExtBClass = class of TExtB;');
  9883. Add(' TExtC = class (TExtB)');
  9884. Add(' procedure ProcA; override;');
  9885. Add(' end;');
  9886. Add(' TExtCClass = class of TExtC;');
  9887. Add('procedure TExtC.ProcA; begin end;');
  9888. Add('var');
  9889. Add(' A: texta; ClA: TExtAClass;');
  9890. Add(' B: textb; ClB: TExtBClass;');
  9891. Add(' C: textc; ClC: TExtCClass;');
  9892. Add('begin');
  9893. Add(' ClA:=texta;');
  9894. Add(' ClA:=textb;');
  9895. Add(' ClA:=textc;');
  9896. Add(' ClB:=textb;');
  9897. Add(' ClB:=textc;');
  9898. Add(' ClC:=textc;');
  9899. ConvertProgram;
  9900. CheckSource('TestExternalClass_ClassOf',
  9901. LinesToStr([ // statements
  9902. 'rtl.createClassExt($mod, "TExtC", ExtB, "", function () {',
  9903. ' this.$init = function () {',
  9904. ' };',
  9905. ' this.$final = function () {',
  9906. ' };',
  9907. ' this.ProcA = function () {',
  9908. ' };',
  9909. '});',
  9910. 'this.A = null;',
  9911. 'this.ClA = null;',
  9912. 'this.B = null;',
  9913. 'this.ClB = null;',
  9914. 'this.C = null;',
  9915. 'this.ClC = null;',
  9916. '']),
  9917. LinesToStr([ // $mod.$main
  9918. '$mod.ClA = ExtA;',
  9919. '$mod.ClA = ExtB;',
  9920. '$mod.ClA = $mod.TExtC;',
  9921. '$mod.ClB = ExtB;',
  9922. '$mod.ClB = $mod.TExtC;',
  9923. '$mod.ClC = $mod.TExtC;',
  9924. '']));
  9925. end;
  9926. procedure TTestModule.TestExternalClass_ClassOtherUnit;
  9927. begin
  9928. AddModuleWithIntfImplSrc('unit2.pas',
  9929. LinesToStr([
  9930. '{$modeswitch externalclass}',
  9931. 'type',
  9932. ' TExtA = class external name ''ExtA''',
  9933. ' class var Id: longint;',
  9934. ' end;',
  9935. '']),
  9936. '');
  9937. StartUnit(true);
  9938. Add('interface');
  9939. Add('uses unit2;');
  9940. Add('implementation');
  9941. Add('begin');
  9942. Add(' unit2.texta.id:=unit2.texta.id+1;');
  9943. ConvertUnit;
  9944. CheckSource('TestExternalClass_ClassOtherUnit',
  9945. LinesToStr([
  9946. '']),
  9947. LinesToStr([
  9948. 'ExtA.Id = ExtA.Id + 1;',
  9949. '']));
  9950. end;
  9951. procedure TTestModule.TestExternalClass_Is;
  9952. begin
  9953. StartProgram(false);
  9954. Add('{$modeswitch externalclass}');
  9955. Add('type');
  9956. Add(' TExtA = class external name ''ExtA''');
  9957. Add(' end;');
  9958. Add(' TExtAClass = class of TExtA;');
  9959. Add(' TExtB = class external name ''ExtB'' (TExtA)');
  9960. Add(' end;');
  9961. Add(' TExtBClass = class of TExtB;');
  9962. Add(' TExtC = class (TExtB)');
  9963. Add(' end;');
  9964. Add(' TExtCClass = class of TExtC;');
  9965. Add('var');
  9966. Add(' A: texta; ClA: TExtAClass;');
  9967. Add(' B: textb; ClB: TExtBClass;');
  9968. Add(' C: textc; ClC: TExtCClass;');
  9969. Add('begin');
  9970. Add(' if a is textb then ;');
  9971. Add(' if a is textc then ;');
  9972. Add(' if b is textc then ;');
  9973. Add(' if cla is textb then ;');
  9974. Add(' if cla is textc then ;');
  9975. Add(' if clb is textc then ;');
  9976. ConvertProgram;
  9977. CheckSource('TestExternalClass_Is',
  9978. LinesToStr([ // statements
  9979. 'rtl.createClassExt($mod, "TExtC", ExtB, "", function () {',
  9980. ' this.$init = function () {',
  9981. ' };',
  9982. ' this.$final = function () {',
  9983. ' };',
  9984. '});',
  9985. 'this.A = null;',
  9986. 'this.ClA = null;',
  9987. 'this.B = null;',
  9988. 'this.ClB = null;',
  9989. 'this.C = null;',
  9990. 'this.ClC = null;',
  9991. '']),
  9992. LinesToStr([ // $mod.$main
  9993. 'if (rtl.isExt($mod.A, ExtB)) ;',
  9994. 'if ($mod.TExtC.isPrototypeOf($mod.A)) ;',
  9995. 'if ($mod.TExtC.isPrototypeOf($mod.B)) ;',
  9996. 'if (rtl.isExt($mod.ClA, ExtB)) ;',
  9997. 'if (rtl.is($mod.ClA, $mod.TExtC)) ;',
  9998. 'if (rtl.is($mod.ClB, $mod.TExtC)) ;',
  9999. '']));
  10000. end;
  10001. procedure TTestModule.TestExternalClass_As;
  10002. begin
  10003. StartProgram(false);
  10004. Add('{$modeswitch externalclass}');
  10005. Add('type');
  10006. Add(' TExtA = class external name ''ExtA''');
  10007. Add(' end;');
  10008. Add(' TExtB = class external name ''ExtB'' (TExtA)');
  10009. Add(' end;');
  10010. Add(' TExtC = class (TExtB)');
  10011. Add(' end;');
  10012. Add('var');
  10013. Add(' A: texta;');
  10014. Add(' B: textb;');
  10015. Add(' C: textc;');
  10016. Add('begin');
  10017. Add(' b:=a as textb;');
  10018. Add(' c:=a as textc;');
  10019. Add(' c:=b as textc;');
  10020. ConvertProgram;
  10021. CheckSource('TestExternalClass_Is',
  10022. LinesToStr([ // statements
  10023. 'rtl.createClassExt($mod, "TExtC", ExtB, "", function () {',
  10024. ' this.$init = function () {',
  10025. ' };',
  10026. ' this.$final = function () {',
  10027. ' };',
  10028. '});',
  10029. 'this.A = null;',
  10030. 'this.B = null;',
  10031. 'this.C = null;',
  10032. '']),
  10033. LinesToStr([ // $mod.$main
  10034. '$mod.B = rtl.asExt($mod.A, ExtB);',
  10035. '$mod.C = rtl.as($mod.A, $mod.TExtC);',
  10036. '$mod.C = rtl.as($mod.B, $mod.TExtC);',
  10037. '']));
  10038. end;
  10039. procedure TTestModule.TestExternalClass_DestructorFail;
  10040. begin
  10041. StartProgram(false);
  10042. Add('{$modeswitch externalclass}');
  10043. Add('type');
  10044. Add(' TExtA = class external name ''ExtA''');
  10045. Add(' destructor Free;');
  10046. Add(' end;');
  10047. SetExpectedPasResolverError('Pascal element not supported: destructor',
  10048. nPasElementNotSupported);
  10049. ConvertProgram;
  10050. end;
  10051. procedure TTestModule.TestExternalClass_New;
  10052. begin
  10053. StartProgram(false);
  10054. Add('{$modeswitch externalclass}');
  10055. Add('type');
  10056. Add(' TExtA = class external name ''ExtA''');
  10057. Add(' constructor New;');
  10058. Add(' constructor New(i: longint; j: longint = 2);');
  10059. Add(' end;');
  10060. Add('var');
  10061. Add(' A: texta;');
  10062. Add('begin');
  10063. Add(' a:=texta.new;');
  10064. Add(' a:=texta.new();');
  10065. Add(' a:=texta.new(1);');
  10066. Add(' with texta do begin');
  10067. Add(' a:=new;');
  10068. Add(' a:=new();');
  10069. Add(' a:=new(2);');
  10070. Add(' end;');
  10071. Add(' a:=test1.texta.new;');
  10072. Add(' a:=test1.texta.new();');
  10073. Add(' a:=test1.texta.new(3);');
  10074. ConvertProgram;
  10075. CheckSource('TestExternalClass_New',
  10076. LinesToStr([ // statements
  10077. 'this.A = null;',
  10078. '']),
  10079. LinesToStr([ // $mod.$main
  10080. '$mod.A = new ExtA();',
  10081. '$mod.A = new ExtA();',
  10082. '$mod.A = new ExtA(1,2);',
  10083. '$mod.A = new ExtA();',
  10084. '$mod.A = new ExtA();',
  10085. '$mod.A = new ExtA(2,2);',
  10086. '$mod.A = new ExtA();',
  10087. '$mod.A = new ExtA();',
  10088. '$mod.A = new ExtA(3,2);',
  10089. '']));
  10090. end;
  10091. procedure TTestModule.TestExternalClass_ClassOf_New;
  10092. begin
  10093. StartProgram(false);
  10094. Add('{$modeswitch externalclass}');
  10095. Add('type');
  10096. Add(' TExtAClass = class of TExtA;');
  10097. Add(' TExtA = class external name ''ExtA''');
  10098. Add(' constructor New;');
  10099. Add(' end;');
  10100. Add('var');
  10101. Add(' A: texta;');
  10102. Add(' C: textaclass;');
  10103. Add('begin');
  10104. Add(' a:=c.new;');
  10105. Add(' a:=c.new();');
  10106. Add(' with C do begin');
  10107. Add(' a:=new;');
  10108. Add(' a:=new();');
  10109. Add(' end;');
  10110. Add(' a:=test1.c.new;');
  10111. Add(' a:=test1.c.new();');
  10112. ConvertProgram;
  10113. CheckSource('TestExternalClass_ClassOf_New',
  10114. LinesToStr([ // statements
  10115. 'this.A = null;',
  10116. 'this.C = null;',
  10117. '']),
  10118. LinesToStr([ // $mod.$main
  10119. '$mod.A = new $mod.C();',
  10120. '$mod.A = new $mod.C();',
  10121. 'var $with1 = $mod.C;',
  10122. '$mod.A = new $with1();',
  10123. '$mod.A = new $with1();',
  10124. '$mod.A = new $mod.C();',
  10125. '$mod.A = new $mod.C();',
  10126. '']));
  10127. end;
  10128. procedure TTestModule.TestExternalClass_FuncClassOf_New;
  10129. begin
  10130. StartProgram(false);
  10131. Add('{$modeswitch externalclass}');
  10132. Add('type');
  10133. Add(' TExtAClass = class of TExtA;');
  10134. Add(' TExtA = class external name ''ExtA''');
  10135. Add(' constructor New;');
  10136. Add(' end;');
  10137. Add('function GetCreator: TExtAClass;');
  10138. Add('begin');
  10139. Add(' Result:=TExtA;');
  10140. Add('end;');
  10141. Add('var');
  10142. Add(' A: texta;');
  10143. Add('begin');
  10144. Add(' a:=getcreator.new;');
  10145. Add(' a:=getcreator().new;');
  10146. Add(' a:=getcreator().new();');
  10147. Add(' a:=getcreator.new();');
  10148. Add(' with getcreator do begin');
  10149. Add(' a:=new;');
  10150. Add(' a:=new();');
  10151. Add(' end;');
  10152. ConvertProgram;
  10153. CheckSource('TestExternalClass_FuncClassOf_New',
  10154. LinesToStr([ // statements
  10155. 'this.GetCreator = function () {',
  10156. ' var Result = null;',
  10157. ' Result = ExtA;',
  10158. ' return Result;',
  10159. '};',
  10160. 'this.A = null;',
  10161. '']),
  10162. LinesToStr([ // $mod.$main
  10163. '$mod.A = new ($mod.GetCreator())();',
  10164. '$mod.A = new ($mod.GetCreator())();',
  10165. '$mod.A = new ($mod.GetCreator())();',
  10166. '$mod.A = new ($mod.GetCreator())();',
  10167. 'var $with1 = $mod.GetCreator();',
  10168. '$mod.A = new $with1();',
  10169. '$mod.A = new $with1();',
  10170. '']));
  10171. end;
  10172. procedure TTestModule.TestExternalClass_LocalConstSameName;
  10173. begin
  10174. StartProgram(false);
  10175. Add('{$modeswitch externalclass}');
  10176. Add('type');
  10177. Add(' TExtA = class external name ''ExtA''');
  10178. Add(' constructor New;');
  10179. Add(' end;');
  10180. Add('function DoIt: longint;');
  10181. Add('const ExtA = 3;');
  10182. Add('begin');
  10183. Add(' Result:=ExtA;');
  10184. Add('end;');
  10185. Add('var');
  10186. Add(' A: texta;');
  10187. Add('begin');
  10188. Add(' a:=texta.new;');
  10189. ConvertProgram;
  10190. CheckSource('TestExternalClass_LocalConstSameName',
  10191. LinesToStr([ // statements
  10192. 'var ExtA$1 = 3;',
  10193. 'this.DoIt = function () {',
  10194. ' var Result = 0;',
  10195. ' Result = ExtA$1;',
  10196. ' return Result;',
  10197. '};',
  10198. 'this.A = null;',
  10199. '']),
  10200. LinesToStr([ // $mod.$main
  10201. '$mod.A = new ExtA();',
  10202. '']));
  10203. end;
  10204. procedure TTestModule.TestExternalClass_ReintroduceOverload;
  10205. begin
  10206. StartProgram(false);
  10207. Add('{$modeswitch externalclass}');
  10208. Add('type');
  10209. Add(' TExtA = class external name ''ExtA''');
  10210. Add(' procedure DoIt;');
  10211. Add(' end;');
  10212. Add(' TMyA = class(TExtA)');
  10213. Add(' procedure DoIt;');
  10214. Add(' end;');
  10215. Add('procedure TMyA.DoIt; begin end;');
  10216. Add('begin');
  10217. ConvertProgram;
  10218. CheckSource('TestExternalClass_ReintroduceOverload',
  10219. LinesToStr([ // statements
  10220. 'rtl.createClassExt($mod, "TMyA", ExtA, "", function () {',
  10221. ' this.$init = function () {',
  10222. ' };',
  10223. ' this.$final = function () {',
  10224. ' };',
  10225. ' this.DoIt$1 = function () {',
  10226. ' };',
  10227. '});',
  10228. '']),
  10229. LinesToStr([ // $mod.$main
  10230. '']));
  10231. end;
  10232. procedure TTestModule.TestExternalClass_Inherited;
  10233. begin
  10234. StartProgram(false);
  10235. Add('{$modeswitch externalclass}');
  10236. Add('type');
  10237. Add(' TExtA = class external name ''ExtA''');
  10238. Add(' procedure DoIt(i: longint = 1); virtual;');
  10239. Add(' procedure DoSome(j: longint = 2);');
  10240. Add(' end;');
  10241. Add(' TExtB = class external name ''ExtB''(TExtA)');
  10242. Add(' end;');
  10243. Add(' TMyC = class(TExtB)');
  10244. Add(' procedure DoIt(i: longint = 1); override;');
  10245. Add(' procedure DoSome(j: longint = 2); reintroduce;');
  10246. Add(' end;');
  10247. Add('procedure TMyC.DoIt(i: longint);');
  10248. Add('begin');
  10249. Add(' inherited;');
  10250. Add(' inherited DoIt;');
  10251. Add(' inherited DoIt();');
  10252. Add(' inherited DoIt(3);');
  10253. Add(' inherited DoSome;');
  10254. Add(' inherited DoSome();');
  10255. Add(' inherited DoSome(4);');
  10256. Add('end;');
  10257. Add('procedure TMyC.DoSome(j: longint);');
  10258. Add('begin');
  10259. Add(' inherited;');
  10260. Add('end;');
  10261. Add('begin');
  10262. ConvertProgram;
  10263. CheckSource('TestExternalClass_ReintroduceOverload',
  10264. LinesToStr([ // statements
  10265. 'rtl.createClassExt($mod, "TMyC", ExtB, "", function () {',
  10266. ' this.$init = function () {',
  10267. ' };',
  10268. ' this.$final = function () {',
  10269. ' };',
  10270. ' this.DoIt = function (i) {',
  10271. ' ExtB.DoIt.apply(this, arguments);',
  10272. ' ExtB.DoIt.call(this, 1);',
  10273. ' ExtB.DoIt.call(this, 1);',
  10274. ' ExtB.DoIt.call(this, 3);',
  10275. ' ExtB.DoSome.call(this, 2);',
  10276. ' ExtB.DoSome.call(this, 2);',
  10277. ' ExtB.DoSome.call(this, 4);',
  10278. ' };',
  10279. ' this.DoSome$1 = function (j) {',
  10280. ' ExtB.DoSome.apply(this, arguments);',
  10281. ' };',
  10282. '});',
  10283. '']),
  10284. LinesToStr([ // $mod.$main
  10285. '']));
  10286. end;
  10287. procedure TTestModule.TestExternalClass_PascalAncestorFail;
  10288. begin
  10289. StartProgram(false);
  10290. Add('{$modeswitch externalclass}');
  10291. Add('type');
  10292. Add(' TObject = class');
  10293. Add(' end;');
  10294. Add(' TExtA = class external name ''ExtA''(TObject)');
  10295. Add(' end;');
  10296. Add('begin');
  10297. SetExpectedPasResolverError('Ancestor "TObject" is not external',nAncestorIsNotExternal);
  10298. ConvertProgram;
  10299. end;
  10300. procedure TTestModule.TestExternalClass_NewInstance;
  10301. begin
  10302. StartProgram(false);
  10303. Add('{$modeswitch externalclass}');
  10304. Add('type');
  10305. Add(' TExtA = class external name ''ExtA''');
  10306. Add(' end;');
  10307. Add(' TMyB = class(TExtA)');
  10308. Add(' protected');
  10309. Add(' class function NewInstance(fnname: string; const paramarray): TMyB; virtual;');
  10310. Add(' end;');
  10311. Add('class function TMyB.NewInstance(fnname: string; const paramarray): TMyB;');
  10312. Add('begin end;');
  10313. Add('begin');
  10314. ConvertProgram;
  10315. CheckSource('TestExternalClass_NewInstance',
  10316. LinesToStr([ // statements
  10317. 'rtl.createClassExt($mod, "TMyB", ExtA, "NewInstance", function () {',
  10318. ' this.$init = function () {',
  10319. ' };',
  10320. ' this.$final = function () {',
  10321. ' };',
  10322. ' this.NewInstance = function (fnname, paramarray) {',
  10323. ' var Result = null;',
  10324. ' return Result;',
  10325. ' };',
  10326. '});',
  10327. '']),
  10328. LinesToStr([ // $mod.$main
  10329. '']));
  10330. end;
  10331. procedure TTestModule.TestExternalClass_NewInstance_NonVirtualFail;
  10332. begin
  10333. StartProgram(false);
  10334. Add('{$modeswitch externalclass}');
  10335. Add('type');
  10336. Add(' TExtA = class external name ''ExtA''');
  10337. Add(' end;');
  10338. Add(' TMyB = class(TExtA)');
  10339. Add(' protected');
  10340. Add(' class function NewInstance(fnname: string; const paramarray): TMyB;');
  10341. Add(' end;');
  10342. Add('class function TMyB.NewInstance(fnname: string; const paramarray): TMyB;');
  10343. Add('begin end;');
  10344. Add('begin');
  10345. SetExpectedPasResolverError(sNewInstanceFunctionMustBeVirtual,nNewInstanceFunctionMustBeVirtual);
  10346. ConvertProgram;
  10347. end;
  10348. procedure TTestModule.TestExternalClass_NewInstance_FirstParamNotString_Fail;
  10349. begin
  10350. StartProgram(false);
  10351. Add('{$modeswitch externalclass}');
  10352. Add('type');
  10353. Add(' TExtA = class external name ''ExtA''');
  10354. Add(' end;');
  10355. Add(' TMyB = class(TExtA)');
  10356. Add(' protected');
  10357. Add(' class function NewInstance(fnname: longint; const paramarray): TMyB; virtual;');
  10358. Add(' end;');
  10359. Add('class function TMyB.NewInstance(fnname: longint; const paramarray): TMyB;');
  10360. Add('begin end;');
  10361. Add('begin');
  10362. SetExpectedPasResolverError('Incompatible type arg no. 1: Got "Longint", expected "String"',
  10363. nIncompatibleTypeArgNo);
  10364. ConvertProgram;
  10365. end;
  10366. procedure TTestModule.TestExternalClass_NewInstance_SecondParamTyped_Fail;
  10367. begin
  10368. StartProgram(false);
  10369. Add('{$modeswitch externalclass}');
  10370. Add('type');
  10371. Add(' TExtA = class external name ''ExtA''');
  10372. Add(' end;');
  10373. Add(' TMyB = class(TExtA)');
  10374. Add(' protected');
  10375. Add(' class function NewInstance(fnname: string; const paramarray: string): TMyB; virtual;');
  10376. Add(' end;');
  10377. Add('class function TMyB.NewInstance(fnname: string; const paramarray: string): TMyB;');
  10378. Add('begin end;');
  10379. Add('begin');
  10380. SetExpectedPasResolverError('Incompatible type arg no. 2: Got "type", expected "untyped"',
  10381. nIncompatibleTypeArgNo);
  10382. ConvertProgram;
  10383. end;
  10384. procedure TTestModule.TestExternalClass_PascalProperty;
  10385. begin
  10386. StartProgram(false);
  10387. Add('{$modeswitch externalclass}');
  10388. Add('type');
  10389. Add(' TJSElement = class;');
  10390. Add(' TJSNotifyEvent = procedure(Sender: TJSElement) of object;');
  10391. Add(' TJSElement = class external name ''ExtA''');
  10392. Add(' end;');
  10393. Add(' TControl = class(TJSElement)');
  10394. Add(' private');
  10395. Add(' FOnClick: TJSNotifyEvent;');
  10396. Add(' property OnClick: TJSNotifyEvent read FOnClick write FOnClick;');
  10397. Add(' procedure Click(Sender: TJSElement);');
  10398. Add(' end;');
  10399. Add('procedure TControl.Click(Sender: TJSElement);');
  10400. Add('begin');
  10401. Add(' OnClick(Self);');
  10402. Add('end;');
  10403. Add('var');
  10404. Add(' Ctrl: TControl;');
  10405. Add('begin');
  10406. Add(' Ctrl.OnClick:[email protected];');
  10407. Add(' Ctrl.OnClick(Ctrl);');
  10408. ConvertProgram;
  10409. CheckSource('TestExternalClass_PascalProperty',
  10410. LinesToStr([ // statements
  10411. 'rtl.createClassExt($mod, "TControl", ExtA, "", function () {',
  10412. ' this.$init = function () {',
  10413. ' this.FOnClick = null;',
  10414. ' };',
  10415. ' this.$final = function () {',
  10416. ' this.FOnClick = undefined;',
  10417. ' };',
  10418. ' this.Click = function (Sender) {',
  10419. ' this.FOnClick(this);',
  10420. ' };',
  10421. '});',
  10422. 'this.Ctrl = null;',
  10423. '']),
  10424. LinesToStr([ // $mod.$main
  10425. '$mod.Ctrl.FOnClick = rtl.createCallback($mod.Ctrl, "Click");',
  10426. '$mod.Ctrl.FOnClick($mod.Ctrl);',
  10427. '']));
  10428. end;
  10429. procedure TTestModule.TestExternalClass_TypeCastToRootClass;
  10430. begin
  10431. StartProgram(false);
  10432. Add('{$modeswitch externalclass}');
  10433. Add('type');
  10434. Add(' TObject = class');
  10435. Add(' end;');
  10436. Add(' TChild = class');
  10437. Add(' end;');
  10438. Add(' TExtRootA = class external name ''ExtRootA''');
  10439. Add(' end;');
  10440. Add(' TExtChildA = class external name ''ExtChildA''(TExtRootA)');
  10441. Add(' end;');
  10442. Add(' TExtRootB = class external name ''ExtRootB''');
  10443. Add(' end;');
  10444. Add(' TExtChildB = class external name ''ExtChildB''(TExtRootB)');
  10445. Add(' end;');
  10446. Add('var');
  10447. Add(' Obj: TObject;');
  10448. Add(' Child: TChild;');
  10449. Add(' RootA: TExtRootA;');
  10450. Add(' ChildA: TExtChildA;');
  10451. Add(' RootB: TExtRootB;');
  10452. Add(' ChildB: TExtChildB;');
  10453. Add('begin');
  10454. Add(' obj:=tobject(roota);');
  10455. Add(' obj:=tobject(childa);');
  10456. Add(' child:=tchild(tobject(roota));');
  10457. Add(' roota:=textroota(obj);');
  10458. Add(' roota:=textroota(child);');
  10459. Add(' roota:=textroota(rootb);');
  10460. Add(' roota:=textroota(childb);');
  10461. Add(' childa:=textchilda(textroota(obj));');
  10462. ConvertProgram;
  10463. CheckSource('TestExternalClass_TypeCastToRootClass',
  10464. LinesToStr([ // statements
  10465. 'rtl.createClass($mod, "TObject", null, function () {',
  10466. ' this.$init = function () {',
  10467. ' };',
  10468. ' this.$final = function () {',
  10469. ' };',
  10470. '});',
  10471. 'rtl.createClass($mod, "TChild", $mod.TObject, function () {',
  10472. '});',
  10473. 'this.Obj = null;',
  10474. 'this.Child = null;',
  10475. 'this.RootA = null;',
  10476. 'this.ChildA = null;',
  10477. 'this.RootB = null;',
  10478. 'this.ChildB = null;',
  10479. '']),
  10480. LinesToStr([ // $mod.$main
  10481. '$mod.Obj = $mod.RootA;',
  10482. '$mod.Obj = $mod.ChildA;',
  10483. '$mod.Child = $mod.RootA;',
  10484. '$mod.RootA = $mod.Obj;',
  10485. '$mod.RootA = $mod.Child;',
  10486. '$mod.RootA = $mod.RootB;',
  10487. '$mod.RootA = $mod.ChildB;',
  10488. '$mod.ChildA = $mod.Obj;',
  10489. '']));
  10490. end;
  10491. procedure TTestModule.TestExternalClass_TypeCastStringToExternalString;
  10492. begin
  10493. StartProgram(false);
  10494. Add('{$modeswitch externalclass}');
  10495. Add('type');
  10496. Add(' TJSString = class external name ''String''');
  10497. Add(' class function fromCharCode() : string; varargs;');
  10498. Add(' function anchor(const aName : string) : string;');
  10499. Add(' end;');
  10500. Add('var');
  10501. Add(' s: string;');
  10502. Add('begin');
  10503. Add(' s:=TJSString.fromCharCode(65,66);');
  10504. Add(' s:=TJSString(s).anchor(s);');
  10505. Add(' s:=TJSString(''foo'').anchor(s);');
  10506. ConvertProgram;
  10507. CheckSource('TestExternalClass_TypeCastStringToExternalString',
  10508. LinesToStr([ // statements
  10509. 'this.s = "";',
  10510. '']),
  10511. LinesToStr([ // $mod.$main
  10512. '$mod.s = String.fromCharCode(65, 66);',
  10513. '$mod.s = $mod.s.anchor($mod.s);',
  10514. '$mod.s = "foo".anchor($mod.s);',
  10515. '']));
  10516. end;
  10517. procedure TTestModule.TestExternalClass_CallClassFunctionOfInstanceFail;
  10518. begin
  10519. StartProgram(false);
  10520. Add('{$modeswitch externalclass}');
  10521. Add('type');
  10522. Add(' TJSString = class external name ''String''');
  10523. Add(' class function fromCharCode() : string; varargs;');
  10524. Add(' end;');
  10525. Add('var');
  10526. Add(' s: string;');
  10527. Add(' sObj: TJSString;');
  10528. Add('begin');
  10529. Add(' s:=sObj.fromCharCode(65,66);');
  10530. SetExpectedPasResolverError('External class instance cannot access static class function fromCharCode',
  10531. nExternalClassInstanceCannotAccessStaticX);
  10532. ConvertProgram;
  10533. end;
  10534. procedure TTestModule.TestExternalClass_BracketAccessor;
  10535. begin
  10536. StartProgram(false);
  10537. Add('{$modeswitch externalclass}');
  10538. Add('type');
  10539. Add(' TJSArray = class external name ''Array2''');
  10540. Add(' function GetItems(Index: longint): jsvalue; external name ''[]'';');
  10541. Add(' procedure SetItems(Index: longint; Value: jsvalue); external name ''[]'';');
  10542. Add(' property Items[Index: longint]: jsvalue read GetItems write SetItems; default;');
  10543. Add(' end;');
  10544. Add('procedure DoIt(vI: JSValue; const vJ: jsvalue; var vK: jsvalue; out vL: jsvalue);');
  10545. Add('begin end;');
  10546. Add('var');
  10547. Add(' Arr: tjsarray;');
  10548. Add(' s: string;');
  10549. Add(' i: longint;');
  10550. Add(' v: jsvalue;');
  10551. Add('begin');
  10552. Add(' v:=arr[0];');
  10553. Add(' v:=arr.items[1];');
  10554. Add(' arr[2]:=s;');
  10555. Add(' arr.items[3]:=s;');
  10556. Add(' arr[4]:=i;');
  10557. Add(' arr[5]:=arr[6];');
  10558. Add(' arr.items[7]:=arr.items[8];');
  10559. Add(' with arr do items[9]:=items[10];');
  10560. Add(' doit(arr[7],arr[8],arr[9],arr[10]);');
  10561. ConvertProgram;
  10562. CheckSource('TestExternalClass_BracketAccessor',
  10563. LinesToStr([ // statements
  10564. 'this.DoIt = function (vI, vJ, vK, vL) {',
  10565. '};',
  10566. 'this.Arr = null;',
  10567. 'this.s = "";',
  10568. 'this.i = 0;',
  10569. 'this.v = undefined;',
  10570. '']),
  10571. LinesToStr([ // $mod.$main
  10572. '$mod.v = $mod.Arr[0];',
  10573. '$mod.v = $mod.Arr[1];',
  10574. '$mod.Arr[2] = $mod.s;',
  10575. '$mod.Arr[3] = $mod.s;',
  10576. '$mod.Arr[4] = $mod.i;',
  10577. '$mod.Arr[5] = $mod.Arr[6];',
  10578. '$mod.Arr[7] = $mod.Arr[8];',
  10579. 'var $with1 = $mod.Arr;',
  10580. '$with1[9] = $with1[10];',
  10581. '$mod.DoIt($mod.Arr[7], $mod.Arr[8], {',
  10582. ' a: 9,',
  10583. ' p: $mod.Arr,',
  10584. ' get: function () {',
  10585. ' return this.p[this.a];',
  10586. ' },',
  10587. ' set: function (v) {',
  10588. ' this.p[this.a] = v;',
  10589. ' }',
  10590. '}, {',
  10591. ' a: 10,',
  10592. ' p: $mod.Arr,',
  10593. ' get: function () {',
  10594. ' return this.p[this.a];',
  10595. ' },',
  10596. ' set: function (v) {',
  10597. ' this.p[this.a] = v;',
  10598. ' }',
  10599. '});',
  10600. '']));
  10601. end;
  10602. procedure TTestModule.TestExternalClass_BracketAccessor_2ParamsFail;
  10603. begin
  10604. StartProgram(false);
  10605. Add('{$modeswitch externalclass}');
  10606. Add('type');
  10607. Add(' TJSArray = class external name ''Array2''');
  10608. Add(' function GetItems(Index1, Index2: longint): jsvalue; external name ''[]'';');
  10609. Add(' procedure SetItems(Index1, Index2: longint; Value: jsvalue); external name ''[]'';');
  10610. Add(' property Items[Index1, Index2: longint]: jsvalue read GetItems write SetItems; default;');
  10611. Add(' end;');
  10612. Add('begin');
  10613. SetExpectedPasResolverError(sBracketAccessorOfExternalClassMustHaveOneParameter,
  10614. nBracketAccessorOfExternalClassMustHaveOneParameter);
  10615. ConvertProgram;
  10616. end;
  10617. procedure TTestModule.TestExternalClass_BracketAccessor_ReadOnly;
  10618. begin
  10619. StartProgram(false);
  10620. Add('{$modeswitch externalclass}');
  10621. Add('type');
  10622. Add(' TJSArray = class external name ''Array2''');
  10623. Add(' function GetItems(Index: longint): jsvalue; external name ''[]'';');
  10624. Add(' property Items[Index: longint]: jsvalue read GetItems; default;');
  10625. Add(' end;');
  10626. Add('procedure DoIt(vI: JSValue; const vJ: jsvalue);');
  10627. Add('begin end;');
  10628. Add('var');
  10629. Add(' Arr: tjsarray;');
  10630. Add(' v: jsvalue;');
  10631. Add('begin');
  10632. Add(' v:=arr[0];');
  10633. Add(' v:=arr.items[1];');
  10634. Add(' with arr do v:=items[2];');
  10635. Add(' doit(arr[3],arr[4]);');
  10636. ConvertProgram;
  10637. CheckSource('TestExternalClass_BracketAccessor_ReadOnly',
  10638. LinesToStr([ // statements
  10639. 'this.DoIt = function (vI, vJ) {',
  10640. '};',
  10641. 'this.Arr = null;',
  10642. 'this.v = undefined;',
  10643. '']),
  10644. LinesToStr([ // $mod.$main
  10645. '$mod.v = $mod.Arr[0];',
  10646. '$mod.v = $mod.Arr[1];',
  10647. 'var $with1 = $mod.Arr;',
  10648. '$mod.v = $with1[2];',
  10649. '$mod.DoIt($mod.Arr[3], $mod.Arr[4]);',
  10650. '']));
  10651. end;
  10652. procedure TTestModule.TestExternalClass_BracketAccessor_WriteOnly;
  10653. begin
  10654. StartProgram(false);
  10655. Add('{$modeswitch externalclass}');
  10656. Add('type');
  10657. Add(' TJSArray = class external name ''Array2''');
  10658. Add(' procedure SetItems(Index: longint; Value: jsvalue); external name ''[]'';');
  10659. Add(' property Items[Index: longint]: jsvalue write SetItems; default;');
  10660. Add(' end;');
  10661. Add('var');
  10662. Add(' Arr: tjsarray;');
  10663. Add(' s: string;');
  10664. Add(' i: longint;');
  10665. Add(' v: jsvalue;');
  10666. Add('begin');
  10667. Add(' arr[2]:=s;');
  10668. Add(' arr.items[3]:=s;');
  10669. Add(' arr[4]:=i;');
  10670. Add(' with arr do items[5]:=i;');
  10671. ConvertProgram;
  10672. CheckSource('TestExternalClass_BracketAccessor_WriteOnly',
  10673. LinesToStr([ // statements
  10674. 'this.Arr = null;',
  10675. 'this.s = "";',
  10676. 'this.i = 0;',
  10677. 'this.v = undefined;',
  10678. '']),
  10679. LinesToStr([ // $mod.$main
  10680. '$mod.Arr[2] = $mod.s;',
  10681. '$mod.Arr[3] = $mod.s;',
  10682. '$mod.Arr[4] = $mod.i;',
  10683. 'var $with1 = $mod.Arr;',
  10684. '$with1[5] = $mod.i;',
  10685. '']));
  10686. end;
  10687. procedure TTestModule.TestExternalClass_BracketAccessor_MultiType;
  10688. begin
  10689. StartProgram(false);
  10690. Add('{$modeswitch externalclass}');
  10691. Add('type');
  10692. Add(' TJSArray = class external name ''Array2''');
  10693. Add(' procedure SetItems(Index: longint; Value: jsvalue); external name ''[]'';');
  10694. Add(' property Items[Index: longint]: jsvalue write SetItems; default;');
  10695. Add(' procedure SetNumbers(Index: longint; Value: longint); external name ''[]'';');
  10696. Add(' property Numbers[Index: longint]: longint write SetNumbers;');
  10697. Add(' end;');
  10698. Add('var');
  10699. Add(' Arr: tjsarray;');
  10700. Add(' s: string;');
  10701. Add(' i: longint;');
  10702. Add(' v: jsvalue;');
  10703. Add('begin');
  10704. Add(' arr[2]:=s;');
  10705. Add(' arr.items[3]:=s;');
  10706. Add(' arr.numbers[4]:=i;');
  10707. Add(' with arr do items[5]:=i;');
  10708. Add(' with arr do numbers[6]:=i;');
  10709. ConvertProgram;
  10710. CheckSource('TestExternalClass_BracketAccessor_MultiType',
  10711. LinesToStr([ // statements
  10712. 'this.Arr = null;',
  10713. 'this.s = "";',
  10714. 'this.i = 0;',
  10715. 'this.v = undefined;',
  10716. '']),
  10717. LinesToStr([ // $mod.$main
  10718. '$mod.Arr[2] = $mod.s;',
  10719. '$mod.Arr[3] = $mod.s;',
  10720. '$mod.Arr[4] = $mod.i;',
  10721. 'var $with1 = $mod.Arr;',
  10722. '$with1[5] = $mod.i;',
  10723. 'var $with2 = $mod.Arr;',
  10724. '$with2[6] = $mod.i;',
  10725. '']));
  10726. end;
  10727. procedure TTestModule.TestExternalClass_BracketAccessor_Index;
  10728. begin
  10729. StartProgram(false);
  10730. Add('{$modeswitch externalclass}');
  10731. Add('type');
  10732. Add(' TJSArray = class external name ''Array2''');
  10733. Add(' function GetItems(Index: longint): jsvalue; external name ''[]'';');
  10734. Add(' procedure SetItems(Index: longint; Value: jsvalue); external name ''[]'';');
  10735. Add(' property Items[Index: longint]: jsvalue read GetItems write SetItems; default;');
  10736. Add(' end;');
  10737. Add('var');
  10738. Add(' Arr: tjsarray;');
  10739. Add(' i: longint;');
  10740. Add(' IntArr: array of longint;');
  10741. Add(' v: jsvalue;');
  10742. Add('begin');
  10743. Add(' v:=arr.items[i];');
  10744. Add(' arr[longint(v)]:=arr.items[intarr[0]];');
  10745. Add(' arr.items[intarr[1]]:=arr[IntArr[2]];');
  10746. ConvertProgram;
  10747. CheckSource('TestExternalClass_BracketAccessor_Index',
  10748. LinesToStr([ // statements
  10749. 'this.Arr = null;',
  10750. 'this.i = 0;',
  10751. 'this.IntArr = [];',
  10752. 'this.v = undefined;',
  10753. '']),
  10754. LinesToStr([ // $mod.$main
  10755. '$mod.v = $mod.Arr[$mod.i];',
  10756. '$mod.Arr[Math.floor($mod.v)] = $mod.Arr[$mod.IntArr[0]];',
  10757. '$mod.Arr[$mod.IntArr[1]] = $mod.Arr[$mod.IntArr[2]];',
  10758. '']));
  10759. end;
  10760. procedure TTestModule.TestClassInterface_Ignore;
  10761. begin
  10762. StartProgram(false);
  10763. Add([
  10764. '{$modeswitch ignoreinterfaces}',
  10765. 'type',
  10766. ' TGUID = record end;',
  10767. ' IUnknown = interface;',
  10768. ' IUnknown = interface',
  10769. ' [''{00000000-0000-0000-C000-000000000046}'']',
  10770. ' function QueryInterface(const iid : tguid;out obj) : longint;',
  10771. ' function _AddRef : longint; cdecl;',
  10772. ' function _Release : longint; stdcall;',
  10773. ' end;',
  10774. ' IInterface = IUnknown;',
  10775. ' TObject = class',
  10776. ' ClassName: string;',
  10777. ' end;',
  10778. ' TInterfacedObject = class(TObject,IUnknown)',
  10779. ' RefCount : longint;',
  10780. ' end;',
  10781. 'var i: TInterfacedObject;',
  10782. 'begin',
  10783. ' i.ClassName:=''a'';',
  10784. ' i.RefCount:=3;',
  10785. '']);
  10786. ConvertProgram;
  10787. CheckSource('TestClassInterface_Ignore',
  10788. LinesToStr([ // statements
  10789. 'this.TGUID = function (s) {',
  10790. '};',
  10791. 'rtl.createClass($mod, "TObject", null, function () {',
  10792. ' this.$init = function () {',
  10793. ' this.ClassName = "";',
  10794. ' };',
  10795. ' this.$final = function () {',
  10796. ' };',
  10797. '});',
  10798. 'rtl.createClass($mod, "TInterfacedObject", $mod.TObject, function () {',
  10799. ' this.$init = function () {',
  10800. ' $mod.TObject.$init.call(this);',
  10801. ' this.RefCount = 0;',
  10802. ' };',
  10803. '});',
  10804. 'this.i = null;',
  10805. '']),
  10806. LinesToStr([ // $mod.$main
  10807. '$mod.i.ClassName = "a";',
  10808. '$mod.i.RefCount = 3;',
  10809. '']));
  10810. end;
  10811. procedure TTestModule.TestProcType;
  10812. begin
  10813. StartProgram(false);
  10814. Add('type');
  10815. Add(' TProcInt = procedure(vI: longint = 1);');
  10816. Add('procedure DoIt(vJ: longint);');
  10817. Add('begin end;');
  10818. Add('var');
  10819. Add(' b: boolean;');
  10820. Add(' vP, vQ: tprocint;');
  10821. Add('begin');
  10822. Add(' vp:=nil;');
  10823. Add(' vp:=vp;');
  10824. Add(' vp:=@doit;');
  10825. Add(' vp;');
  10826. Add(' vp();');
  10827. Add(' vp(2);');
  10828. Add(' b:=vp=nil;');
  10829. Add(' b:=nil=vp;');
  10830. Add(' b:=vp=vq;');
  10831. Add(' b:=vp=@doit;');
  10832. Add(' b:=@doit=vp;');
  10833. Add(' b:=vp<>nil;');
  10834. Add(' b:=nil<>vp;');
  10835. Add(' b:=vp<>vq;');
  10836. Add(' b:=vp<>@doit;');
  10837. Add(' b:=@doit<>vp;');
  10838. Add(' b:=Assigned(vp);');
  10839. Add(' if Assigned(vp) then ;');
  10840. ConvertProgram;
  10841. CheckSource('TestProcType',
  10842. LinesToStr([ // statements
  10843. 'this.DoIt = function(vJ) {',
  10844. '};',
  10845. 'this.b = false;',
  10846. 'this.vP = null;',
  10847. 'this.vQ = null;'
  10848. ]),
  10849. LinesToStr([ // $mod.$main
  10850. '$mod.vP = null;',
  10851. '$mod.vP = $mod.vP;',
  10852. '$mod.vP = $mod.DoIt;',
  10853. '$mod.vP(1);',
  10854. '$mod.vP(1);',
  10855. '$mod.vP(2);',
  10856. '$mod.b = $mod.vP === null;',
  10857. '$mod.b = null === $mod.vP;',
  10858. '$mod.b = rtl.eqCallback($mod.vP,$mod.vQ);',
  10859. '$mod.b = rtl.eqCallback($mod.vP, $mod.DoIt);',
  10860. '$mod.b = rtl.eqCallback($mod.DoIt, $mod.vP);',
  10861. '$mod.b = $mod.vP !== null;',
  10862. '$mod.b = null !== $mod.vP;',
  10863. '$mod.b = !rtl.eqCallback($mod.vP,$mod.vQ);',
  10864. '$mod.b = !rtl.eqCallback($mod.vP, $mod.DoIt);',
  10865. '$mod.b = !rtl.eqCallback($mod.DoIt, $mod.vP);',
  10866. '$mod.b = $mod.vP != null;',
  10867. 'if ($mod.vP != null) ;',
  10868. '']));
  10869. end;
  10870. procedure TTestModule.TestProcType_FunctionFPC;
  10871. begin
  10872. StartProgram(false);
  10873. Add('type');
  10874. Add(' TFuncInt = function(vA: longint = 1): longint;');
  10875. Add('function DoIt(vI: longint): longint;');
  10876. Add('begin end;');
  10877. Add('var');
  10878. Add(' b: boolean;');
  10879. Add(' vP, vQ: tfuncint;');
  10880. Add('begin');
  10881. Add(' vp:=nil;');
  10882. Add(' vp:=vp;');
  10883. Add(' vp:=@doit;'); // ok in fpc and delphi
  10884. //Add(' vp:=doit;'); // illegal in fpc, ok in delphi
  10885. Add(' vp;'); // ok in fpc and delphi
  10886. Add(' vp();');
  10887. Add(' vp(2);');
  10888. Add(' b:=vp=nil;'); // ok in fpc, illegal in delphi
  10889. Add(' b:=nil=vp;'); // ok in fpc, illegal in delphi
  10890. Add(' b:=vp=vq;'); // in fpc compare proctypes, in delphi compare results
  10891. Add(' b:=vp=@doit;'); // ok in fpc, illegal in delphi
  10892. Add(' b:=@doit=vp;'); // ok in fpc, illegal in delphi
  10893. //Add(' b:=vp=3;'); // illegal in fpc, ok in delphi
  10894. Add(' b:=4=vp;'); // illegal in fpc, ok in delphi
  10895. Add(' b:=vp<>nil;'); // ok in fpc, illegal in delphi
  10896. Add(' b:=nil<>vp;'); // ok in fpc, illegal in delphi
  10897. Add(' b:=vp<>vq;'); // in fpc compare proctypes, in delphi compare results
  10898. Add(' b:=vp<>@doit;'); // ok in fpc, illegal in delphi
  10899. Add(' b:=@doit<>vp;'); // ok in fpc, illegal in delphi
  10900. //Add(' b:=vp<>5;'); // illegal in fpc, ok in delphi
  10901. Add(' b:=6<>vp;'); // illegal in fpc, ok in delphi
  10902. Add(' b:=Assigned(vp);');
  10903. //Add(' doit(vp);'); // illegal in fpc, ok in delphi
  10904. Add(' doit(vp());'); // ok in fpc and delphi
  10905. Add(' doit(vp(2));'); // ok in fpc and delphi
  10906. ConvertProgram;
  10907. CheckSource('TestProcType_FunctionFPC',
  10908. LinesToStr([ // statements
  10909. 'this.DoIt = function(vI) {',
  10910. ' var Result = 0;',
  10911. ' return Result;',
  10912. '};',
  10913. 'this.b = false;',
  10914. 'this.vP = null;',
  10915. 'this.vQ = null;'
  10916. ]),
  10917. LinesToStr([ // $mod.$main
  10918. '$mod.vP = null;',
  10919. '$mod.vP = $mod.vP;',
  10920. '$mod.vP = $mod.DoIt;',
  10921. '$mod.vP(1);',
  10922. '$mod.vP(1);',
  10923. '$mod.vP(2);',
  10924. '$mod.b = $mod.vP === null;',
  10925. '$mod.b = null === $mod.vP;',
  10926. '$mod.b = rtl.eqCallback($mod.vP,$mod.vQ);',
  10927. '$mod.b = rtl.eqCallback($mod.vP, $mod.DoIt);',
  10928. '$mod.b = rtl.eqCallback($mod.DoIt, $mod.vP);',
  10929. '$mod.b = 4 === $mod.vP(1);',
  10930. '$mod.b = $mod.vP !== null;',
  10931. '$mod.b = null !== $mod.vP;',
  10932. '$mod.b = !rtl.eqCallback($mod.vP,$mod.vQ);',
  10933. '$mod.b = !rtl.eqCallback($mod.vP, $mod.DoIt);',
  10934. '$mod.b = !rtl.eqCallback($mod.DoIt, $mod.vP);',
  10935. '$mod.b = 6 !== $mod.vP(1);',
  10936. '$mod.b = $mod.vP != null;',
  10937. '$mod.DoIt($mod.vP(1));',
  10938. '$mod.DoIt($mod.vP(2));',
  10939. '']));
  10940. end;
  10941. procedure TTestModule.TestProcType_FunctionDelphi;
  10942. begin
  10943. StartProgram(false);
  10944. Add('{$mode Delphi}');
  10945. Add('type');
  10946. Add(' TFuncInt = function(vA: longint = 1): longint;');
  10947. Add('function DoIt(vI: longint): longint;');
  10948. Add('begin end;');
  10949. Add('var');
  10950. Add(' b: boolean;');
  10951. Add(' vP, vQ: tfuncint;');
  10952. Add('begin');
  10953. Add(' vp:=nil;');
  10954. Add(' vp:=vp;');
  10955. Add(' vp:=@doit;'); // ok in fpc and delphi
  10956. Add(' vp:=doit;'); // illegal in fpc, ok in delphi
  10957. Add(' vp;'); // ok in fpc and delphi
  10958. Add(' vp();');
  10959. Add(' vp(2);');
  10960. //Add(' b:=vp=nil;'); // ok in fpc, illegal in delphi
  10961. //Add(' b:=nil=vp;'); // ok in fpc, illegal in delphi
  10962. Add(' b:=vp=vq;'); // in fpc compare proctypes, in delphi compare results
  10963. //Add(' b:=vp=@doit;'); // ok in fpc, illegal in delphi
  10964. //Add(' b:=@doit=vp;'); // ok in fpc, illegal in delphi
  10965. Add(' b:=vp=3;'); // illegal in fpc, ok in delphi
  10966. Add(' b:=4=vp;'); // illegal in fpc, ok in delphi
  10967. //Add(' b:=vp<>nil;'); // ok in fpc, illegal in delphi
  10968. //Add(' b:=nil<>vp;'); // ok in fpc, illegal in delphi
  10969. Add(' b:=vp<>vq;'); // in fpc compare proctypes, in delphi compare results
  10970. //Add(' b:=vp<>@doit;'); // ok in fpc, illegal in delphi
  10971. //Add(' b:=@doit<>vp;'); // ok in fpc, illegal in delphi
  10972. Add(' b:=vp<>5;'); // illegal in fpc, ok in delphi
  10973. Add(' b:=6<>vp;'); // illegal in fpc, ok in delphi
  10974. Add(' b:=Assigned(vp);');
  10975. Add(' doit(vp);'); // illegal in fpc, ok in delphi
  10976. Add(' doit(vp());'); // ok in fpc and delphi
  10977. Add(' doit(vp(2));'); // ok in fpc and delphi *)
  10978. ConvertProgram;
  10979. CheckSource('TestProcType_FunctionDelphi',
  10980. LinesToStr([ // statements
  10981. 'this.DoIt = function(vI) {',
  10982. ' var Result = 0;',
  10983. ' return Result;',
  10984. '};',
  10985. 'this.b = false;',
  10986. 'this.vP = null;',
  10987. 'this.vQ = null;'
  10988. ]),
  10989. LinesToStr([ // $mod.$main
  10990. '$mod.vP = null;',
  10991. '$mod.vP = $mod.vP;',
  10992. '$mod.vP = $mod.DoIt;',
  10993. '$mod.vP = $mod.DoIt;',
  10994. '$mod.vP(1);',
  10995. '$mod.vP(1);',
  10996. '$mod.vP(2);',
  10997. '$mod.b = $mod.vP(1) === $mod.vQ(1);',
  10998. '$mod.b = $mod.vP(1) === 3;',
  10999. '$mod.b = 4 === $mod.vP(1);',
  11000. '$mod.b = $mod.vP(1) !== $mod.vQ(1);',
  11001. '$mod.b = $mod.vP(1) !== 5;',
  11002. '$mod.b = 6 !== $mod.vP(1);',
  11003. '$mod.b = $mod.vP != null;',
  11004. '$mod.DoIt($mod.vP(1));',
  11005. '$mod.DoIt($mod.vP(1));',
  11006. '$mod.DoIt($mod.vP(2));',
  11007. '']));
  11008. end;
  11009. procedure TTestModule.TestProcType_ProcedureDelphi;
  11010. begin
  11011. StartProgram(false);
  11012. Add('{$mode Delphi}');
  11013. Add('type');
  11014. Add(' TProc = procedure;');
  11015. Add('procedure DoIt;');
  11016. Add('begin end;');
  11017. Add('var');
  11018. Add(' b: boolean;');
  11019. Add(' vP, vQ: tproc;');
  11020. Add('begin');
  11021. Add(' vp:=nil;');
  11022. Add(' vp:=vp;');
  11023. Add(' vp:=vq;');
  11024. 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
  11025. Add(' vp:=doit;'); // illegal in fpc, ok in delphi
  11026. //Add(' vp:=@doit;'); // illegal in fpc, ok in delphi (because Delphi treats @F as Pointer), not supported by resolver
  11027. Add(' vp;'); // ok in fpc and delphi
  11028. Add(' vp();');
  11029. // equal
  11030. //Add(' b:=vp=nil;'); // ok in fpc, illegal in delphi
  11031. Add(' b:=@@vp=nil;'); // ok in fpc delphi mode, ok in delphi
  11032. //Add(' b:=nil=vp;'); // ok in fpc, illegal in delphi
  11033. Add(' b:=nil=@@vp;'); // ok in fpc delphi mode, ok in delphi
  11034. Add(' b:=@@vp=@@vq;'); // ok in fpc delphi mode, ok in Delphi
  11035. //Add(' b:=vp=vq;'); // in fpc compare proctypes, in delphi compare results
  11036. //Add(' b:=vp=@doit;'); // ok in fpc, illegal in delphi
  11037. Add(' b:=@@vp=@doit;'); // ok in fpc delphi mode, ok in delphi
  11038. //Add(' b:=@doit=vp;'); // ok in fpc, illegal in delphi
  11039. Add(' b:=@doit=@@vp;'); // ok in fpc delphi mode, ok in delphi
  11040. // unequal
  11041. //Add(' b:=vp<>nil;'); // ok in fpc, illegal in delphi
  11042. Add(' b:=@@vp<>nil;'); // ok in fpc mode delphi, ok in delphi
  11043. //Add(' b:=nil<>vp;'); // ok in fpc, illegal in delphi
  11044. Add(' b:=nil<>@@vp;'); // ok in fpc mode delphi, ok in delphi
  11045. //Add(' b:=vp<>vq;'); // in fpc compare proctypes, in delphi compare results
  11046. Add(' b:=@@vp<>@@vq;'); // ok in fpc mode delphi, ok in delphi
  11047. //Add(' b:=vp<>@doit;'); // ok in fpc, illegal in delphi
  11048. Add(' b:=@@vp<>@doit;'); // ok in fpc mode delphi, illegal in delphi
  11049. //Add(' b:=@doit<>vp;'); // ok in fpc, illegal in delphi
  11050. Add(' b:=@doit<>@@vp;'); // ok in fpc mode delphi, illegal in delphi
  11051. Add(' b:=Assigned(vp);');
  11052. ConvertProgram;
  11053. CheckSource('TestProcType_ProcedureDelphi',
  11054. LinesToStr([ // statements
  11055. 'this.DoIt = function() {',
  11056. '};',
  11057. 'this.b = false;',
  11058. 'this.vP = null;',
  11059. 'this.vQ = null;'
  11060. ]),
  11061. LinesToStr([ // $mod.$main
  11062. '$mod.vP = null;',
  11063. '$mod.vP = $mod.vP;',
  11064. '$mod.vP = $mod.vQ;',
  11065. '$mod.vP = $mod.DoIt;',
  11066. '$mod.vP = $mod.DoIt;',
  11067. '$mod.vP();',
  11068. '$mod.vP();',
  11069. '$mod.b = $mod.vP === null;',
  11070. '$mod.b = null === $mod.vP;',
  11071. '$mod.b = rtl.eqCallback($mod.vP, $mod.vQ);',
  11072. '$mod.b = rtl.eqCallback($mod.vP, $mod.DoIt);',
  11073. '$mod.b = rtl.eqCallback($mod.DoIt, $mod.vP);',
  11074. '$mod.b = $mod.vP !== null;',
  11075. '$mod.b = null !== $mod.vP;',
  11076. '$mod.b = !rtl.eqCallback($mod.vP, $mod.vQ);',
  11077. '$mod.b = !rtl.eqCallback($mod.vP, $mod.DoIt);',
  11078. '$mod.b = !rtl.eqCallback($mod.DoIt, $mod.vP);',
  11079. '$mod.b = $mod.vP != null;',
  11080. '']));
  11081. end;
  11082. procedure TTestModule.TestProcType_AsParam;
  11083. begin
  11084. StartProgram(false);
  11085. Add('type');
  11086. Add(' TFuncInt = function(vA: longint = 1): longint;');
  11087. Add('procedure DoIt(vG: tfuncint; const vH: tfuncint; var vI: tfuncint);');
  11088. Add('var vJ: tfuncint;');
  11089. Add('begin');
  11090. Add(' vg:=vg;');
  11091. Add(' vj:=vh;');
  11092. Add(' vi:=vi;');
  11093. Add(' doit(vg,vg,vg);');
  11094. Add(' doit(vh,vh,vj);');
  11095. Add(' doit(vi,vi,vi);');
  11096. Add(' doit(vj,vj,vj);');
  11097. Add('end;');
  11098. Add('var i: tfuncint;');
  11099. Add('begin');
  11100. Add(' doit(i,i,i);');
  11101. ConvertProgram;
  11102. CheckSource('TestProcType_AsParam',
  11103. LinesToStr([ // statements
  11104. 'this.DoIt = function (vG,vH,vI) {',
  11105. ' var vJ = null;',
  11106. ' vG = vG;',
  11107. ' vJ = vH;',
  11108. ' vI.set(vI.get());',
  11109. ' $mod.DoIt(vG, vG, {',
  11110. ' get: function () {',
  11111. ' return vG;',
  11112. ' },',
  11113. ' set: function (v) {',
  11114. ' vG = v;',
  11115. ' }',
  11116. ' });',
  11117. ' $mod.DoIt(vH, vH, {',
  11118. ' get: function () {',
  11119. ' return vJ;',
  11120. ' },',
  11121. ' set: function (v) {',
  11122. ' vJ = v;',
  11123. ' }',
  11124. ' });',
  11125. ' $mod.DoIt(vI.get(), vI.get(), vI);',
  11126. ' $mod.DoIt(vJ, vJ, {',
  11127. ' get: function () {',
  11128. ' return vJ;',
  11129. ' },',
  11130. ' set: function (v) {',
  11131. ' vJ = v;',
  11132. ' }',
  11133. ' });',
  11134. '};',
  11135. 'this.i = null;'
  11136. ]),
  11137. LinesToStr([
  11138. '$mod.DoIt($mod.i,$mod.i,{',
  11139. ' p: $mod,',
  11140. ' get: function () {',
  11141. ' return this.p.i;',
  11142. ' },',
  11143. ' set: function (v) {',
  11144. ' this.p.i = v;',
  11145. ' }',
  11146. '});'
  11147. ]));
  11148. end;
  11149. procedure TTestModule.TestProcType_MethodFPC;
  11150. begin
  11151. StartProgram(false);
  11152. Add('type');
  11153. Add(' TFuncInt = function(vA: longint = 1): longint of object;');
  11154. Add(' TObject = class');
  11155. Add(' function DoIt(vA: longint = 1): longint;');
  11156. Add(' end;');
  11157. Add('function TObject.DoIt(vA: longint = 1): longint;');
  11158. Add('begin');
  11159. Add('end;');
  11160. Add('var');
  11161. Add(' Obj: TObject;');
  11162. Add(' vP: tfuncint;');
  11163. Add(' b: boolean;');
  11164. Add('begin');
  11165. Add(' vp:[email protected];'); // ok in fpc and delphi
  11166. //Add(' vp:=obj.doit;'); // illegal in fpc, ok in delphi
  11167. Add(' vp;'); // ok in fpc and delphi
  11168. Add(' vp();');
  11169. Add(' vp(2);');
  11170. Add(' b:[email protected];'); // ok in fpc, illegal in delphi
  11171. Add(' b:[email protected]=vp;'); // ok in fpc, illegal in delphi
  11172. Add(' b:=vp<>@obj.doit;'); // ok in fpc, illegal in delphi
  11173. Add(' b:[email protected]<>vp;'); // ok in fpc, illegal in delphi
  11174. ConvertProgram;
  11175. CheckSource('TestProcType_MethodFPC',
  11176. LinesToStr([ // statements
  11177. 'rtl.createClass($mod, "TObject", null, function () {',
  11178. ' this.$init = function () {',
  11179. ' };',
  11180. ' this.$final = function () {',
  11181. ' };',
  11182. ' this.DoIt = function (vA) {',
  11183. ' var Result = 0;',
  11184. ' return Result;',
  11185. ' };',
  11186. '});',
  11187. 'this.Obj = null;',
  11188. 'this.vP = null;',
  11189. 'this.b = false;'
  11190. ]),
  11191. LinesToStr([
  11192. '$mod.vP = rtl.createCallback($mod.Obj, "DoIt");',
  11193. '$mod.vP(1);',
  11194. '$mod.vP(1);',
  11195. '$mod.vP(2);',
  11196. '$mod.b = rtl.eqCallback($mod.vP, rtl.createCallback($mod.Obj, "DoIt"));',
  11197. '$mod.b = rtl.eqCallback(rtl.createCallback($mod.Obj, "DoIt"), $mod.vP);',
  11198. '$mod.b = !rtl.eqCallback($mod.vP, rtl.createCallback($mod.Obj, "DoIt"));',
  11199. '$mod.b = !rtl.eqCallback(rtl.createCallback($mod.Obj, "DoIt"), $mod.vP);',
  11200. '']));
  11201. end;
  11202. procedure TTestModule.TestProcType_MethodDelphi;
  11203. begin
  11204. StartProgram(false);
  11205. Add('{$mode delphi}');
  11206. Add('type');
  11207. Add(' TFuncInt = function(vA: longint = 1): longint of object;');
  11208. Add(' TObject = class');
  11209. Add(' function DoIt(vA: longint = 1): longint;');
  11210. Add(' end;');
  11211. Add('function TObject.DoIt(vA: longint = 1): longint;');
  11212. Add('begin');
  11213. Add('end;');
  11214. Add('var');
  11215. Add(' Obj: TObject;');
  11216. Add(' vP: tfuncint;');
  11217. Add(' b: boolean;');
  11218. Add('begin');
  11219. Add(' vp:[email protected];'); // ok in fpc and delphi
  11220. Add(' vp:=obj.doit;'); // illegal in fpc, ok in delphi
  11221. Add(' vp;'); // ok in fpc and delphi
  11222. Add(' vp();');
  11223. Add(' vp(2);');
  11224. //Add(' b:[email protected];'); // ok in fpc, illegal in delphi
  11225. //Add(' b:[email protected]=vp;'); // ok in fpc, illegal in delphi
  11226. //Add(' b:=vp<>@obj.doit;'); // ok in fpc, illegal in delphi
  11227. //Add(' b:[email protected]<>vp;'); // ok in fpc, illegal in delphi
  11228. ConvertProgram;
  11229. CheckSource('TestProcType_MethodDelphi',
  11230. LinesToStr([ // statements
  11231. 'rtl.createClass($mod, "TObject", null, function () {',
  11232. ' this.$init = function () {',
  11233. ' };',
  11234. ' this.$final = function () {',
  11235. ' };',
  11236. ' this.DoIt = function (vA) {',
  11237. ' var Result = 0;',
  11238. ' return Result;',
  11239. ' };',
  11240. '});',
  11241. 'this.Obj = null;',
  11242. 'this.vP = null;',
  11243. 'this.b = false;'
  11244. ]),
  11245. LinesToStr([
  11246. '$mod.vP = rtl.createCallback($mod.Obj, "DoIt");',
  11247. '$mod.vP = rtl.createCallback($mod.Obj, "DoIt");',
  11248. '$mod.vP(1);',
  11249. '$mod.vP(1);',
  11250. '$mod.vP(2);',
  11251. '']));
  11252. end;
  11253. procedure TTestModule.TestProcType_PropertyFPC;
  11254. begin
  11255. StartProgram(false);
  11256. Add('type');
  11257. Add(' TFuncInt = function(vA: longint = 1): longint of object;');
  11258. Add(' TObject = class');
  11259. Add(' FOnFoo: TFuncInt;');
  11260. Add(' function DoIt(vA: longint = 1): longint;');
  11261. Add(' function GetFoo: TFuncInt;');
  11262. Add(' procedure SetFoo(const Value: TFuncInt);');
  11263. Add(' function GetEvents(Index: longint): TFuncInt;');
  11264. Add(' procedure SetEvents(Index: longint; const Value: TFuncInt);');
  11265. Add(' property OnFoo: TFuncInt read FOnFoo write FOnFoo;');
  11266. Add(' property OnBar: TFuncInt read GetFoo write SetFoo;');
  11267. Add(' property Events[Index: longint]: TFuncInt read GetEvents write SetEvents; default;');
  11268. Add(' end;');
  11269. Add('function tobject.doit(va: longint = 1): longint; begin end;');
  11270. Add('function tobject.getfoo: tfuncint; begin end;');
  11271. Add('procedure tobject.setfoo(const value: tfuncint); begin end;');
  11272. Add('function tobject.getevents(index: longint): tfuncint; begin end;');
  11273. Add('procedure tobject.setevents(index: longint; const value: tfuncint); begin end;');
  11274. Add('var');
  11275. Add(' Obj: TObject;');
  11276. Add(' vP: tfuncint;');
  11277. Add(' b: boolean;');
  11278. Add('begin');
  11279. Add(' obj.onfoo:=nil;');
  11280. Add(' obj.onbar:=nil;');
  11281. Add(' obj.events[1]:=nil;');
  11282. Add(' obj.onfoo:=obj.onfoo;');
  11283. Add(' obj.onbar:=obj.onbar;');
  11284. Add(' obj.events[2]:=obj.events[3];');
  11285. Add(' obj.onfoo:[email protected];');
  11286. Add(' obj.onbar:[email protected];');
  11287. Add(' obj.events[4]:[email protected];');
  11288. //Add(' obj.onfoo:=obj.doit;'); // delphi
  11289. //Add(' obj.onbar:=obj.doit;'); // delphi
  11290. //Add(' obj.events[4]:=obj.doit;'); // delphi
  11291. Add(' obj.onfoo;');
  11292. Add(' obj.onbar;');
  11293. //Add(' obj.events[5];'); ToDo in pasresolver
  11294. Add(' obj.onfoo();');
  11295. Add(' obj.onbar();');
  11296. Add(' obj.events[6]();');
  11297. Add(' b:=obj.onfoo=nil;');
  11298. Add(' b:=obj.onbar=nil;');
  11299. Add(' b:=obj.events[7]=nil;');
  11300. Add(' b:=obj.onfoo<>nil;');
  11301. Add(' b:=obj.onbar<>nil;');
  11302. Add(' b:=obj.events[8]<>nil;');
  11303. Add(' b:=obj.onfoo=vp;');
  11304. Add(' b:=obj.onbar=vp;');
  11305. Add(' b:=obj.events[9]=vp;');
  11306. Add(' b:=obj.onfoo=obj.onfoo;');
  11307. Add(' b:=obj.onbar=obj.onfoo;');
  11308. Add(' b:=obj.events[10]=obj.onfoo;');
  11309. Add(' b:=obj.onfoo<>obj.onfoo;');
  11310. Add(' b:=obj.onbar<>obj.onfoo;');
  11311. Add(' b:=obj.events[11]<>obj.onfoo;');
  11312. Add(' b:[email protected];');
  11313. Add(' b:[email protected];');
  11314. Add(' b:=obj.events[12][email protected];');
  11315. Add(' b:=obj.onfoo<>@obj.doit;');
  11316. Add(' b:=obj.onbar<>@obj.doit;');
  11317. Add(' b:=obj.events[12]<>@obj.doit;');
  11318. Add(' b:=Assigned(obj.onfoo);');
  11319. Add(' b:=Assigned(obj.onbar);');
  11320. Add(' b:=Assigned(obj.events[13]);');
  11321. ConvertProgram;
  11322. CheckSource('TestProcType_PropertyFPC',
  11323. LinesToStr([ // statements
  11324. 'rtl.createClass($mod, "TObject", null, function () {',
  11325. ' this.$init = function () {',
  11326. ' this.FOnFoo = null;',
  11327. ' };',
  11328. ' this.$final = function () {',
  11329. ' this.FOnFoo = undefined;',
  11330. ' };',
  11331. ' this.DoIt = function (vA) {',
  11332. ' var Result = 0;',
  11333. ' return Result;',
  11334. ' };',
  11335. 'this.GetFoo = function () {',
  11336. ' var Result = null;',
  11337. ' return Result;',
  11338. '};',
  11339. 'this.SetFoo = function (Value) {',
  11340. '};',
  11341. 'this.GetEvents = function (Index) {',
  11342. ' var Result = null;',
  11343. ' return Result;',
  11344. '};',
  11345. 'this.SetEvents = function (Index, Value) {',
  11346. '};',
  11347. '});',
  11348. 'this.Obj = null;',
  11349. 'this.vP = null;',
  11350. 'this.b = false;'
  11351. ]),
  11352. LinesToStr([
  11353. '$mod.Obj.FOnFoo = null;',
  11354. '$mod.Obj.SetFoo(null);',
  11355. '$mod.Obj.SetEvents(1, null);',
  11356. '$mod.Obj.FOnFoo = $mod.Obj.FOnFoo;',
  11357. '$mod.Obj.SetFoo($mod.Obj.GetFoo());',
  11358. '$mod.Obj.SetEvents(2, $mod.Obj.GetEvents(3));',
  11359. '$mod.Obj.FOnFoo = rtl.createCallback($mod.Obj, "DoIt");',
  11360. '$mod.Obj.SetFoo(rtl.createCallback($mod.Obj, "DoIt"));',
  11361. '$mod.Obj.SetEvents(4, rtl.createCallback($mod.Obj, "DoIt"));',
  11362. '$mod.Obj.FOnFoo(1);',
  11363. '$mod.Obj.GetFoo();',
  11364. '$mod.Obj.FOnFoo(1);',
  11365. '$mod.Obj.GetFoo()(1);',
  11366. '$mod.Obj.GetEvents(6)(1);',
  11367. '$mod.b = $mod.Obj.FOnFoo === null;',
  11368. '$mod.b = $mod.Obj.GetFoo() === null;',
  11369. '$mod.b = $mod.Obj.GetEvents(7) === null;',
  11370. '$mod.b = $mod.Obj.FOnFoo !== null;',
  11371. '$mod.b = $mod.Obj.GetFoo() !== null;',
  11372. '$mod.b = $mod.Obj.GetEvents(8) !== null;',
  11373. '$mod.b = rtl.eqCallback($mod.Obj.FOnFoo, $mod.vP);',
  11374. '$mod.b = rtl.eqCallback($mod.Obj.GetFoo(), $mod.vP);',
  11375. '$mod.b = rtl.eqCallback($mod.Obj.GetEvents(9), $mod.vP);',
  11376. '$mod.b = rtl.eqCallback($mod.Obj.FOnFoo, $mod.Obj.FOnFoo);',
  11377. '$mod.b = rtl.eqCallback($mod.Obj.GetFoo(), $mod.Obj.FOnFoo);',
  11378. '$mod.b = rtl.eqCallback($mod.Obj.GetEvents(10), $mod.Obj.FOnFoo);',
  11379. '$mod.b = !rtl.eqCallback($mod.Obj.FOnFoo, $mod.Obj.FOnFoo);',
  11380. '$mod.b = !rtl.eqCallback($mod.Obj.GetFoo(), $mod.Obj.FOnFoo);',
  11381. '$mod.b = !rtl.eqCallback($mod.Obj.GetEvents(11), $mod.Obj.FOnFoo);',
  11382. '$mod.b = rtl.eqCallback($mod.Obj.FOnFoo, rtl.createCallback($mod.Obj, "DoIt"));',
  11383. '$mod.b = rtl.eqCallback($mod.Obj.GetFoo(), rtl.createCallback($mod.Obj, "DoIt"));',
  11384. '$mod.b = rtl.eqCallback($mod.Obj.GetEvents(12), rtl.createCallback($mod.Obj, "DoIt"));',
  11385. '$mod.b = !rtl.eqCallback($mod.Obj.FOnFoo, rtl.createCallback($mod.Obj, "DoIt"));',
  11386. '$mod.b = !rtl.eqCallback($mod.Obj.GetFoo(), rtl.createCallback($mod.Obj, "DoIt"));',
  11387. '$mod.b = !rtl.eqCallback($mod.Obj.GetEvents(12), rtl.createCallback($mod.Obj, "DoIt"));',
  11388. '$mod.b = $mod.Obj.FOnFoo != null;',
  11389. '$mod.b = $mod.Obj.GetFoo() != null;',
  11390. '$mod.b = $mod.Obj.GetEvents(13) != null;',
  11391. '']));
  11392. end;
  11393. procedure TTestModule.TestProcType_PropertyDelphi;
  11394. begin
  11395. StartProgram(false);
  11396. Add('{$mode delphi}');
  11397. Add('type');
  11398. Add(' TFuncInt = function(vA: longint = 1): longint of object;');
  11399. Add(' TObject = class');
  11400. Add(' FOnFoo: TFuncInt;');
  11401. Add(' function DoIt(vA: longint = 1): longint;');
  11402. Add(' function GetFoo: TFuncInt;');
  11403. Add(' procedure SetFoo(const Value: TFuncInt);');
  11404. Add(' function GetEvents(Index: longint): TFuncInt;');
  11405. Add(' procedure SetEvents(Index: longint; const Value: TFuncInt);');
  11406. Add(' property OnFoo: TFuncInt read FOnFoo write FOnFoo;');
  11407. Add(' property OnBar: TFuncInt read GetFoo write SetFoo;');
  11408. Add(' property Events[Index: longint]: TFuncInt read GetEvents write SetEvents; default;');
  11409. Add(' end;');
  11410. Add('function tobject.doit(va: longint = 1): longint; begin end;');
  11411. Add('function tobject.getfoo: tfuncint; begin end;');
  11412. Add('procedure tobject.setfoo(const value: tfuncint); begin end;');
  11413. Add('function tobject.getevents(index: longint): tfuncint; begin end;');
  11414. Add('procedure tobject.setevents(index: longint; const value: tfuncint); begin end;');
  11415. Add('var');
  11416. Add(' Obj: TObject;');
  11417. Add(' vP: tfuncint;');
  11418. Add(' b: boolean;');
  11419. Add('begin');
  11420. Add(' obj.onfoo:=nil;');
  11421. Add(' obj.onbar:=nil;');
  11422. Add(' obj.events[1]:=nil;');
  11423. Add(' obj.onfoo:=obj.onfoo;');
  11424. Add(' obj.onbar:=obj.onbar;');
  11425. Add(' obj.events[2]:=obj.events[3];');
  11426. Add(' obj.onfoo:[email protected];');
  11427. Add(' obj.onbar:[email protected];');
  11428. Add(' obj.events[4]:[email protected];');
  11429. Add(' obj.onfoo:=obj.doit;'); // delphi
  11430. Add(' obj.onbar:=obj.doit;'); // delphi
  11431. Add(' obj.events[4]:=obj.doit;'); // delphi
  11432. Add(' obj.onfoo;');
  11433. Add(' obj.onbar;');
  11434. //Add(' obj.events[5];'); ToDo in pasresolver
  11435. Add(' obj.onfoo();');
  11436. Add(' obj.onbar();');
  11437. Add(' obj.events[6]();');
  11438. //Add(' b:=obj.onfoo=nil;'); // fpc
  11439. //Add(' b:=obj.onbar=nil;'); // fpc
  11440. //Add(' b:=obj.events[7]=nil;'); // fpc
  11441. //Add(' b:=obj.onfoo<>nil;'); // fpc
  11442. //Add(' b:=obj.onbar<>nil;'); // fpc
  11443. //Add(' b:=obj.events[8]<>nil;'); // fpc
  11444. Add(' b:=obj.onfoo=vp;');
  11445. Add(' b:=obj.onbar=vp;');
  11446. //Add(' b:=obj.events[9]=vp;'); ToDo in pasresolver
  11447. Add(' b:=obj.onfoo=obj.onfoo;');
  11448. Add(' b:=obj.onbar=obj.onfoo;');
  11449. //Add(' b:=obj.events[10]=obj.onfoo;'); // ToDo in pasresolver
  11450. Add(' b:=obj.onfoo<>obj.onfoo;');
  11451. Add(' b:=obj.onbar<>obj.onfoo;');
  11452. //Add(' b:=obj.events[11]<>obj.onfoo;'); // ToDo in pasresolver
  11453. //Add(' b:[email protected];'); // fpc
  11454. //Add(' b:[email protected];'); // fpc
  11455. //Add(' b:=obj.events[12][email protected];'); // fpc
  11456. //Add(' b:=obj.onfoo<>@obj.doit;'); // fpc
  11457. //Add(' b:=obj.onbar<>@obj.doit;'); // fpc
  11458. //Add(' b:=obj.events[12]<>@obj.doit;'); // fpc
  11459. Add(' b:=Assigned(obj.onfoo);');
  11460. Add(' b:=Assigned(obj.onbar);');
  11461. Add(' b:=Assigned(obj.events[13]);');
  11462. ConvertProgram;
  11463. CheckSource('TestProcType_PropertyDelphi',
  11464. LinesToStr([ // statements
  11465. 'rtl.createClass($mod, "TObject", null, function () {',
  11466. ' this.$init = function () {',
  11467. ' this.FOnFoo = null;',
  11468. ' };',
  11469. ' this.$final = function () {',
  11470. ' this.FOnFoo = undefined;',
  11471. ' };',
  11472. ' this.DoIt = function (vA) {',
  11473. ' var Result = 0;',
  11474. ' return Result;',
  11475. ' };',
  11476. 'this.GetFoo = function () {',
  11477. ' var Result = null;',
  11478. ' return Result;',
  11479. '};',
  11480. 'this.SetFoo = function (Value) {',
  11481. '};',
  11482. 'this.GetEvents = function (Index) {',
  11483. ' var Result = null;',
  11484. ' return Result;',
  11485. '};',
  11486. 'this.SetEvents = function (Index, Value) {',
  11487. '};',
  11488. '});',
  11489. 'this.Obj = null;',
  11490. 'this.vP = null;',
  11491. 'this.b = false;'
  11492. ]),
  11493. LinesToStr([
  11494. '$mod.Obj.FOnFoo = null;',
  11495. '$mod.Obj.SetFoo(null);',
  11496. '$mod.Obj.SetEvents(1, null);',
  11497. '$mod.Obj.FOnFoo = $mod.Obj.FOnFoo;',
  11498. '$mod.Obj.SetFoo($mod.Obj.GetFoo());',
  11499. '$mod.Obj.SetEvents(2, $mod.Obj.GetEvents(3));',
  11500. '$mod.Obj.FOnFoo = rtl.createCallback($mod.Obj, "DoIt");',
  11501. '$mod.Obj.SetFoo(rtl.createCallback($mod.Obj, "DoIt"));',
  11502. '$mod.Obj.SetEvents(4, rtl.createCallback($mod.Obj, "DoIt"));',
  11503. '$mod.Obj.FOnFoo = rtl.createCallback($mod.Obj, "DoIt");',
  11504. '$mod.Obj.SetFoo(rtl.createCallback($mod.Obj, "DoIt"));',
  11505. '$mod.Obj.SetEvents(4, rtl.createCallback($mod.Obj, "DoIt"));',
  11506. '$mod.Obj.FOnFoo(1);',
  11507. '$mod.Obj.GetFoo();',
  11508. '$mod.Obj.FOnFoo(1);',
  11509. '$mod.Obj.GetFoo()(1);',
  11510. '$mod.Obj.GetEvents(6)(1);',
  11511. '$mod.b = $mod.Obj.FOnFoo(1) === $mod.vP(1);',
  11512. '$mod.b = $mod.Obj.GetFoo() === $mod.vP(1);',
  11513. '$mod.b = $mod.Obj.FOnFoo(1) === $mod.Obj.FOnFoo(1);',
  11514. '$mod.b = $mod.Obj.GetFoo() === $mod.Obj.FOnFoo(1);',
  11515. '$mod.b = $mod.Obj.FOnFoo(1) !== $mod.Obj.FOnFoo(1);',
  11516. '$mod.b = $mod.Obj.GetFoo() !== $mod.Obj.FOnFoo(1);',
  11517. '$mod.b = $mod.Obj.FOnFoo != null;',
  11518. '$mod.b = $mod.Obj.GetFoo() != null;',
  11519. '$mod.b = $mod.Obj.GetEvents(13) != null;',
  11520. '']));
  11521. end;
  11522. procedure TTestModule.TestProcType_WithClassInstDoPropertyFPC;
  11523. begin
  11524. StartProgram(false);
  11525. Add('type');
  11526. Add(' TFuncInt = function(vA: longint = 1): longint of object;');
  11527. Add(' TObject = class');
  11528. Add(' FOnFoo: TFuncInt;');
  11529. Add(' function DoIt(vA: longint = 1): longint;');
  11530. Add(' function GetFoo: TFuncInt;');
  11531. Add(' procedure SetFoo(const Value: TFuncInt);');
  11532. Add(' property OnFoo: TFuncInt read FOnFoo write FOnFoo;');
  11533. Add(' property OnBar: TFuncInt read GetFoo write SetFoo;');
  11534. Add(' end;');
  11535. Add('function tobject.doit(va: longint = 1): longint; begin end;');
  11536. Add('function tobject.getfoo: tfuncint; begin end;');
  11537. Add('procedure tobject.setfoo(const value: tfuncint); begin end;');
  11538. Add('var');
  11539. Add(' Obj: TObject;');
  11540. Add(' vP: tfuncint;');
  11541. Add(' b: boolean;');
  11542. Add('begin');
  11543. Add('with obj do begin');
  11544. Add(' fonfoo:=nil;');
  11545. Add(' onfoo:=nil;');
  11546. Add(' onbar:=nil;');
  11547. Add(' fonfoo:=fonfoo;');
  11548. Add(' onfoo:=onfoo;');
  11549. Add(' onbar:=onbar;');
  11550. Add(' fonfoo:=@doit;');
  11551. Add(' onfoo:=@doit;');
  11552. Add(' onbar:=@doit;');
  11553. //Add(' fonfoo:=doit;'); // delphi
  11554. //Add(' onfoo:=doit;'); // delphi
  11555. //Add(' onbar:=doit;'); // delphi
  11556. Add(' fonfoo;');
  11557. Add(' onfoo;');
  11558. Add(' onbar;');
  11559. Add(' fonfoo();');
  11560. Add(' onfoo();');
  11561. Add(' onbar();');
  11562. Add(' b:=fonfoo=nil;');
  11563. Add(' b:=onfoo=nil;');
  11564. Add(' b:=onbar=nil;');
  11565. Add(' b:=fonfoo<>nil;');
  11566. Add(' b:=onfoo<>nil;');
  11567. Add(' b:=onbar<>nil;');
  11568. Add(' b:=fonfoo=vp;');
  11569. Add(' b:=onfoo=vp;');
  11570. Add(' b:=onbar=vp;');
  11571. Add(' b:=fonfoo=fonfoo;');
  11572. Add(' b:=onfoo=onfoo;');
  11573. Add(' b:=onbar=onfoo;');
  11574. Add(' b:=fonfoo<>fonfoo;');
  11575. Add(' b:=onfoo<>onfoo;');
  11576. Add(' b:=onbar<>onfoo;');
  11577. Add(' b:=fonfoo=@doit;');
  11578. Add(' b:=onfoo=@doit;');
  11579. Add(' b:=onbar=@doit;');
  11580. Add(' b:=fonfoo<>@doit;');
  11581. Add(' b:=onfoo<>@doit;');
  11582. Add(' b:=onbar<>@doit;');
  11583. Add(' b:=Assigned(fonfoo);');
  11584. Add(' b:=Assigned(onfoo);');
  11585. Add(' b:=Assigned(onbar);');
  11586. Add('end;');
  11587. ConvertProgram;
  11588. CheckSource('TestProcType_WithClassInstDoPropertyFPC',
  11589. LinesToStr([ // statements
  11590. 'rtl.createClass($mod, "TObject", null, function () {',
  11591. ' this.$init = function () {',
  11592. ' this.FOnFoo = null;',
  11593. ' };',
  11594. ' this.$final = function () {',
  11595. ' this.FOnFoo = undefined;',
  11596. ' };',
  11597. ' this.DoIt = function (vA) {',
  11598. ' var Result = 0;',
  11599. ' return Result;',
  11600. ' };',
  11601. ' this.GetFoo = function () {',
  11602. ' var Result = null;',
  11603. ' return Result;',
  11604. ' };',
  11605. ' this.SetFoo = function (Value) {',
  11606. ' };',
  11607. '});',
  11608. 'this.Obj = null;',
  11609. 'this.vP = null;',
  11610. 'this.b = false;'
  11611. ]),
  11612. LinesToStr([
  11613. 'var $with1 = $mod.Obj;',
  11614. '$with1.FOnFoo = null;',
  11615. '$with1.FOnFoo = null;',
  11616. '$with1.SetFoo(null);',
  11617. '$with1.FOnFoo = $with1.FOnFoo;',
  11618. '$with1.FOnFoo = $with1.FOnFoo;',
  11619. '$with1.SetFoo($with1.GetFoo());',
  11620. '$with1.FOnFoo = rtl.createCallback($with1, "DoIt");',
  11621. '$with1.FOnFoo = rtl.createCallback($with1, "DoIt");',
  11622. '$with1.SetFoo(rtl.createCallback($with1, "DoIt"));',
  11623. '$with1.FOnFoo(1);',
  11624. '$with1.FOnFoo(1);',
  11625. '$with1.GetFoo();',
  11626. '$with1.FOnFoo(1);',
  11627. '$with1.FOnFoo(1);',
  11628. '$with1.GetFoo()(1);',
  11629. '$mod.b = $with1.FOnFoo === null;',
  11630. '$mod.b = $with1.FOnFoo === null;',
  11631. '$mod.b = $with1.GetFoo() === null;',
  11632. '$mod.b = $with1.FOnFoo !== null;',
  11633. '$mod.b = $with1.FOnFoo !== null;',
  11634. '$mod.b = $with1.GetFoo() !== null;',
  11635. '$mod.b = rtl.eqCallback($with1.FOnFoo, $mod.vP);',
  11636. '$mod.b = rtl.eqCallback($with1.FOnFoo, $mod.vP);',
  11637. '$mod.b = rtl.eqCallback($with1.GetFoo(), $mod.vP);',
  11638. '$mod.b = rtl.eqCallback($with1.FOnFoo, $with1.FOnFoo);',
  11639. '$mod.b = rtl.eqCallback($with1.FOnFoo, $with1.FOnFoo);',
  11640. '$mod.b = rtl.eqCallback($with1.GetFoo(), $with1.FOnFoo);',
  11641. '$mod.b = !rtl.eqCallback($with1.FOnFoo, $with1.FOnFoo);',
  11642. '$mod.b = !rtl.eqCallback($with1.FOnFoo, $with1.FOnFoo);',
  11643. '$mod.b = !rtl.eqCallback($with1.GetFoo(), $with1.FOnFoo);',
  11644. '$mod.b = rtl.eqCallback($with1.FOnFoo, rtl.createCallback($with1, "DoIt"));',
  11645. '$mod.b = rtl.eqCallback($with1.FOnFoo, rtl.createCallback($with1, "DoIt"));',
  11646. '$mod.b = rtl.eqCallback($with1.GetFoo(), rtl.createCallback($with1, "DoIt"));',
  11647. '$mod.b = !rtl.eqCallback($with1.FOnFoo, rtl.createCallback($with1, "DoIt"));',
  11648. '$mod.b = !rtl.eqCallback($with1.FOnFoo, rtl.createCallback($with1, "DoIt"));',
  11649. '$mod.b = !rtl.eqCallback($with1.GetFoo(), rtl.createCallback($with1, "DoIt"));',
  11650. '$mod.b = $with1.FOnFoo != null;',
  11651. '$mod.b = $with1.FOnFoo != null;',
  11652. '$mod.b = $with1.GetFoo() != null;',
  11653. '']));
  11654. end;
  11655. procedure TTestModule.TestProcType_Nested;
  11656. begin
  11657. StartProgram(false);
  11658. Add([
  11659. 'type',
  11660. ' TProcInt = procedure(vI: longint = 1);',
  11661. 'procedure DoIt(vJ: longint);',
  11662. 'var aProc: TProcInt;',
  11663. ' b: boolean;',
  11664. ' procedure Sub(vK: longint);',
  11665. ' var aSub: TProcInt;',
  11666. ' procedure SubSub(vK: longint);',
  11667. ' var aSubSub: TProcInt;',
  11668. ' begin;',
  11669. ' aProc:=@DoIt;',
  11670. ' aSub:=@DoIt;',
  11671. ' aSubSub:=@DoIt;',
  11672. ' aProc:=@Sub;',
  11673. ' aSub:=@Sub;',
  11674. ' aSubSub:=@Sub;',
  11675. ' aProc:=@SubSub;',
  11676. ' aSub:=@SubSub;',
  11677. ' aSubSub:=@SubSub;',
  11678. ' end;',
  11679. ' begin;',
  11680. ' end;',
  11681. 'begin;',
  11682. ' aProc:=@Sub;',
  11683. ' b:=aProc=@Sub;',
  11684. ' b:=@Sub=aProc;',
  11685. 'end;',
  11686. 'begin',
  11687. '']);
  11688. ConvertProgram;
  11689. CheckSource('TestProcType_Nested',
  11690. LinesToStr([ // statements
  11691. 'this.DoIt = function (vJ) {',
  11692. ' var aProc = null;',
  11693. ' var b = false;',
  11694. ' function Sub(vK) {',
  11695. ' var aSub = null;',
  11696. ' function SubSub(vK) {',
  11697. ' var aSubSub = null;',
  11698. ' aProc = $mod.DoIt;',
  11699. ' aSub = $mod.DoIt;',
  11700. ' aSubSub = $mod.DoIt;',
  11701. ' aProc = Sub;',
  11702. ' aSub = Sub;',
  11703. ' aSubSub = Sub;',
  11704. ' aProc = SubSub;',
  11705. ' aSub = SubSub;',
  11706. ' aSubSub = SubSub;',
  11707. ' };',
  11708. ' };',
  11709. ' aProc = Sub;',
  11710. ' b = rtl.eqCallback(aProc, Sub);',
  11711. ' b = rtl.eqCallback(Sub, aProc);',
  11712. '};',
  11713. '']),
  11714. LinesToStr([ // $mod.$main
  11715. '']));
  11716. end;
  11717. procedure TTestModule.TestProcType_NestedOfObject;
  11718. begin
  11719. StartProgram(false);
  11720. Add([
  11721. 'type',
  11722. ' TProcInt = procedure(vI: longint = 1) of object;',
  11723. ' TObject = class',
  11724. ' procedure DoIt(vJ: longint);',
  11725. ' end;',
  11726. 'procedure TObject.DoIt(vJ: longint);',
  11727. 'var aProc: TProcInt;',
  11728. ' b: boolean;',
  11729. ' procedure Sub(vK: longint);',
  11730. ' var aSub: TProcInt;',
  11731. ' procedure SubSub(vK: longint);',
  11732. ' var aSubSub: TProcInt;',
  11733. ' begin;',
  11734. ' aProc:=@DoIt;',
  11735. ' aSub:=@DoIt;',
  11736. ' aSubSub:=@DoIt;',
  11737. ' aProc:=@Sub;',
  11738. ' aSub:=@Sub;',
  11739. ' aSubSub:=@Sub;',
  11740. ' aProc:=@SubSub;',
  11741. ' aSub:=@SubSub;',
  11742. ' aSubSub:=@SubSub;',
  11743. ' end;',
  11744. ' begin;',
  11745. ' end;',
  11746. 'begin;',
  11747. ' aProc:=@Sub;',
  11748. ' b:=aProc=@Sub;',
  11749. ' b:=@Sub=aProc;',
  11750. 'end;',
  11751. 'begin',
  11752. '']);
  11753. ConvertProgram;
  11754. CheckSource('TestProcType_Nested',
  11755. LinesToStr([ // statements
  11756. 'rtl.createClass($mod, "TObject", null, function () {',
  11757. ' this.$init = function () {',
  11758. ' };',
  11759. ' this.$final = function () {',
  11760. ' };',
  11761. ' this.DoIt = function (vJ) {',
  11762. ' var Self = this;',
  11763. ' var aProc = null;',
  11764. ' var b = false;',
  11765. ' function Sub(vK) {',
  11766. ' var aSub = null;',
  11767. ' function SubSub(vK) {',
  11768. ' var aSubSub = null;',
  11769. ' aProc = rtl.createCallback(Self, "DoIt");',
  11770. ' aSub = rtl.createCallback(Self, "DoIt");',
  11771. ' aSubSub = rtl.createCallback(Self, "DoIt");',
  11772. ' aProc = Sub;',
  11773. ' aSub = Sub;',
  11774. ' aSubSub = Sub;',
  11775. ' aProc = SubSub;',
  11776. ' aSub = SubSub;',
  11777. ' aSubSub = SubSub;',
  11778. ' };',
  11779. ' };',
  11780. ' aProc = Sub;',
  11781. ' b = rtl.eqCallback(aProc, Sub);',
  11782. ' b = rtl.eqCallback(Sub, aProc);',
  11783. ' };',
  11784. '});',
  11785. '']),
  11786. LinesToStr([ // $mod.$main
  11787. '']));
  11788. end;
  11789. procedure TTestModule.TestProcType_ReferenceToProc;
  11790. begin
  11791. StartProgram(false);
  11792. Add([
  11793. 'type',
  11794. ' TProcRef = reference to procedure(i: longint = 0);',
  11795. ' TFuncRef = reference to function(i: longint = 0): longint;',
  11796. 'var',
  11797. ' p: TProcRef;',
  11798. ' f: TFuncRef;',
  11799. 'procedure DoIt(i: longint);',
  11800. 'begin',
  11801. 'end;',
  11802. 'function GetIt(i: longint): longint;',
  11803. 'begin',
  11804. ' p:=@DoIt;',
  11805. ' f:=@GetIt;',
  11806. ' f;',
  11807. ' f();',
  11808. ' f(1);',
  11809. 'end;',
  11810. 'begin',
  11811. ' p:=@DoIt;',
  11812. ' f:=@GetIt;',
  11813. ' f;',
  11814. ' f();',
  11815. ' f(1);',
  11816. ' p:=TProcRef(f);',
  11817. '']);
  11818. ConvertProgram;
  11819. CheckSource('TestProcType_ReferenceToProc',
  11820. LinesToStr([ // statements
  11821. 'this.p = null;',
  11822. 'this.f = null;',
  11823. 'this.DoIt = function (i) {',
  11824. '};',
  11825. 'this.GetIt = function (i) {',
  11826. ' var Result = 0;',
  11827. ' $mod.p = $mod.DoIt;',
  11828. ' $mod.f = $mod.GetIt;',
  11829. ' $mod.f(0);',
  11830. ' $mod.f(0);',
  11831. ' $mod.f(1);',
  11832. ' return Result;',
  11833. '};',
  11834. '']),
  11835. LinesToStr([ // $mod.$main
  11836. '$mod.p = $mod.DoIt;',
  11837. '$mod.f = $mod.GetIt;',
  11838. '$mod.f(0);',
  11839. '$mod.f(0);',
  11840. '$mod.f(1);',
  11841. '$mod.p = $mod.f;',
  11842. '']));
  11843. end;
  11844. procedure TTestModule.TestProcType_ReferenceToMethod;
  11845. begin
  11846. StartProgram(false);
  11847. Add([
  11848. 'type',
  11849. ' TFuncRef = reference to function(i: longint = 5): longint;',
  11850. ' TObject = class',
  11851. ' function Grow(s: longint): longint;',
  11852. ' end;',
  11853. 'var',
  11854. ' f: tfuncref;',
  11855. 'function tobject.grow(s: longint): longint;',
  11856. ' function GrowSub(i: longint): longint;',
  11857. ' begin',
  11858. ' f:=@grow;',
  11859. ' f:=@growsub;',
  11860. ' end;',
  11861. 'begin',
  11862. ' f:=@grow;',
  11863. ' f:=@growsub;',
  11864. 'end;',
  11865. 'begin',
  11866. '']);
  11867. ConvertProgram;
  11868. CheckSource('TestProcType_ReferenceToMethod',
  11869. LinesToStr([ // statements
  11870. 'rtl.createClass($mod, "TObject", null, function () {',
  11871. ' this.$init = function () {',
  11872. ' };',
  11873. ' this.$final = function () {',
  11874. ' };',
  11875. ' this.Grow = function (s) {',
  11876. ' var Self = this;',
  11877. ' var Result = 0;',
  11878. ' function GrowSub(i) {',
  11879. ' var Result = 0;',
  11880. ' $mod.f = rtl.createCallback(Self, "Grow");',
  11881. ' $mod.f = GrowSub;',
  11882. ' return Result;',
  11883. ' };',
  11884. ' $mod.f = rtl.createCallback(Self, "Grow");',
  11885. ' $mod.f = GrowSub;',
  11886. ' return Result;',
  11887. ' };',
  11888. '});',
  11889. 'this.f = null;',
  11890. '']),
  11891. LinesToStr([ // $mod.$main
  11892. '']));
  11893. end;
  11894. procedure TTestModule.TestProcType_Typecast;
  11895. begin
  11896. StartProgram(false);
  11897. Add([
  11898. 'type',
  11899. ' TNotifyEvent = procedure(Sender: Pointer) of object;',
  11900. ' TEvent = procedure of object;',
  11901. ' TGetter = function:longint of object;',
  11902. ' TProcA = procedure(i: longint);',
  11903. ' TFuncB = function(i, j: longint): longint;',
  11904. 'procedure DoIt(); varargs; begin end;',
  11905. 'var',
  11906. ' Notify: tnotifyevent;',
  11907. ' Event: tevent;',
  11908. ' Getter: tgetter;',
  11909. ' ProcA: tproca;',
  11910. ' FuncB: tfuncb;',
  11911. ' p: pointer;',
  11912. 'begin',
  11913. ' notify:=tnotifyevent(event);',
  11914. ' event:=tevent(event);',
  11915. ' event:=tevent(notify);',
  11916. ' event:=tevent(getter);',
  11917. ' event:=tevent(proca);',
  11918. ' proca:=tproca(funcb);',
  11919. ' funcb:=tfuncb(funcb);',
  11920. ' funcb:=tfuncb(proca);',
  11921. ' funcb:=tfuncb(getter);',
  11922. ' proca:=tproca(p);',
  11923. ' funcb:=tfuncb(p);',
  11924. ' getter:=tgetter(p);',
  11925. ' p:=pointer(notify);',
  11926. ' p:=notify;',
  11927. ' p:=pointer(proca);',
  11928. ' p:=proca;',
  11929. ' p:=pointer(funcb);',
  11930. ' p:=funcb;',
  11931. ' doit(Pointer(notify),pointer(event),pointer(proca));',
  11932. '']);
  11933. ConvertProgram;
  11934. CheckSource('TestProcType_Typecast',
  11935. LinesToStr([ // statements
  11936. 'this.DoIt = function () {',
  11937. '};',
  11938. 'this.Notify = null;',
  11939. 'this.Event = null;',
  11940. 'this.Getter = null;',
  11941. 'this.ProcA = null;',
  11942. 'this.FuncB = null;',
  11943. 'this.p = null;',
  11944. '']),
  11945. LinesToStr([ // $mod.$main
  11946. '$mod.Notify = $mod.Event;',
  11947. '$mod.Event = $mod.Event;',
  11948. '$mod.Event = $mod.Notify;',
  11949. '$mod.Event = $mod.Getter;',
  11950. '$mod.Event = $mod.ProcA;',
  11951. '$mod.ProcA = $mod.FuncB;',
  11952. '$mod.FuncB = $mod.FuncB;',
  11953. '$mod.FuncB = $mod.ProcA;',
  11954. '$mod.FuncB = $mod.Getter;',
  11955. '$mod.ProcA = $mod.p;',
  11956. '$mod.FuncB = $mod.p;',
  11957. '$mod.Getter = $mod.p;',
  11958. '$mod.p = $mod.Notify;',
  11959. '$mod.p = $mod.Notify;',
  11960. '$mod.p = $mod.ProcA;',
  11961. '$mod.p = $mod.ProcA;',
  11962. '$mod.p = $mod.FuncB;',
  11963. '$mod.p = $mod.FuncB;',
  11964. '$mod.DoIt($mod.Notify, $mod.Event, $mod.ProcA);',
  11965. '']));
  11966. end;
  11967. procedure TTestModule.TestProcType_PassProcToUntyped;
  11968. begin
  11969. StartProgram(false);
  11970. Add([
  11971. 'type',
  11972. ' TEvent = procedure of object;',
  11973. ' TFunc = function: longint;',
  11974. 'procedure DoIt(); varargs; begin end;',
  11975. 'procedure DoSome(const a; var b; p: pointer); begin end;',
  11976. 'var',
  11977. ' Event: tevent;',
  11978. ' Func: TFunc;',
  11979. 'begin',
  11980. ' doit(event,func);',
  11981. ' dosome(event,event,event);',
  11982. ' dosome(func,func,func);',
  11983. '']);
  11984. ConvertProgram;
  11985. CheckSource('TestProcType_PassProcToUntyped',
  11986. LinesToStr([ // statements
  11987. 'this.DoIt = function () {',
  11988. '};',
  11989. 'this.DoSome = function (a, b, p) {',
  11990. '};',
  11991. 'this.Event = null;',
  11992. 'this.Func = null;',
  11993. '']),
  11994. LinesToStr([ // $mod.$main
  11995. '$mod.DoIt($mod.Event, $mod.Func);',
  11996. '$mod.DoSome($mod.Event, {',
  11997. ' p: $mod,',
  11998. ' get: function () {',
  11999. ' return this.p.Event;',
  12000. ' },',
  12001. ' set: function (v) {',
  12002. ' this.p.Event = v;',
  12003. ' }',
  12004. '}, $mod.Event);',
  12005. '$mod.DoSome($mod.Func, {',
  12006. ' p: $mod,',
  12007. ' get: function () {',
  12008. ' return this.p.Func;',
  12009. ' },',
  12010. ' set: function (v) {',
  12011. ' this.p.Func = v;',
  12012. ' }',
  12013. '}, $mod.Func);',
  12014. '']));
  12015. end;
  12016. procedure TTestModule.TestPointer;
  12017. begin
  12018. StartProgram(false);
  12019. Add('type');
  12020. Add(' TObject = class end;');
  12021. Add(' TClass = class of TObject;');
  12022. Add(' TArrInt = array of longint;');
  12023. Add('var');
  12024. Add(' v: jsvalue;');
  12025. Add(' Obj: tobject;');
  12026. Add(' C: tclass;');
  12027. Add(' a: tarrint;');
  12028. Add(' p: Pointer;');
  12029. Add('begin');
  12030. Add(' p:=p;');
  12031. Add(' p:=nil;');
  12032. Add(' if p=nil then;');
  12033. Add(' if nil=p then;');
  12034. Add(' if Assigned(p) then;');
  12035. Add(' p:=Pointer(v);');
  12036. Add(' p:=obj;');
  12037. Add(' p:=c;');
  12038. Add(' p:=a;');
  12039. Add(' p:=tobject;');
  12040. Add(' obj:=TObject(p);');
  12041. Add(' c:=TClass(p);');
  12042. Add(' a:=TArrInt(p);');
  12043. ConvertProgram;
  12044. CheckSource('TestPointer',
  12045. LinesToStr([ // statements
  12046. 'rtl.createClass($mod, "TObject", null, function () {',
  12047. ' this.$init = function () {',
  12048. ' };',
  12049. ' this.$final = function () {',
  12050. ' };',
  12051. '});',
  12052. 'this.v = undefined;',
  12053. 'this.Obj = null;',
  12054. 'this.C = null;',
  12055. 'this.a = [];',
  12056. 'this.p = null;',
  12057. '']),
  12058. LinesToStr([ // $mod.$main
  12059. '$mod.p = $mod.p;',
  12060. '$mod.p = null;',
  12061. 'if ($mod.p === null) ;',
  12062. 'if (null === $mod.p) ;',
  12063. 'if ($mod.p != null) ;',
  12064. '$mod.p = $mod.v;',
  12065. '$mod.p = $mod.Obj;',
  12066. '$mod.p = $mod.C;',
  12067. '$mod.p = $mod.a;',
  12068. '$mod.p = $mod.TObject;',
  12069. '$mod.Obj = $mod.p;',
  12070. '$mod.C = $mod.p;',
  12071. '$mod.a = $mod.p;',
  12072. '']));
  12073. end;
  12074. procedure TTestModule.TestPointer_Proc;
  12075. begin
  12076. StartProgram(false);
  12077. Add('type');
  12078. Add(' TObject = class');
  12079. Add(' procedure DoIt; virtual; abstract;');
  12080. Add(' end;');
  12081. Add('procedure DoSome; begin end;');
  12082. Add('var');
  12083. Add(' o: TObject;');
  12084. Add(' p: Pointer;');
  12085. Add('begin');
  12086. Add(' p:=@DoSome;');
  12087. Add(' p:[email protected];');
  12088. ConvertProgram;
  12089. CheckSource('TestPointer_Proc',
  12090. LinesToStr([ // statements
  12091. 'rtl.createClass($mod, "TObject", null, function () {',
  12092. ' this.$init = function () {',
  12093. ' };',
  12094. ' this.$final = function () {',
  12095. ' };',
  12096. '});',
  12097. 'this.DoSome = function () {',
  12098. '};',
  12099. 'this.o = null;',
  12100. 'this.p = null;',
  12101. '']),
  12102. LinesToStr([ // $mod.$main
  12103. '$mod.p = $mod.DoSome;',
  12104. '$mod.p = rtl.createCallback($mod.o, "DoIt");',
  12105. '']));
  12106. end;
  12107. procedure TTestModule.TestPointer_AssignRecordFail;
  12108. begin
  12109. StartProgram(false);
  12110. Add('type');
  12111. Add(' TRec = record end;');
  12112. Add('var');
  12113. Add(' p: Pointer;');
  12114. Add(' r: TRec;');
  12115. Add('begin');
  12116. Add(' p:=r;');
  12117. SetExpectedPasResolverError('Incompatible types: got "TRec" expected "Pointer"',
  12118. nIncompatibleTypesGotExpected);
  12119. ConvertProgram;
  12120. end;
  12121. procedure TTestModule.TestPointer_AssignStaticArrayFail;
  12122. begin
  12123. StartProgram(false);
  12124. Add('type');
  12125. Add(' TArr = array[boolean] of longint;');
  12126. Add('var');
  12127. Add(' p: Pointer;');
  12128. Add(' a: TArr;');
  12129. Add('begin');
  12130. Add(' p:=a;');
  12131. SetExpectedPasResolverError('Incompatible types: got "TArr" expected "Pointer"',
  12132. nIncompatibleTypesGotExpected);
  12133. ConvertProgram;
  12134. end;
  12135. procedure TTestModule.TestPointer_ArrayParamsFail;
  12136. begin
  12137. StartProgram(false);
  12138. Add('var');
  12139. Add(' p: Pointer;');
  12140. Add('begin');
  12141. Add(' p:=p[1];');
  12142. SetExpectedPasResolverError('illegal qualifier "["',nIllegalQualifier);
  12143. ConvertProgram;
  12144. end;
  12145. procedure TTestModule.TestPointer_TypeCastJSValueToPointer;
  12146. begin
  12147. StartProgram(false);
  12148. Add([
  12149. 'procedure DoIt(args: array of jsvalue); begin end;',
  12150. 'procedure DoAll; varargs; begin end;',
  12151. 'var',
  12152. ' v: jsvalue;',
  12153. 'begin',
  12154. ' DoIt([pointer(v)]);',
  12155. ' DoAll(pointer(v));',
  12156. '']);
  12157. ConvertProgram;
  12158. CheckSource('TestPointer_TypeCastJSValueToPointer',
  12159. LinesToStr([ // statements
  12160. 'this.DoIt = function (args) {',
  12161. '};',
  12162. 'this.DoAll = function () {',
  12163. '};',
  12164. 'this.v = undefined;',
  12165. '']),
  12166. LinesToStr([ // $mod.$main
  12167. '$mod.DoIt([$mod.v]);',
  12168. '$mod.DoAll($mod.v);',
  12169. '']));
  12170. end;
  12171. procedure TTestModule.TestJSValue_AssignToJSValue;
  12172. begin
  12173. StartProgram(false);
  12174. Add('var');
  12175. Add(' v: jsvalue;');
  12176. Add(' i: longint;');
  12177. Add(' s: string;');
  12178. Add(' b: boolean;');
  12179. Add(' d: double;');
  12180. Add(' p: pointer;');
  12181. Add('begin');
  12182. Add(' v:=v;');
  12183. Add(' v:=1;');
  12184. Add(' v:=i;');
  12185. Add(' v:='''';');
  12186. Add(' v:=''c'';');
  12187. Add(' v:=''foo'';');
  12188. Add(' v:=s;');
  12189. Add(' v:=false;');
  12190. Add(' v:=true;');
  12191. Add(' v:=b;');
  12192. Add(' v:=0.1;');
  12193. Add(' v:=d;');
  12194. Add(' v:=nil;');
  12195. Add(' v:=p;');
  12196. ConvertProgram;
  12197. CheckSource('TestJSValue_AssignToJSValue',
  12198. LinesToStr([ // statements
  12199. 'this.v = undefined;',
  12200. 'this.i = 0;',
  12201. 'this.s = "";',
  12202. 'this.b = false;',
  12203. 'this.d = 0.0;',
  12204. 'this.p = null;',
  12205. '']),
  12206. LinesToStr([ // $mod.$main
  12207. '$mod.v = $mod.v;',
  12208. '$mod.v = 1;',
  12209. '$mod.v = $mod.i;',
  12210. '$mod.v = "";',
  12211. '$mod.v = "c";',
  12212. '$mod.v = "foo";',
  12213. '$mod.v = $mod.s;',
  12214. '$mod.v = false;',
  12215. '$mod.v = true;',
  12216. '$mod.v = $mod.b;',
  12217. '$mod.v = 0.1;',
  12218. '$mod.v = $mod.d;',
  12219. '$mod.v = null;',
  12220. '$mod.v = $mod.p;',
  12221. '']));
  12222. end;
  12223. procedure TTestModule.TestJSValue_TypeCastToBaseType;
  12224. begin
  12225. StartProgram(false);
  12226. Add('type');
  12227. Add(' integer = longint;');
  12228. Add(' TYesNo = boolean;');
  12229. Add(' TFloat = double;');
  12230. Add(' TCaption = string;');
  12231. Add(' TChar = char;');
  12232. Add('var');
  12233. Add(' v: jsvalue;');
  12234. Add(' i: integer;');
  12235. Add(' s: TCaption;');
  12236. Add(' b: TYesNo;');
  12237. Add(' d: TFloat;');
  12238. Add(' c: char;');
  12239. Add('begin');
  12240. Add(' i:=longint(v);');
  12241. Add(' i:=integer(v);');
  12242. Add(' s:=string(v);');
  12243. Add(' s:=TCaption(v);');
  12244. Add(' b:=boolean(v);');
  12245. Add(' b:=TYesNo(v);');
  12246. Add(' d:=double(v);');
  12247. Add(' d:=TFloat(v);');
  12248. Add(' c:=char(v);');
  12249. Add(' c:=TChar(v);');
  12250. ConvertProgram;
  12251. CheckSource('TestJSValue_TypeCastToBaseType',
  12252. LinesToStr([ // statements
  12253. 'this.v = undefined;',
  12254. 'this.i = 0;',
  12255. 'this.s = "";',
  12256. 'this.b = false;',
  12257. 'this.d = 0.0;',
  12258. 'this.c = "";',
  12259. '']),
  12260. LinesToStr([ // $mod.$main
  12261. '$mod.i = Math.floor($mod.v);',
  12262. '$mod.i = Math.floor($mod.v);',
  12263. '$mod.s = "" + $mod.v;',
  12264. '$mod.s = "" + $mod.v;',
  12265. '$mod.b = !($mod.v == false);',
  12266. '$mod.b = !($mod.v == false);',
  12267. '$mod.d = rtl.getNumber($mod.v);',
  12268. '$mod.d = rtl.getNumber($mod.v);',
  12269. '$mod.c = rtl.getChar($mod.v);',
  12270. '$mod.c = rtl.getChar($mod.v);',
  12271. '']));
  12272. end;
  12273. procedure TTestModule.TestJSValue_Equal;
  12274. begin
  12275. StartProgram(false);
  12276. Add('type');
  12277. Add(' integer = longint;');
  12278. Add(' TYesNo = boolean;');
  12279. Add(' TFloat = double;');
  12280. Add(' TCaption = string;');
  12281. Add(' TChar = char;');
  12282. Add(' TMulti = JSValue;');
  12283. Add('var');
  12284. Add(' v: jsvalue;');
  12285. Add(' i: integer;');
  12286. Add(' s: TCaption;');
  12287. Add(' b: TYesNo;');
  12288. Add(' d: TFloat;');
  12289. Add(' c: char;');
  12290. Add(' m: TMulti;');
  12291. Add('begin');
  12292. Add(' b:=v=v;');
  12293. Add(' b:=v<>v;');
  12294. Add(' b:=v=1;');
  12295. Add(' b:=v<>1;');
  12296. Add(' b:=2=v;');
  12297. Add(' b:=2<>v;');
  12298. Add(' b:=v=i;');
  12299. Add(' b:=i=v;');
  12300. Add(' b:=v=nil;');
  12301. Add(' b:=nil=v;');
  12302. Add(' b:=v=false;');
  12303. Add(' b:=true=v;');
  12304. Add(' b:=v=b;');
  12305. Add(' b:=b=v;');
  12306. Add(' b:=v=s;');
  12307. Add(' b:=s=v;');
  12308. Add(' b:=v=''foo'';');
  12309. Add(' b:=''''=v;');
  12310. Add(' b:=v=d;');
  12311. Add(' b:=d=v;');
  12312. Add(' b:=v=3.4;');
  12313. Add(' b:=5.6=v;');
  12314. Add(' b:=v=c;');
  12315. Add(' b:=c=v;');
  12316. Add(' b:=m=m;');
  12317. Add(' b:=v=m;');
  12318. Add(' b:=m=v;');
  12319. ConvertProgram;
  12320. CheckSource('TestJSValue_Equal',
  12321. LinesToStr([ // statements
  12322. 'this.v = undefined;',
  12323. 'this.i = 0;',
  12324. 'this.s = "";',
  12325. 'this.b = false;',
  12326. 'this.d = 0.0;',
  12327. 'this.c = "";',
  12328. 'this.m = undefined;',
  12329. '']),
  12330. LinesToStr([ // $mod.$main
  12331. '$mod.b = $mod.v == $mod.v;',
  12332. '$mod.b = $mod.v != $mod.v;',
  12333. '$mod.b = $mod.v == 1;',
  12334. '$mod.b = $mod.v != 1;',
  12335. '$mod.b = 2 == $mod.v;',
  12336. '$mod.b = 2 != $mod.v;',
  12337. '$mod.b = $mod.v == $mod.i;',
  12338. '$mod.b = $mod.i == $mod.v;',
  12339. '$mod.b = $mod.v == null;',
  12340. '$mod.b = null == $mod.v;',
  12341. '$mod.b = $mod.v == false;',
  12342. '$mod.b = true == $mod.v;',
  12343. '$mod.b = $mod.v == $mod.b;',
  12344. '$mod.b = $mod.b == $mod.v;',
  12345. '$mod.b = $mod.v == $mod.s;',
  12346. '$mod.b = $mod.s == $mod.v;',
  12347. '$mod.b = $mod.v == "foo";',
  12348. '$mod.b = "" == $mod.v;',
  12349. '$mod.b = $mod.v == $mod.d;',
  12350. '$mod.b = $mod.d == $mod.v;',
  12351. '$mod.b = $mod.v == 3.4;',
  12352. '$mod.b = 5.6 == $mod.v;',
  12353. '$mod.b = $mod.v == $mod.c;',
  12354. '$mod.b = $mod.c == $mod.v;',
  12355. '$mod.b = $mod.m == $mod.m;',
  12356. '$mod.b = $mod.v == $mod.m;',
  12357. '$mod.b = $mod.m == $mod.v;',
  12358. '']));
  12359. end;
  12360. procedure TTestModule.TestJSValue_If;
  12361. begin
  12362. StartProgram(false);
  12363. Add([
  12364. 'var',
  12365. ' v: jsvalue;',
  12366. 'begin',
  12367. ' if v then ;',
  12368. ' while v do ;',
  12369. ' repeat until v;',
  12370. '']);
  12371. ConvertProgram;
  12372. CheckSource('TestJSValue_If',
  12373. LinesToStr([ // statements
  12374. 'this.v = undefined;',
  12375. '']),
  12376. LinesToStr([ // $mod.$main
  12377. 'if ($mod.v) ;',
  12378. 'while($mod.v){',
  12379. '};',
  12380. 'do{',
  12381. '} while(!$mod.v);',
  12382. '']));
  12383. end;
  12384. procedure TTestModule.TestJSValue_Enum;
  12385. begin
  12386. StartProgram(false);
  12387. Add('type');
  12388. Add(' TColor = (red, blue);');
  12389. Add(' TRedBlue = TColor;');
  12390. Add('var');
  12391. Add(' v: jsvalue;');
  12392. Add(' e: TColor;');
  12393. Add('begin');
  12394. Add(' v:=e;');
  12395. Add(' v:=TColor(e);');
  12396. Add(' v:=TRedBlue(e);');
  12397. Add(' e:=TColor(v);');
  12398. Add(' e:=TRedBlue(v);');
  12399. ConvertProgram;
  12400. CheckSource('TestJSValue_Enum',
  12401. LinesToStr([ // statements
  12402. 'this.TColor = {',
  12403. ' "0": "red",',
  12404. ' red: 0,',
  12405. ' "1": "blue",',
  12406. ' blue: 1',
  12407. '};',
  12408. 'this.v = undefined;',
  12409. 'this.e = 0;',
  12410. '']),
  12411. LinesToStr([ // $mod.$main
  12412. '$mod.v = $mod.e;',
  12413. '$mod.v = $mod.e;',
  12414. '$mod.v = $mod.e;',
  12415. '$mod.e = $mod.v;',
  12416. '$mod.e = $mod.v;',
  12417. '']));
  12418. end;
  12419. procedure TTestModule.TestJSValue_ClassInstance;
  12420. begin
  12421. StartProgram(false);
  12422. Add('type');
  12423. Add(' TObject = class');
  12424. Add(' end;');
  12425. Add(' TBirdObject = TObject;');
  12426. Add('var');
  12427. Add(' v: jsvalue;');
  12428. Add(' o: TObject;');
  12429. Add('begin');
  12430. Add(' v:=o;');
  12431. Add(' v:=TObject(o);');
  12432. Add(' v:=TBirdObject(o);');
  12433. Add(' o:=TObject(v);');
  12434. Add(' o:=TBirdObject(v);');
  12435. ConvertProgram;
  12436. CheckSource('TestJSValue_ClassInstance',
  12437. LinesToStr([ // statements
  12438. 'rtl.createClass($mod, "TObject", null, function () {',
  12439. ' this.$init = function () {',
  12440. ' };',
  12441. ' this.$final = function () {',
  12442. ' };',
  12443. '});',
  12444. 'this.v = undefined;',
  12445. 'this.o = null;',
  12446. '']),
  12447. LinesToStr([ // $mod.$main
  12448. '$mod.v = $mod.o;',
  12449. '$mod.v = $mod.o;',
  12450. '$mod.v = $mod.o;',
  12451. '$mod.o = rtl.getObject($mod.v);',
  12452. '$mod.o = rtl.getObject($mod.v);',
  12453. '']));
  12454. end;
  12455. procedure TTestModule.TestJSValue_ClassOf;
  12456. begin
  12457. StartProgram(false);
  12458. Add('type');
  12459. Add(' TClass = class of TObject;');
  12460. Add(' TObject = class');
  12461. Add(' end;');
  12462. Add(' TBirds = class of TBird;');
  12463. Add(' TBird = class(TObject) end;');
  12464. Add('var');
  12465. Add(' v: jsvalue;');
  12466. Add(' c: TClass;');
  12467. Add('begin');
  12468. Add(' v:=c;');
  12469. Add(' v:=TObject;');
  12470. Add(' v:=TClass(c);');
  12471. Add(' v:=TBirds(c);');
  12472. Add(' c:=TClass(v);');
  12473. Add(' c:=TBirds(v);');
  12474. ConvertProgram;
  12475. CheckSource('TestJSValue_ClassOf',
  12476. LinesToStr([ // statements
  12477. 'rtl.createClass($mod, "TObject", null, function () {',
  12478. ' this.$init = function () {',
  12479. ' };',
  12480. ' this.$final = function () {',
  12481. ' };',
  12482. '});',
  12483. 'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
  12484. '});',
  12485. 'this.v = undefined;',
  12486. 'this.c = null;',
  12487. '']),
  12488. LinesToStr([ // $mod.$main
  12489. '$mod.v = $mod.c;',
  12490. '$mod.v = $mod.TObject;',
  12491. '$mod.v = $mod.c;',
  12492. '$mod.v = $mod.c;',
  12493. '$mod.c = rtl.getObject($mod.v);',
  12494. '$mod.c = rtl.getObject($mod.v);',
  12495. '']));
  12496. end;
  12497. procedure TTestModule.TestJSValue_ArrayOfJSValue;
  12498. begin
  12499. StartProgram(false);
  12500. Add('type');
  12501. Add(' integer = longint;');
  12502. Add(' TArray = array of JSValue;');
  12503. Add(' TArrgh = tarray;');
  12504. Add(' TArrInt = array of integer;');
  12505. Add('var');
  12506. Add(' v: jsvalue;');
  12507. Add(' TheArray: tarray;');
  12508. Add(' Arr: tarrgh;');
  12509. Add(' i: integer;');
  12510. Add(' ArrInt: tarrint;');
  12511. Add('begin');
  12512. Add(' arr:=thearray;');
  12513. Add(' thearray:=arr;');
  12514. Add(' setlength(arr,2);');
  12515. Add(' setlength(thearray,3);');
  12516. Add(' arr[4]:=v;');
  12517. Add(' arr[5]:=length(thearray);');
  12518. Add(' arr[6]:=nil;');
  12519. Add(' arr[7]:=thearray[8];');
  12520. Add(' arr[low(arr)]:=high(thearray);');
  12521. Add(' arr:=arrint;');
  12522. Add(' arrInt:=tarrint(arr);');
  12523. Add(' if TheArray = nil then ;');
  12524. Add(' if nil = TheArray then ;');
  12525. Add(' if TheArray <> nil then ;');
  12526. Add(' if nil <> TheArray then ;');
  12527. ConvertProgram;
  12528. CheckSource('TestJSValue_ArrayOfJSValue',
  12529. LinesToStr([ // statements
  12530. 'this.v = undefined;',
  12531. 'this.TheArray = [];',
  12532. 'this.Arr = [];',
  12533. 'this.i = 0;',
  12534. 'this.ArrInt = [];',
  12535. '']),
  12536. LinesToStr([ // $mod.$main
  12537. '$mod.Arr = $mod.TheArray;',
  12538. '$mod.TheArray = $mod.Arr;',
  12539. '$mod.Arr = rtl.arraySetLength($mod.Arr,undefined,2);',
  12540. '$mod.TheArray = rtl.arraySetLength($mod.TheArray,undefined,3);',
  12541. '$mod.Arr[4] = $mod.v;',
  12542. '$mod.Arr[5] = rtl.length($mod.TheArray);',
  12543. '$mod.Arr[6] = null;',
  12544. '$mod.Arr[7] = $mod.TheArray[8];',
  12545. '$mod.Arr[0] = rtl.length($mod.TheArray) - 1;',
  12546. '$mod.Arr = $mod.ArrInt;',
  12547. '$mod.ArrInt = $mod.Arr;',
  12548. 'if (rtl.length($mod.TheArray) === 0) ;',
  12549. 'if (rtl.length($mod.TheArray) === 0) ;',
  12550. 'if (rtl.length($mod.TheArray) > 0) ;',
  12551. 'if (rtl.length($mod.TheArray) > 0) ;',
  12552. '']));
  12553. end;
  12554. procedure TTestModule.TestJSValue_Params;
  12555. begin
  12556. StartProgram(false);
  12557. Add('type');
  12558. Add(' integer = longint;');
  12559. Add(' TYesNo = boolean;');
  12560. Add(' TFloat = double;');
  12561. Add(' TCaption = string;');
  12562. Add(' TChar = char;');
  12563. Add('function DoIt(a: jsvalue; const b: jsvalue; var c: jsvalue; out d: jsvalue): jsvalue;');
  12564. Add('var');
  12565. Add(' l: jsvalue;');
  12566. Add('begin');
  12567. Add(' a:=a;');
  12568. Add(' l:=b;');
  12569. Add(' c:=c;');
  12570. Add(' d:=d;');
  12571. Add(' Result:=l;');
  12572. Add('end;');
  12573. Add('function DoSome(a: jsvalue; const b: jsvalue): jsvalue; begin end;');
  12574. Add('var');
  12575. Add(' v: jsvalue;');
  12576. Add(' i: integer;');
  12577. Add(' b: TYesNo;');
  12578. Add(' d: TFloat;');
  12579. Add(' s: TCaption;');
  12580. Add(' c: TChar;');
  12581. Add('begin');
  12582. Add(' v:=doit(v,v,v,v);');
  12583. Add(' i:=integer(dosome(i,i));');
  12584. Add(' b:=TYesNo(dosome(b,b));');
  12585. Add(' d:=TFloat(dosome(d,d));');
  12586. Add(' s:=TCaption(dosome(s,s));');
  12587. Add(' c:=TChar(dosome(c,c));');
  12588. ConvertProgram;
  12589. CheckSource('TestJSValue_Params',
  12590. LinesToStr([ // statements
  12591. 'this.DoIt = function (a, b, c, d) {',
  12592. ' var Result = undefined;',
  12593. ' var l = undefined;',
  12594. ' a = a;',
  12595. ' l = b;',
  12596. ' c.set(c.get());',
  12597. ' d.set(d.get());',
  12598. ' Result = l;',
  12599. ' return Result;',
  12600. '};',
  12601. 'this.DoSome = function (a, b) {',
  12602. ' var Result = undefined;',
  12603. ' return Result;',
  12604. '};',
  12605. 'this.v = undefined;',
  12606. 'this.i = 0;',
  12607. 'this.b = false;',
  12608. 'this.d = 0.0;',
  12609. 'this.s = "";',
  12610. 'this.c = "";',
  12611. '']),
  12612. LinesToStr([ // $mod.$main
  12613. '$mod.v = $mod.DoIt($mod.v, $mod.v, {',
  12614. ' p: $mod,',
  12615. ' get: function () {',
  12616. ' return this.p.v;',
  12617. ' },',
  12618. ' set: function (v) {',
  12619. ' this.p.v = v;',
  12620. ' }',
  12621. '}, {',
  12622. ' p: $mod,',
  12623. ' get: function () {',
  12624. ' return this.p.v;',
  12625. ' },',
  12626. ' set: function (v) {',
  12627. ' this.p.v = v;',
  12628. ' }',
  12629. '});',
  12630. '$mod.i = Math.floor($mod.DoSome($mod.i, $mod.i));',
  12631. '$mod.b = !($mod.DoSome($mod.b, $mod.b) == false);',
  12632. '$mod.d = rtl.getNumber($mod.DoSome($mod.d, $mod.d));',
  12633. '$mod.s = "" + $mod.DoSome($mod.s, $mod.s);',
  12634. '$mod.c = rtl.getChar($mod.DoSome($mod.c, $mod.c));',
  12635. '']));
  12636. end;
  12637. procedure TTestModule.TestJSValue_UntypedParam;
  12638. begin
  12639. StartProgram(false);
  12640. Add('function DoIt(const a; var b; out c): jsvalue;');
  12641. Add('begin');
  12642. Add(' Result:=a;');
  12643. Add(' Result:=b;');
  12644. Add(' Result:=c;');
  12645. Add(' b:=Result;');
  12646. Add(' c:=Result;');
  12647. Add('end;');
  12648. Add('var i: longint;');
  12649. Add('begin');
  12650. Add(' doit(i,i,i);');
  12651. ConvertProgram;
  12652. CheckSource('TestJSValue_UntypedParam',
  12653. LinesToStr([ // statements
  12654. 'this.DoIt = function (a, b, c) {',
  12655. ' var Result = undefined;',
  12656. ' Result = a;',
  12657. ' Result = b.get();',
  12658. ' Result = c.get();',
  12659. ' b.set(Result);',
  12660. ' c.set(Result);',
  12661. ' return Result;',
  12662. '};',
  12663. 'this.i = 0;',
  12664. '']),
  12665. LinesToStr([ // $mod.$main
  12666. '$mod.DoIt($mod.i, {',
  12667. ' p: $mod,',
  12668. ' get: function () {',
  12669. ' return this.p.i;',
  12670. ' },',
  12671. ' set: function (v) {',
  12672. ' this.p.i = v;',
  12673. ' }',
  12674. '}, {',
  12675. ' p: $mod,',
  12676. ' get: function () {',
  12677. ' return this.p.i;',
  12678. ' },',
  12679. ' set: function (v) {',
  12680. ' this.p.i = v;',
  12681. ' }',
  12682. '});',
  12683. '']));
  12684. end;
  12685. procedure TTestModule.TestJSValue_FuncResultType;
  12686. begin
  12687. StartProgram(false);
  12688. Add('type');
  12689. Add(' integer = longint;');
  12690. Add(' TJSValueArray = array of JSValue;');
  12691. Add(' TListSortCompare = function(Item1, Item2: JSValue): Integer;');
  12692. Add('procedure Sort(P: JSValue; aList: TJSValueArray; const Compare: TListSortCompare);');
  12693. Add('begin');
  12694. Add(' while Compare(P,aList[0])>0 do ;');
  12695. Add('end;');
  12696. Add('var');
  12697. Add(' Compare: TListSortCompare;');
  12698. Add(' V: JSValue;');
  12699. Add(' i: integer;');
  12700. Add('begin');
  12701. Add(' if Compare(V,V)>0 then ;');
  12702. Add(' if Compare(i,i)>1 then ;');
  12703. Add(' if Compare(nil,false)>2 then ;');
  12704. Add(' if Compare(1,true)>3 then ;');
  12705. ConvertProgram;
  12706. CheckSource('TestJSValue_UntypedParam',
  12707. LinesToStr([ // statements
  12708. 'this.Sort = function (P, aList, Compare) {',
  12709. ' while (Compare(P, aList[0]) > 0) {',
  12710. ' };',
  12711. '};',
  12712. 'this.Compare = null;',
  12713. 'this.V = undefined;',
  12714. 'this.i = 0;',
  12715. '']),
  12716. LinesToStr([ // $mod.$main
  12717. 'if ($mod.Compare($mod.V, $mod.V) > 0) ;',
  12718. 'if ($mod.Compare($mod.i, $mod.i) > 1) ;',
  12719. 'if ($mod.Compare(null, false) > 2) ;',
  12720. 'if ($mod.Compare(1, true) > 3) ;',
  12721. '']));
  12722. end;
  12723. procedure TTestModule.TestJSValue_ProcType_Assign;
  12724. begin
  12725. StartProgram(false);
  12726. Add('type');
  12727. Add(' integer = longint;');
  12728. Add(' TObject = class');
  12729. Add(' class function GetGlob: integer;');
  12730. Add(' function Getter: integer;');
  12731. Add(' end;');
  12732. Add('class function TObject.GetGlob: integer;');
  12733. Add('var v1: jsvalue;');
  12734. Add('begin');
  12735. Add(' v1:=@GetGlob;');
  12736. Add(' v1:[email protected];');
  12737. Add('end;');
  12738. Add('function TObject.Getter: integer;');
  12739. Add('var v2: jsvalue;');
  12740. Add('begin');
  12741. Add(' v2:=@Getter;');
  12742. Add(' v2:[email protected];');
  12743. Add(' v2:=@GetGlob;');
  12744. Add(' v2:[email protected];');
  12745. Add('end;');
  12746. Add('function GetIt(i: integer): integer;');
  12747. Add('var v3: jsvalue;');
  12748. Add('begin');
  12749. Add(' v3:=@GetIt;');
  12750. Add('end;');
  12751. Add('var');
  12752. Add(' V: JSValue;');
  12753. Add(' o: TObject;');
  12754. Add('begin');
  12755. Add(' v:=@GetIt;');
  12756. Add(' v:[email protected];');
  12757. Add(' v:[email protected];');
  12758. ConvertProgram;
  12759. CheckSource('TestJSValue_ProcType_Assign',
  12760. LinesToStr([ // statements
  12761. 'rtl.createClass($mod, "TObject", null, function () {',
  12762. ' this.$init = function () {',
  12763. ' };',
  12764. ' this.$final = function () {',
  12765. ' };',
  12766. ' this.GetGlob = function () {',
  12767. ' var Result = 0;',
  12768. ' var v1 = undefined;',
  12769. ' v1 = rtl.createCallback(this, "GetGlob");',
  12770. ' v1 = rtl.createCallback(this, "GetGlob");',
  12771. ' return Result;',
  12772. ' };',
  12773. ' this.Getter = function () {',
  12774. ' var Result = 0;',
  12775. ' var v2 = undefined;',
  12776. ' v2 = rtl.createCallback(this, "Getter");',
  12777. ' v2 = rtl.createCallback(this, "Getter");',
  12778. ' v2 = rtl.createCallback(this.$class, "GetGlob");',
  12779. ' v2 = rtl.createCallback(this.$class, "GetGlob");',
  12780. ' return Result;',
  12781. ' };',
  12782. '});',
  12783. 'this.GetIt = function (i) {',
  12784. ' var Result = 0;',
  12785. ' var v3 = undefined;',
  12786. ' v3 = $mod.GetIt;',
  12787. ' return Result;',
  12788. '};',
  12789. 'this.V = undefined;',
  12790. 'this.o = null;',
  12791. '']),
  12792. LinesToStr([ // $mod.$main
  12793. '$mod.V = $mod.GetIt;',
  12794. '$mod.V = rtl.createCallback($mod.o, "Getter");',
  12795. '$mod.V = rtl.createCallback($mod.o.$class, "GetGlob");',
  12796. '']));
  12797. end;
  12798. procedure TTestModule.TestJSValue_ProcType_Equal;
  12799. begin
  12800. StartProgram(false);
  12801. Add('type');
  12802. Add(' integer = longint;');
  12803. Add(' TObject = class');
  12804. Add(' class function GetGlob: integer;');
  12805. Add(' function Getter: integer;');
  12806. Add(' end;');
  12807. Add('class function TObject.GetGlob: integer;');
  12808. Add('var v1: jsvalue;');
  12809. Add('begin');
  12810. Add(' if v1=@GetGlob then;');
  12811. Add(' if [email protected] then ;');
  12812. Add('end;');
  12813. Add('function TObject.Getter: integer;');
  12814. Add('var v2: jsvalue;');
  12815. Add('begin');
  12816. Add(' if v2=@Getter then;');
  12817. Add(' if [email protected] then ;');
  12818. Add(' if v2=@GetGlob then;');
  12819. Add(' if [email protected] then;');
  12820. Add('end;');
  12821. Add('function GetIt(i: integer): integer;');
  12822. Add('var v3: jsvalue;');
  12823. Add('begin');
  12824. Add(' if v3=@GetIt then;');
  12825. Add('end;');
  12826. Add('var');
  12827. Add(' V: JSValue;');
  12828. Add(' o: TObject;');
  12829. Add('begin');
  12830. Add(' if v=@GetIt then;');
  12831. Add(' if [email protected] then;');
  12832. Add(' if [email protected] then;');
  12833. Add(' if @GetIt=v then;');
  12834. Add(' if @o.Getter=v then;');
  12835. Add(' if @o.GetGlob=v then;');
  12836. ConvertProgram;
  12837. CheckSource('TestJSValue_ProcType_Equal',
  12838. LinesToStr([ // statements
  12839. 'rtl.createClass($mod, "TObject", null, function () {',
  12840. ' this.$init = function () {',
  12841. ' };',
  12842. ' this.$final = function () {',
  12843. ' };',
  12844. ' this.GetGlob = function () {',
  12845. ' var Result = 0;',
  12846. ' var v1 = undefined;',
  12847. ' if (rtl.eqCallback(v1, rtl.createCallback(this, "GetGlob"))) ;',
  12848. ' if (rtl.eqCallback(v1, rtl.createCallback(this, "GetGlob"))) ;',
  12849. ' return Result;',
  12850. ' };',
  12851. ' this.Getter = function () {',
  12852. ' var Result = 0;',
  12853. ' var v2 = undefined;',
  12854. ' if (rtl.eqCallback(v2, rtl.createCallback(this, "Getter"))) ;',
  12855. ' if (rtl.eqCallback(v2, rtl.createCallback(this, "Getter"))) ;',
  12856. ' if (rtl.eqCallback(v2, rtl.createCallback(this.$class, "GetGlob"))) ;',
  12857. ' if (rtl.eqCallback(v2, rtl.createCallback(this.$class, "GetGlob"))) ;',
  12858. ' return Result;',
  12859. ' };',
  12860. '});',
  12861. 'this.GetIt = function (i) {',
  12862. ' var Result = 0;',
  12863. ' var v3 = undefined;',
  12864. ' if (rtl.eqCallback(v3, $mod.GetIt)) ;',
  12865. ' return Result;',
  12866. '};',
  12867. 'this.V = undefined;',
  12868. 'this.o = null;',
  12869. '']),
  12870. LinesToStr([ // $mod.$main
  12871. 'if (rtl.eqCallback($mod.V, $mod.GetIt)) ;',
  12872. 'if (rtl.eqCallback($mod.V, rtl.createCallback($mod.o, "Getter"))) ;',
  12873. 'if (rtl.eqCallback($mod.V, rtl.createCallback($mod.o.$class, "GetGlob"))) ;',
  12874. 'if (rtl.eqCallback($mod.GetIt, $mod.V)) ;',
  12875. 'if (rtl.eqCallback(rtl.createCallback($mod.o, "Getter"), $mod.V)) ;',
  12876. 'if (rtl.eqCallback(rtl.createCallback($mod.o.$class, "GetGlob"), $mod.V)) ;',
  12877. '']));
  12878. end;
  12879. procedure TTestModule.TestJSValue_AssignToPointerFail;
  12880. begin
  12881. StartProgram(false);
  12882. Add([
  12883. 'var',
  12884. ' v: JSValue;',
  12885. ' p: Pointer;',
  12886. 'begin',
  12887. ' p:=v;',
  12888. '']);
  12889. SetExpectedPasResolverError('Incompatible types: got "JSValue" expected "Pointer"',
  12890. nIncompatibleTypesGotExpected);
  12891. ConvertProgram;
  12892. end;
  12893. procedure TTestModule.TestJSValue_OverloadDouble;
  12894. begin
  12895. StartProgram(false);
  12896. Add([
  12897. 'type',
  12898. ' integer = longint;',
  12899. ' tdatetime = double;',
  12900. 'procedure DoIt(d: double); begin end;',
  12901. 'procedure DoIt(v: jsvalue); begin end;',
  12902. 'var',
  12903. ' d: double;',
  12904. ' dt: tdatetime;',
  12905. ' i: integer;',
  12906. ' b: byte;',
  12907. ' shi: shortint;',
  12908. ' w: word;',
  12909. ' smi: smallint;',
  12910. ' lw: longword;',
  12911. ' li: longint;',
  12912. ' ni: nativeint;',
  12913. ' nu: nativeuint;',
  12914. 'begin',
  12915. ' DoIt(d);',
  12916. ' DoIt(dt);',
  12917. ' DoIt(i);',
  12918. ' DoIt(b);',
  12919. ' DoIt(shi);',
  12920. ' DoIt(w);',
  12921. ' DoIt(smi);',
  12922. ' DoIt(lw);',
  12923. ' DoIt(li);',
  12924. ' DoIt(ni);',
  12925. ' DoIt(nu);',
  12926. '']);
  12927. ConvertProgram;
  12928. CheckSource('TestJSValue_OverloadDouble',
  12929. LinesToStr([ // statements
  12930. 'this.DoIt = function (d) {',
  12931. '};',
  12932. 'this.DoIt$1 = function (v) {',
  12933. '};',
  12934. 'this.d = 0.0;',
  12935. 'this.dt = 0.0;',
  12936. 'this.i = 0;',
  12937. 'this.b = 0;',
  12938. 'this.shi = 0;',
  12939. 'this.w = 0;',
  12940. 'this.smi = 0;',
  12941. 'this.lw = 0;',
  12942. 'this.li = 0;',
  12943. 'this.ni = 0;',
  12944. 'this.nu = 0;',
  12945. '']),
  12946. LinesToStr([ // $mod.$main
  12947. '$mod.DoIt($mod.d);',
  12948. '$mod.DoIt($mod.dt);',
  12949. '$mod.DoIt($mod.i);',
  12950. '$mod.DoIt($mod.b);',
  12951. '$mod.DoIt($mod.shi);',
  12952. '$mod.DoIt($mod.w);',
  12953. '$mod.DoIt($mod.smi);',
  12954. '$mod.DoIt($mod.lw);',
  12955. '$mod.DoIt($mod.li);',
  12956. '$mod.DoIt($mod.ni);',
  12957. '$mod.DoIt($mod.nu);',
  12958. '']));
  12959. end;
  12960. procedure TTestModule.TestJSValue_OverloadNativeInt;
  12961. begin
  12962. StartProgram(false);
  12963. Add([
  12964. 'type',
  12965. ' integer = longint;',
  12966. ' int53 = nativeint;',
  12967. ' tdatetime = double;',
  12968. 'procedure DoIt(n: nativeint); begin end;',
  12969. 'procedure DoIt(v: jsvalue); begin end;',
  12970. 'var',
  12971. ' d: double;',
  12972. ' dt: tdatetime;',
  12973. ' i: integer;',
  12974. ' b: byte;',
  12975. ' shi: shortint;',
  12976. ' w: word;',
  12977. ' smi: smallint;',
  12978. ' lw: longword;',
  12979. ' li: longint;',
  12980. ' ni: nativeint;',
  12981. ' nu: nativeuint;',
  12982. 'begin',
  12983. ' DoIt(d);',
  12984. ' DoIt(dt);',
  12985. ' DoIt(i);',
  12986. ' DoIt(b);',
  12987. ' DoIt(shi);',
  12988. ' DoIt(w);',
  12989. ' DoIt(smi);',
  12990. ' DoIt(lw);',
  12991. ' DoIt(li);',
  12992. ' DoIt(ni);',
  12993. ' DoIt(nu);',
  12994. '']);
  12995. ConvertProgram;
  12996. CheckSource('TestJSValue_OverloadNativeInt',
  12997. LinesToStr([ // statements
  12998. 'this.DoIt = function (n) {',
  12999. '};',
  13000. 'this.DoIt$1 = function (v) {',
  13001. '};',
  13002. 'this.d = 0.0;',
  13003. 'this.dt = 0.0;',
  13004. 'this.i = 0;',
  13005. 'this.b = 0;',
  13006. 'this.shi = 0;',
  13007. 'this.w = 0;',
  13008. 'this.smi = 0;',
  13009. 'this.lw = 0;',
  13010. 'this.li = 0;',
  13011. 'this.ni = 0;',
  13012. 'this.nu = 0;',
  13013. '']),
  13014. LinesToStr([ // $mod.$main
  13015. '$mod.DoIt$1($mod.d);',
  13016. '$mod.DoIt$1($mod.dt);',
  13017. '$mod.DoIt($mod.i);',
  13018. '$mod.DoIt($mod.b);',
  13019. '$mod.DoIt($mod.shi);',
  13020. '$mod.DoIt($mod.w);',
  13021. '$mod.DoIt($mod.smi);',
  13022. '$mod.DoIt($mod.lw);',
  13023. '$mod.DoIt($mod.li);',
  13024. '$mod.DoIt($mod.ni);',
  13025. '$mod.DoIt($mod.nu);',
  13026. '']));
  13027. end;
  13028. procedure TTestModule.TestJSValue_OverloadWord;
  13029. begin
  13030. StartProgram(false);
  13031. Add([
  13032. 'type',
  13033. ' integer = longint;',
  13034. ' int53 = nativeint;',
  13035. ' tdatetime = double;',
  13036. 'procedure DoIt(w: word); begin end;',
  13037. 'procedure DoIt(v: jsvalue); begin end;',
  13038. 'var',
  13039. ' d: double;',
  13040. ' dt: tdatetime;',
  13041. ' i: integer;',
  13042. ' b: byte;',
  13043. ' shi: shortint;',
  13044. ' w: word;',
  13045. ' smi: smallint;',
  13046. ' lw: longword;',
  13047. ' li: longint;',
  13048. ' ni: nativeint;',
  13049. ' nu: nativeuint;',
  13050. 'begin',
  13051. ' DoIt(d);',
  13052. ' DoIt(dt);',
  13053. ' DoIt(i);',
  13054. ' DoIt(b);',
  13055. ' DoIt(shi);',
  13056. ' DoIt(w);',
  13057. ' DoIt(smi);',
  13058. ' DoIt(lw);',
  13059. ' DoIt(li);',
  13060. ' DoIt(ni);',
  13061. ' DoIt(nu);',
  13062. '']);
  13063. ConvertProgram;
  13064. CheckSource('TestJSValue_OverloadWord',
  13065. LinesToStr([ // statements
  13066. 'this.DoIt = function (w) {',
  13067. '};',
  13068. 'this.DoIt$1 = function (v) {',
  13069. '};',
  13070. 'this.d = 0.0;',
  13071. 'this.dt = 0.0;',
  13072. 'this.i = 0;',
  13073. 'this.b = 0;',
  13074. 'this.shi = 0;',
  13075. 'this.w = 0;',
  13076. 'this.smi = 0;',
  13077. 'this.lw = 0;',
  13078. 'this.li = 0;',
  13079. 'this.ni = 0;',
  13080. 'this.nu = 0;',
  13081. '']),
  13082. LinesToStr([ // $mod.$main
  13083. '$mod.DoIt$1($mod.d);',
  13084. '$mod.DoIt$1($mod.dt);',
  13085. '$mod.DoIt$1($mod.i);',
  13086. '$mod.DoIt($mod.b);',
  13087. '$mod.DoIt($mod.shi);',
  13088. '$mod.DoIt($mod.w);',
  13089. '$mod.DoIt$1($mod.smi);',
  13090. '$mod.DoIt$1($mod.lw);',
  13091. '$mod.DoIt$1($mod.li);',
  13092. '$mod.DoIt$1($mod.ni);',
  13093. '$mod.DoIt$1($mod.nu);',
  13094. '']));
  13095. end;
  13096. procedure TTestModule.TestJSValue_OverloadString;
  13097. begin
  13098. StartProgram(false);
  13099. Add([
  13100. 'type',
  13101. ' uni = string;',
  13102. ' WChar = char;',
  13103. 'procedure DoIt(s: string); begin end;',
  13104. 'procedure DoIt(v: jsvalue); begin end;',
  13105. 'var',
  13106. ' s: string;',
  13107. ' c: char;',
  13108. ' u: uni;',
  13109. 'begin',
  13110. ' DoIt(s);',
  13111. ' DoIt(c);',
  13112. ' DoIt(u);',
  13113. '']);
  13114. ConvertProgram;
  13115. CheckSource('TestJSValue_OverloadString',
  13116. LinesToStr([ // statements
  13117. 'this.DoIt = function (s) {',
  13118. '};',
  13119. 'this.DoIt$1 = function (v) {',
  13120. '};',
  13121. 'this.s = "";',
  13122. 'this.c = "";',
  13123. 'this.u = "";',
  13124. '']),
  13125. LinesToStr([ // $mod.$main
  13126. '$mod.DoIt($mod.s);',
  13127. '$mod.DoIt($mod.c);',
  13128. '$mod.DoIt($mod.u);',
  13129. '']));
  13130. end;
  13131. procedure TTestModule.TestJSValue_OverloadChar;
  13132. begin
  13133. StartProgram(false);
  13134. Add([
  13135. 'type',
  13136. ' uni = string;',
  13137. ' WChar = char;',
  13138. 'procedure DoIt(c: char); begin end;',
  13139. 'procedure DoIt(v: jsvalue); begin end;',
  13140. 'var',
  13141. ' s: string;',
  13142. ' c: char;',
  13143. ' u: uni;',
  13144. 'begin',
  13145. ' DoIt(s);',
  13146. ' DoIt(c);',
  13147. ' DoIt(u);',
  13148. '']);
  13149. ConvertProgram;
  13150. CheckSource('TestJSValue_OverloadChar',
  13151. LinesToStr([ // statements
  13152. 'this.DoIt = function (c) {',
  13153. '};',
  13154. 'this.DoIt$1 = function (v) {',
  13155. '};',
  13156. 'this.s = "";',
  13157. 'this.c = "";',
  13158. 'this.u = "";',
  13159. '']),
  13160. LinesToStr([ // $mod.$main
  13161. '$mod.DoIt$1($mod.s);',
  13162. '$mod.DoIt($mod.c);',
  13163. '$mod.DoIt$1($mod.u);',
  13164. '']));
  13165. end;
  13166. procedure TTestModule.TestJSValue_OverloadPointer;
  13167. begin
  13168. StartProgram(false);
  13169. Add([
  13170. 'type',
  13171. ' TObject = class end;',
  13172. 'procedure DoIt(p: pointer); begin end;',
  13173. 'procedure DoIt(v: jsvalue); begin end;',
  13174. 'var',
  13175. ' o: TObject;',
  13176. 'begin',
  13177. ' DoIt(o);',
  13178. '']);
  13179. ConvertProgram;
  13180. CheckSource('TestJSValue_OverloadPointer',
  13181. LinesToStr([ // statements
  13182. 'rtl.createClass($mod, "TObject", null, function () {',
  13183. ' this.$init = function () {',
  13184. ' };',
  13185. ' this.$final = function () {',
  13186. ' };',
  13187. '});',
  13188. 'this.DoIt = function (p) {',
  13189. '};',
  13190. 'this.DoIt$1 = function (v) {',
  13191. '};',
  13192. 'this.o = null;',
  13193. '']),
  13194. LinesToStr([ // $mod.$main
  13195. '$mod.DoIt($mod.o);',
  13196. '']));
  13197. end;
  13198. procedure TTestModule.TestRTTI_ProcType;
  13199. begin
  13200. Converter.Options:=Converter.Options-[coNoTypeInfo];
  13201. StartProgram(false);
  13202. Add('type');
  13203. Add(' TProcA = procedure;');
  13204. Add(' TMethodB = procedure of object;');
  13205. Add(' TProcC = procedure; varargs;');
  13206. Add(' TProcD = procedure(i: longint; const j: string; var c: char; out d: double);');
  13207. Add(' TProcE = function: nativeint;');
  13208. Add(' TProcF = function(const p: TProcA): nativeuint;');
  13209. Add('var p: pointer;');
  13210. Add('begin');
  13211. Add(' p:=typeinfo(tproca);');
  13212. ConvertProgram;
  13213. CheckSource('TestRTTI_ProcType',
  13214. LinesToStr([ // statements
  13215. '$mod.$rtti.$ProcVar("TProcA", {',
  13216. ' procsig: rtl.newTIProcSig(null)',
  13217. '});',
  13218. '$mod.$rtti.$MethodVar("TMethodB", {',
  13219. ' procsig: rtl.newTIProcSig(null),',
  13220. ' methodkind: 0',
  13221. '});',
  13222. '$mod.$rtti.$ProcVar("TProcC", {',
  13223. ' procsig: rtl.newTIProcSig(null, 2)',
  13224. '});',
  13225. '$mod.$rtti.$ProcVar("TProcD", {',
  13226. ' procsig: rtl.newTIProcSig([["i", rtl.longint], ["j", rtl.string, 2], ["c", rtl.char, 1], ["d", rtl.double, 4]])',
  13227. '});',
  13228. '$mod.$rtti.$ProcVar("TProcE", {',
  13229. ' procsig: rtl.newTIProcSig(null, rtl.nativeint)',
  13230. '});',
  13231. '$mod.$rtti.$ProcVar("TProcF", {',
  13232. ' procsig: rtl.newTIProcSig([["p", $mod.$rtti["TProcA"], 2]], rtl.nativeuint)',
  13233. '});',
  13234. 'this.p = null;',
  13235. '']),
  13236. LinesToStr([ // $mod.$main
  13237. '$mod.p = $mod.$rtti["TProcA"];',
  13238. '']));
  13239. end;
  13240. procedure TTestModule.TestRTTI_ProcType_ArgFromOtherUnit;
  13241. begin
  13242. Converter.Options:=Converter.Options-[coNoTypeInfo];
  13243. AddModuleWithIntfImplSrc('unit2.pas',
  13244. LinesToStr([
  13245. 'type',
  13246. ' TObject = class end;'
  13247. ]),
  13248. '');
  13249. StartUnit(true);
  13250. Add('interface');
  13251. Add('uses unit2;');
  13252. Add('type');
  13253. Add(' TProcA = function(o: tobject): tobject;');
  13254. Add('implementation');
  13255. Add('type');
  13256. Add(' TProcB = function(o: tobject): tobject;');
  13257. Add('var p: Pointer;');
  13258. Add('initialization');
  13259. Add(' p:=typeinfo(tproca);');
  13260. Add(' p:=typeinfo(tprocb);');
  13261. ConvertUnit;
  13262. CheckSource('TestRTTI_ProcType_ArgFromOtherUnit',
  13263. LinesToStr([ // statements
  13264. 'var $impl = $mod.$impl;',
  13265. '$mod.$rtti.$ProcVar("TProcA", {',
  13266. ' procsig: rtl.newTIProcSig([["o", pas.unit2.$rtti["TObject"]]], pas.unit2.$rtti["TObject"])',
  13267. '});',
  13268. '']),
  13269. LinesToStr([ // this.$init
  13270. '$impl.p = $mod.$rtti["TProcA"];',
  13271. '$impl.p = $mod.$rtti["TProcB"];',
  13272. '']),
  13273. LinesToStr([ // implementation
  13274. '$mod.$rtti.$ProcVar("TProcB", {',
  13275. ' procsig: rtl.newTIProcSig([["o", pas.unit2.$rtti["TObject"]]], pas.unit2.$rtti["TObject"])',
  13276. '});',
  13277. '$impl.p = null;',
  13278. '']) );
  13279. end;
  13280. procedure TTestModule.TestRTTI_EnumAndSetType;
  13281. begin
  13282. Converter.Options:=Converter.Options-[coNoTypeInfo];
  13283. StartProgram(false);
  13284. Add('type');
  13285. Add(' TFlag = (light,dark);');
  13286. Add(' TFlags = set of TFlag;');
  13287. Add(' TProc = function(f: TFlags): TFlag;');
  13288. Add('var p: pointer;');
  13289. Add('begin');
  13290. Add(' p:=typeinfo(tflag);');
  13291. Add(' p:=typeinfo(tflags);');
  13292. ConvertProgram;
  13293. CheckSource('TestRTTI_EnumAndType',
  13294. LinesToStr([ // statements
  13295. 'this.TFlag = {',
  13296. ' "0": "light",',
  13297. ' light: 0,',
  13298. ' "1": "dark",',
  13299. ' dark: 1',
  13300. '};',
  13301. '$mod.$rtti.$Enum("TFlag", {',
  13302. ' minvalue: 0,',
  13303. ' maxvalue: 1,',
  13304. ' ordtype: 1,',
  13305. ' enumtype: this.TFlag',
  13306. '});',
  13307. '$mod.$rtti.$Set("TFlags", {',
  13308. ' comptype: $mod.$rtti["TFlag"]',
  13309. '});',
  13310. '$mod.$rtti.$ProcVar("TProc", {',
  13311. ' procsig: rtl.newTIProcSig([["f", $mod.$rtti["TFlags"]]], $mod.$rtti["TFlag"])',
  13312. '});',
  13313. 'this.p = null;',
  13314. '']),
  13315. LinesToStr([ // $mod.$main
  13316. '$mod.p = $mod.$rtti["TFlag"];',
  13317. '$mod.p = $mod.$rtti["TFlags"];',
  13318. '']));
  13319. end;
  13320. procedure TTestModule.TestRTTI_EnumRange;
  13321. begin
  13322. Converter.Options:=Converter.Options-[coNoTypeInfo];
  13323. StartProgram(false);
  13324. Add([
  13325. 'type',
  13326. ' TCol = (red,green,blue);',
  13327. ' TColRg = green..blue;',
  13328. ' TSetOfColRg = set of TColRg;',
  13329. 'var p: pointer;',
  13330. 'begin',
  13331. ' p:=typeinfo(tcolrg);',
  13332. ' p:=typeinfo(tsetofcolrg);',
  13333. '']);
  13334. ConvertProgram;
  13335. end;
  13336. procedure TTestModule.TestRTTI_AnonymousEnumType;
  13337. begin
  13338. Converter.Options:=Converter.Options-[coNoTypeInfo];
  13339. StartProgram(false);
  13340. Add('type');
  13341. Add(' TFlags = set of (red, green);');
  13342. Add('var');
  13343. Add(' f: TFlags;');
  13344. Add('begin');
  13345. Add(' Include(f,red);');
  13346. ConvertProgram;
  13347. CheckSource('TestRTTI_AnonymousEnumType',
  13348. LinesToStr([ // statements
  13349. 'this.TFlags$a = {',
  13350. ' "0": "red",',
  13351. ' red: 0,',
  13352. ' "1": "green",',
  13353. ' green: 1',
  13354. '};',
  13355. '$mod.$rtti.$Enum("TFlags$a", {',
  13356. ' minvalue: 0,',
  13357. ' maxvalue: 1,',
  13358. ' ordtype: 1,',
  13359. ' enumtype: this.TFlags$a',
  13360. '});',
  13361. '$mod.$rtti.$Set("TFlags", {',
  13362. ' comptype: $mod.$rtti["TFlags$a"]',
  13363. '});',
  13364. 'this.f = {};',
  13365. '']),
  13366. LinesToStr([
  13367. '$mod.f = rtl.includeSet($mod.f, $mod.TFlags$a.red);',
  13368. '']));
  13369. end;
  13370. procedure TTestModule.TestRTTI_StaticArray;
  13371. begin
  13372. Converter.Options:=Converter.Options-[coNoTypeInfo];
  13373. StartProgram(false);
  13374. Add('type');
  13375. Add(' TFlag = (light,dark);');
  13376. Add(' TFlagNames = array[TFlag] of string;');
  13377. Add(' TBoolNames = array[boolean] of string;');
  13378. Add(' TByteArray = array[1..32768] of byte;');
  13379. Add(' TProc = function(f: TBoolNames): TFlagNames;');
  13380. Add('var p: pointer;');
  13381. Add('begin');
  13382. Add(' p:=typeinfo(TFlagNames);');
  13383. Add(' p:=typeinfo(TBoolNames);');
  13384. ConvertProgram;
  13385. CheckSource('TestRTTI_StaticArray',
  13386. LinesToStr([ // statements
  13387. 'this.TFlag = {',
  13388. ' "0": "light",',
  13389. ' light: 0,',
  13390. ' "1": "dark",',
  13391. ' dark: 1',
  13392. '};',
  13393. '$mod.$rtti.$Enum("TFlag", {',
  13394. ' minvalue: 0,',
  13395. ' maxvalue: 1,',
  13396. ' ordtype: 1,',
  13397. ' enumtype: this.TFlag',
  13398. '});',
  13399. '$mod.$rtti.$StaticArray("TFlagNames", {',
  13400. ' dims: [2],',
  13401. ' eltype: rtl.string',
  13402. '});',
  13403. '$mod.$rtti.$StaticArray("TBoolNames", {',
  13404. ' dims: [2],',
  13405. ' eltype: rtl.string',
  13406. '});',
  13407. '$mod.$rtti.$StaticArray("TByteArray", {',
  13408. ' dims: [32768],',
  13409. ' eltype: rtl.byte',
  13410. '});',
  13411. '$mod.$rtti.$ProcVar("TProc", {',
  13412. ' procsig: rtl.newTIProcSig([["f", $mod.$rtti["TBoolNames"]]], $mod.$rtti["TFlagNames"])',
  13413. '});',
  13414. 'this.p = null;',
  13415. '']),
  13416. LinesToStr([ // $mod.$main
  13417. '$mod.p = $mod.$rtti["TFlagNames"];',
  13418. '$mod.p = $mod.$rtti["TBoolNames"];',
  13419. '']));
  13420. end;
  13421. procedure TTestModule.TestRTTI_DynArray;
  13422. begin
  13423. Converter.Options:=Converter.Options-[coNoTypeInfo];
  13424. StartProgram(false);
  13425. Add('type');
  13426. Add(' TArrStr = array of string;');
  13427. Add(' TArr2Dim = array of tarrstr;');
  13428. Add(' TProc = function(f: TArrStr): TArr2Dim;');
  13429. Add('var p: pointer;');
  13430. Add('begin');
  13431. Add(' p:=typeinfo(tarrstr);');
  13432. Add(' p:=typeinfo(tarr2dim);');
  13433. ConvertProgram;
  13434. CheckSource('TestRTTI_DynArray',
  13435. LinesToStr([ // statements
  13436. '$mod.$rtti.$DynArray("TArrStr", {',
  13437. ' eltype: rtl.string',
  13438. '});',
  13439. '$mod.$rtti.$DynArray("TArr2Dim", {',
  13440. ' eltype: $mod.$rtti["TArrStr"]',
  13441. '});',
  13442. '$mod.$rtti.$ProcVar("TProc", {',
  13443. ' procsig: rtl.newTIProcSig([["f", $mod.$rtti["TArrStr"]]], $mod.$rtti["TArr2Dim"])',
  13444. '});',
  13445. 'this.p = null;',
  13446. '']),
  13447. LinesToStr([ // $mod.$main
  13448. '$mod.p = $mod.$rtti["TArrStr"];',
  13449. '$mod.p = $mod.$rtti["TArr2Dim"];',
  13450. '']));
  13451. end;
  13452. procedure TTestModule.TestRTTI_ArrayNestedAnonymous;
  13453. begin
  13454. Converter.Options:=Converter.Options-[coNoTypeInfo];
  13455. StartProgram(false);
  13456. Add('type');
  13457. Add(' TArr = array of array of longint;');
  13458. Add('var a: TArr;');
  13459. Add('begin');
  13460. ConvertProgram;
  13461. CheckSource('TestRTTI_ArrayNestedAnonymous',
  13462. LinesToStr([ // statements
  13463. '$mod.$rtti.$DynArray("TArr$a", {',
  13464. ' eltype: rtl.longint',
  13465. '});',
  13466. '$mod.$rtti.$DynArray("TArr", {',
  13467. ' eltype: $mod.$rtti["TArr$a"]',
  13468. '});',
  13469. 'this.a = [];',
  13470. '']),
  13471. LinesToStr([ // $mod.$main
  13472. ]));
  13473. end;
  13474. procedure TTestModule.TestRTTI_PublishedMethodOverloadFail;
  13475. begin
  13476. Converter.Options:=Converter.Options-[coNoTypeInfo];
  13477. StartProgram(false);
  13478. Add('type');
  13479. Add(' TObject = class');
  13480. Add(' published');
  13481. Add(' procedure Proc; virtual; abstract;');
  13482. Add(' procedure Proc(Sender: tobject); virtual; abstract;');
  13483. Add(' end;');
  13484. Add('begin');
  13485. SetExpectedPasResolverError('Duplicate identifier "Proc" at test1.pp(6,19)',
  13486. nDuplicateIdentifier);
  13487. ConvertProgram;
  13488. end;
  13489. procedure TTestModule.TestRTTI_PublishedMethodExternalFail;
  13490. begin
  13491. Converter.Options:=Converter.Options-[coNoTypeInfo];
  13492. StartProgram(false);
  13493. Add('type');
  13494. Add(' TObject = class');
  13495. Add(' published');
  13496. Add(' procedure Proc; external name ''foo'';');
  13497. Add(' end;');
  13498. Add('begin');
  13499. SetExpectedPasResolverError(sPublishedNameMustMatchExternal,
  13500. nPublishedNameMustMatchExternal);
  13501. ConvertProgram;
  13502. end;
  13503. procedure TTestModule.TestRTTI_PublishedClassPropertyFail;
  13504. begin
  13505. Converter.Options:=Converter.Options-[coNoTypeInfo];
  13506. StartProgram(false);
  13507. Add('type');
  13508. Add(' TObject = class');
  13509. Add(' class var FA: longint;');
  13510. Add(' published');
  13511. Add(' class property A: longint read FA;');
  13512. Add(' end;');
  13513. Add('begin');
  13514. SetExpectedPasResolverError('Invalid published property modifier "class"',
  13515. nInvalidXModifierY);
  13516. ConvertProgram;
  13517. end;
  13518. procedure TTestModule.TestRTTI_PublishedClassFieldFail;
  13519. begin
  13520. Converter.Options:=Converter.Options-[coNoTypeInfo];
  13521. StartProgram(false);
  13522. Add('type');
  13523. Add(' TObject = class');
  13524. Add(' published');
  13525. Add(' class var FA: longint;');
  13526. Add(' end;');
  13527. Add('begin');
  13528. SetExpectedPasResolverError(sSymbolCannotBePublished,
  13529. nSymbolCannotBePublished);
  13530. ConvertProgram;
  13531. end;
  13532. procedure TTestModule.TestRTTI_PublishedFieldExternalFail;
  13533. begin
  13534. Converter.Options:=Converter.Options-[coNoTypeInfo];
  13535. StartProgram(false);
  13536. Add('{$modeswitch externalclass}');
  13537. Add('type');
  13538. Add(' TObject = class');
  13539. Add(' published');
  13540. Add(' V: longint; external name ''foo'';');
  13541. Add(' end;');
  13542. Add('begin');
  13543. SetExpectedPasResolverError(sPublishedNameMustMatchExternal,
  13544. nPublishedNameMustMatchExternal);
  13545. ConvertProgram;
  13546. end;
  13547. procedure TTestModule.TestRTTI_IndexModifier;
  13548. begin
  13549. Converter.Options:=Converter.Options-[coNoTypeInfo];
  13550. StartProgram(false);
  13551. Add([
  13552. 'type',
  13553. ' TEnum = (red, blue);',
  13554. ' TObject = class',
  13555. ' FB: boolean;',
  13556. ' procedure SetIntBool(Index: longint; b: boolean); virtual; abstract;',
  13557. ' function GetBoolBool(Index: boolean): boolean; virtual; abstract;',
  13558. ' procedure SetBoolBool(Index: boolean; b: boolean); virtual; abstract;',
  13559. ' function GetEnumBool(Index: TEnum): boolean; virtual; abstract;',
  13560. ' function GetStrIntBool(A: String; I: longint): boolean; virtual; abstract;',
  13561. ' procedure SetStrIntBool(A: String; I: longint; b: boolean); virtual; abstract;',
  13562. ' published',
  13563. ' property B1: boolean index 1 read FB write SetIntBool;',
  13564. ' property B2: boolean index TEnum.blue read GetEnumBool write FB;',
  13565. ' property I1[A: String]: boolean index 2 read GetStrIntBool write SetStrIntBool;',
  13566. ' end;',
  13567. 'begin']);
  13568. ConvertProgram;
  13569. CheckSource('TestRTTI_IndexModifier',
  13570. LinesToStr([ // statements
  13571. 'this.TEnum = {',
  13572. ' "0": "red",',
  13573. ' red: 0,',
  13574. ' "1": "blue",',
  13575. ' blue: 1',
  13576. '};',
  13577. '$mod.$rtti.$Enum("TEnum", {',
  13578. ' minvalue: 0,',
  13579. ' maxvalue: 1,',
  13580. ' ordtype: 1,',
  13581. ' enumtype: this.TEnum',
  13582. '});',
  13583. 'rtl.createClass($mod, "TObject", null, function () {',
  13584. ' this.$init = function () {',
  13585. ' this.FB = false;',
  13586. ' };',
  13587. ' this.$final = function () {',
  13588. ' };',
  13589. ' var $r = this.$rtti;',
  13590. ' $r.addProperty(',
  13591. ' "B1",',
  13592. ' 18,',
  13593. ' rtl.boolean,',
  13594. ' "FB",',
  13595. ' "SetIntBool",',
  13596. ' {',
  13597. ' index: 1',
  13598. ' }',
  13599. ' );',
  13600. ' $r.addProperty(',
  13601. ' "B2",',
  13602. ' 17,',
  13603. ' rtl.boolean,',
  13604. ' "GetEnumBool",',
  13605. ' "FB",',
  13606. ' {',
  13607. ' index: $mod.TEnum.blue',
  13608. ' }',
  13609. ' );',
  13610. ' $r.addProperty(',
  13611. ' "I1",',
  13612. ' 19,',
  13613. ' rtl.boolean,',
  13614. ' "GetStrIntBool",',
  13615. ' "SetStrIntBool",',
  13616. ' {',
  13617. ' index: 2',
  13618. ' }',
  13619. ' );',
  13620. '});',
  13621. '']),
  13622. LinesToStr([ // $mod.$main
  13623. '']));
  13624. end;
  13625. procedure TTestModule.TestRTTI_StoredModifier;
  13626. begin
  13627. Converter.Options:=Converter.Options-[coNoTypeInfo];
  13628. StartProgram(false);
  13629. Add([
  13630. 'const',
  13631. ' ConstB = true;',
  13632. 'type',
  13633. ' TObject = class',
  13634. ' private',
  13635. ' FB: boolean;',
  13636. ' function IsBStored: boolean; virtual; abstract;',
  13637. ' published',
  13638. ' property BoolA: boolean read FB stored true;',
  13639. ' property BoolB: boolean read FB stored false;',
  13640. ' property BoolC: boolean read FB stored FB;',
  13641. ' property BoolD: boolean read FB stored ConstB;',
  13642. ' property BoolE: boolean read FB stored IsBStored;',
  13643. ' end;',
  13644. 'begin']);
  13645. ConvertProgram;
  13646. CheckSource('TestRTTI_StoredModifier',
  13647. LinesToStr([ // statements
  13648. 'this.ConstB = true;',
  13649. 'rtl.createClass($mod, "TObject", null, function () {',
  13650. ' this.$init = function () {',
  13651. ' this.FB = false;',
  13652. ' };',
  13653. ' this.$final = function () {',
  13654. ' };',
  13655. ' var $r = this.$rtti;',
  13656. ' $r.addProperty("BoolA", 0, rtl.boolean, "FB", "");',
  13657. ' $r.addProperty("BoolB", 4, rtl.boolean, "FB", "");',
  13658. ' $r.addProperty(',
  13659. ' "BoolC",',
  13660. ' 8,',
  13661. ' rtl.boolean,',
  13662. ' "FB",',
  13663. ' "",',
  13664. ' {',
  13665. ' stored: "FB"',
  13666. ' }',
  13667. ' );',
  13668. ' $r.addProperty("BoolD", 0, rtl.boolean, "FB", "");',
  13669. ' $r.addProperty(',
  13670. ' "BoolE",',
  13671. ' 12,',
  13672. ' rtl.boolean,',
  13673. ' "FB",',
  13674. ' "",',
  13675. ' {',
  13676. ' stored: "IsBStored"',
  13677. ' }',
  13678. ' );',
  13679. '});',
  13680. '']),
  13681. LinesToStr([ // $mod.$main
  13682. '']));
  13683. end;
  13684. procedure TTestModule.TestRTTI_DefaultValue;
  13685. begin
  13686. Converter.Options:=Converter.Options-[coNoTypeInfo];
  13687. StartProgram(false);
  13688. Add([
  13689. 'type',
  13690. ' TEnum = (red, blue);',
  13691. 'const',
  13692. ' CB = true or false;',
  13693. ' CI = 1+2;',
  13694. 'type',
  13695. ' TObject = class',
  13696. ' FB: boolean;',
  13697. ' FI: longint;',
  13698. ' FE: TEnum;',
  13699. ' published',
  13700. ' property B1: boolean read FB default true;',
  13701. ' property B2: boolean read FB default CB;',
  13702. ' property B3: boolean read FB default test1.cb;',
  13703. ' property I1: longint read FI default 2;',
  13704. ' property I2: longint read FI default CI;',
  13705. ' property E1: TEnum read FE default red;',
  13706. ' property E2: TEnum read FE default TEnum.blue;',
  13707. ' end;',
  13708. 'begin']);
  13709. ConvertProgram;
  13710. CheckSource('TestRTTI_DefaultValue',
  13711. LinesToStr([ // statements
  13712. 'this.TEnum = {',
  13713. ' "0": "red",',
  13714. ' red: 0,',
  13715. ' "1": "blue",',
  13716. ' blue: 1',
  13717. '};',
  13718. '$mod.$rtti.$Enum("TEnum", {',
  13719. ' minvalue: 0,',
  13720. ' maxvalue: 1,',
  13721. ' ordtype: 1,',
  13722. ' enumtype: this.TEnum',
  13723. '});',
  13724. 'this.CB = true || false;',
  13725. 'this.CI = 1 + 2;',
  13726. 'rtl.createClass($mod, "TObject", null, function () {',
  13727. ' this.$init = function () {',
  13728. ' this.FB = false;',
  13729. ' this.FI = 0;',
  13730. ' this.FE = 0;',
  13731. ' };',
  13732. ' this.$final = function () {',
  13733. ' };',
  13734. ' var $r = this.$rtti;',
  13735. ' $r.addProperty(',
  13736. ' "B1",',
  13737. ' 0,',
  13738. ' rtl.boolean,',
  13739. ' "FB",',
  13740. ' "",',
  13741. ' {',
  13742. ' Default: true',
  13743. ' }',
  13744. ' );',
  13745. ' $r.addProperty(',
  13746. ' "B2",',
  13747. ' 0,',
  13748. ' rtl.boolean,',
  13749. ' "FB",',
  13750. ' "",',
  13751. ' {',
  13752. ' Default: true',
  13753. ' }',
  13754. ' );',
  13755. ' $r.addProperty(',
  13756. ' "B3",',
  13757. ' 0,',
  13758. ' rtl.boolean,',
  13759. ' "FB",',
  13760. ' "",',
  13761. ' {',
  13762. ' Default: true',
  13763. ' }',
  13764. ' );',
  13765. ' $r.addProperty(',
  13766. ' "I1",',
  13767. ' 0,',
  13768. ' rtl.longint,',
  13769. ' "FI",',
  13770. ' "",',
  13771. ' {',
  13772. ' Default: 2',
  13773. ' }',
  13774. ' );',
  13775. ' $r.addProperty(',
  13776. ' "I2",',
  13777. ' 0,',
  13778. ' rtl.longint,',
  13779. ' "FI",',
  13780. ' "",',
  13781. ' {',
  13782. ' Default: 3',
  13783. ' }',
  13784. ' );',
  13785. ' $r.addProperty(',
  13786. ' "E1",',
  13787. ' 0,',
  13788. ' $mod.$rtti["TEnum"],',
  13789. ' "FE",',
  13790. ' "",',
  13791. ' {',
  13792. ' Default: $mod.TEnum.red',
  13793. ' }',
  13794. ' );',
  13795. ' $r.addProperty(',
  13796. ' "E2",',
  13797. ' 0,',
  13798. ' $mod.$rtti["TEnum"],',
  13799. ' "FE",',
  13800. ' "",',
  13801. ' {',
  13802. ' Default: $mod.TEnum.blue',
  13803. ' }',
  13804. ' );',
  13805. '});',
  13806. '']),
  13807. LinesToStr([ // $mod.$main
  13808. '']));
  13809. end;
  13810. procedure TTestModule.TestRTTI_DefaultValueSet;
  13811. begin
  13812. Converter.Options:=Converter.Options-[coNoTypeInfo];
  13813. StartProgram(false);
  13814. Add([
  13815. 'type',
  13816. ' TEnum = (red, blue);',
  13817. ' TSet = set of TEnum;',
  13818. 'const',
  13819. ' CSet = [red,blue];',
  13820. 'type',
  13821. ' TObject = class',
  13822. ' FSet: TSet;',
  13823. ' published',
  13824. ' property Set1: TSet read FSet default [];',
  13825. ' property Set2: TSet read FSet default [red];',
  13826. ' property Set3: TSet read FSet default [red,blue];',
  13827. ' property Set4: TSet read FSet default CSet;',
  13828. ' end;',
  13829. 'begin']);
  13830. ConvertProgram;
  13831. CheckSource('TestRTTI_DefaultValueSet',
  13832. LinesToStr([ // statements
  13833. 'this.TEnum = {',
  13834. ' "0": "red",',
  13835. ' red: 0,',
  13836. ' "1": "blue",',
  13837. ' blue: 1',
  13838. '};',
  13839. '$mod.$rtti.$Enum("TEnum", {',
  13840. ' minvalue: 0,',
  13841. ' maxvalue: 1,',
  13842. ' ordtype: 1,',
  13843. ' enumtype: this.TEnum',
  13844. '});',
  13845. '$mod.$rtti.$Set("TSet", {',
  13846. ' comptype: $mod.$rtti["TEnum"]',
  13847. '});',
  13848. 'this.CSet = rtl.createSet($mod.TEnum.red, $mod.TEnum.blue);',
  13849. 'rtl.createClass($mod, "TObject", null, function () {',
  13850. ' this.$init = function () {',
  13851. ' this.FSet = {};',
  13852. ' };',
  13853. ' this.$final = function () {',
  13854. ' this.FSet = undefined;',
  13855. ' };',
  13856. ' var $r = this.$rtti;',
  13857. ' $r.addProperty(',
  13858. ' "Set1",',
  13859. ' 0,',
  13860. ' $mod.$rtti["TSet"],',
  13861. ' "FSet",',
  13862. ' "",',
  13863. ' {',
  13864. ' Default: {}',
  13865. ' }',
  13866. ' );',
  13867. ' $r.addProperty(',
  13868. ' "Set2",',
  13869. ' 0,',
  13870. ' $mod.$rtti["TSet"],',
  13871. ' "FSet",',
  13872. ' "",',
  13873. ' {',
  13874. ' Default: rtl.createSet($mod.TEnum.red)',
  13875. ' }',
  13876. ' );',
  13877. ' $r.addProperty(',
  13878. ' "Set3",',
  13879. ' 0,',
  13880. ' $mod.$rtti["TSet"],',
  13881. ' "FSet",',
  13882. ' "",',
  13883. ' {',
  13884. ' Default: rtl.createSet($mod.TEnum.red, $mod.TEnum.blue)',
  13885. ' }',
  13886. ' );',
  13887. ' $r.addProperty(',
  13888. ' "Set4",',
  13889. ' 0,',
  13890. ' $mod.$rtti["TSet"],',
  13891. ' "FSet",',
  13892. ' "",',
  13893. ' {',
  13894. ' Default: $mod.CSet',
  13895. ' }',
  13896. ' );',
  13897. '});',
  13898. '']),
  13899. LinesToStr([ // $mod.$main
  13900. '']));
  13901. end;
  13902. procedure TTestModule.TestRTTI_DefaultValueRangeType;
  13903. begin
  13904. Converter.Options:=Converter.Options-[coNoTypeInfo];
  13905. StartProgram(false);
  13906. Add([
  13907. 'type',
  13908. ' TRg = -1..1;',
  13909. 'const',
  13910. ' l = low(TRg);',
  13911. ' h = high(TRg);',
  13912. 'type',
  13913. ' TObject = class',
  13914. ' FV: TRg;',
  13915. ' published',
  13916. ' property V1: TRg read FV default -1;',
  13917. ' end;',
  13918. 'begin']);
  13919. ConvertProgram;
  13920. CheckSource('TestRTTI_DefaultValueRangeType',
  13921. LinesToStr([ // statements
  13922. '$mod.$rtti.$Int("TRg", {',
  13923. ' minvalue: -1,',
  13924. ' maxvalue: 1,',
  13925. ' ordtype: 0',
  13926. '});',
  13927. 'this.l = -1;',
  13928. 'this.h = 1;',
  13929. 'rtl.createClass($mod, "TObject", null, function () {',
  13930. ' this.$init = function () {',
  13931. ' this.FV = -1;',
  13932. ' };',
  13933. ' this.$final = function () {',
  13934. ' };',
  13935. ' var $r = this.$rtti;',
  13936. ' $r.addProperty(',
  13937. ' "V1",',
  13938. ' 0,',
  13939. ' $mod.$rtti["TRg"],',
  13940. ' "FV",',
  13941. ' "",',
  13942. ' {',
  13943. ' Default: -1',
  13944. ' }',
  13945. ' );',
  13946. '});',
  13947. '']),
  13948. LinesToStr([ // $mod.$main
  13949. '']));
  13950. end;
  13951. procedure TTestModule.TestRTTI_Class_Field;
  13952. begin
  13953. Converter.Options:=Converter.Options-[coNoTypeInfo];
  13954. StartProgram(false);
  13955. Add('{$modeswitch externalclass}');
  13956. Add('type');
  13957. Add(' TObject = class');
  13958. Add(' private');
  13959. Add(' FPropA: string;');
  13960. Add(' published');
  13961. Add(' VarLI: longint;');
  13962. Add(' VarC: char;');
  13963. Add(' VarS: string;');
  13964. Add(' VarD: double;');
  13965. Add(' VarB: boolean;');
  13966. Add(' VarLW: longword;');
  13967. Add(' VarSmI: smallint;');
  13968. Add(' VarW: word;');
  13969. Add(' VarShI: shortint;');
  13970. Add(' VarBy: byte;');
  13971. Add(' VarExt: longint external name ''VarExt'';');
  13972. Add(' end;');
  13973. Add('var p: pointer;');
  13974. Add(' Obj: tobject;');
  13975. Add('begin');
  13976. Add(' p:=typeinfo(tobject);');
  13977. Add(' p:=typeinfo(p);');
  13978. Add(' p:=typeinfo(obj);');
  13979. ConvertProgram;
  13980. CheckSource('TestRTTI_Class_Field',
  13981. LinesToStr([ // statements
  13982. 'rtl.createClass($mod, "TObject", null, function () {',
  13983. ' this.$init = function () {',
  13984. ' this.FPropA = "";',
  13985. ' this.VarLI = 0;',
  13986. ' this.VarC = "";',
  13987. ' this.VarS = "";',
  13988. ' this.VarD = 0.0;',
  13989. ' this.VarB = false;',
  13990. ' this.VarLW = 0;',
  13991. ' this.VarSmI = 0;',
  13992. ' this.VarW = 0;',
  13993. ' this.VarShI = 0;',
  13994. ' this.VarBy = 0;',
  13995. ' };',
  13996. ' this.$final = function () {',
  13997. ' };',
  13998. ' var $r = this.$rtti;',
  13999. ' $r.addField("VarLI", rtl.longint);',
  14000. ' $r.addField("VarC", rtl.char);',
  14001. ' $r.addField("VarS", rtl.string);',
  14002. ' $r.addField("VarD", rtl.double);',
  14003. ' $r.addField("VarB", rtl.boolean);',
  14004. ' $r.addField("VarLW", rtl.longword);',
  14005. ' $r.addField("VarSmI", rtl.smallint);',
  14006. ' $r.addField("VarW", rtl.word);',
  14007. ' $r.addField("VarShI", rtl.shortint);',
  14008. ' $r.addField("VarBy", rtl.byte);',
  14009. ' $r.addField("VarExt", rtl.longint);',
  14010. '});',
  14011. 'this.p = null;',
  14012. 'this.Obj = null;',
  14013. '']),
  14014. LinesToStr([ // $mod.$main
  14015. '$mod.p = $mod.$rtti["TObject"];',
  14016. '$mod.p = rtl.pointer;',
  14017. '$mod.p = $mod.Obj.$rtti;',
  14018. '']));
  14019. end;
  14020. procedure TTestModule.TestRTTI_Class_Method;
  14021. begin
  14022. Converter.Options:=Converter.Options-[coNoTypeInfo];
  14023. StartProgram(false);
  14024. Add('type');
  14025. Add(' TObject = class');
  14026. Add(' private');
  14027. Add(' procedure Internal; external name ''$intern'';');
  14028. Add(' published');
  14029. Add(' procedure Click; virtual; abstract;');
  14030. Add(' procedure Notify(Sender: TObject); virtual; abstract;');
  14031. Add(' function GetNotify: boolean; external name ''GetNotify'';');
  14032. Add(' procedure Println(a,b: longint); varargs; virtual; abstract;');
  14033. Add(' end;');
  14034. Add('begin');
  14035. ConvertProgram;
  14036. CheckSource('TestRTTI_Class_Method',
  14037. LinesToStr([ // statements
  14038. 'rtl.createClass($mod, "TObject", null, function () {',
  14039. ' this.$init = function () {',
  14040. ' };',
  14041. ' this.$final = function () {',
  14042. ' };',
  14043. ' var $r = this.$rtti;',
  14044. ' $r.addMethod("Click", 0, null);',
  14045. ' $r.addMethod("Notify", 0, [["Sender", $r]]);',
  14046. ' $r.addMethod("GetNotify", 1, null, rtl.boolean,{flags: 4});',
  14047. ' $r.addMethod("Println", 0, [["a", rtl.longint], ["b", rtl.longint]], null, {',
  14048. ' flags: 2',
  14049. ' });',
  14050. '});',
  14051. '']),
  14052. LinesToStr([ // $mod.$main
  14053. '']));
  14054. end;
  14055. procedure TTestModule.TestRTTI_Class_MethodArgFlags;
  14056. begin
  14057. Converter.Options:=Converter.Options-[coNoTypeInfo];
  14058. StartProgram(false);
  14059. Add('type');
  14060. Add(' TObject = class');
  14061. Add(' published');
  14062. Add(' procedure OpenArray(const Args: array of string); virtual; abstract;');
  14063. Add(' procedure ByRef(var Value: longint; out Item: longint); virtual; abstract;');
  14064. Add(' procedure Untyped(var Value; out Item); virtual; abstract;');
  14065. Add(' end;');
  14066. Add('begin');
  14067. ConvertProgram;
  14068. CheckSource('TestRTTI_Class_MethodOpenArray',
  14069. LinesToStr([ // statements
  14070. 'rtl.createClass($mod, "TObject", null, function () {',
  14071. ' this.$init = function () {',
  14072. ' };',
  14073. ' this.$final = function () {',
  14074. ' };',
  14075. ' var $r = this.$rtti;',
  14076. '$r.addMethod("OpenArray", 0, [["Args", rtl.string, 10]]);',
  14077. '$r.addMethod("ByRef", 0, [["Value", rtl.longint, 1], ["Item", rtl.longint, 4]]);',
  14078. '$r.addMethod("Untyped", 0, [["Value", null, 1], ["Item", null, 4]]);',
  14079. '});',
  14080. '']),
  14081. LinesToStr([ // $mod.$main
  14082. '']));
  14083. end;
  14084. procedure TTestModule.TestRTTI_Class_Property;
  14085. begin
  14086. Converter.Options:=Converter.Options-[coNoTypeInfo];
  14087. StartProgram(false);
  14088. Add('{$modeswitch externalclass}');
  14089. Add('type');
  14090. Add(' TObject = class');
  14091. Add(' private');
  14092. Add(' FColor: longint;');
  14093. Add(' FColorStored: boolean;');
  14094. Add(' procedure SetColor(Value: longint); virtual; abstract;');
  14095. Add(' function GetColor: longint; virtual; abstract;');
  14096. Add(' function GetColorStored: boolean; virtual; abstract;');
  14097. Add(' FExtSize: longint external name ''$extSize'';');
  14098. Add(' FExtSizeStored: boolean external name ''$extSizeStored'';');
  14099. Add(' procedure SetExtSize(Value: longint); external name ''$setSize'';');
  14100. Add(' function GetExtSize: longint; external name ''$getSize'';');
  14101. Add(' function GetExtSizeStored: boolean; external name ''$getExtSizeStored'';');
  14102. Add(' published');
  14103. Add(' property ColorA: longint read FColor;');
  14104. Add(' property ColorB: longint write FColor;');
  14105. Add(' property ColorC: longint read GetColor write SetColor;');
  14106. Add(' property ColorD: longint read FColor write FColor stored FColorStored;');
  14107. Add(' property ExtSizeA: longint read FExtSize write FExtSize;');
  14108. Add(' property ExtSizeB: longint read GetExtSize write SetExtSize stored FExtSizeStored;');
  14109. Add(' property ExtSizeC: longint read FExtSize write FExtSize stored GetExtSizeStored;');
  14110. Add(' end;');
  14111. Add('begin');
  14112. ConvertProgram;
  14113. CheckSource('TestRTTI_Class_Property',
  14114. LinesToStr([ // statements
  14115. 'rtl.createClass($mod, "TObject", null, function () {',
  14116. ' this.$init = function () {',
  14117. ' this.FColor = 0;',
  14118. ' this.FColorStored = false;',
  14119. ' };',
  14120. ' this.$final = function () {',
  14121. ' };',
  14122. ' var $r = this.$rtti;',
  14123. ' $r.addProperty("ColorA", 0, rtl.longint, "FColor", "");',
  14124. ' $r.addProperty("ColorB", 0, rtl.longint, "", "FColor");',
  14125. ' $r.addProperty("ColorC", 3, rtl.longint, "GetColor", "SetColor");',
  14126. ' $r.addProperty(',
  14127. ' "ColorD",',
  14128. ' 8,',
  14129. ' rtl.longint,',
  14130. ' "FColor",',
  14131. ' "FColor",',
  14132. ' {',
  14133. ' stored: "FColorStored"',
  14134. ' }',
  14135. ' );',
  14136. ' $r.addProperty("ExtSizeA", 0, rtl.longint, "$extSize", "$extSize");',
  14137. ' $r.addProperty(',
  14138. ' "ExtSizeB",',
  14139. ' 11,',
  14140. ' rtl.longint,',
  14141. ' "$getSize",',
  14142. ' "$setSize",',
  14143. ' {',
  14144. ' stored: "$extSizeStored"',
  14145. ' }',
  14146. ' );',
  14147. ' $r.addProperty(',
  14148. ' "ExtSizeC",',
  14149. ' 12,',
  14150. ' rtl.longint,',
  14151. ' "$extSize",',
  14152. ' "$extSize",',
  14153. ' {',
  14154. ' stored: "$getExtSizeStored"',
  14155. ' }',
  14156. ' );',
  14157. '});',
  14158. '']),
  14159. LinesToStr([ // $mod.$main
  14160. '']));
  14161. end;
  14162. procedure TTestModule.TestRTTI_Class_PropertyParams;
  14163. begin
  14164. Converter.Options:=Converter.Options-[coNoTypeInfo];
  14165. StartProgram(false);
  14166. Add('{$modeswitch externalclass}');
  14167. Add('type');
  14168. Add(' integer = longint;');
  14169. Add(' TObject = class');
  14170. Add(' private');
  14171. Add(' function GetItems(i: integer): tobject; virtual; abstract;');
  14172. Add(' procedure SetItems(i: integer; value: tobject); virtual; abstract;');
  14173. Add(' function GetValues(const i: integer; var b: boolean): char; virtual; abstract;');
  14174. Add(' procedure SetValues(const i: integer; var b: boolean; value: char); virtual; abstract;');
  14175. Add(' published');
  14176. Add(' property Items[Index: integer]: tobject read getitems write setitems;');
  14177. Add(' property Values[const keya: integer; var keyb: boolean]: char read getvalues write setvalues;');
  14178. Add(' end;');
  14179. Add('begin');
  14180. ConvertProgram;
  14181. CheckSource('TestRTTI_Class_PropertyParams',
  14182. LinesToStr([ // statements
  14183. 'rtl.createClass($mod, "TObject", null, function () {',
  14184. ' this.$init = function () {',
  14185. ' };',
  14186. ' this.$final = function () {',
  14187. ' };',
  14188. ' var $r = this.$rtti;',
  14189. ' $r.addProperty("Items", 3, $r, "GetItems", "SetItems");',
  14190. ' $r.addProperty("Values", 3, rtl.char, "GetValues", "SetValues");',
  14191. '});',
  14192. '']),
  14193. LinesToStr([ // $mod.$main
  14194. '']));
  14195. end;
  14196. procedure TTestModule.TestRTTI_OverrideMethod;
  14197. begin
  14198. Converter.Options:=Converter.Options-[coNoTypeInfo];
  14199. StartProgram(false);
  14200. Add('type');
  14201. Add(' TObject = class');
  14202. Add(' published');
  14203. Add(' procedure DoIt; virtual; abstract;');
  14204. Add(' end;');
  14205. Add(' TSky = class');
  14206. Add(' published');
  14207. Add(' procedure DoIt; override;');
  14208. Add(' end;');
  14209. Add('procedure TSky.DoIt; begin end;');
  14210. Add('begin');
  14211. ConvertProgram;
  14212. CheckSource('TestRTTI_OverrideMethod',
  14213. LinesToStr([ // statements
  14214. 'rtl.createClass($mod, "TObject", null, function () {',
  14215. ' this.$init = function () {',
  14216. ' };',
  14217. ' this.$final = function () {',
  14218. ' };',
  14219. ' var $r = this.$rtti;',
  14220. ' $r.addMethod("DoIt", 0, null);',
  14221. '});',
  14222. 'rtl.createClass($mod, "TSky", $mod.TObject, function () {',
  14223. ' this.DoIt = function () {',
  14224. ' };',
  14225. '});',
  14226. '']),
  14227. LinesToStr([ // $mod.$main
  14228. '']));
  14229. end;
  14230. procedure TTestModule.TestRTTI_OverloadProperty;
  14231. begin
  14232. Converter.Options:=Converter.Options-[coNoTypeInfo];
  14233. StartProgram(false);
  14234. Add('type');
  14235. Add(' TObject = class');
  14236. Add(' protected');
  14237. Add(' FFlag: longint;');
  14238. Add(' published');
  14239. Add(' property Flag: longint read fflag;');
  14240. Add(' end;');
  14241. Add(' TSky = class');
  14242. Add(' published');
  14243. Add(' property FLAG: longint write fflag;');
  14244. Add(' end;');
  14245. Add('begin');
  14246. ConvertProgram;
  14247. CheckSource('TestRTTI_OverrideMethod',
  14248. LinesToStr([ // statements
  14249. 'rtl.createClass($mod, "TObject", null, function () {',
  14250. ' this.$init = function () {',
  14251. ' this.FFlag = 0;',
  14252. ' };',
  14253. ' this.$final = function () {',
  14254. ' };',
  14255. ' var $r = this.$rtti;',
  14256. ' $r.addProperty("Flag", 0, rtl.longint, "FFlag", "");',
  14257. '});',
  14258. 'rtl.createClass($mod, "TSky", $mod.TObject, function () {',
  14259. ' var $r = this.$rtti;',
  14260. ' $r.addProperty("Flag", 0, rtl.longint, "", "FFlag");',
  14261. '});',
  14262. '']),
  14263. LinesToStr([ // $mod.$main
  14264. '']));
  14265. end;
  14266. procedure TTestModule.TestRTTI_ClassForward;
  14267. begin
  14268. Converter.Options:=Converter.Options-[coNoTypeInfo];
  14269. StartProgram(false);
  14270. Add('type');
  14271. Add(' TObject = class end;');
  14272. Add(' tbridge = class;');
  14273. Add(' TProc = function: tbridge;');
  14274. Add(' TOger = class');
  14275. Add(' published');
  14276. Add(' FBridge: tbridge;');
  14277. Add(' procedure SetBridge(Value: tbridge); virtual; abstract;');
  14278. Add(' property Bridge: tbridge read fbridge write setbridge;');
  14279. Add(' end;');
  14280. Add(' TBridge = class');
  14281. Add(' FOger: toger;');
  14282. Add(' end;');
  14283. Add('var p: Pointer;');
  14284. Add(' b: tbridge;');
  14285. Add('begin');
  14286. Add(' p:=typeinfo(tbridge);');
  14287. Add(' p:=typeinfo(b);');
  14288. ConvertProgram;
  14289. CheckSource('TestRTTI_ClassForward',
  14290. LinesToStr([ // statements
  14291. 'rtl.createClass($mod, "TObject", null, function () {',
  14292. ' this.$init = function () {',
  14293. ' };',
  14294. ' this.$final = function () {',
  14295. ' };',
  14296. '});',
  14297. '$mod.$rtti.$Class("TBridge");',
  14298. '$mod.$rtti.$ProcVar("TProc", {',
  14299. ' procsig: rtl.newTIProcSig(null, $mod.$rtti["TBridge"])',
  14300. '});',
  14301. 'rtl.createClass($mod, "TOger", $mod.TObject, function () {',
  14302. ' this.$init = function () {',
  14303. ' $mod.TObject.$init.call(this);',
  14304. ' this.FBridge = null;',
  14305. ' };',
  14306. ' this.$final = function () {',
  14307. ' this.FBridge = undefined;',
  14308. ' $mod.TObject.$final.call(this);',
  14309. ' };',
  14310. ' var $r = this.$rtti;',
  14311. ' $r.addField("FBridge", $mod.$rtti["TBridge"]);',
  14312. ' $r.addMethod("SetBridge", 0, [["Value", $mod.$rtti["TBridge"]]]);',
  14313. ' $r.addProperty("Bridge", 2, $mod.$rtti["TBridge"], "FBridge", "SetBridge");',
  14314. '});',
  14315. 'rtl.createClass($mod, "TBridge", $mod.TObject, function () {',
  14316. ' this.$init = function () {',
  14317. ' $mod.TObject.$init.call(this);',
  14318. ' this.FOger = null;',
  14319. ' };',
  14320. ' this.$final = function () {',
  14321. ' this.FOger = undefined;',
  14322. ' $mod.TObject.$final.call(this);',
  14323. ' };',
  14324. '});',
  14325. 'this.p = null;',
  14326. 'this.b = null;',
  14327. '']),
  14328. LinesToStr([ // $mod.$main
  14329. '$mod.p = $mod.$rtti["TBridge"];',
  14330. '$mod.p = $mod.b.$rtti;',
  14331. '']));
  14332. end;
  14333. procedure TTestModule.TestRTTI_ClassOf;
  14334. begin
  14335. Converter.Options:=Converter.Options-[coNoTypeInfo];
  14336. StartProgram(false);
  14337. Add('type');
  14338. Add(' TClass = class of tobject;');
  14339. Add(' TProcA = function: TClass;');
  14340. Add(' TObject = class');
  14341. Add(' published');
  14342. Add(' C: tclass;');
  14343. Add(' end;');
  14344. Add(' tfox = class;');
  14345. Add(' TBird = class end;');
  14346. Add(' TBirds = class of tbird;');
  14347. Add(' TFox = class end;');
  14348. Add(' TFoxes = class of tfox;');
  14349. Add(' TCows = class of TCow;');
  14350. Add(' TCow = class;');
  14351. Add(' TCow = class end;');
  14352. Add('begin');
  14353. ConvertProgram;
  14354. CheckSource('TestRTTI_ClassOf',
  14355. LinesToStr([ // statements
  14356. '$mod.$rtti.$Class("TObject");',
  14357. '$mod.$rtti.$ClassRef("TClass", {',
  14358. ' instancetype: $mod.$rtti["TObject"]',
  14359. '});',
  14360. '$mod.$rtti.$ProcVar("TProcA", {',
  14361. ' procsig: rtl.newTIProcSig(null, $mod.$rtti["TClass"])',
  14362. '});',
  14363. 'rtl.createClass($mod, "TObject", null, function () {',
  14364. ' this.$init = function () {',
  14365. ' this.C = null;',
  14366. ' };',
  14367. ' this.$final = function () {',
  14368. ' this.C = undefined;',
  14369. ' };',
  14370. ' var $r = this.$rtti;',
  14371. ' $r.addField("C", $mod.$rtti["TClass"]);',
  14372. '});',
  14373. '$mod.$rtti.$Class("TFox");',
  14374. 'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
  14375. '});',
  14376. '$mod.$rtti.$ClassRef("TBirds", {',
  14377. ' instancetype: $mod.$rtti["TBird"]',
  14378. '});',
  14379. 'rtl.createClass($mod, "TFox", $mod.TObject, function () {',
  14380. '});',
  14381. '$mod.$rtti.$ClassRef("TFoxes", {',
  14382. ' instancetype: $mod.$rtti["TFox"]',
  14383. '});',
  14384. '$mod.$rtti.$Class("TCow");',
  14385. '$mod.$rtti.$ClassRef("TCows", {',
  14386. ' instancetype: $mod.$rtti["TCow"]',
  14387. '});',
  14388. 'rtl.createClass($mod, "TCow", $mod.TObject, function () {',
  14389. '});',
  14390. '']),
  14391. LinesToStr([ // $mod.$main
  14392. '']));
  14393. end;
  14394. procedure TTestModule.TestRTTI_Record;
  14395. begin
  14396. Converter.Options:=Converter.Options-[coNoTypeInfo];
  14397. StartProgram(false);
  14398. Add('type');
  14399. Add(' integer = longint;');
  14400. Add(' TPoint = record');
  14401. Add(' x,y: integer;');
  14402. Add(' end;');
  14403. Add('var p: pointer;');
  14404. Add(' r: tpoint;');
  14405. Add('begin');
  14406. Add(' p:=typeinfo(tpoint);');
  14407. Add(' p:=typeinfo(r);');
  14408. Add(' p:=typeinfo(r.x);');
  14409. ConvertProgram;
  14410. CheckSource('TestRTTI_Record',
  14411. LinesToStr([ // statements
  14412. 'this.TPoint = function (s) {',
  14413. ' if (s) {',
  14414. ' this.x = s.x;',
  14415. ' this.y = s.y;',
  14416. ' } else {',
  14417. ' this.x = 0;',
  14418. ' this.y = 0;',
  14419. ' };',
  14420. ' this.$equal = function (b) {',
  14421. ' return (this.x === b.x) && (this.y === b.y);',
  14422. ' };',
  14423. '};',
  14424. '$mod.$rtti.$Record("TPoint", {}).addFields("x", rtl.longint, "y", rtl.longint);',
  14425. 'this.p = null;',
  14426. 'this.r = new $mod.TPoint();',
  14427. '']),
  14428. LinesToStr([ // $mod.$main
  14429. '$mod.p = $mod.$rtti["TPoint"];',
  14430. '$mod.p = $mod.$rtti["TPoint"];',
  14431. '$mod.p = rtl.longint;',
  14432. '']));
  14433. end;
  14434. procedure TTestModule.TestRTTI_RecordAnonymousArray;
  14435. begin
  14436. Converter.Options:=Converter.Options-[coNoTypeInfo];
  14437. StartProgram(false);
  14438. Add('type');
  14439. Add(' TFloatRec = record');
  14440. Add(' d: array of char;');
  14441. // Add(' i: array of array of longint;');
  14442. Add(' end;');
  14443. Add('var p: pointer;');
  14444. Add(' r: tfloatrec;');
  14445. Add('begin');
  14446. Add(' p:=typeinfo(tfloatrec);');
  14447. Add(' p:=typeinfo(r);');
  14448. Add(' p:=typeinfo(r.d);');
  14449. ConvertProgram;
  14450. CheckSource('TestRTTI_Record',
  14451. LinesToStr([ // statements
  14452. 'this.TFloatRec = function (s) {',
  14453. ' if (s) {',
  14454. ' this.d = s.d;',
  14455. ' } else {',
  14456. ' this.d = [];',
  14457. ' };',
  14458. ' this.$equal = function (b) {',
  14459. ' return this.d === b.d;',
  14460. ' };',
  14461. '};',
  14462. '$mod.$rtti.$DynArray("TFloatRec.d$a", {',
  14463. ' eltype: rtl.char',
  14464. '});',
  14465. '$mod.$rtti.$Record("TFloatRec", {}).addFields("d", $mod.$rtti["TFloatRec.d$a"]);',
  14466. 'this.p = null;',
  14467. 'this.r = new $mod.TFloatRec();',
  14468. '']),
  14469. LinesToStr([ // $mod.$main
  14470. '$mod.p = $mod.$rtti["TFloatRec"];',
  14471. '$mod.p = $mod.$rtti["TFloatRec"];',
  14472. '$mod.p = $mod.$rtti["TFloatRec.d$a"];',
  14473. '']));
  14474. end;
  14475. procedure TTestModule.TestRTTI_LocalTypes;
  14476. begin
  14477. Converter.Options:=Converter.Options-[coNoTypeInfo];
  14478. StartProgram(false);
  14479. Add('procedure DoIt;');
  14480. Add('type');
  14481. Add(' integer = longint;');
  14482. Add(' TPoint = record');
  14483. Add(' x,y: integer;');
  14484. Add(' end;');
  14485. Add('begin');
  14486. Add('end;');
  14487. Add('begin');
  14488. ConvertProgram;
  14489. CheckSource('TestRTTI_LocalTypes',
  14490. LinesToStr([ // statements
  14491. 'this.DoIt = function () {',
  14492. ' this.TPoint = function (s) {',
  14493. ' if (s) {',
  14494. ' this.x = s.x;',
  14495. ' this.y = s.y;',
  14496. ' } else {',
  14497. ' this.x = 0;',
  14498. ' this.y = 0;',
  14499. ' };',
  14500. ' this.$equal = function (b) {',
  14501. ' return (this.x === b.x) && (this.y === b.y);',
  14502. ' };',
  14503. ' };',
  14504. '};',
  14505. '']),
  14506. LinesToStr([ // $mod.$main
  14507. '']));
  14508. end;
  14509. procedure TTestModule.TestRTTI_TypeInfo_BaseTypes;
  14510. begin
  14511. Converter.Options:=Converter.Options-[coNoTypeInfo];
  14512. StartProgram(false);
  14513. Add('type');
  14514. Add(' TCaption = string;');
  14515. Add(' TYesNo = boolean;');
  14516. Add(' TLetter = char;');
  14517. Add(' TFloat = double;');
  14518. Add(' TPtr = pointer;');
  14519. Add(' TShortInt = shortint;');
  14520. Add(' TByte = byte;');
  14521. Add(' TSmallInt = smallint;');
  14522. Add(' TWord = word;');
  14523. Add(' TInt32 = longint;');
  14524. Add(' TDWord = longword;');
  14525. Add(' TValue = jsvalue;');
  14526. Add('var p: TPtr;');
  14527. Add('begin');
  14528. Add(' p:=typeinfo(string);');
  14529. Add(' p:=typeinfo(tcaption);');
  14530. Add(' p:=typeinfo(boolean);');
  14531. Add(' p:=typeinfo(tyesno);');
  14532. Add(' p:=typeinfo(char);');
  14533. Add(' p:=typeinfo(tletter);');
  14534. Add(' p:=typeinfo(double);');
  14535. Add(' p:=typeinfo(tfloat);');
  14536. Add(' p:=typeinfo(pointer);');
  14537. Add(' p:=typeinfo(tptr);');
  14538. Add(' p:=typeinfo(shortint);');
  14539. Add(' p:=typeinfo(tshortint);');
  14540. Add(' p:=typeinfo(byte);');
  14541. Add(' p:=typeinfo(tbyte);');
  14542. Add(' p:=typeinfo(smallint);');
  14543. Add(' p:=typeinfo(tsmallint);');
  14544. Add(' p:=typeinfo(word);');
  14545. Add(' p:=typeinfo(tword);');
  14546. Add(' p:=typeinfo(longword);');
  14547. Add(' p:=typeinfo(tdword);');
  14548. Add(' p:=typeinfo(jsvalue);');
  14549. Add(' p:=typeinfo(tvalue);');
  14550. ConvertProgram;
  14551. CheckSource('TestRTTI_TypeInfo_BaseTypes',
  14552. LinesToStr([ // statements
  14553. 'this.p = null;',
  14554. '']),
  14555. LinesToStr([ // $mod.$main
  14556. '$mod.p = rtl.string;',
  14557. '$mod.p = rtl.string;',
  14558. '$mod.p = rtl.boolean;',
  14559. '$mod.p = rtl.boolean;',
  14560. '$mod.p = rtl.char;',
  14561. '$mod.p = rtl.char;',
  14562. '$mod.p = rtl.double;',
  14563. '$mod.p = rtl.double;',
  14564. '$mod.p = rtl.pointer;',
  14565. '$mod.p = rtl.pointer;',
  14566. '$mod.p = rtl.shortint;',
  14567. '$mod.p = rtl.shortint;',
  14568. '$mod.p = rtl.byte;',
  14569. '$mod.p = rtl.byte;',
  14570. '$mod.p = rtl.smallint;',
  14571. '$mod.p = rtl.smallint;',
  14572. '$mod.p = rtl.word;',
  14573. '$mod.p = rtl.word;',
  14574. '$mod.p = rtl.longword;',
  14575. '$mod.p = rtl.longword;',
  14576. '$mod.p = rtl.jsvalue;',
  14577. '$mod.p = rtl.jsvalue;',
  14578. '']));
  14579. end;
  14580. procedure TTestModule.TestRTTI_TypeInfo_LocalFail;
  14581. begin
  14582. Converter.Options:=Converter.Options-[coNoTypeInfo];
  14583. StartProgram(false);
  14584. Add('procedure DoIt;');
  14585. Add('type');
  14586. Add(' integer = longint;');
  14587. Add(' TPoint = record');
  14588. Add(' x,y: integer;');
  14589. Add(' end;');
  14590. Add('var p: pointer;');
  14591. Add('begin');
  14592. Add(' p:=typeinfo(tpoint);');
  14593. Add('end;');
  14594. Add('begin');
  14595. SetExpectedPasResolverError(sSymbolCannotBePublished,nSymbolCannotBePublished);
  14596. ConvertProgram;
  14597. end;
  14598. procedure TTestModule.TestRTTI_TypeInfo_ExtTypeInfoClasses1;
  14599. begin
  14600. Converter.Options:=Converter.Options-[coNoTypeInfo];
  14601. StartProgram(false);
  14602. Add('{$modeswitch externalclass}');
  14603. Add('type');
  14604. Add(' TTypeInfo = class external name ''rtl.tTypeInfo'' end;');
  14605. Add(' TTypeInfoInteger = class external name ''rtl.tTypeInfoInteger''(TTypeInfo) end;');
  14606. Add(' TFlag = (up,down);');
  14607. Add(' TTypeInfoEnum = class external name ''rtl.tTypeInfoEnum''(TTypeInfoInteger) end;');
  14608. Add(' TFlags = set of TFlag;');
  14609. Add(' TTypeInfoSet = class external name ''rtl.tTypeInfoSet''(TTypeInfo) end;');
  14610. Add('var');
  14611. Add(' ti: TTypeInfo;');
  14612. Add(' tiInt: TTypeInfoInteger;');
  14613. Add(' tiEnum: TTypeInfoEnum;');
  14614. Add(' tiSet: TTypeInfoSet;');
  14615. Add('begin');
  14616. Add(' ti:=typeinfo(string);');
  14617. Add(' ti:=typeinfo(boolean);');
  14618. Add(' ti:=typeinfo(char);');
  14619. Add(' ti:=typeinfo(double);');
  14620. Add(' tiInt:=typeinfo(shortint);');
  14621. Add(' tiInt:=typeinfo(byte);');
  14622. Add(' tiInt:=typeinfo(smallint);');
  14623. Add(' tiInt:=typeinfo(word);');
  14624. Add(' tiInt:=typeinfo(longint);');
  14625. Add(' tiInt:=typeinfo(longword);');
  14626. Add(' ti:=typeinfo(jsvalue);');
  14627. Add(' tiEnum:=typeinfo(tflag);');
  14628. Add(' tiSet:=typeinfo(tflags);');
  14629. ConvertProgram;
  14630. CheckSource('TestRTTI_TypeInfo_ExtTypeInfoClasses1',
  14631. LinesToStr([ // statements
  14632. 'this.TFlag = {',
  14633. ' "0": "up",',
  14634. ' up: 0,',
  14635. ' "1": "down",',
  14636. ' down: 1',
  14637. '};',
  14638. '$mod.$rtti.$Enum("TFlag", {',
  14639. ' minvalue: 0,',
  14640. ' maxvalue: 1,',
  14641. ' ordtype: 1,',
  14642. ' enumtype: this.TFlag',
  14643. '});',
  14644. '$mod.$rtti.$Set("TFlags", {',
  14645. ' comptype: $mod.$rtti["TFlag"]',
  14646. '});',
  14647. 'this.ti = null;',
  14648. 'this.tiInt = null;',
  14649. 'this.tiEnum = null;',
  14650. 'this.tiSet = null;',
  14651. '']),
  14652. LinesToStr([ // $mod.$main
  14653. '$mod.ti = rtl.string;',
  14654. '$mod.ti = rtl.boolean;',
  14655. '$mod.ti = rtl.char;',
  14656. '$mod.ti = rtl.double;',
  14657. '$mod.tiInt = rtl.shortint;',
  14658. '$mod.tiInt = rtl.byte;',
  14659. '$mod.tiInt = rtl.smallint;',
  14660. '$mod.tiInt = rtl.word;',
  14661. '$mod.tiInt = rtl.longint;',
  14662. '$mod.tiInt = rtl.longword;',
  14663. '$mod.ti = rtl.jsvalue;',
  14664. '$mod.tiEnum = $mod.$rtti["TFlag"];',
  14665. '$mod.tiSet = $mod.$rtti["TFlags"];',
  14666. '']));
  14667. end;
  14668. procedure TTestModule.TestRTTI_TypeInfo_ExtTypeInfoClasses2;
  14669. begin
  14670. Converter.Options:=Converter.Options-[coNoTypeInfo];
  14671. StartProgram(false);
  14672. Add('{$modeswitch externalclass}');
  14673. Add('type');
  14674. Add(' TTypeInfo = class external name ''rtl.tTypeInfo'' end;');
  14675. Add(' TStaticArr = array[boolean] of string;');
  14676. Add(' TTypeInfoStaticArray = class external name ''rtl.tTypeInfoStaticArray''(TTypeInfo) end;');
  14677. Add(' TDynArr = array of string;');
  14678. Add(' TTypeInfoDynArray = class external name ''rtl.tTypeInfoDynArray''(TTypeInfo) end;');
  14679. Add(' TProc = procedure;');
  14680. Add(' TTypeInfoProcVar = class external name ''rtl.tTypeInfoProcVar''(TTypeInfo) end;');
  14681. Add(' TMethod = procedure of object;');
  14682. Add(' TTypeInfoMethodVar = class external name ''rtl.tTypeInfoMethodVar''(TTypeInfoProcVar) end;');
  14683. Add('var');
  14684. Add(' StaticArray: TStaticArr;');
  14685. Add(' tiStaticArray: TTypeInfoStaticArray;');
  14686. Add(' DynArray: TDynArr;');
  14687. Add(' tiDynArray: TTypeInfoDynArray;');
  14688. Add(' ProcVar: TProc;');
  14689. Add(' tiProcVar: TTypeInfoProcVar;');
  14690. Add(' MethodVar: TMethod;');
  14691. Add(' tiMethodVar: TTypeInfoMethodVar;');
  14692. Add('begin');
  14693. Add(' tiStaticArray:=typeinfo(StaticArray);');
  14694. Add(' tiStaticArray:=typeinfo(TStaticArr);');
  14695. Add(' tiDynArray:=typeinfo(DynArray);');
  14696. Add(' tiDynArray:=typeinfo(TDynArr);');
  14697. Add(' tiProcVar:=typeinfo(ProcVar);');
  14698. Add(' tiProcVar:=typeinfo(TProc);');
  14699. Add(' tiMethodVar:=typeinfo(MethodVar);');
  14700. Add(' tiMethodVar:=typeinfo(TMethod);');
  14701. ConvertProgram;
  14702. CheckSource('TestRTTI_TypeInfo_ExtTypeInfoClasses2',
  14703. LinesToStr([ // statements
  14704. ' $mod.$rtti.$StaticArray("TStaticArr", {',
  14705. ' dims: [2],',
  14706. ' eltype: rtl.string',
  14707. '});',
  14708. '$mod.$rtti.$DynArray("TDynArr", {',
  14709. ' eltype: rtl.string',
  14710. '});',
  14711. '$mod.$rtti.$ProcVar("TProc", {',
  14712. ' procsig: rtl.newTIProcSig(null)',
  14713. '});',
  14714. '$mod.$rtti.$MethodVar("TMethod", {',
  14715. ' procsig: rtl.newTIProcSig(null),',
  14716. ' methodkind: 0',
  14717. '});',
  14718. 'this.StaticArray = rtl.arraySetLength(null,"",2);',
  14719. 'this.tiStaticArray = null;',
  14720. 'this.DynArray = [];',
  14721. 'this.tiDynArray = null;',
  14722. 'this.ProcVar = null;',
  14723. 'this.tiProcVar = null;',
  14724. 'this.MethodVar = null;',
  14725. 'this.tiMethodVar = null;',
  14726. '']),
  14727. LinesToStr([ // $mod.$main
  14728. '$mod.tiStaticArray = $mod.$rtti["TStaticArr"];',
  14729. '$mod.tiStaticArray = $mod.$rtti["TStaticArr"];',
  14730. '$mod.tiDynArray = $mod.$rtti["TDynArr"];',
  14731. '$mod.tiDynArray = $mod.$rtti["TDynArr"];',
  14732. '$mod.tiProcVar = $mod.$rtti["TProc"];',
  14733. '$mod.tiProcVar = $mod.$rtti["TProc"];',
  14734. '$mod.tiMethodVar = $mod.$rtti["TMethod"];',
  14735. '$mod.tiMethodVar = $mod.$rtti["TMethod"];',
  14736. '']));
  14737. end;
  14738. procedure TTestModule.TestRTTI_TypeInfo_ExtTypeInfoClasses3;
  14739. begin
  14740. Converter.Options:=Converter.Options-[coNoTypeInfo];
  14741. StartProgram(false);
  14742. Add('{$modeswitch externalclass}');
  14743. Add('type');
  14744. Add(' TTypeInfo = class external name ''rtl.tTypeInfo'' end;');
  14745. Add(' TRec = record end;');
  14746. Add(' TTypeInfoRecord = class external name ''rtl.tTypeInfoRecord''(TTypeInfo) end;');
  14747. // ToDo: ^PRec
  14748. Add(' TObject = class end;');
  14749. Add(' TTypeInfoClass = class external name ''rtl.tTypeInfoClass''(TTypeInfo) end;');
  14750. Add(' TClass = class of tobject;');
  14751. Add(' TTypeInfoClassRef = class external name ''rtl.tTypeInfoClassRef''(TTypeInfo) end;');
  14752. Add(' TTypeInfoPointer = class external name ''rtl.tTypeInfoPointer''(TTypeInfo) end;');
  14753. Add('var');
  14754. Add(' Rec: trec;');
  14755. Add(' tiRecord: ttypeinforecord;');
  14756. Add(' Obj: tobject;');
  14757. Add(' tiClass: ttypeinfoclass;');
  14758. Add(' aClass: tclass;');
  14759. Add(' tiClassRef: ttypeinfoclassref;');
  14760. // ToDo: ^PRec
  14761. Add(' tiPointer: ttypeinfopointer;');
  14762. Add('begin');
  14763. Add(' tirecord:=typeinfo(trec);');
  14764. Add(' tirecord:=typeinfo(trec);');
  14765. Add(' ticlass:=typeinfo(obj);');
  14766. Add(' ticlass:=typeinfo(tobject);');
  14767. Add(' ticlass:=typeinfo(aclass);');
  14768. Add(' ticlassref:=typeinfo(tclass);');
  14769. ConvertProgram;
  14770. CheckSource('TestRTTI_TypeInfo_ExtTypeInfoClasses3',
  14771. LinesToStr([ // statements
  14772. 'this.TRec = function (s) {',
  14773. '};',
  14774. '$mod.$rtti.$Record("TRec", {});',
  14775. 'rtl.createClass($mod, "TObject", null, function () {',
  14776. ' this.$init = function () {',
  14777. ' };',
  14778. ' this.$final = function () {',
  14779. ' };',
  14780. '});',
  14781. '$mod.$rtti.$ClassRef("TClass", {',
  14782. ' instancetype: $mod.$rtti["TObject"]',
  14783. '});',
  14784. 'this.Rec = new $mod.TRec();',
  14785. 'this.tiRecord = null;',
  14786. 'this.Obj = null;',
  14787. 'this.tiClass = null;',
  14788. 'this.aClass = null;',
  14789. 'this.tiClassRef = null;',
  14790. 'this.tiPointer = null;',
  14791. '']),
  14792. LinesToStr([ // $mod.$main
  14793. '$mod.tiRecord = $mod.$rtti["TRec"];',
  14794. '$mod.tiRecord = $mod.$rtti["TRec"];',
  14795. '$mod.tiClass = $mod.Obj.$rtti;',
  14796. '$mod.tiClass = $mod.$rtti["TObject"];',
  14797. '$mod.tiClass = $mod.aClass.$rtti;',
  14798. '$mod.tiClassRef = $mod.$rtti["TClass"];',
  14799. '']));
  14800. end;
  14801. procedure TTestModule.TestRTTI_TypeInfo_FunctionClassType;
  14802. begin
  14803. Converter.Options:=Converter.Options-[coNoTypeInfo];
  14804. StartProgram(false);
  14805. Add([
  14806. '{$modeswitch externalclass}',
  14807. 'type',
  14808. ' TClass = class of tobject;',
  14809. ' TObject = class',
  14810. ' function MyClass: TClass;',
  14811. ' class function ClassType: TClass;',
  14812. ' end;',
  14813. ' TTypeInfo = class external name ''rtl.tTypeInfo'' end;',
  14814. ' TTypeInfoClass = class external name ''rtl.tTypeInfoClass''(TTypeInfo) end;',
  14815. 'function TObject.MyClass: TClass;',
  14816. 'var t: TTypeInfoClass;',
  14817. 'begin',
  14818. ' t:=TypeInfo(Self);',
  14819. ' t:=TypeInfo(Result);',
  14820. 'end;',
  14821. 'class function TObject.ClassType: TClass;',
  14822. 'var t: TTypeInfoClass;',
  14823. 'begin',
  14824. ' t:=TypeInfo(Self);',
  14825. ' t:=TypeInfo(Result);',
  14826. 'end;',
  14827. 'var',
  14828. ' Obj: TObject;',
  14829. ' t: TTypeInfoClass;',
  14830. 'begin',
  14831. ' t:=TypeInfo(TObject.ClassType);',
  14832. ' t:=TypeInfo(Obj.ClassType);',
  14833. ' t:=TypeInfo(Obj.MyClass);',
  14834. '']);
  14835. ConvertProgram;
  14836. CheckSource('TestRTTI_TypeInfo_FunctionClassType',
  14837. LinesToStr([ // statements
  14838. '$mod.$rtti.$Class("TObject");',
  14839. '$mod.$rtti.$ClassRef("TClass", {',
  14840. ' instancetype: $mod.$rtti["TObject"]',
  14841. '});',
  14842. 'rtl.createClass($mod, "TObject", null, function () {',
  14843. ' this.$init = function () {',
  14844. ' };',
  14845. ' this.$final = function () {',
  14846. ' };',
  14847. ' this.MyClass = function () {',
  14848. ' var Result = null;',
  14849. ' var t = null;',
  14850. ' t = this.$rtti;',
  14851. ' t = Result.$rtti;',
  14852. ' return Result;',
  14853. ' };',
  14854. ' this.ClassType = function () {',
  14855. ' var Result = null;',
  14856. ' var t = null;',
  14857. ' t = this.$rtti;',
  14858. ' t = Result.$rtti;',
  14859. ' return Result;',
  14860. ' };',
  14861. '});',
  14862. 'this.Obj = null;',
  14863. 'this.t = null;',
  14864. '']),
  14865. LinesToStr([ // $mod.$main
  14866. '$mod.t = $mod.TObject.ClassType().$rtti;',
  14867. '$mod.t = $mod.Obj.$class.ClassType().$rtti;',
  14868. '$mod.t = $mod.Obj.MyClass().$rtti;',
  14869. '']));
  14870. end;
  14871. procedure TTestModule.TestResourcestringProgram;
  14872. begin
  14873. StartProgram(false);
  14874. Add([
  14875. 'const Bar = ''bar'';',
  14876. 'resourcestring',
  14877. ' Red = ''red'';',
  14878. ' Foobar = ''fOo''+bar;',
  14879. 'var s: string;',
  14880. ' c: char;',
  14881. 'begin',
  14882. ' s:=red;',
  14883. ' s:=test1.red;',
  14884. ' c:=red[1];',
  14885. ' c:=test1.red[2];',
  14886. ' if red=foobar then ;',
  14887. ' if red[3]=red[4] then ;']);
  14888. ConvertProgram;
  14889. CheckSource('TestResourcestringProgram',
  14890. LinesToStr([ // statements
  14891. 'this.Bar = "bar";',
  14892. 'this.s = "";',
  14893. 'this.c = "";',
  14894. '$mod.$resourcestrings = {',
  14895. ' Red: {',
  14896. ' org: "red"',
  14897. ' },',
  14898. ' Foobar: {',
  14899. ' org: "fOobar"',
  14900. ' }',
  14901. '};',
  14902. '']),
  14903. LinesToStr([ // $mod.$main
  14904. '$mod.s = rtl.getResStr(pas.program, "Red");',
  14905. '$mod.s = rtl.getResStr(pas.program, "Red");',
  14906. '$mod.c = rtl.getResStr(pas.program, "Red").charAt(0);',
  14907. '$mod.c = rtl.getResStr(pas.program, "Red").charAt(1);',
  14908. 'if (rtl.getResStr(pas.program, "Red") === rtl.getResStr(pas.program, "Foobar")) ;',
  14909. 'if (rtl.getResStr(pas.program, "Red").charAt(2) === rtl.getResStr(pas.program, "Red").charAt(3)) ;',
  14910. '']));
  14911. end;
  14912. procedure TTestModule.TestResourcestringUnit;
  14913. begin
  14914. StartUnit(false);
  14915. Add([
  14916. 'interface',
  14917. 'const Red = ''rEd'';',
  14918. 'resourcestring',
  14919. ' Blue = ''blue'';',
  14920. ' NotRed = ''not''+Red;',
  14921. 'var s: string;',
  14922. 'implementation',
  14923. 'resourcestring',
  14924. ' ImplGreen = ''green'';',
  14925. 'initialization',
  14926. ' s:=blue+ImplGreen;',
  14927. ' s:=test1.blue+test1.implgreen;',
  14928. ' s:=blue[1]+implgreen[2];']);
  14929. ConvertUnit;
  14930. CheckSource('TestResourcestringUnit',
  14931. LinesToStr([ // statements
  14932. 'this.Red = "rEd";',
  14933. 'this.s = "";',
  14934. '$mod.$resourcestrings = {',
  14935. ' Blue: {',
  14936. ' org: "blue"',
  14937. ' },',
  14938. ' NotRed: {',
  14939. ' org: "notrEd"',
  14940. ' },',
  14941. ' ImplGreen: {',
  14942. ' org: "green"',
  14943. ' }',
  14944. '};',
  14945. '']),
  14946. LinesToStr([ // $mod.$main
  14947. '$mod.s = rtl.getResStr(pas.Test1, "Blue") + rtl.getResStr(pas.Test1, "ImplGreen");',
  14948. '$mod.s = rtl.getResStr(pas.Test1, "Blue") + rtl.getResStr(pas.Test1, "ImplGreen");',
  14949. '$mod.s = rtl.getResStr(pas.Test1, "Blue").charAt(0) + rtl.getResStr(pas.Test1, "ImplGreen").charAt(1);',
  14950. '']));
  14951. end;
  14952. procedure TTestModule.TestResourcestringImplementation;
  14953. begin
  14954. StartUnit(false);
  14955. Add([
  14956. 'interface',
  14957. 'implementation',
  14958. 'resourcestring',
  14959. ' ImplRed = ''red'';']);
  14960. ConvertUnit;
  14961. CheckSource('TestResourcestringImplementation',
  14962. LinesToStr([ // intf statements
  14963. 'var $impl = $mod.$impl;']),
  14964. LinesToStr([ // $mod.$init
  14965. '']),
  14966. LinesToStr([ // impl statements
  14967. '$mod.$resourcestrings = {',
  14968. ' ImplRed: {',
  14969. ' org: "red"',
  14970. ' }',
  14971. '};',
  14972. '']));
  14973. end;
  14974. procedure TTestModule.TestAtributes_Ignore;
  14975. begin
  14976. StartProgram(false);
  14977. Add([
  14978. '{$modeswitch ignoreattributes}',
  14979. 'type',
  14980. ' [custom1, custom2(1+3,''foo'')] [mod1.custom3]',
  14981. ' TObject = class',
  14982. ' [custom5()] FS: string;',
  14983. ' [customProp] property S: string read FS;',
  14984. ' end;',
  14985. 'var',
  14986. ' [custom6]',
  14987. ' o: TObject;',
  14988. 'begin',
  14989. '']);
  14990. ConvertProgram;
  14991. CheckSource('TestAtributes_Ignore',
  14992. LinesToStr([ // statements
  14993. 'rtl.createClass($mod, "TObject", null, function () {',
  14994. ' this.$init = function () {',
  14995. ' this.FS = "";',
  14996. ' };',
  14997. ' this.$final = function () {',
  14998. ' };',
  14999. '});',
  15000. 'this.o = null;',
  15001. '']),
  15002. LinesToStr([ // $mod.$main
  15003. '']));
  15004. end;
  15005. Initialization
  15006. RegisterTests([TTestModule]);
  15007. end.