tcconverter.pas 48 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528
  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=TTestExpressionConverter.TestVariable
  13. }
  14. unit tcconverter;
  15. {$mode objfpc}{$H+}
  16. interface
  17. uses
  18. Classes, SysUtils, fpcunit, testregistry, fppas2js, jsbase, jstree, pastree;
  19. type
  20. { TTestConverter }
  21. TTestConverter = class(TTestCase)
  22. private
  23. FAC: TPasElement;
  24. FConverter: TPasToJSConverter;
  25. FRes: TJSElement;
  26. FSource: TPasElement;
  27. FOwnedElements: TFPList;
  28. procedure OnAddEl(El: TPasElement; Arg: pointer);
  29. protected
  30. procedure SetUp; override;
  31. procedure TearDown; override;
  32. Property AttemptConvert : TPasElement Read FAC Write FAC;
  33. Procedure TryConvert;
  34. Function Convert(AElement : TPasElement; AClass : TJSElementClass) : TJSElement;
  35. Property Converter : TPasToJSConverter Read FConverter;
  36. Procedure AddEl(El: TPasElement);
  37. Procedure AddElWithChildren(El: TPasElement);
  38. Function CreateElement(aClass: TPTreeElement; aParent: TPasElement = nil): TPasElement;
  39. Function CreatePrimitiveExpr(aParent: TPasElement; Kind: TPasExprKind; const Value: string): TPrimitiveExpr;
  40. Property TheSource : TPasElement Read FSource Write FSource;
  41. Property TheResult : TJSElement Read FRes Write FRes;
  42. Public
  43. Class procedure AssertEquals(Const Msg : String; AExpected, AActual : TJSType); overload;
  44. Class procedure AssertLiteral(Const Msg : String; Lit : TJSElement; AType : TJSType);
  45. Class procedure AssertLiteral(Const Msg : String; Lit : TJSElement; AValue : Boolean);
  46. Class procedure AssertLiteral(Const Msg : String; Lit : TJSElement; AValue : TJSString);
  47. Class procedure AssertLiteral(Const Msg : String; Lit : TJSElement; AValue : TJSNumber);
  48. Class procedure AssertIdentifier(Const Msg : String; Ident : TJSElement; AName : String);
  49. Class Procedure AssertAssignStatement(Const Msg: String; El: TJSElement; LHS: String='a'; RHS: String='b');
  50. Class Procedure AssertEmptyBlockStatement(Const Msg: String; El: TJSElement);
  51. class Function AssertListStatement(Const Msg: String; El: TJSElement) : TJSStatementList;
  52. class Function AssertElement(Const Msg: String; AClass : TJSElementClass; El: TJSElement) : TJSElement;
  53. Function CreateLiteral(AValue : String) : TPasExpr;
  54. Function CreateLiteral(AValue : Double) : TPasExpr;
  55. Function CreateIdent(AName : String) : TPrimitiveExpr;
  56. Function CreateAssignStatement(LHS: String = 'a';RHS : String = 'b'): TPasImplAssign;
  57. Function CreateParamsExpr(Kind: TPasExprKind; aParent: TPasElement = nil) : TParamsExpr;
  58. Function CreateFunctionCall(AName : String; Params : Array of String) : TParamsExpr;
  59. Function CreateCondition: TPasExpr;
  60. Function CreateVariable(aName: String; aParent: TPasElement = nil) : TPasVariable;
  61. Function CreateBinary(AOpCode: TExprOpCode; aParent: TPasElement = nil) : TBinaryExpr;
  62. Function CreateBoolConstExpr(Value: boolean): TBoolConstExpr;
  63. Function CreateUnaryExpr(AOpCode: TExprOpCode): TUnaryExpr;
  64. end;
  65. { TTestTestConverter }
  66. TTestTestConverter = class(TTestConverter)
  67. published
  68. procedure TestEmpty;
  69. end;
  70. { TTestExpressionConverter }
  71. TTestExpressionConverter = Class(TTestConverter)
  72. Protected
  73. Function TestLiteralExpression(AElement : TPasElement; AClass : TJSElementClass) : TJSLIteral;
  74. Function TestUnaryExpression(AElement : TPasElement; AClass : TJSElementClass) : TJSUnary;
  75. Function TestBinaryExpression(AElement : TPasElement; AClass : TJSElementClass) : TJSBinary;
  76. Published
  77. Procedure TestPrimitiveString;
  78. Procedure TestPrimitiveNumber;
  79. Procedure TestPrimitiveNil;
  80. Procedure TestPrimitiveBoolTrue;
  81. Procedure TestPrimitiveBoolFalse;
  82. Procedure TestPrimitiveIdent;
  83. Procedure TestUnaryMinus;
  84. Procedure TestUnaryPlus;
  85. Procedure TestBinaryPlus;
  86. Procedure TestBinaryMinus;
  87. Procedure TestBinaryMultiply;
  88. Procedure TestBinaryDivision;
  89. Procedure TestBinaryDiv;
  90. Procedure TestBinaryMod;
  91. Procedure TestBinarySHL;
  92. Procedure TestBinarySHR;
  93. Procedure TestBinaryEqual;
  94. Procedure TestBinaryNotEqual;
  95. Procedure TestBinaryLessThan;
  96. Procedure TestBinaryLessThanEqual;
  97. Procedure TestBinaryGreater;
  98. Procedure TestBinaryGreaterThanEqual;
  99. Procedure TestBinaryIs;
  100. Procedure TestBinaryPower;
  101. Procedure TestCallExpressionNone;
  102. Procedure TestCallExpressionOne;
  103. Procedure TestCallExpressionTwo;
  104. Procedure TestMemberExpressionArrayOneDim;
  105. Procedure TestMemberExpressionArrayTwoDim;
  106. Procedure TestVariable;
  107. Procedure TestArrayVariable;
  108. end;
  109. { TTestStatementConverter }
  110. TTestStatementConverter = Class(TTestConverter)
  111. private
  112. Published
  113. Procedure TestRaiseStatement;
  114. Procedure TestAssignStatement;
  115. Procedure TestIfStatement;
  116. Procedure TestIfStatementFull;
  117. Procedure TestIfStatementElse;
  118. Procedure TestWhileStatementEmpty;
  119. Procedure TestWhileStatement;
  120. Procedure TestSimpleStatement;
  121. Procedure TestRepeatUntilStatementEmpty;
  122. Procedure TestRepeatUntilStatementOne;
  123. Procedure TestRepeatUntilStatementTwo;
  124. Procedure TestRepeatUntilStatementThree;
  125. Procedure TestForLoopUp;
  126. Procedure TestForLoopDown;
  127. Procedure TestBeginEndBlockEmpty;
  128. Procedure TestBeginEndBlockStatementOne;
  129. Procedure TestBeginEndBlockStatementTwo;
  130. Procedure TestBeginEndBlockStatementThree;
  131. Procedure TestWithStatementEmpty;
  132. Procedure TestWithStatementOne;
  133. Procedure TestWithStatementTwo;
  134. Procedure TestTryFinallyStatement;
  135. Procedure TestTryExceptStatement;
  136. Procedure TestTryExceptStatementOnE;
  137. Procedure TestReRaise;
  138. Procedure TestVariableStatement;
  139. end;
  140. implementation
  141. uses typinfo;
  142. { TTestStatementConverter }
  143. Procedure TTestStatementConverter.TestRaiseStatement;
  144. Var
  145. R : TPasImplRaise;
  146. E : TJSThrowStatement;
  147. begin
  148. R:=TPasImplRaise(CreateElement(TPasImplRaise));
  149. R.ExceptObject:=CreateIdent('e');
  150. E:=TJSThrowStatement(Convert(R,TJSThrowStatement));
  151. AssertIdentifier('Raise exception object',E.A,'e');
  152. end;
  153. Procedure TTestStatementConverter.TestAssignStatement;
  154. Var
  155. R : TPasImplAssign;
  156. E : TJSSimpleAssignStatement;
  157. begin
  158. R:=CreateAssignStatement('a','b');
  159. E:=TJSSimpleAssignStatement(Convert(R,TJSSimpleAssignStatement));
  160. AssertAssignStatement('a = b assignment',E);
  161. end;
  162. Procedure TTestStatementConverter.TestIfStatement;
  163. Var
  164. R : TPasImplIfElse;
  165. E : TJSIfStatement;
  166. begin
  167. // If a then ;
  168. R:=TPasImplIfElse(CreateElement(TPasImplIfElse));
  169. R.ConditionExpr:=CreateCondition;
  170. E:=TJSIfStatement(Convert(R,TJSIfStatement));
  171. AssertNull('If branch is empty',E.BTrue);
  172. AssertNull('No else branch',E.BFalse);
  173. AssertIdentifier('Left hand side OK',E.Cond,'a');
  174. end;
  175. Procedure TTestStatementConverter.TestIfStatementFull;
  176. Var
  177. R : TPasImplIfElse;
  178. E : TJSIfStatement;
  179. begin
  180. // If a then a:=b;
  181. R:=TPasImplIfElse(CreateElement(TPasImplIfElse));
  182. R.ConditionExpr:=CreateCondition;
  183. R.IfBranch:=CreateAssignStatement;
  184. E:=TJSIfStatement(Convert(R,TJSIfStatement));
  185. AssertIdentifier('Conditional expression',E.Cond,'a');
  186. AssertAssignStatement('If branch',E.btrue);
  187. AssertNull('No else branch',E.bfalse);
  188. end;
  189. Procedure TTestStatementConverter.TestIfStatementElse;
  190. Var
  191. R : TPasImplIfElse;
  192. E : TJSIfStatement;
  193. begin
  194. // If a then a:=b else a:=e;
  195. R:=TPasImplIfElse(CreateElement(TPasImplIfElse));
  196. R.ConditionExpr:=CreateCondition;
  197. R.IfBranch:=CreateAssignStatement;
  198. R.ElseBranch:=CreateAssignStatement('a','e');
  199. E:=TJSIfStatement(Convert(R,TJSIfStatement));
  200. AssertIdentifier('Conditional expression',E.Cond,'a');
  201. AssertAssignStatement('If branch',E.btrue);
  202. AssertAssignStatement('else branch',E.bfalse,'a','e');
  203. end;
  204. Procedure TTestStatementConverter.TestWhileStatementEmpty;
  205. Var
  206. R : TPasImplWhileDo;
  207. E : TJSWhileStatement;
  208. begin
  209. // While a do ;
  210. R:=TPasImplWhileDo(CreateElement(TPasImplWhileDo));
  211. R.ConditionExpr:=CreateCondition;
  212. E:=TJSWhileStatement(Convert(R,TJSWhileStatement));
  213. AssertIdentifier('Conditional expression',E.Cond,'a');
  214. AssertEquals('No statement, empty block statement',TJSEmptyBlockStatement,E.body.ClassType);
  215. end;
  216. Procedure TTestStatementConverter.TestWhileStatement;
  217. Var
  218. R : TPasImplWhileDo;
  219. E : TJSWhileStatement;
  220. begin
  221. // While a do b:=c;
  222. R:=TPasImplWhileDo(CreateElement(TPasImplWhileDo));
  223. R.Body:=CreateAssignStatement('b','c');
  224. R.ConditionExpr:=CreateCondition;
  225. E:=TJSWhileStatement(Convert(R,TJSWhileStatement));
  226. AssertIdentifier('Conditional expression',E.Cond,'a');
  227. AssertAssignStatement('While Block is assignment',E.body,'b','c');
  228. end;
  229. Procedure TTestStatementConverter.TestSimpleStatement;
  230. Var
  231. R : TPasImplSimple;
  232. E : TJSExpressionStatement;
  233. C : TJSCallExpression;
  234. begin
  235. R:=TPasImplSimple(CreateElement(TPasImplSimple));
  236. R.Expr:=CreateFunctionCall('a',['b']);
  237. E:=TJSExpressionStatement(Convert(R,TJSExpressionStatement));
  238. AssertNotNull('Have call node',E.A);
  239. AssertEquals('Have call expression',TJSCallExpression,E.A.ClassType);
  240. C:=TJSCallExpression(E.A);
  241. AssertIdentifier('Call expression',C.Expr,'a');
  242. end;
  243. Procedure TTestStatementConverter.TestRepeatUntilStatementEmpty;
  244. Var
  245. R : TPasImplRepeatUntil;
  246. E : TJSWhileStatement;
  247. begin
  248. // Repeat until a;
  249. R:=TPasImplRepeatUntil(CreateElement(TPasImplRepeatUntil));
  250. R.ConditionExpr:=CreateCondition;
  251. E:=TJSDoWhileStatement(Convert(R,TJSDoWhileStatement));
  252. AssertNotNull('Have condition',E.Cond);
  253. AssertEquals('Correct condition class',TJSUnaryNotExpression,E.Cond.ClassType);
  254. AssertIdentifier('Conditional expression',TJSUnaryNotExpression(E.Cond).A,'a');
  255. AssertNotNull('Have body',E.Body);
  256. AssertEquals('No statement, empty block statement',TJSEmptyBlockStatement,E.body.ClassType);
  257. end;
  258. Procedure TTestStatementConverter.TestRepeatUntilStatementOne;
  259. Var
  260. R : TPasImplRepeatUntil;
  261. E : TJSWhileStatement;
  262. L : TJSStatementList;
  263. begin
  264. // Repeat b:=c; until a;
  265. R:=TPasImplRepeatUntil(CreateElement(TPasImplRepeatUntil));
  266. R.ConditionExpr:=CreateCondition;
  267. AddEl(R.AddAssign(CreateIdent('b'),CreateIdent('c')));
  268. E:=TJSDoWhileStatement(Convert(R,TJSDoWhileStatement));
  269. AssertNotNull('Have condition',E.Cond);
  270. AssertEquals('Correct condition class',TJSUnaryNotExpression,E.Cond.ClassType);
  271. AssertIdentifier('Conditional expression',TJSUnaryNotExpression(E.Cond).A,'a');
  272. AssertNotNull('Have body',E.Body);
  273. AssertEquals('List statement, List statement',TJSStatementList,E.body.ClassType);
  274. L:=TJSStatementList(E.Body);
  275. AssertAssignStatement('First List statement is assignment',L.A,'b','c');
  276. AssertNull('No second statement',L.B);
  277. end;
  278. Procedure TTestStatementConverter.TestRepeatUntilStatementTwo;
  279. Var
  280. R : TPasImplRepeatUntil;
  281. E : TJSWhileStatement;
  282. L : TJSStatementList;
  283. begin
  284. // Repeat b:=c; d:=e; until a;
  285. R:=TPasImplRepeatUntil(CreateElement(TPasImplRepeatUntil));
  286. R.ConditionExpr:=CreateCondition;
  287. AddEl(R.AddAssign(CreateIdent('b'),CreateIdent('c')));
  288. AddEl(R.AddAssign(CreateIdent('d'),CreateIdent('e')));
  289. E:=TJSDoWhileStatement(Convert(R,TJSDoWhileStatement));
  290. AssertNotNull('Have condition',E.Cond);
  291. AssertEquals('Correct condition class',TJSUnaryNotExpression,E.Cond.ClassType);
  292. AssertIdentifier('Conditional expression',TJSUnaryNotExpression(E.Cond).A,'a');
  293. L:=AssertListStatement('Multiple statements',E.Body);
  294. AssertAssignStatement('First List statement is assignment',L.A,'b','c');
  295. AssertAssignStatement('Second List statement is assignment',L.B,'d','e');
  296. end;
  297. Procedure TTestStatementConverter.TestRepeatUntilStatementThree;
  298. Var
  299. R : TPasImplRepeatUntil;
  300. E : TJSWhileStatement;
  301. L : TJSStatementList;
  302. begin
  303. // Repeat b:=c; d:=e; f:=g; until a;
  304. R:=TPasImplRepeatUntil(CreateElement(TPasImplRepeatUntil));
  305. R.ConditionExpr:=CreateCondition;
  306. AddEl(R.AddAssign(CreateIdent('b'),CreateIdent('c')));
  307. AddEl(R.AddAssign(CreateIdent('d'),CreateIdent('e')));
  308. AddEl(R.AddAssign(CreateIdent('f'),CreateIdent('g')));
  309. E:=TJSDoWhileStatement(Convert(R,TJSDoWhileStatement));
  310. AssertNotNull('Have condition',E.Cond);
  311. AssertEquals('Correct condition class',TJSUnaryNotExpression,E.Cond.ClassType);
  312. AssertIdentifier('Conditional expression',TJSUnaryNotExpression(E.Cond).A,'a');
  313. AssertNotNull('Have body',E.Body);
  314. L:=AssertListStatement('Multiple statements',E.Body);
  315. AssertAssignStatement('First List statement is assignment',L.A,'b','c');
  316. L:=AssertListStatement('Second statement is again list',L.B);
  317. AssertAssignStatement('Second List statement is assignment',L.A,'d','e');
  318. AssertAssignStatement('third List statement is assignment',L.B,'f','g');
  319. end;
  320. Procedure TTestStatementConverter.TestForLoopUp;
  321. Var
  322. F : TPasImplForLoop;
  323. ForSt: TJSForStatement;
  324. L : TJSStatementList;
  325. VD : TJSVarDeclaration;
  326. A : TJSSimpleAssignStatement;
  327. I : TJSUnaryPostPlusPlusExpression;
  328. Cond : TJSRelationalExpressionLE;
  329. VS: TJSVariableStatement;
  330. LoopEndVar, LoopVar: String;
  331. VDL: TJSVariableDeclarationList;
  332. begin
  333. // For I:=1 to 100 do a:=b;
  334. F:=TPasImplForLoop(CreateElement(TPasImplForLoop));
  335. F.Variable:=CreateVariable('I',F);
  336. F.VariableName:=CreateIdent('I');
  337. F.StartExpr:=CreateLiteral(1);
  338. F.EndExpr:=CreateLiteral(100);
  339. F.Body:=CreateAssignStatement();
  340. ForSt:=TJSForStatement(Convert(F,TJSForStatement));
  341. // Should be
  342. // for(var $l=1, $end=100; $l<=$end2; $l++){
  343. // I=$l;
  344. // a=b;
  345. // }
  346. LoopVar:=Pas2JSBuiltInNames[pbivnLoop];
  347. LoopEndVar:=Pas2JSBuiltInNames[pbivnLoopEnd];
  348. // "var $l=1, $end=100"
  349. VS:=TJSVariableStatement(AssertElement('For init is var '+LoopEndVar,TJSVariableStatement,ForSt.Init));
  350. VDL:=TJSVariableDeclarationList(AssertElement('For init var has comma',TJSVariableDeclarationList,VS.VarDecl));
  351. VD:=TJSVarDeclaration(AssertElement('var '+LoopVar,TJSVarDeclaration,VDL.A));
  352. AssertEquals('Correct name for '+LoopVar,LoopVar,String(VD.Name));
  353. AssertLiteral('Correct start value',VD.Init,1);
  354. VD:=TJSVarDeclaration(AssertElement('var '+LoopEndVar,TJSVarDeclaration,VDL.B));
  355. AssertEquals('Correct name for '+LoopEndVar,LoopEndVar,String(VD.Name));
  356. AssertLiteral('Correct end value',VD.Init,100);
  357. // $l<=$end
  358. Cond:=TJSRelationalExpressionLE(AssertElement('Condition is <= expression',TJSRelationalExpressionLE,ForSt.Cond));
  359. AssertIdentifier('Cond LHS is '+LoopVar,Cond.A,LoopVar);
  360. AssertIdentifier('Cond RHS is '+LoopEndVar,Cond.B,LoopEndVar);
  361. // $l++
  362. I:=TJSUnaryPostPlusPlusExpression(AssertElement('Increment is ++ statement',TJSUnaryPostPlusPlusExpression,ForSt.Incr));
  363. AssertIdentifier('++ on correct variable name',I.A,LoopVar);
  364. // body
  365. L:=TJSStatementList(AssertElement('For body ist list',TJSStatementList,ForSt.Body));
  366. // I:=$l
  367. A:=TJSSimpleAssignStatement(AssertElement('I:='+LoopVar,TJSSimpleAssignStatement,L.A));
  368. AssertIdentifier('Init statement LHS is loop variable',A.LHS,'i');
  369. AssertIdentifier('Init statement RHS is '+LoopVar,A.Expr,LoopVar);
  370. AssertAssignStatement('Correct body',L.B);
  371. end;
  372. Procedure TTestStatementConverter.TestForLoopDown;
  373. Var
  374. F : TPasImplForLoop;
  375. ForSt: TJSForStatement;
  376. L : TJSStatementList;
  377. VD : TJSVarDeclaration;
  378. A : TJSSimpleAssignStatement;
  379. I : TJSUnaryPostMinusMinusExpression;
  380. Cond: TJSRelationalExpressionGE;
  381. VS: TJSVariableStatement;
  382. LoopEndVar, LoopVar: String;
  383. VDL: TJSVariableDeclarationList;
  384. begin
  385. // For I:=100 downto 1 do a:=b;
  386. F:=TPasImplForLoop(CreateElement(TPasImplForLoop));
  387. F.Variable:=CreateVariable('I',F);
  388. F.VariableName:=CreateIdent('I');
  389. F.StartExpr:=CreateLiteral(100);
  390. F.EndExpr:=CreateLiteral(1);
  391. F.LoopType:=ltDown;
  392. F.Body:=CreateAssignStatement();
  393. ForSt:=TJSForStatement(Convert(F,TJSForStatement));
  394. // Should be
  395. // for(var $l=100, $end=1; $l>=$end; $l--){
  396. // I=$l;
  397. // a=b;
  398. // }
  399. LoopVar:=Pas2JSBuiltInNames[pbivnLoop];
  400. LoopEndVar:=Pas2JSBuiltInNames[pbivnLoopEnd];
  401. // "var $l=100, $end=1"
  402. VS:=TJSVariableStatement(AssertElement('For init is var '+LoopEndVar,TJSVariableStatement,ForSt.Init));
  403. VDL:=TJSVariableDeclarationList(AssertElement('For init var has comma',TJSVariableDeclarationList,VS.VarDecl));
  404. VD:=TJSVarDeclaration(AssertElement('var '+LoopVar,TJSVarDeclaration,VDL.A));
  405. AssertEquals('Correct name for '+LoopVar,LoopVar,String(VD.Name));
  406. AssertLiteral('Correct start value',VD.Init,100);
  407. VD:=TJSVarDeclaration(AssertElement('var '+LoopEndVar,TJSVarDeclaration,VDL.B));
  408. AssertEquals('Correct name for '+LoopEndVar,LoopEndVar,String(VD.Name));
  409. AssertLiteral('Correct end value',VD.Init,1);
  410. // $l>=$end
  411. Cond:=TJSRelationalExpressionGE(AssertElement('Condition is >= expression',TJSRelationalExpressionGE,ForSt.Cond));
  412. AssertIdentifier('Cond LHS is '+LoopVar,Cond.A,LoopVar);
  413. AssertIdentifier('Cond RHS is '+LoopEndVar,Cond.B,LoopEndVar);
  414. // $l--
  415. I:=TJSUnaryPostMinusMinusExpression(AssertElement('Increment is -- statement',TJSUnaryPostMinusMinusExpression,ForSt.Incr));
  416. AssertIdentifier('-- on correct variable name',I.A,LoopVar);
  417. // body
  418. L:=TJSStatementList(AssertElement('For body ist list',TJSStatementList,ForSt.Body));
  419. // I:=$l
  420. A:=TJSSimpleAssignStatement(AssertElement('I:='+LoopVar,TJSSimpleAssignStatement,L.A));
  421. AssertIdentifier('Init statement LHS is loop variable',A.LHS,'i');
  422. AssertIdentifier('Init statement RHS is '+LoopVar,A.Expr,LoopVar);
  423. AssertAssignStatement('Correct body',L.B);
  424. end;
  425. Procedure TTestStatementConverter.TestBeginEndBlockEmpty;
  426. Var
  427. R : TPasImplBeginBlock;
  428. begin
  429. // begin end;
  430. R:=TPasImplBeginBlock(CreateElement(TPasImplBeginBlock));
  431. Convert(R,TJSEmptyBlockStatement);
  432. end;
  433. Procedure TTestStatementConverter.TestBeginEndBlockStatementOne;
  434. Var
  435. R : TPasImplBeginBlock;
  436. L : TJSStatementList;
  437. begin
  438. // begin a:=bend;
  439. R:=TPasImplBeginBlock(CreateElement(TPasImplBeginBlock));
  440. AddEl(R.AddAssign(CreateIdent('a'),CreateIdent('b')));
  441. L:=TJSStatementList(Convert(R,TJSStatementList));
  442. AssertNull('No second statement',L.B);
  443. AssertAssignStatement('First List statement is assignment',L.A,'a','b');
  444. end;
  445. Procedure TTestStatementConverter.TestBeginEndBlockStatementTwo;
  446. Var
  447. R : TPasImplBeginBlock;
  448. L : TJSStatementList;
  449. begin
  450. // begin a:=b; c:=d; end;
  451. R:=TPasImplBeginBlock(CreateElement(TPasImplBeginBlock));
  452. AddEl(R.AddAssign(CreateIdent('a'),CreateIdent('b')));
  453. AddEl(R.AddAssign(CreateIdent('c'),CreateIdent('d')));
  454. L:=TJSStatementList(Convert(R,TJSStatementList));
  455. AssertAssignStatement('First List statement is assignment',L.A,'a','b');
  456. AssertAssignStatement('Second List statement is assignment',L.B,'c','d');
  457. end;
  458. Procedure TTestStatementConverter.TestBeginEndBlockStatementThree;
  459. Var
  460. R : TPasImplBeginBlock;
  461. L : TJSStatementList;
  462. begin
  463. // begin a:=b; c:=d; end;
  464. R:=TPasImplBeginBlock(CreateElement(TPasImplBeginBlock));
  465. AddEl(R.AddAssign(CreateIdent('a'),CreateIdent('b')));
  466. AddEl(R.AddAssign(CreateIdent('c'),CreateIdent('d')));
  467. AddEl(R.AddAssign(CreateIdent('e'),CreateIdent('f')));
  468. L:=TJSStatementList(Convert(R,TJSStatementList));
  469. AssertAssignStatement('First List statement is assignment',L.A,'a','b');
  470. L:=AssertListStatement('Second statement is again list',L.B);
  471. AssertAssignStatement('Second List statement is assignment',L.A,'c','d');
  472. AssertAssignStatement('third List statement is assignment',L.B,'e','f');
  473. end;
  474. Procedure TTestStatementConverter.TestWithStatementEmpty;
  475. Var
  476. W : TPasImplWithDo;
  477. El : TJSWithStatement;
  478. begin
  479. // With A do ;
  480. W:=TPasImplWithDo(CreateElement(TPasImplWithDo));
  481. W.Expressions.Add(CreateIdent('a'));
  482. El:=TJSWithStatement(Convert(W,TJSWithStatement));
  483. AssertIdentifier('Correct with expression',EL.A,'a');
  484. AssertEmptyBlockStatement('Empty with',El.B);
  485. end;
  486. Procedure TTestStatementConverter.TestWithStatementOne;
  487. Var
  488. W : TPasImplWithDo;
  489. El : TJSWithStatement;
  490. begin
  491. // With A do b:=c;
  492. W:=TPasImplWithDo(CreateElement(TPasImplWithDo));
  493. W.Expressions.Add(CreateIdent('a'));
  494. W.Body:=CreateAssignStatement('b','c');
  495. El:=TJSWithStatement(Convert(W,TJSWithStatement));
  496. AssertIdentifier('Correct with expression',EL.A,'a');
  497. AssertAssignStatement('Correct assignment',EL.B,'b','c');
  498. end;
  499. Procedure TTestStatementConverter.TestWithStatementTwo;
  500. Var
  501. W : TPasImplWithDo;
  502. El : TJSWithStatement;
  503. begin
  504. // With A,D do b:=c;
  505. W:=TPasImplWithDo(CreateElement(TPasImplWithDo));
  506. W.Expressions.Add(CreateIdent('a'));
  507. W.Expressions.Add(CreateIdent('d'));
  508. W.Body:=CreateAssignStatement('b','c');
  509. El:=TJSWithStatement(Convert(W,TJSWithStatement));
  510. AssertIdentifier('Correct with expression',EL.A,'a');
  511. El:=TJSWithStatement(AssertElement('Have second with statement',TJSWithStatement,EL.B));
  512. AssertIdentifier('Correct with expression',EL.A,'d');
  513. AssertAssignStatement('Correct assignment',El.B,'b','c');
  514. end;
  515. Procedure TTestStatementConverter.TestTryFinallyStatement;
  516. Var
  517. T : TPasImplTry;
  518. F : TPasImplTryFinally;
  519. El : TJSTryFinallyStatement;
  520. L : TJSStatementList;
  521. begin
  522. // Try a:=B finally b:=c end;
  523. T:=TPasImplTry(CreateElement(TPasImplTry));
  524. T.AddElement(CreateAssignStatement('a','b'));
  525. F:=T.AddFinally;
  526. AddEl(F);
  527. F.AddElement(CreateAssignStatement('b','c'));
  528. El:=TJSTryFinallyStatement(Convert(T,TJSTryFinallyStatement));
  529. L:=AssertListStatement('try..finally block is statement list',EL.Block);
  530. AssertAssignStatement('Correct assignment in try..finally block',L.A,'a','b');
  531. AssertNull('No second statement',L.B);
  532. L:=AssertListStatement('try..finally block is statement list',El.BFinally);
  533. AssertAssignStatement('Correct assignment in finally..end block',L.A,'b','c');
  534. AssertNull('No second statement',L.B);
  535. end;
  536. Procedure TTestStatementConverter.TestTryExceptStatement;
  537. Var
  538. T : TPasImplTry;
  539. F : TPasImplTryExcept;
  540. El : TJSTryCatchStatement;
  541. L : TJSStatementList;
  542. ExceptObjName: String;
  543. begin
  544. // Try a:=b except b:=c end;
  545. (*
  546. Becomes:
  547. try {
  548. a=b;
  549. } catch ($e) {
  550. b = c;
  551. }
  552. *)
  553. T:=TPasImplTry(CreateElement(TPasImplTry));
  554. T.AddElement(CreateAssignStatement('a','b'));
  555. F:=T.AddExcept;
  556. AddElWithChildren(F);
  557. F.AddElement(CreateAssignStatement('b','c'));
  558. // Convert
  559. El:=TJSTryCatchStatement(Convert(T,TJSTryCatchStatement));
  560. // check "catch(exceptobject)"
  561. ExceptObjName:=lowercase(Pas2JSBuiltInNames[pbivnExceptObject]);
  562. AssertEquals('Correct exception object name',ExceptObjName,String(El.Ident));
  563. // check "a=b;"
  564. L:=AssertListStatement('try..except block is statement list',El.Block);
  565. AssertAssignStatement('Correct assignment in try..except block',L.A,'a','b');
  566. AssertNull('No second statement',L.B);
  567. // check "b=c;'
  568. L:=AssertListStatement('try..except block is statement list',El.BCatch);
  569. AssertAssignStatement('Correct assignment in except..end block',L.A,'b','c');
  570. AssertNull('No second statement',L.B);
  571. end;
  572. Procedure TTestStatementConverter.TestTryExceptStatementOnE;
  573. Var
  574. T : TPasImplTry;
  575. F : TPasImplTryExcept;
  576. O : TPasImplExceptOn;
  577. El : TJSTryCatchStatement;
  578. L : TJSStatementList;
  579. I : TJSIfStatement;
  580. IC : TJSCallExpression;
  581. D: TJSDotMemberExpression;
  582. ExObj: TJSElement;
  583. VS: TJSVariableStatement;
  584. V: TJSVarDeclaration;
  585. ExceptObjName: String;
  586. begin
  587. // Try a:=B except on E : exception do b:=c end;
  588. (*
  589. Becomes:
  590. try {
  591. a=b;
  592. } catch (exceptobject) {
  593. if (exception.isPrototypeOf(exceptobject)) {
  594. var e = exceptobject;
  595. b = c;
  596. }
  597. }
  598. *)
  599. T:=TPasImplTry(CreateElement(TPasImplTry));
  600. T.AddElement(CreateAssignStatement('a','b'));
  601. F:=T.AddExcept;
  602. AddElWithChildren(F);
  603. O:=F.AddExceptOn('E','Exception');
  604. AddElWithChildren(O);
  605. O.Body:=CreateAssignStatement('b','c');
  606. // Convert
  607. El:=TJSTryCatchStatement(Convert(T,TJSTryCatchStatement));
  608. // check "catch(exceptobject)"
  609. ExceptObjName:=lowercase(Pas2JSBuiltInNames[pbivnExceptObject]);
  610. AssertEquals('Correct exception object name',ExceptObjName,String(El.Ident));
  611. // check "if"
  612. I:=TJSIfStatement(AssertElement('On block is if',TJSIfStatement,El.BCatch));
  613. // check if condition "exception.isPrototypeOf(exceptobject)"
  614. IC:=TJSCallExpression(AssertElement('If condition is call expression',TJSCallExpression,I.Cond));
  615. D:=TJSDotMemberExpression(AssertElement('exception.isPrototypeOf is dot member expression',TJSDotMemberExpression,IC.Expr));
  616. Assertidentifier('left side of exception.isPrototypeOf',D.MExpr,'exception');
  617. AssertEquals('right side of exception.isPrototypeOf','isPrototypeOf',String(D.Name));
  618. AssertNotNull('args of exception.isPrototypeOf(exceptobject)',IC.Args);
  619. AssertEquals('args of exception.isPrototypeOf(exceptobject)',1,IC.Args.Elements.Count);
  620. ExObj:=IC.Args.Elements.Elements[0].Expr;
  621. Assertidentifier('arg of exception.isPrototypeOf(exceptobject)',ExObj,ExceptObjName);
  622. // check statement "var e = exceptobject;"
  623. L:=AssertListStatement('On block is always a list',I.BTrue);
  624. writeln('TTestStatementConverter.TestTryExceptStatementOnE ',L.A.ClassName);
  625. VS:=TJSVariableStatement(AssertElement('First statement in list is a var statement',TJSVariableStatement,L.A));
  626. V:=TJSVarDeclaration(AssertElement('var declaration e=ExceptObject',TJSVarDeclaration,VS.VarDecl));
  627. AssertEquals('Variable name is identifier in On A : Ex do','e',String(V.Name));
  628. Assertidentifier('Variable init is exception object',V.Init,ExceptObjName);
  629. // check "b = c;"
  630. AssertAssignStatement('Original assignment in second statement',L.B,'b','c');
  631. end;
  632. Procedure TTestStatementConverter.TestReRaise;
  633. Var
  634. T : TPasImplTry;
  635. F : TPasImplTryExcept;
  636. O : TPasImplExceptOn;
  637. El : TJSTryCatchStatement;
  638. L : TJSStatementList;
  639. I : TJSIfStatement;
  640. IC : TJSCallExpression;
  641. R : TJSThrowStatement;
  642. V : TJSVarDeclaration;
  643. D: TJSDotMemberExpression;
  644. ExObj: TJSElement;
  645. VS: TJSVariableStatement;
  646. ExceptObjName: String;
  647. begin
  648. // Try a:=B except on E : exception do raise; end;
  649. (*
  650. Becomes:
  651. try {
  652. a=b;
  653. } catch ($e) {
  654. if (exception.isPrototypeOf($e)) {
  655. var e = $e;
  656. throw $e;
  657. }
  658. }
  659. *)
  660. T:=TPasImplTry(CreateElement(TPasImplTry));
  661. T.AddElement(CreateAssignStatement('a','b'));
  662. F:=T.AddExcept;
  663. AddEl(F);
  664. O:=F.AddExceptOn('E','Exception');
  665. AddElWithChildren(O);
  666. O.Body:=TPasImplRaise(CreateElement(TPasImplRaise));
  667. // Convert
  668. El:=TJSTryCatchStatement(Convert(T,TJSTryCatchStatement));
  669. // check "catch(exceptobject)"
  670. ExceptObjName:=lowercase(Pas2JSBuiltInNames[pbivnExceptObject]);
  671. AssertEquals('Correct exception object name',ExceptObjName,String(El.Ident));
  672. // check "if"
  673. I:=TJSIfStatement(AssertElement('On block is if',TJSIfStatement,El.BCatch));
  674. // check if condition "exception.isPrototypeOf(exceptobject)"
  675. IC:=TJSCallExpression(AssertElement('If condition is call expression',TJSCallExpression,I.Cond));
  676. D:=TJSDotMemberExpression(AssertElement('exception.isPrototypeOf is dot member expression',TJSDotMemberExpression,IC.Expr));
  677. Assertidentifier('left side of exception.isPrototypeOf',D.MExpr,'exception');
  678. AssertEquals('right side of exception.isPrototypeOf','isPrototypeOf',String(D.Name));
  679. AssertNotNull('args of exception.isPrototypeOf(ExceptObject)',IC.Args);
  680. AssertEquals('args of exception.isPrototypeOf(ExceptObject)',1,IC.Args.Elements.Count);
  681. ExObj:=IC.Args.Elements.Elements[0].Expr;
  682. Assertidentifier('arg of exception.isPrototypeOf(ExceptObject)',ExObj,ExceptObjName);
  683. // check statement "var e = exceptobject;"
  684. L:=AssertListStatement('On block is always a list',I.BTrue);
  685. writeln('TTestStatementConverter.TestTryExceptStatementOnE ',L.A.ClassName);
  686. VS:=TJSVariableStatement(AssertElement('First statement in list is a var statement',TJSVariableStatement,L.A));
  687. V:=TJSVarDeclaration(AssertElement('var declaration e=ExceptObject',TJSVarDeclaration,VS.VarDecl));
  688. AssertEquals('Variable name is identifier in On A : Ex do','e',String(V.Name));
  689. Assertidentifier('Variable init is exception object',V.Init,ExceptObjName);
  690. R:=TJSThrowStatement(AssertElement('On block is throw statement',TJSThrowStatement,L.B));
  691. Assertidentifier('R expression is original exception ',R.A,ExceptObjName);
  692. end;
  693. Procedure TTestStatementConverter.TestVariableStatement;
  694. Var
  695. S : TPasSection;
  696. V : TPasVariable;
  697. L : TJSStatementList;
  698. JV : TJSVariableStatement;
  699. JVD : TJSVarDeclaration;
  700. begin
  701. S:=TPasSection(CreateElement(TPasSection));
  702. V:=CreateVariable('A',Nil);
  703. S.Declarations.Add(V);
  704. S.Variables.Add(V);
  705. L:=TJSStatementList(Convert(S,TJSStatementList));
  706. JV:=TJSVariableStatement(AssertElement('Variable statement',TJSVariableStatement,L.A));
  707. JVD:=TJSVarDeclaration(AssertElement('Variable declaration',TJSVarDeclaration,JV.VarDecl));
  708. AssertEquals('Correct variable name','a',String(JVD.Name));
  709. end;
  710. { TTestExpressionConverter }
  711. function TTestExpressionConverter.TestLiteralExpression(AElement: TPasElement;
  712. AClass: TJSElementClass): TJSLIteral;
  713. Var
  714. E : TJSElement;
  715. begin
  716. E:=Convert(AElement,AClass);
  717. if not (E is TJSLiteral) then
  718. Fail('Do not have literal class, but: '+E.ClassName);
  719. Result:=TJSLiteral(E);
  720. end;
  721. function TTestExpressionConverter.TestUnaryExpression(AElement: TPasElement;
  722. AClass: TJSElementClass): TJSUnary;
  723. Var
  724. E : TJSElement;
  725. begin
  726. E:=Convert(AElement,AClass);
  727. AssertNotNull('Convert returned a result',E);
  728. if not (E is TJSUnary) then
  729. Fail('Do not have unary class, but: '+E.ClassName);
  730. AssertEquals('TTestExpressionConverter.TestUnaryExpression: wrong class',AClass.ClassName,E.ClassName);
  731. Result:=TJSUnary(E);
  732. end;
  733. function TTestExpressionConverter.TestBinaryExpression(AElement: TPasElement;
  734. AClass: TJSElementClass): TJSBinary;
  735. Var
  736. E : TJSElement;
  737. begin
  738. E:=Convert(AElement,AClass);
  739. if not (E is TJSBinary) then
  740. Fail('Do not have literal class, but: '+E.ClassName);
  741. Result:=TJSBinary(E);
  742. end;
  743. procedure TTestExpressionConverter.TestPrimitiveString;
  744. Var
  745. S : TPrimitiveExpr;
  746. E : TJSLiteral;
  747. begin
  748. S:=CreatePrimitiveExpr(Nil,pekString,'''me''');
  749. E:=TestLiteralExpression(S,TJSLiteral);
  750. AssertEquals('Correct literal type',jstString,E.Value.ValueType);
  751. AssertEquals('Correct literal value','me',String(E.Value.AsString));
  752. end;
  753. procedure TTestExpressionConverter.TestPrimitiveNumber;
  754. Var
  755. S : TPrimitiveExpr;
  756. E : TJSLiteral;
  757. begin
  758. S:=CreatePrimitiveExpr(Nil,pekNumber,'1.23');
  759. E:=TestLiteralExpression(S,TJSLiteral);
  760. AssertEquals('Correct literal type',jstNumber,E.Value.ValueType);
  761. AssertEquals('Correct literal value',1.23,E.Value.AsNumber);
  762. end;
  763. procedure TTestExpressionConverter.TestPrimitiveNil;
  764. Var
  765. S : TNilExpr;
  766. E : TJSLiteral;
  767. begin
  768. S:=TNilExpr(CreateElement(TNilExpr));
  769. E:=TestLiteralExpression(S,TJSLiteral);
  770. AssertEquals('Correct literal type',jstNull,E.Value.ValueType);
  771. AssertEquals('Correct literal value',True,E.Value.IsNull);
  772. end;
  773. procedure TTestExpressionConverter.TestPrimitiveBoolTrue;
  774. Var
  775. S : TBoolConstExpr;
  776. E : TJSLiteral;
  777. begin
  778. S:=CreateBoolConstExpr(True);
  779. E:=TestLiteralExpression(S,TJSLiteral);
  780. AssertEquals('Correct literal type',jstBoolean,E.Value.ValueType);
  781. AssertEquals('Correct literal value',True,E.Value.AsBoolean);
  782. end;
  783. procedure TTestExpressionConverter.TestPrimitiveBoolFalse;
  784. Var
  785. S : TBoolConstExpr;
  786. E : TJSLiteral;
  787. begin
  788. S:=CreateBoolConstExpr(False);
  789. E:=TestLiteralExpression(S,TJSLiteral);
  790. AssertEquals('Correct literal type',jstBoolean,E.Value.ValueType);
  791. AssertEquals('Correct literal value',False,E.Value.AsBoolean);
  792. end;
  793. procedure TTestExpressionConverter.TestPrimitiveIdent;
  794. Var
  795. Id : TPrimitiveExpr;
  796. Res : TJSPrimaryExpressionIdent;
  797. begin
  798. Id:=CreatePrimitiveExpr(Nil,pekIdent,'a');
  799. Res:=TJSPrimaryExpressionIdent(Convert(Id,TJSPrimaryExpressionIdent));
  800. AssertEquals('Correct identifier name','a',String(Res.Name));
  801. end;
  802. procedure TTestExpressionConverter.TestUnaryMinus;
  803. Var
  804. U : TUnaryExpr;
  805. E : TJSUnaryMinusExpression;
  806. begin
  807. U:=CreateUnaryExpr(eopSubtract);
  808. U.Operand:=CreateLiteral(1.23);
  809. E:=TJSUnaryMinusExpression(TestUnaryExpression(U,TJSUnaryMinusExpression));
  810. AssertLiteral('Correct literal for minus',E.A,1.23)
  811. end;
  812. procedure TTestExpressionConverter.TestUnaryPlus;
  813. Var
  814. U : TUnaryExpr;
  815. E : TJSUnaryPlusExpression;
  816. begin
  817. U:=CreateUnaryExpr(eopAdd);
  818. U.Operand:=CreateLiteral(1.23);
  819. E:=TJSUnaryPlusExpression(TestUnaryExpression(U,TJSUnaryPlusExpression));
  820. AssertLiteral('Correct literal for plus',E.A,1.23)
  821. end;
  822. procedure TTestExpressionConverter.TestBinaryPlus;
  823. Var
  824. B : TBinaryExpr;
  825. E : TJSAdditiveExpressionPlus;
  826. begin
  827. B:=CreateBinary(eopAdd);
  828. B.left:=CreateLiteral(1.23);
  829. B.Right:=CreateLiteral(3.45);
  830. E:=TJSAdditiveExpressionPlus(TestBinaryExpression(B,TJSAdditiveExpressionPlus));
  831. AssertLiteral('Correct left literal for addition',E.A,1.23);
  832. AssertLiteral('Correct right literal for addition',E.B,3.45);
  833. end;
  834. procedure TTestExpressionConverter.TestBinaryMinus;
  835. Var
  836. B : TBinaryExpr;
  837. E : TJSAdditiveExpressionMinus;
  838. begin
  839. B:=CreateBinary(eopSubtract);
  840. B.left:=CreateLiteral(1.23);
  841. B.Right:=CreateLiteral(3.45);
  842. E:=TJSAdditiveExpressionMinus(TestBinaryExpression(B,TJSAdditiveExpressionMinus));
  843. AssertLiteral('Correct left literal for subtract',E.A,1.23);
  844. AssertLiteral('Correct right literal for subtract',E.B,3.45);
  845. end;
  846. procedure TTestExpressionConverter.TestBinaryMultiply;
  847. Var
  848. B : TBinaryExpr;
  849. E : TJSMultiplicativeExpressionMul;
  850. begin
  851. B:=CreateBinary(eopMultiply);
  852. B.left:=CreateLiteral(1.23);
  853. B.Right:=CreateLiteral(3.45);
  854. E:=TJSMultiplicativeExpressionMul(TestBinaryExpression(B,TJSMultiplicativeExpressionMul));
  855. AssertLiteral('Correct left literal for multiplication',E.A,1.23);
  856. AssertLiteral('Correct right literal for multiplication',E.B,3.45);
  857. end;
  858. procedure TTestExpressionConverter.TestBinaryDivision;
  859. Var
  860. B : TBinaryExpr;
  861. E : TJSMultiplicativeExpressionDiv;
  862. begin
  863. B:=CreateBinary(eopDivide);
  864. B.left:=CreateLiteral(1.23);
  865. B.Right:=CreateLiteral(3.45);
  866. E:=TJSMultiplicativeExpressionDiv(TestBinaryExpression(B,TJSMultiplicativeExpressionDiv));
  867. AssertLiteral('Correct left literal for division',E.A,1.23);
  868. AssertLiteral('Correct right literal for division',E.B,3.45);
  869. end;
  870. procedure TTestExpressionConverter.TestBinaryDiv;
  871. Var
  872. B : TBinaryExpr;
  873. E : TJSMultiplicativeExpressionDiv;
  874. C: TJSCallExpression;
  875. Args: TJSArguments;
  876. begin
  877. B:=CreateBinary(eopDiv);
  878. B.left:=CreateLiteral(1.23);
  879. B.Right:=CreateLiteral(3.45);
  880. C:=TJSCallExpression(Convert(B,TJSCallExpression));
  881. Args:=TJSArguments(AssertElement('Math.floor param',TJSArguments,C.Args));
  882. E:=TJSMultiplicativeExpressionDiv(AssertElement('param',TJSMultiplicativeExpressionDiv,Args.Elements.Elements[0].Expr));
  883. AssertLiteral('Correct left literal for div',E.A,1.23);
  884. AssertLiteral('Correct right literal for div',E.B,3.45);
  885. end;
  886. procedure TTestExpressionConverter.TestBinaryMod;
  887. Var
  888. B : TBinaryExpr;
  889. E : TJSMultiplicativeExpressionMod;
  890. begin
  891. B:=CreateBinary(eopMod);
  892. B.left:=CreateLiteral(1.23);
  893. B.Right:=CreateLiteral(3.45);
  894. E:=TJSMultiplicativeExpressionMod(TestBinaryExpression(B,TJSMultiplicativeExpressionMod));
  895. AssertLiteral('Correct left literal for mod',E.A,1.23);
  896. AssertLiteral('Correct right literal for mod',E.B,3.45);
  897. end;
  898. procedure TTestExpressionConverter.TestBinarySHL;
  899. Var
  900. B : TBinaryExpr;
  901. E : TJSLShiftExpression;
  902. begin
  903. B:=CreateBinary(eopSHL);
  904. B.left:=CreateLiteral(13);
  905. B.Right:=CreateLiteral(3);
  906. E:=TJSLShiftExpression(TestBinaryExpression(B,TJSLShiftExpression));
  907. AssertLiteral('Correct left literal for shl',E.A,13);
  908. AssertLiteral('Correct right literal for shl',E.B,3);
  909. end;
  910. procedure TTestExpressionConverter.TestBinarySHR;
  911. Var
  912. B : TBinaryExpr;
  913. E : TJSURShiftExpression;
  914. begin
  915. B:=CreateBinary(eopSHR);
  916. B.left:=CreateLiteral(13);
  917. B.Right:=CreateLiteral(3);
  918. E:=TJSURShiftExpression(TestBinaryExpression(B,TJSURShiftExpression));
  919. AssertLiteral('Correct left literal for shr',E.A,13);
  920. AssertLiteral('Correct right literal for shr',E.B,3);
  921. end;
  922. procedure TTestExpressionConverter.TestBinaryEqual;
  923. Var
  924. B : TBinaryExpr;
  925. E : TJSEqualityExpressionSEQ;
  926. begin
  927. B:=CreateBinary(eopEqual);
  928. B.left:=CreateLiteral(13);
  929. B.Right:=CreateLiteral(3);
  930. E:=TJSEqualityExpressionSEQ(TestBinaryExpression(B,TJSEqualityExpressionSEQ));
  931. AssertLiteral('Correct left literal for equal',E.A,13);
  932. AssertLiteral('Correct right literal for equal',E.B,3);
  933. end;
  934. procedure TTestExpressionConverter.TestBinaryNotEqual;
  935. Var
  936. B : TBinaryExpr;
  937. E : TJSEqualityExpressionSNE;
  938. begin
  939. B:=CreateBinary(eopNotEqual);
  940. B.left:=CreateLiteral(13);
  941. B.Right:=CreateLiteral(3);
  942. E:=TJSEqualityExpressionSNE(TestBinaryExpression(B,TJSEqualityExpressionSNE));
  943. AssertLiteral('Correct left literal for not equal',E.A,13);
  944. AssertLiteral('Correct right literal for not equal',E.B,3);
  945. end;
  946. procedure TTestExpressionConverter.TestBinaryLessThan;
  947. Var
  948. B : TBinaryExpr;
  949. E : TJSRelationalExpressionLT;
  950. begin
  951. B:=CreateBinary(eopLessThan);
  952. B.left:=CreateLiteral(13);
  953. B.Right:=CreateLiteral(3);
  954. E:=TJSRelationalExpressionLT(TestBinaryExpression(B,TJSRelationalExpressionLT));
  955. AssertLiteral('Correct left literal for less than',E.A,13);
  956. AssertLiteral('Correct right literal for less than',E.B,3);
  957. end;
  958. procedure TTestExpressionConverter.TestBinaryLessThanEqual;
  959. Var
  960. B : TBinaryExpr;
  961. E : TJSRelationalExpressionLE;
  962. begin
  963. B:=CreateBinary(eopLessThanEqual);
  964. B.left:=CreateLiteral(13);
  965. B.Right:=CreateLiteral(3);
  966. E:=TJSRelationalExpressionLE(TestBinaryExpression(B,TJSRelationalExpressionLE));
  967. AssertLiteral('Correct left literal for less than or equal',E.A,13);
  968. AssertLiteral('Correct right literal for less than or equal',E.B,3);
  969. end;
  970. procedure TTestExpressionConverter.TestBinaryGreater;
  971. Var
  972. B : TBinaryExpr;
  973. E : TJSRelationalExpressionGT;
  974. begin
  975. B:=CreateBinary(eopGreaterThan);
  976. B.left:=CreateLiteral(13);
  977. B.Right:=CreateLiteral(3);
  978. E:=TJSRelationalExpressionGT(TestBinaryExpression(B,TJSRelationalExpressionGT));
  979. AssertLiteral('Correct left literal for greater than',E.A,13);
  980. AssertLiteral('Correct right literal for greater than',E.B,3);
  981. end;
  982. procedure TTestExpressionConverter.TestBinaryGreaterThanEqual;
  983. Var
  984. B : TBinaryExpr;
  985. E : TJSRelationalExpressionGE;
  986. begin
  987. B:=CreateBinary(eopGreaterThanEqual);
  988. B.left:=CreateLiteral(13);
  989. B.Right:=CreateLiteral(3);
  990. E:=TJSRelationalExpressionGE(TestBinaryExpression(B,TJSRelationalExpressionGE));
  991. AssertLiteral('Correct left literal for greater than or equal',E.A,13);
  992. AssertLiteral('Correct right literal for greater than or equal',E.B,3);
  993. end;
  994. procedure TTestExpressionConverter.TestBinaryIs;
  995. Var
  996. B : TBinaryExpr;
  997. E : TJSRelationalExpressionInstanceOf;
  998. begin
  999. B:=CreateBinary(eopIs);
  1000. B.left:=CreateIdent('a');
  1001. B.Right:=CreateIdent('b');
  1002. E:=TJSRelationalExpressionInstanceOf(TestBinaryExpression(B,TJSRelationalExpressionInstanceOf));
  1003. AssertIdentifier('Correct left literal for is',E.A,'a');
  1004. AssertIdentifier('Correct right literal for is',E.B,'b');
  1005. end;
  1006. procedure TTestExpressionConverter.TestBinaryPower;
  1007. Var
  1008. B : TBinaryExpr;
  1009. E : TJSPowerExpression;
  1010. begin
  1011. B:=CreateBinary(eopPower);
  1012. B.left:=CreateIdent('a');
  1013. B.Right:=CreateIdent('b');
  1014. E:=TJSPowerExpression(TestBinaryExpression(B,TJSPowerExpression));
  1015. AssertIdentifier('Correct left literal for power',E.A,'a');
  1016. AssertIdentifier('Correct right literal for power',E.B,'b');
  1017. end;
  1018. procedure TTestExpressionConverter.TestCallExpressionNone;
  1019. Var
  1020. B : TParamsExpr;
  1021. E : TJSCallExpression;
  1022. begin
  1023. // a();
  1024. B:=CreateFunctionCall('a',[]);
  1025. E:=TJSCallExpression(Convert(B,TJSCallExpression));
  1026. AssertIdentifier('Correct left literal for is',E.Expr,'a');
  1027. AssertNull('No arguments',E.Args);
  1028. // AssertEquals('No arguments',0,E.Args.Elements.Count);
  1029. end;
  1030. procedure TTestExpressionConverter.TestCallExpressionOne;
  1031. Var
  1032. B : TParamsExpr;
  1033. E : TJSCallExpression;
  1034. begin
  1035. // a(b);
  1036. B:=CreateFunctionCall('a',['b']);
  1037. E:=TJSCallExpression(Convert(B,TJSCallExpression));
  1038. AssertIdentifier('Correct left literal for is',E.Expr,'a');
  1039. AssertNotNull('have arguments',E.Args);
  1040. AssertEquals('Argument count',1,E.Args.Elements.Count);
  1041. AssertIdentifier('Argument 1 identifier',E.Args.Elements[0].Expr,'b');
  1042. end;
  1043. procedure TTestExpressionConverter.TestCallExpressionTwo;
  1044. Var
  1045. B : TParamsExpr;
  1046. E : TJSCallExpression;
  1047. begin
  1048. // a(b,c);
  1049. B:=CreateFunctionCall('a',['b','c']);
  1050. E:=TJSCallExpression(Convert(B,TJSCallExpression));
  1051. AssertIdentifier('Correct left literal for is',E.Expr,'a');
  1052. AssertNotNull('have arguments',E.Args);
  1053. AssertEquals('Argument count',2,E.Args.Elements.Count);
  1054. AssertIdentifier('Argument 1 identifier',E.Args.Elements[0].Expr,'b');
  1055. AssertIdentifier('Argument 2 identifier',E.Args.Elements[1].Expr,'c');
  1056. end;
  1057. procedure TTestExpressionConverter.TestMemberExpressionArrayOneDim;
  1058. Var
  1059. B : TParamsExpr;
  1060. E : TJSBracketMemberExpression;
  1061. begin
  1062. // a[b];
  1063. B:=CreateParamsExpr(pekArrayParams);
  1064. B.Value:=CreateIdent('a');
  1065. B.AddParam(CreateIdent('b'));
  1066. E:=TJSBracketMemberExpression(Convert(B,TJSBracketMemberExpression));
  1067. AssertIdentifier('Correct array name',E.MExpr,'a');
  1068. AssertIdentifier('Correct array member name',E.Name,'b');
  1069. end;
  1070. procedure TTestExpressionConverter.TestMemberExpressionArrayTwoDim;
  1071. Var
  1072. B : TParamsExpr;
  1073. begin
  1074. // a[b,c];
  1075. B:=CreateParamsExpr(pekArrayParams);
  1076. B.Value:=CreateIdent('a');
  1077. B.AddParam(CreateIdent('b'));
  1078. B.AddParam(CreateIdent('c'));
  1079. AttemptConvert:=B;
  1080. AssertException('Pascal element not supported: TParamsExpr:TParamsExpr: Cannot convert 2-dim arrays',EPas2JS,@TryConvert);
  1081. end;
  1082. procedure TTestExpressionConverter.TestVariable;
  1083. Var
  1084. VD : TJSVarDeclaration;
  1085. R :TPasVariable;
  1086. begin
  1087. R:=CreateVariable('A',Nil);
  1088. VD:=TJSVarDeclaration(Convert(R,TJSVarDeclaration));
  1089. AssertEquals('Correct name, lowercased','a',String(VD.Name));
  1090. AssertNotNull('No init',VD.Init);
  1091. end;
  1092. procedure TTestExpressionConverter.TestArrayVariable;
  1093. Var
  1094. VD : TJSVarDeclaration;
  1095. R :TPasVariable;
  1096. A : TJSArrayLiteral;
  1097. begin
  1098. R:=CreateVariable('A',Nil);
  1099. R.VarType:=TPasArrayType.Create('myarray',Nil);
  1100. AddEl(R.VarType);
  1101. VD:=TJSVarDeclaration(Convert(R,TJSVarDeclaration));
  1102. AssertEquals('Correct name, lowercased','a',String(VD.Name));
  1103. A:=TJSArrayLiteral(AssertElement('Init is array literal',TJSArrayLiteral,VD.Init));
  1104. AssertEquals('No elements',0,A.Elements.Count);
  1105. end;
  1106. procedure TTestTestConverter.TestEmpty;
  1107. begin
  1108. AssertNotNull('Have converter',Converter);
  1109. end;
  1110. procedure TTestConverter.OnAddEl(El: TPasElement; Arg: pointer);
  1111. begin
  1112. //writeln('TTestConverter.OnAddEl ',El.Name,':',El.ClassName);
  1113. if FOwnedElements.IndexOf(El)<0 then
  1114. FOwnedElements.Add(El);
  1115. if Arg=nil then ;
  1116. end;
  1117. procedure TTestConverter.SetUp;
  1118. begin
  1119. FOwnedElements:=TFPList.Create;
  1120. FConverter:=TPasToJSConverter.Create;
  1121. FConverter.Globals:=TPasToJSConverterGlobals.Create(FConverter);
  1122. end;
  1123. procedure TTestConverter.TearDown;
  1124. var
  1125. i: Integer;
  1126. begin
  1127. for i:=0 to FOwnedElements.Count-1 do
  1128. TPasElement(FOwnedElements[i]).Free;
  1129. FreeAndNil(FOwnedElements);
  1130. FSource:=nil;
  1131. FreeAndNil(FRes);
  1132. FreeAndNil(FConverter);
  1133. end;
  1134. procedure TTestConverter.TryConvert;
  1135. begin
  1136. Convert(FAC,TJSElement);
  1137. end;
  1138. function TTestConverter.Convert(AElement: TPasElement; AClass: TJSElementClass
  1139. ): TJSElement;
  1140. begin
  1141. FSource:=AElement;
  1142. Result:=FConverter.ConvertPasElement(AElement,nil);
  1143. FRes:=Result;
  1144. if (AClass<>Nil) then
  1145. begin
  1146. AssertNotNull('Have conversion result',Result);
  1147. AssertEquals('Conversion result has correct class',AClass,Result.ClassType);
  1148. end;
  1149. end;
  1150. procedure TTestConverter.AddEl(El: TPasElement);
  1151. begin
  1152. FOwnedElements.Add(El);
  1153. end;
  1154. procedure TTestConverter.AddElWithChildren(El: TPasElement);
  1155. begin
  1156. El.ForEachCall(@OnAddEl,nil);
  1157. end;
  1158. function TTestConverter.CreateElement(aClass: TPTreeElement;
  1159. aParent: TPasElement): TPasElement;
  1160. begin
  1161. Result:=aClass.Create('',aParent);
  1162. AddEl(Result);
  1163. end;
  1164. function TTestConverter.CreatePrimitiveExpr(aParent: TPasElement;
  1165. Kind: TPasExprKind; const Value: string): TPrimitiveExpr;
  1166. begin
  1167. Result:=TPrimitiveExpr.Create(aParent,Kind,Value);
  1168. AddEl(Result);
  1169. end;
  1170. class procedure TTestConverter.AssertEquals(const Msg: String; AExpected,
  1171. AActual: TJSType);
  1172. begin
  1173. AssertEquals(Msg,GetEnumName(TypeInfo(TJSType),Ord(AExpected)),
  1174. GetEnumName(TypeInfo(TJSType),Ord(AActual)));
  1175. end;
  1176. class procedure TTestConverter.AssertLiteral(const Msg: String;
  1177. Lit: TJSElement; AType: TJSType);
  1178. begin
  1179. AssertNotNull(Msg+': Have instance',Lit);
  1180. AssertEquals(Msg+': Correct class',TJSLIteral,Lit.ClassType);
  1181. AssertEquals(Msg+': Correct value type',AType,TJSLIteral(Lit).Value.ValueType);
  1182. end;
  1183. class procedure TTestConverter.AssertLiteral(const Msg: String;
  1184. Lit: TJSElement; AValue: Boolean);
  1185. begin
  1186. AssertLiteral(Msg,Lit,jstBoolean);
  1187. AssertEquals(Msg+': Correct value',AValue,TJSLiteral(Lit).Value.AsBoolean);
  1188. end;
  1189. class procedure TTestConverter.AssertLiteral(const Msg: String;
  1190. Lit: TJSElement; AValue: TJSString);
  1191. begin
  1192. AssertLiteral(Msg,Lit,jstString);
  1193. AssertEquals(Msg+': Correct value',String(AValue),String(TJSLiteral(Lit).Value.AsString));
  1194. end;
  1195. class procedure TTestConverter.AssertLiteral(const Msg: String;
  1196. Lit: TJSElement; AValue: TJSNumber);
  1197. begin
  1198. AssertLiteral(Msg,Lit,jstNumber);
  1199. AssertEquals(Msg+': Correct value',AValue,TJSLiteral(Lit).Value.AsNumber);
  1200. end;
  1201. class procedure TTestConverter.AssertIdentifier(const Msg: String;
  1202. Ident: TJSElement; AName: String);
  1203. begin
  1204. AssertNotNull(Msg+': Have instance',Ident);
  1205. AssertEquals(Msg+': Correct class',TJSPrimaryExpressionIdent,Ident.ClassType);
  1206. AssertEquals(Msg+': Correct name',AName,String(TJSPrimaryExpressionIdent(Ident).Name));
  1207. end;
  1208. function TTestConverter.CreateLiteral(AValue: String): TPasExpr;
  1209. begin
  1210. Result:=CreatePrimitiveExpr(Nil,pekString,AValue);
  1211. end;
  1212. function TTestConverter.CreateLiteral(AValue: Double): TPasExpr;
  1213. Var
  1214. S : String;
  1215. begin
  1216. Str(AValue,S);
  1217. Result:=CreatePrimitiveExpr(Nil,pekNumber,Trim(S));
  1218. end;
  1219. function TTestConverter.CreateIdent(AName: String): TPrimitiveExpr;
  1220. begin
  1221. Result:=CreatePrimitiveExpr(Nil,pekIdent,AName);
  1222. end;
  1223. function TTestConverter.CreateCondition: TPasExpr;
  1224. begin
  1225. Result:=CreateIdent('a');
  1226. end;
  1227. function TTestConverter.CreateVariable(aName: String; aParent: TPasElement
  1228. ): TPasVariable;
  1229. begin
  1230. Result:=TPasVariable.Create(aName,aParent);
  1231. AddEl(Result);
  1232. end;
  1233. function TTestConverter.CreateBinary(AOpCode: TExprOpCode; aParent: TPasElement
  1234. ): TBinaryExpr;
  1235. begin
  1236. Result:=TBinaryExpr.Create(aParent,pekBinary,AOpCode);
  1237. AddEl(Result);
  1238. end;
  1239. function TTestConverter.CreateBoolConstExpr(Value: boolean): TBoolConstExpr;
  1240. begin
  1241. Result:=TBoolConstExpr.Create(Nil,pekBoolConst,Value);
  1242. AddEl(Result);
  1243. end;
  1244. function TTestConverter.CreateUnaryExpr(AOpCode: TExprOpCode): TUnaryExpr;
  1245. begin
  1246. Result:=TUnaryExpr.Create(Nil,pekUnary,AOpCode);
  1247. AddEl(Result);
  1248. end;
  1249. function TTestConverter.CreateAssignStatement(LHS: String; RHS: String
  1250. ): TPasImplAssign;
  1251. begin
  1252. Result:=TPasImplAssign(CreateElement(TPasImplAssign));
  1253. Result.Left:=CreateIdent(LHS);
  1254. Result.Right:=CreateIdent(RHS);
  1255. end;
  1256. function TTestConverter.CreateParamsExpr(Kind: TPasExprKind;
  1257. aParent: TPasElement): TParamsExpr;
  1258. begin
  1259. Result:=TParamsExpr.Create(aParent,Kind);
  1260. AddEl(Result);
  1261. end;
  1262. function TTestConverter.CreateFunctionCall(AName: String;
  1263. Params: array of String): TParamsExpr;
  1264. Var
  1265. I : Integer;
  1266. begin
  1267. Result:=TParamsExpr.Create(Nil,pekFuncParams,eopNone);
  1268. AddEl(Result);
  1269. Result.Value:=CreateIdent(AName);
  1270. For I:=Low(Params) to High(Params) do
  1271. Result.AddParam(TPasExpr(CreateIdent(Params[I])));
  1272. end;
  1273. class procedure TTestConverter.AssertAssignStatement(const Msg: String;
  1274. El: TJSElement; LHS: String; RHS: String);
  1275. begin
  1276. AssertNotNull(Msg+': have statement',EL);
  1277. If not (El is TJSSimpleAssignStatement) then
  1278. Fail(Msg+': statement is not assign statement but is '+El.ClassName);
  1279. AssertIdentifier(Msg+': left hand side ('+LHS+')',TJSAssignStatement(EL).LHS,LHS);
  1280. AssertIdentifier(Msg+': left hand side ('+LHS+')',TJSAssignStatement(EL).Expr,RHS);
  1281. end;
  1282. class procedure TTestConverter.AssertEmptyBlockStatement(const Msg: String;
  1283. El: TJSElement);
  1284. begin
  1285. AssertNotNull(Msg+': have statement',EL);
  1286. If not (El is TJSEmptyBlockStatement) then
  1287. Fail(Msg+': statement is not empty block statement but is'+El.ClassName);
  1288. end;
  1289. class function TTestConverter.AssertListStatement(const Msg: String;
  1290. El: TJSElement): TJSStatementList;
  1291. begin
  1292. AssertNotNull(Msg+': have statement',EL);
  1293. If not (El is TJSStatementList) then
  1294. Fail(Msg+': statement is not a list statement but is'+El.ClassName);
  1295. Result:=TJSStatementList(El);
  1296. end;
  1297. class function TTestConverter.AssertElement(const Msg: String;
  1298. AClass: TJSElementClass; El: TJSElement): TJSElement;
  1299. begin
  1300. AssertNotNull(Msg+': have element',El);
  1301. if not (El is ACLass) then
  1302. Fail(Msg+': is not of class '+AClass.ClassName+' but is '+EL.ClassName);
  1303. Result:=El;
  1304. end;
  1305. Initialization
  1306. RegisterTests([TTestTestConverter,TTestExpressionConverter,TTestStatementConverter]);
  1307. end.