tcexprparser.pas 44 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378
  1. unit tcexprparser;
  2. {$mode objfpc}{$H+}
  3. interface
  4. uses
  5. Classes, SysUtils, fpcunit, testregistry, tcbaseparser, pastree, pparser, PScanner;
  6. type
  7. { TTestExpressions }
  8. TTestExpressions= class(TTestParser)
  9. private
  10. FLeft: TPAsExpr;
  11. FRight: TPAsExpr;
  12. FTheExpr: TPasExpr;
  13. FVariables : TStringList;
  14. procedure AssertLeftPrecedence(AInnerLeft: Integer; AInnerOp: TExprOpCode;
  15. AInnerRight: Integer; AOuterOp: TexprOpCode; AOuterRight: Integer);
  16. procedure AssertRightPrecedence(AOuterLeft: Integer; AOuterOp: TExprOpCode;
  17. AInnerLeft: Integer; AInnerOp: TexprOpCode; AInnerRight: Integer);
  18. procedure DeclareVar(const AVarType: String; const AVarName: String = 'a');
  19. protected
  20. procedure SetUp; override;
  21. procedure TearDown; override;
  22. Procedure SetExpression(Const AExpression : String);
  23. Procedure ParseExpression;
  24. Procedure ParseExpression(Const AExpression : String);
  25. Function AssertBinaryExpr(Const Msg : String; Op : TExprOpCode; Out ALeft,ARight : TPasExpr) : TBinaryExpr;
  26. Function AssertBinaryExpr(Const Msg : String; AExpr : TPasExpr; Op : TExprOpCode; Out ALeft,ARight : TPasExpr) : TBinaryExpr;
  27. Function AssertUnaryExpr(Const Msg : String; Op : TExprOpCode; Out AOperand : TPasExpr) : TUnaryExpr;
  28. Function AssertUnaryExpr(Const Msg : String; AExpr: TPasExpr; Op : TExprOpCode; Out AOperand : TPasExpr) : TUnaryExpr;
  29. Property TheExpr : TPasExpr read FTheExpr;
  30. Property Theleft : TPAsExpr Read FLeft;
  31. Property TheRight : TPAsExpr Read FRight;
  32. published
  33. {
  34. TPasExprKind = (pekRange,
  35. pekListOfExp, );
  36. }
  37. procedure TestPrimitiveInteger;
  38. procedure TestPrimitiveIntegerHex;
  39. procedure TestPrimitiveIntegerOctal;
  40. procedure TestPrimitiveIntegerBinary;
  41. procedure TestPrimitiveDouble;
  42. procedure TestPrimitiveDouble2;
  43. procedure TestPrimitiveDouble3;
  44. procedure TestPrimitiveDouble4;
  45. procedure TestPrimitiveDouble5;
  46. procedure TestPrimitiveDouble6;
  47. procedure TestPrimitiveDouble7;
  48. procedure TestPrimitiveDouble8;
  49. procedure TestPrimitiveDouble9;
  50. procedure TestPrimitiveDouble10;
  51. procedure TestPrimitiveDouble11;
  52. procedure TestPrimitiveString;
  53. procedure TestPrimitiveIdent;
  54. procedure TestPrimitiveBooleanFalse;
  55. procedure TestPrimitiveBooleanTrue;
  56. procedure TestPrimitiveNil;
  57. procedure TestPrimitiveSet;
  58. procedure TestPrimitiveChar;
  59. procedure TestPrimitiveControlChar;
  60. procedure TestPrimitiveSetEmpty;
  61. procedure TestPrimitiveSelf;
  62. Procedure TestInherited;
  63. Procedure TestInheritedFunction;
  64. Procedure TestUnaryMinus;
  65. Procedure TestUnaryMinusWhiteSpace;
  66. Procedure TestUnaryAddress;
  67. Procedure TestUnaryNot;
  68. Procedure TestUnaryDeref;
  69. Procedure TestUnaryDoubleDeref;
  70. Procedure TestUnaryDoubleDeref2;
  71. Procedure TestBinaryAdd;
  72. Procedure TestBinarySubtract;
  73. Procedure TestBinaryMultiply;
  74. Procedure TestBinaryDivision;
  75. Procedure TestBinaryPower;
  76. Procedure TestBinaryMod;
  77. Procedure TestBinaryDiv;
  78. procedure TestBinaryShl;
  79. procedure TestBinaryShr;
  80. Procedure TestBinarySymmetricalDifference;
  81. Procedure TestBinaryAnd;
  82. Procedure TestBinaryOr;
  83. Procedure TestBinaryXOr;
  84. Procedure TestBinaryIn;
  85. Procedure TestBinaryIs;
  86. Procedure TestBinaryAs;
  87. Procedure TestBinaryEquals;
  88. Procedure TestBinaryDiffers;
  89. Procedure TestBinaryLessThan;
  90. Procedure TestBinaryLessThanEqual;
  91. Procedure TestBinaryLargerThan;
  92. Procedure TestBinaryLargerThanEqual;
  93. procedure TestBinarySubIdent;
  94. Procedure TestArrayElement;
  95. Procedure TestArrayElementRecord;
  96. Procedure TestArrayElement2Dims;
  97. Procedure TestFunctionCall;
  98. Procedure TestFunctionCall2args;
  99. Procedure TestFunctionCallNoArgs;
  100. Procedure TestSubIdentStrWithFormat;
  101. Procedure TestAPlusCallB;
  102. Procedure TestAPlusBBracketFuncParams;
  103. Procedure TestAPlusBBracketArrayParams;
  104. Procedure TestAPlusBBracketDotC;
  105. Procedure TestADotBDotC;
  106. Procedure TestADotBBracketC;
  107. procedure TestADotKeyWord;
  108. procedure TestADotKeyWordOnlyDelphi;
  109. Procedure TestSelfDotBBracketC;
  110. Procedure TestAasBDotCBracketFuncParams;
  111. Procedure TestRange;
  112. Procedure TestBracketsTotal;
  113. Procedure TestBracketsLeft;
  114. Procedure TestBracketsRight;
  115. Procedure TestPrecedenceLeftToRight;
  116. Procedure TestPrecedenceLeftToRightMinus;
  117. Procedure TestPrecedenceLeftToRightMultiply;
  118. Procedure TestPrecedenceLeftToRightDivision;
  119. Procedure TestPrecedenceLeftToRightPlusMinus;
  120. Procedure TestPrecedenceLeftToRightMinusPlus;
  121. Procedure TestPrecedenceLeftToRightMultiplyDivision;
  122. Procedure TestPrecedenceLeftToRightDivisionMultiply;
  123. Procedure TestPrecedencePlusMultiply;
  124. Procedure TestPrecedencePlusDivide;
  125. Procedure TestPrecedenceMinusMultiply;
  126. Procedure TestPrecedenceMinusDivide;
  127. Procedure TestPrecedencePlusOr;
  128. Procedure TestPrecedenceAndOr;
  129. Procedure TestPrecedenceAndNot;
  130. Procedure TestPrecedencePlusAnd;
  131. Procedure TestPrecedenceMinusOr;
  132. Procedure TestPrecedenceMinusAnd;
  133. Procedure TestPrecedenceMultiplyOr;
  134. Procedure TestPrecedenceMultiplyAnd;
  135. Procedure TestPrecedencePlusDiv;
  136. Procedure TestPrecedencePlusMod;
  137. Procedure TestPrecedenceMultiplyDiv;
  138. Procedure TestPrecedenceDivMultiply;
  139. Procedure TestPrecedenceMultiplyPower;
  140. Procedure TestPrecedencePowerMultiply;
  141. Procedure TestTypeCast;
  142. procedure TestTypeCast2;
  143. Procedure TestCreate;
  144. procedure TestChainedPointers;
  145. procedure TestChainedPointers2;
  146. procedure TestChainedPointers3;
  147. Procedure TestNilCaret;
  148. Procedure TestExpCaret;
  149. Procedure TestArrayAccess;
  150. Procedure TestHelperOnLiteral;
  151. procedure TestParseAdhocExpression;
  152. end;
  153. implementation
  154. procedure TTestExpressions.DeclareVar(const AVarType: String;
  155. const AVarName: String = 'a');
  156. begin
  157. FVariables.Add(AVarName+' : '+AVarType+';');
  158. end;
  159. procedure TTestExpressions.TestPrimitiveInteger;
  160. begin
  161. ParseExpression('1');
  162. AssertExpression('Simple integer',theExpr,pekNumber,'1');
  163. end;
  164. procedure TTestExpressions.TestPrimitiveIntegerHex;
  165. begin
  166. ParseExpression('$FF');
  167. AssertExpression('Simple integer',theExpr,pekNumber,'$FF');
  168. end;
  169. procedure TTestExpressions.TestPrimitiveIntegerOctal;
  170. begin
  171. ParseExpression('&777');
  172. AssertExpression('Simple integer',theExpr,pekNumber,'&777');
  173. end;
  174. procedure TTestExpressions.TestPrimitiveIntegerBinary;
  175. begin
  176. ParseExpression('%10101010');
  177. AssertExpression('Simple integer',theExpr,pekNumber,'%10101010');
  178. end;
  179. procedure TTestExpressions.TestPrimitiveDouble;
  180. begin
  181. ParseExpression('1.2');
  182. AssertExpression('Simple double',theExpr,pekNumber,'1.2');
  183. end;
  184. procedure TTestExpressions.TestPrimitiveDouble2;
  185. begin
  186. ParseExpression('1.200');
  187. AssertExpression('Simple double',theExpr,pekNumber,'1.200');
  188. end;
  189. procedure TTestExpressions.TestPrimitiveDouble3;
  190. begin
  191. ParseExpression('01.2');
  192. AssertExpression('Simple double',theExpr,pekNumber,'01.2');
  193. end;
  194. procedure TTestExpressions.TestPrimitiveDouble4;
  195. begin
  196. ParseExpression('1.2e10');
  197. AssertExpression('Simple double',theExpr,pekNumber,'1.2e10');
  198. end;
  199. procedure TTestExpressions.TestPrimitiveDouble5;
  200. begin
  201. ParseExpression('1.2e-10');
  202. AssertExpression('Simple double',theExpr,pekNumber,'1.2e-10');
  203. end;
  204. procedure TTestExpressions.TestPrimitiveDouble6;
  205. begin
  206. ParseExpression('12e10');
  207. AssertExpression('Simple double',theExpr,pekNumber,'12e10');
  208. end;
  209. procedure TTestExpressions.TestPrimitiveDouble7;
  210. begin
  211. ParseExpression('12e-10');
  212. AssertExpression('Simple double',theExpr,pekNumber,'12e-10');
  213. end;
  214. procedure TTestExpressions.TestPrimitiveDouble8;
  215. begin
  216. ParseExpression('8.5');
  217. AssertExpression('Simple double',theExpr,pekNumber,'8.5');
  218. end;
  219. procedure TTestExpressions.TestPrimitiveDouble9;
  220. begin
  221. ParseExpression('8.E5');
  222. AssertExpression('Simple double',theExpr,pekNumber,'8.E5');
  223. end;
  224. procedure TTestExpressions.TestPrimitiveDouble10;
  225. begin
  226. ParseExpression('8.E-5');
  227. AssertExpression('Simple double',theExpr,pekNumber,'8.E-5');
  228. end;
  229. procedure TTestExpressions.TestPrimitiveDouble11;
  230. begin
  231. ParseExpression('8E+5');
  232. AssertExpression('Simple double',theExpr,pekNumber,'8E+5');
  233. end;
  234. procedure TTestExpressions.TestPrimitiveString;
  235. begin
  236. DeclareVar('string');
  237. ParseExpression('''123''');
  238. AssertExpression('Simple string',theExpr,pekString,'''123''');
  239. end;
  240. procedure TTestExpressions.TestPrimitiveIdent;
  241. begin
  242. DeclareVar('integer','a');
  243. DeclareVar('integer','b');
  244. ParseExpression('b');
  245. AssertExpression('Simple identifier',theExpr,pekIdent,'b');
  246. end;
  247. procedure TTestExpressions.TestBinarySubIdent;
  248. begin
  249. DeclareVar('integer','a');
  250. DeclareVar('record x,y : integer; end','b');
  251. ParseExpression('b.x');
  252. AssertBinaryExpr('sub identifier',eopSubIdent,Fleft,FRight);
  253. AssertExpression('Simple identifier',Theleft,pekIdent,'b');
  254. AssertExpression('Simple identifier',Theright,pekIdent,'x');
  255. end;
  256. procedure TTestExpressions.TestArrayElement;
  257. Var
  258. P : TParamsExpr;
  259. begin
  260. DeclareVar('integer','a');
  261. DeclareVar('array[1..2] of integer','b');
  262. ParseExpression('b[1]');
  263. P:=TParamsExpr(AssertExpression('Simple identifier',theExpr,pekArrayParams,TParamsExpr));
  264. AssertExpression('Name of array',P.Value,pekIdent,'b');
  265. AssertEquals('One dimension',1,Length(p.params));
  266. AssertExpression('Simple identifier',p.params[0],pekNumber,'1');
  267. end;
  268. procedure TTestExpressions.TestArrayElementRecord;
  269. Var
  270. P : TParamsExpr;
  271. B : TBinaryExpr;
  272. begin
  273. DeclareVar('record a : array[1..2] of integer; end ','b');
  274. ParseExpression('b.a[1]');
  275. P:=TParamsExpr(AssertExpression('Array Param',TheExpr,pekArrayParams,TParamsExpr));
  276. TAssert.AssertSame('P.value.parent=P',P,P.Value.Parent);
  277. AssertEquals('One dimension',1,Length(P.params));
  278. AssertExpression('Simple identifier',P.params[0],pekNumber,'1');
  279. B:=TBinaryExpr(AssertExpression('Binary of record',P.Value,pekBinary,TBinaryExpr));
  280. AssertEquals('Name is Subident',eopSubIdent,B.Opcode);
  281. AssertExpression('Name of array',B.Left,pekIdent,'b');
  282. AssertExpression('Name of array',B.Right,pekIdent,'a');
  283. TAssert.AssertSame('B.left.parent=B',B,B.Left.Parent);
  284. TAssert.AssertSame('B.right.parent=B',B,B.Right.Parent);
  285. end;
  286. procedure TTestExpressions.TestArrayElement2Dims;
  287. Var
  288. P : TParamsExpr;
  289. begin
  290. DeclareVar('integer','a');
  291. DeclareVar('array[1..2,1..2] of integer','b');
  292. ParseExpression('b[1,2]');
  293. P:=TParamsExpr(AssertExpression('Simple identifier',theExpr,pekArrayParams,TParamsExpr));
  294. AssertExpression('Name of array',P.Value,pekIdent,'b');
  295. AssertEquals('Two dimensions',2,Length(p.params));
  296. AssertExpression('Simple identifier',p.params[0],pekNumber,'1');
  297. AssertExpression('Simple identifier',p.params[1],pekNumber,'2');
  298. end;
  299. procedure TTestExpressions.TestFunctionCall;
  300. Var
  301. P : TParamsExpr;
  302. begin
  303. DeclareVar('integer','a');
  304. ParseExpression('Random(10)');
  305. P:=TParamsExpr(AssertExpression('Simple identifier',theExpr,pekFuncParams,TParamsExpr));
  306. AssertExpression('Name of function',P.Value,pekIdent,'Random');
  307. AssertEquals('1 argument',1,Length(p.params));
  308. AssertExpression('Simple identifier',p.params[0],pekNumber,'10');
  309. end;
  310. procedure TTestExpressions.TestFunctionCall2args;
  311. Var
  312. P : TParamsExpr;
  313. begin
  314. DeclareVar('integer','a');
  315. ParseExpression('Random(10,12)');
  316. P:=TParamsExpr(AssertExpression('Simple identifier',theExpr,pekFuncParams,TParamsExpr));
  317. AssertExpression('Name of function',P.Value,pekIdent,'Random');
  318. AssertEquals('2 argument',2,Length(p.params));
  319. AssertExpression('Simple identifier 1',p.params[0],pekNumber,'10');
  320. AssertExpression('Simple identifier 2',p.params[1],pekNumber,'12');
  321. end;
  322. procedure TTestExpressions.TestFunctionCallNoArgs;
  323. Var
  324. P : TParamsExpr;
  325. begin
  326. DeclareVar('integer','a');
  327. ParseExpression('Random()');
  328. P:=TParamsExpr(AssertExpression('Simple identifier',theExpr,pekFuncParams,TParamsExpr));
  329. AssertExpression('Name of function',P.Value,pekIdent,'Random');
  330. AssertEquals('0 arguments',0,Length(p.params));
  331. end;
  332. procedure TTestExpressions.TestRange;
  333. Var
  334. P : TParamsExpr;
  335. B : TBinaryExpr;
  336. begin
  337. DeclareVar('boolean','a');
  338. DeclareVar('byte','b');
  339. ParseExpression('b in [0..10]');
  340. AssertBinaryExpr('Simple binary In',eopIn,FLeft,FRight);
  341. AssertExpression('Left is b',TheLeft,pekIdent,'b');
  342. P:=TParamsExpr(AssertExpression('Right is set',TheRight,pekSet,TParamsExpr));
  343. AssertEquals('Number of items',1,Length(P.Params));
  344. B:=TBinaryExpr(AssertExpression('First element is range',P.Params[0],pekRange,TBinaryExpr));
  345. AssertExpression('Left is 0',B.Left,pekNumber,'0');
  346. AssertExpression('Right is 10',B.Right,pekNumber,'10');
  347. B:=TBinaryExpr(TheExpr);
  348. TAssert.AssertSame('B.left.parent=B',B,B.Left.Parent);
  349. TAssert.AssertSame('B.right.parent=B',B,B.Right.Parent);
  350. end;
  351. procedure TTestExpressions.TestBracketsTotal;
  352. begin
  353. DeclareVar('integer','a');
  354. ParseExpression('(3+4)');
  355. AssertBinaryExpr('simple binary add',eopAdd,FLeft,FRight);
  356. AssertExpression('Inner Left is 3',TheLeft,pekNumber,'3');
  357. AssertExpression('Inner Right is 4',TheRight,pekNumber,'4');
  358. end;
  359. procedure TTestExpressions.TestBracketsLeft;
  360. begin
  361. DeclareVar('integer','a');
  362. ParseExpression('2*(3+4)');
  363. AssertRightPrecedence(2,eopMultiply,3,eopAdd,4);
  364. end;
  365. procedure TTestExpressions.TestBracketsRight;
  366. begin
  367. DeclareVar('integer','a');
  368. ParseExpression('(2*3)+4');
  369. AssertLeftPrecedence(2,eopMultiply,3,eopAdd,4);
  370. end;
  371. procedure TTestExpressions.TestPrecedenceLeftToRight;
  372. begin
  373. ParseExpression('1+2+3');
  374. AssertLeftPrecedence(1,eopAdd,2,eopAdd,3);
  375. end;
  376. procedure TTestExpressions.TestPrecedenceLeftToRightMinus;
  377. begin
  378. ParseExpression('1-2-3');
  379. AssertLeftPrecedence(1,eopSubtract,2,eopSubtract,3);
  380. end;
  381. procedure TTestExpressions.TestPrecedenceLeftToRightMultiply;
  382. begin
  383. ParseExpression('1*2*3');
  384. AssertLeftPrecedence(1,eopMultiply,2,eopMultiply,3);
  385. end;
  386. procedure TTestExpressions.TestPrecedenceLeftToRightDivision;
  387. begin
  388. ParseExpression('1/2/3');
  389. AssertLeftPrecedence(1,eopDivide,2,eopDivide,3);
  390. end;
  391. procedure TTestExpressions.TestPrecedenceLeftToRightPlusMinus;
  392. begin
  393. ParseExpression('1+2-3');
  394. AssertLeftPrecedence(1,eopAdd,2,eopSubtract,3);
  395. end;
  396. procedure TTestExpressions.TestPrecedenceLeftToRightMinusPlus;
  397. begin
  398. ParseExpression('1-2+3');
  399. AssertLeftPrecedence(1,eopSubtract,2,eopAdd,3);
  400. end;
  401. procedure TTestExpressions.TestPrecedenceLeftToRightMultiplyDivision;
  402. begin
  403. ParseExpression('1*2/3');
  404. AssertLeftPrecedence(1,eopMultiply,2,eopDivide,3);
  405. end;
  406. procedure TTestExpressions.TestPrecedenceLeftToRightDivisionMultiply;
  407. begin
  408. ParseExpression('1/2*3');
  409. AssertLeftPrecedence(1,eopDivide,2,eopMultiply,3);
  410. end;
  411. procedure TTestExpressions.TestPrecedencePlusMultiply;
  412. begin
  413. ParseExpression('1+2*3');
  414. AssertRightPrecedence(1,eopAdd,2,eopMultiply,3);
  415. end;
  416. procedure TTestExpressions.TestPrecedencePlusDivide;
  417. begin
  418. ParseExpression('1+2/3');
  419. AssertRightPrecedence(1,eopAdd,2,eopDivide,3);
  420. end;
  421. procedure TTestExpressions.TestPrecedenceMinusMultiply;
  422. begin
  423. ParseExpression('1-2*3');
  424. AssertRightPrecedence(1,eopsubtract,2,eopMultiply,3);
  425. end;
  426. procedure TTestExpressions.TestPrecedenceMinusDivide;
  427. begin
  428. ParseExpression('1-2/3');
  429. AssertRightPrecedence(1,eopsubtract,2,eopDivide,3);
  430. end;
  431. procedure TTestExpressions.TestPrecedencePlusOr;
  432. begin
  433. ParseExpression('1 or 2 + 3');
  434. AssertLeftPrecedence(1,eopor,2,eopAdd,3);
  435. end;
  436. procedure TTestExpressions.TestPrecedenceAndOr;
  437. begin
  438. ParseExpression('1 or 2 and 3');
  439. AssertRightPrecedence(1,eopor,2,eopAnd,3);
  440. end;
  441. procedure TTestExpressions.TestPrecedenceAndNot;
  442. begin
  443. ParseExpression('Not 1 and 3');
  444. AssertBinaryExpr('Simple binary and',eopAnd,FLeft,FRight);
  445. AssertExpression('Outer right is 3',TheRight,pekNumber,'3');
  446. AssertUnaryExpr('Left is Unary not ',TheLeft,eopNot,FRight);
  447. AssertExpression('Inner Right is 1',TheRight,pekNumber,'1');
  448. end;
  449. procedure TTestExpressions.TestPrecedencePlusAnd;
  450. begin
  451. ParseExpression('1 + 2 and 3');
  452. AssertRightPrecedence(1,eopAdd,2,eopAnd,3);
  453. end;
  454. procedure TTestExpressions.TestPrecedenceMinusOr;
  455. begin
  456. ParseExpression('1 or 2 - 3');
  457. AssertLeftPrecedence(1,eopOr,2,eopSubtract,3);
  458. end;
  459. procedure TTestExpressions.TestPrecedenceMinusAnd;
  460. begin
  461. ParseExpression('1 - 2 and 3');
  462. AssertRightPrecedence(1,eopSubtract,2,eopand,3);
  463. end;
  464. procedure TTestExpressions.TestPrecedenceMultiplyOr;
  465. begin
  466. ParseExpression('1 or 2 * 3');
  467. AssertRightPrecedence(1,eopOr,2,eopMultiply,3);
  468. end;
  469. procedure TTestExpressions.TestPrecedenceMultiplyAnd;
  470. begin
  471. ParseExpression('1 * 2 and 3');
  472. AssertLeftPrecedence(1,eopMultiply,2,eopAnd,3);
  473. end;
  474. procedure TTestExpressions.TestPrecedencePlusDiv;
  475. begin
  476. ParseExpression('1+2 div 3');
  477. AssertRightPrecedence(1,eopAdd,2,eopDiv,3);
  478. end;
  479. procedure TTestExpressions.TestPrecedencePlusMod;
  480. begin
  481. ParseExpression('1+2 mod 3');
  482. AssertRightPrecedence(1,eopAdd,2,eopMod,3);
  483. end;
  484. procedure TTestExpressions.AssertLeftPrecedence(AInnerLeft : Integer; AInnerOp : TExprOpCode; AInnerRight : Integer; AOuterOp : TexprOpCode; AOuterRight: Integer);
  485. begin
  486. AssertBinaryExpr('Outer expression',AOuterOp,FLeft,FRight);
  487. AssertExpression('Outer right constant',TheRight,pekNumber,intToStr(AOuterRight));
  488. AssertBinaryExpr('Inner (left) expression',TheLeft,AInnerOp,FLeft,FRight);
  489. AssertExpression('Inner Left constant',TheLeft,pekNumber,IntToStr(AInnerLeft));
  490. AssertExpression('Inner Right constant',TheRight,pekNumber,IntToStr(AInnerRight));
  491. end;
  492. procedure TTestExpressions.AssertRightPrecedence(AOuterLeft : Integer; AOuterOp : TExprOpCode; AInnerLeft : Integer; AInnerOp : TexprOpCode; AInnerRight: Integer);
  493. begin
  494. AssertBinaryExpr('Outer expression',AOuterOp,FLeft,FRight);
  495. AssertExpression('Outer left constant',TheLeft,pekNumber,intToStr(AOuterLeft));
  496. AssertBinaryExpr('Inner (right) expression',TheRight,AInnerOp,FLeft,FRight);
  497. AssertExpression('Inner Left constant',TheLeft,pekNumber,IntToStr(AInnerLeft));
  498. AssertExpression('Inner Right constant',TheRight,pekNumber,IntToStr(AInnerRight));
  499. end;
  500. procedure TTestExpressions.TestPrecedenceMultiplyDiv;
  501. begin
  502. ParseExpression('1 * 2 div 3');
  503. AssertLeftPrecedence(1,eopMultiply,2,eopDiv,3);
  504. end;
  505. procedure TTestExpressions.TestPrecedenceDivMultiply;
  506. begin
  507. ParseExpression('1 div 2 * 3');
  508. AssertLeftPrecedence(1,eopDiv,2,eopMultiply,3);
  509. end;
  510. procedure TTestExpressions.TestPrecedenceMultiplyPower;
  511. begin
  512. ParseExpression('1 * 2 ** 3');
  513. AssertRightPrecedence(1,eopMultiply,2,eopPower,3);
  514. end;
  515. procedure TTestExpressions.TestPrecedencePowerMultiply;
  516. begin
  517. ParseExpression('1 ** 2 * 3');
  518. AssertLeftPrecedence(1,eopPower,2,eopMultiply,3);
  519. end;
  520. procedure TTestExpressions.TestTypeCast;
  521. begin
  522. DeclareVar('TSDOBaseDataObjectClass');
  523. ParseExpression('TSDOBaseDataObjectClass(Self.ClassType).Create');
  524. end;
  525. procedure TTestExpressions.TestTypeCast2;
  526. begin
  527. DeclareVar('TSDOBaseDataObjectClass');
  528. ParseExpression('TSDOBaseDataObjectClass(Self.ClassType).Create.D');
  529. end;
  530. procedure TTestExpressions.TestCreate;
  531. begin
  532. DeclareVar('ESDOSerializationException');
  533. ParseExpression('ESDOSerializationException.CreateFmt(SERR_InvalidDataTypeInContext,[IntToStr(Ord(AOwner^.DataType))])');
  534. end;
  535. procedure TTestExpressions.TestChainedPointers;
  536. begin
  537. // From bug report 31719
  538. Source.Add('type');
  539. Source.Add(' PTResourceManager=^TResourceManager;');
  540. Source.Add(' TResourceManager=object');
  541. Source.Add(' function LoadResourceFromFile(filename:string):PTResourceManager;');
  542. Source.Add(' end;');
  543. Source.Add(' function TResourceManager.LoadResourceFromFile(filename:string):PTResourceManager;');
  544. Source.Add(' begin');
  545. Source.Add(' result:=@self;');
  546. Source.Add(' end;');
  547. Source.Add('');
  548. Source.Add(' var');
  549. Source.Add(' ResourceManager:TResourceManager;');
  550. Source.Add('');
  551. Source.Add(' begin');
  552. Source.Add(' ResourceManager.LoadResourceFromFile(''file1'')');
  553. Source.Add(' ^.LoadResourceFromFile(''file2'');');
  554. Source.Add(' end.');
  555. ParseModule;
  556. end;
  557. procedure TTestExpressions.TestChainedPointers2;
  558. begin
  559. Source.Add('program afile;');
  560. Source.Add('procedure test;');
  561. Source.Add('begin');
  562. Source.Add('ResourcePool.Shared^.Register(TypeOf(tTexture), @LoadTexture)^.Tag(GLResourceTag)');
  563. Source.Add(' ^.Register(TypeOf(tShader), @LoadShader)^.Tag(GLResourceTag)//space - works');
  564. Source.Add('^.Register(TypeOf(ShaderProgram), @LoadShaderProgram)^.Tag(GLResourceTag);//without space - does not work');
  565. Source.Add('end;');
  566. Source.Add('begin');
  567. Source.Add('end.');
  568. ParseModule;
  569. end;
  570. procedure TTestExpressions.TestChainedPointers3;
  571. begin
  572. Source.Add('program afile;');
  573. Source.Add('procedure test;');
  574. Source.Add('begin');
  575. Source.Add('ResourcePool.Shared^.Register(TypeOf(tTexture), @LoadTexture)^.Tag(GLResourceTag)');
  576. Source.Add(' ^.Register(TypeOf(tShader), @LoadShader)^.Tag(GLResourceTag)//space - works');
  577. Source.Add(#9'^.Register(TypeOf(ShaderProgram), @LoadShaderProgram)^.Tag(GLResourceTag);// tab - does not work');
  578. Source.Add('end;');
  579. Source.Add('begin');
  580. Source.Add('end.');
  581. ParseModule;
  582. end;
  583. procedure TTestExpressions.TestNilCaret;
  584. begin
  585. Source.Add('{$mode objfpc}');
  586. Source.Add('begin');
  587. Source.Add('FillChar(nil^,10,10);');
  588. Source.Add('end.');
  589. ParseModule;
  590. end;
  591. procedure TTestExpressions.TestExpCaret;
  592. begin
  593. Source.Add('{$mode objfpc}');
  594. Source.Add('begin');
  595. Source.Add('A:=B^;');
  596. Source.Add('end.');
  597. ParseModule;
  598. end;
  599. procedure TTestExpressions.TestArrayAccess;
  600. begin
  601. Source.Add('begin');
  602. Source.Add('DoSomething((pb + 10)[4]);');
  603. Source.Add('end.');
  604. ParseModule;
  605. end;
  606. procedure TTestExpressions.TestHelperOnLiteral;
  607. begin
  608. Source.Add('begin');
  609. Source.Add('writeln(''10''.toint);');
  610. Source.Add('end.');
  611. ParseModule;
  612. end;
  613. procedure TTestExpressions.TestUnaryMinus;
  614. begin
  615. DeclareVar('integer','a');
  616. DeclareVar('integer','b');
  617. ParseExpression('-b');
  618. AssertUnaryExpr('Simple minus unary',eopSubtract,FLeft);
  619. AssertExpression('Simple identifier',theLeft,pekIdent,'b');
  620. end;
  621. procedure TTestExpressions.TestUnaryMinusWhiteSpace;
  622. begin
  623. DeclareVar('integer','a');
  624. DeclareVar('integer','b');
  625. ParseExpression('- b');
  626. AssertUnaryExpr('Simple minus unary',eopSubtract,FLeft);
  627. AssertExpression('Simple identifier',theLeft,pekIdent,'b');
  628. end;
  629. procedure TTestExpressions.TestUnaryAddress;
  630. begin
  631. DeclareVar('integer','a');
  632. DeclareVar('integer','b');
  633. ParseExpression('@b');
  634. AssertUnaryExpr('Simple address unary',eopAddress,FLeft);
  635. AssertExpression('Simple identifier',theLeft,pekIdent,'b');
  636. end;
  637. procedure TTestExpressions.TestUnaryNot;
  638. begin
  639. DeclareVar('boolean','a');
  640. DeclareVar('boolean','b');
  641. ParseExpression('not b');
  642. AssertUnaryExpr('Simple address unary',eopNot,FLeft);
  643. AssertExpression('Simple identifier',theLeft,pekIdent,'b');
  644. end;
  645. procedure TTestExpressions.TestUnaryDeref;
  646. begin
  647. DeclareVar('integer','a');
  648. DeclareVar('pinteger','b');
  649. ParseExpression('b^');
  650. AssertUnaryExpr('Simple deref unary',eopDeref,FLeft);
  651. AssertExpression('Simple identifier',theLeft,pekIdent,'b');
  652. end;
  653. procedure TTestExpressions.TestUnaryDoubleDeref;
  654. begin
  655. DeclareVar('integer','a');
  656. DeclareVar('ppinteger','b');
  657. ParseExpression('(b)^^');
  658. AssertExpression('Deref expression 1',TheExpr,pekUnary,TUnaryExpr);
  659. AssertExpression('Deref expression 2',TUnaryExpr(TheExpr).Operand,pekUnary,TUnaryExpr);
  660. AssertExpression('Deref expression 3',TUnaryExpr(TUnaryExpr(TheExpr).Operand).Operand,pekIdent,'b');
  661. end;
  662. procedure TTestExpressions.TestUnaryDoubleDeref2;
  663. begin
  664. DeclareVar('integer','a');
  665. DeclareVar('ppinteger','b');
  666. ParseExpression('b^^');
  667. AssertExpression('Deref expression 1',TheExpr,pekUnary,TUnaryExpr);
  668. AssertExpression('Deref expression 2',TUnaryExpr(TheExpr).Operand,pekUnary,TUnaryExpr);
  669. AssertExpression('Deref expression 3',TUnaryExpr(TUnaryExpr(TheExpr).Operand).Operand,pekIdent,'b');
  670. end;
  671. procedure TTestExpressions.TestBinaryAdd;
  672. begin
  673. ParseExpression('1+2');
  674. AssertBinaryExpr('Simple binary add',eopAdd,FLeft,FRight);
  675. AssertExpression('Left is 1',TheLeft,pekNumber,'1');
  676. AssertExpression('Right is 2',TheRight,pekNumber,'2');
  677. end;
  678. procedure TTestExpressions.TestBinarySubtract;
  679. begin
  680. ParseExpression('1-2');
  681. AssertBinaryExpr('Simple binary subtract',eopSubtract,FLeft,FRight);
  682. AssertExpression('Left is 1',TheLeft,pekNumber,'1');
  683. AssertExpression('Right is 2',TheRight,pekNumber,'2');
  684. end;
  685. procedure TTestExpressions.TestBinaryMultiply;
  686. begin
  687. ParseExpression('1*2');
  688. AssertBinaryExpr('Simple binary multiply',eopMultiply,FLeft,FRight);
  689. AssertExpression('Left is 1',TheLeft,pekNumber,'1');
  690. AssertExpression('Right is 2',TheRight,pekNumber,'2');
  691. end;
  692. procedure TTestExpressions.TestBinaryDivision;
  693. begin
  694. DeclareVar('double');
  695. ParseExpression('1/2');
  696. AssertBinaryExpr('Simple binary division',eopDivide,FLeft,FRight);
  697. AssertExpression('Left is 1',TheLeft,pekNumber,'1');
  698. AssertExpression('Right is 2',TheRight,pekNumber,'2');
  699. end;
  700. procedure TTestExpressions.TestBinaryPower;
  701. begin
  702. DeclareVar('double');
  703. ParseExpression('1**2');
  704. AssertBinaryExpr('Simple binary power',eopPower,FLeft,FRight);
  705. AssertExpression('Left is 1',TheLeft,pekNumber,'1');
  706. AssertExpression('Right is 2',TheRight,pekNumber,'2');
  707. end;
  708. procedure TTestExpressions.TestBinaryMod;
  709. begin
  710. ParseExpression('1 mod 2');
  711. AssertBinaryExpr('Simple binary mod',eopMod,FLeft,FRight);
  712. AssertExpression('Left is 1',TheLeft,pekNumber,'1');
  713. AssertExpression('Right is 2',TheRight,pekNumber,'2');
  714. end;
  715. procedure TTestExpressions.TestBinaryDiv;
  716. begin
  717. ParseExpression('1 div 2');
  718. AssertBinaryExpr('Simple binary div',eopDiv,FLeft,FRight);
  719. AssertExpression('Left is 1',TheLeft,pekNumber,'1');
  720. AssertExpression('Right is 2',TheRight,pekNumber,'2');
  721. end;
  722. procedure TTestExpressions.TestBinaryShl;
  723. begin
  724. ParseExpression('1 shl 2');
  725. AssertBinaryExpr('Simple binary shl',eopShl,FLeft,FRight);
  726. AssertExpression('Left is 1',TheLeft,pekNumber,'1');
  727. AssertExpression('Right is 2',TheRight,pekNumber,'2');
  728. end;
  729. procedure TTestExpressions.TestBinaryShr;
  730. begin
  731. ParseExpression('1 shr 2');
  732. AssertBinaryExpr('Simple binary shr',eopShr,FLeft,FRight);
  733. AssertExpression('Left is 1',TheLeft,pekNumber,'1');
  734. AssertExpression('Right is 2',TheRight,pekNumber,'2');
  735. end;
  736. procedure TTestExpressions.TestBinarySymmetricalDifference;
  737. begin
  738. DeclareVar('Set of Byte','a');
  739. DeclareVar('Set of Byte','b');
  740. DeclareVar('Set of Byte','c');
  741. ParseExpression('b >< c');
  742. AssertBinaryExpr('Simple binary smmetrical difference',eopSymmetricalDifference,FLeft,FRight);
  743. AssertExpression('Left is b',TheLeft,pekident,'b');
  744. AssertExpression('Right is c',TheRight,pekIdent,'c');
  745. end;
  746. procedure TTestExpressions.TestBinaryAnd;
  747. begin
  748. DeclareVar('boolean','a');
  749. DeclareVar('boolean','b');
  750. DeclareVar('boolean','b');
  751. ParseExpression('b and c');
  752. AssertBinaryExpr('Simple binary and',eopAnd,FLeft,FRight);
  753. AssertExpression('Left is b',TheLeft,pekIdent,'b');
  754. AssertExpression('Right is c',TheRight,pekIdent,'c');
  755. end;
  756. procedure TTestExpressions.TestBinaryOr;
  757. begin
  758. DeclareVar('boolean','a');
  759. DeclareVar('boolean','b');
  760. DeclareVar('boolean','b');
  761. ParseExpression('b or c');
  762. AssertBinaryExpr('Simple binary or',eopOr,FLeft,FRight);
  763. AssertExpression('Left is b',TheLeft,pekIdent,'b');
  764. AssertExpression('Right is c',TheRight,pekIdent,'c');
  765. end;
  766. procedure TTestExpressions.TestBinaryXOr;
  767. begin
  768. DeclareVar('boolean','a');
  769. DeclareVar('boolean','b');
  770. DeclareVar('boolean','b');
  771. ParseExpression('b xor c');
  772. AssertBinaryExpr('Simple binary xor',eopxOr,FLeft,FRight);
  773. AssertExpression('Left is b',TheLeft,pekIdent,'b');
  774. AssertExpression('Right is c',TheRight,pekIdent,'c');
  775. end;
  776. procedure TTestExpressions.TestBinaryIn;
  777. begin
  778. DeclareVar('boolean','a');
  779. ParseExpression('1 in [1,2,3]');
  780. AssertBinaryExpr('Simple binary In',eopIn,FLeft,FRight);
  781. AssertExpression('Left is 1',TheLeft,pekNumber,'1');
  782. AssertExpression('Right is array set',TheRight,pekSet,TParamsExpr);
  783. end;
  784. procedure TTestExpressions.TestBinaryIs;
  785. begin
  786. DeclareVar('boolean','a');
  787. DeclareVar('TObject','b');
  788. ParseExpression('b is TObject');
  789. AssertBinaryExpr('Simple binary Is',eopIs,FLeft,FRight);
  790. AssertExpression('Left is 1',TheLeft,pekident,'b');
  791. AssertExpression('Right is TObject',TheRight,pekIdent,'TObject');
  792. end;
  793. procedure TTestExpressions.TestBinaryAs;
  794. begin
  795. DeclareVar('TObject','a');
  796. DeclareVar('TObject','b');
  797. ParseExpression('b as TObject');
  798. AssertBinaryExpr('Simple binary As',eopAs,FLeft,FRight);
  799. AssertExpression('Left is 1',TheLeft,pekident,'b');
  800. AssertExpression('Right is TObject',TheRight,pekIdent,'TObject');
  801. end;
  802. procedure TTestExpressions.TestBinaryEquals;
  803. begin
  804. DeclareVar('boolean','a');
  805. DeclareVar('integer','b');
  806. DeclareVar('integer','c');
  807. ParseExpression('b=c');
  808. AssertBinaryExpr('Simple binary equals',eopEqual,FLeft,FRight);
  809. AssertExpression('Left is b',TheLeft,pekident,'b');
  810. AssertExpression('Right is c',TheRight,pekIdent,'c');
  811. end;
  812. procedure TTestExpressions.TestBinaryDiffers;
  813. begin
  814. DeclareVar('boolean','a');
  815. DeclareVar('integer','b');
  816. DeclareVar('integer','c');
  817. ParseExpression('b<>c');
  818. AssertBinaryExpr('Simple binary differs',eopNotEqual,FLeft,FRight);
  819. AssertExpression('Left is b',TheLeft,pekident,'b');
  820. AssertExpression('Right is c',TheRight,pekIdent,'c');
  821. end;
  822. procedure TTestExpressions.TestBinaryLessThan;
  823. begin
  824. DeclareVar('boolean','a');
  825. DeclareVar('integer','b');
  826. DeclareVar('integer','c');
  827. ParseExpression('b<c');
  828. AssertBinaryExpr('Simple binary less than',eopLessThan,FLeft,FRight);
  829. AssertExpression('Left is b',TheLeft,pekident,'b');
  830. AssertExpression('Right is c',TheRight,pekIdent,'c');
  831. end;
  832. procedure TTestExpressions.TestBinaryLessThanEqual;
  833. begin
  834. DeclareVar('boolean','a');
  835. DeclareVar('integer','b');
  836. DeclareVar('integer','c');
  837. ParseExpression('b<=c');
  838. AssertBinaryExpr('Simple binary less than or equal',eopLessThanEqual,FLeft,FRight);
  839. AssertExpression('Left is b',TheLeft,pekident,'b');
  840. AssertExpression('Right is c',TheRight,pekIdent,'c');
  841. end;
  842. procedure TTestExpressions.TestBinaryLargerThan;
  843. begin
  844. DeclareVar('boolean','a');
  845. DeclareVar('integer','b');
  846. DeclareVar('integer','c');
  847. ParseExpression('b>c');
  848. AssertBinaryExpr('Simple binary larger than ',eopGreaterThan,FLeft,FRight);
  849. AssertExpression('Left is b',TheLeft,pekident,'b');
  850. AssertExpression('Right is c',TheRight,pekIdent,'c');
  851. end;
  852. procedure TTestExpressions.TestBinaryLargerThanEqual;
  853. begin
  854. DeclareVar('boolean','a');
  855. DeclareVar('integer','b');
  856. DeclareVar('integer','c');
  857. ParseExpression('b>=c');
  858. AssertBinaryExpr('Simple binary larger than or equal',eopGreaterThanEqual,FLeft,FRight);
  859. AssertExpression('Left is b',TheLeft,pekident,'b');
  860. AssertExpression('Right is c',TheRight,pekIdent,'c');
  861. end;
  862. procedure TTestExpressions.TestPrimitiveBooleanFalse;
  863. begin
  864. DeclareVar('boolean','a');
  865. ParseExpression('False');
  866. AssertExpression('Simple boolean',theExpr,pekBoolConst,TBoolConstExpr);
  867. AssertEquals('Boolean false',False,TBoolConstExpr(TheExpr).Value);
  868. end;
  869. procedure TTestExpressions.TestPrimitiveBooleanTrue;
  870. begin
  871. DeclareVar('boolean','a');
  872. ParseExpression('True');
  873. AssertExpression('Simple boolean',theExpr,pekBoolConst,TBoolConstExpr);
  874. AssertEquals('Boolean true',True,TBoolConstExpr(TheExpr).Value);
  875. end;
  876. procedure TTestExpressions.TestPrimitiveNil;
  877. begin
  878. DeclareVar('pointer','a');
  879. ParseExpression('Nil');
  880. AssertExpression('Nil expr',theExpr,pekNil,TNilExpr);
  881. end;
  882. procedure TTestExpressions.TestPrimitiveSet;
  883. Var
  884. P : TParamsExpr;
  885. begin
  886. DeclareVar('set of byte','a');
  887. ParseExpression('[1,2,3]');
  888. P:=TParamsExpr(AssertExpression('Set expr',theExpr,pekSet,TParamsExpr));
  889. AssertEquals('Element count',3,Length(P.Params));
  890. AssertExpression('Element 1 in set',P.Params[0],pekNumber,'1');
  891. AssertExpression('Element 2 in set',P.Params[1],pekNumber,'2');
  892. AssertExpression('Element 3 in set',P.Params[2],pekNumber,'3');
  893. end;
  894. procedure TTestExpressions.TestPrimitiveChar;
  895. begin
  896. DeclareVar('AnsiChar');
  897. ParseExpression('#32');
  898. AssertExpression('Simple string',theExpr,pekString,'#32');
  899. end;
  900. procedure TTestExpressions.TestPrimitiveControlChar;
  901. begin
  902. DeclareVar('AnsiChar');
  903. ParseExpression('^M');
  904. AssertExpression('Simple string',theExpr,pekString,'^M');
  905. end;
  906. procedure TTestExpressions.TestPrimitiveSetEmpty;
  907. Var
  908. P : TParamsExpr;
  909. begin
  910. DeclareVar('set of byte','a');
  911. ParseExpression('[]');
  912. P:=TParamsExpr(AssertExpression('Set expr',theExpr,pekSet,TParamsExpr));
  913. AssertEquals('Element count',0,Length(P.Params));
  914. end;
  915. procedure TTestExpressions.TestPrimitiveSelf;
  916. begin
  917. DeclareVar('pointer','a');
  918. ParseExpression('Self');
  919. AssertExpression('Inherited expr',theExpr,pekSelf,TSelfExpr);
  920. end;
  921. procedure TTestExpressions.TestInherited;
  922. begin
  923. DeclareVar('pointer','a');
  924. ParseExpression('inherited');
  925. AssertExpression('Inherited expr',theExpr,pekInherited,TInheritedExpr);
  926. end;
  927. procedure TTestExpressions.TestInheritedFunction;
  928. begin
  929. DeclareVar('pointer','a');
  930. ParseExpression('inherited myfunction');
  931. AssertBinaryExpr('Inherited expr',eopNone,Fleft,FRight);
  932. AssertExpression('Inherited expr',theleft,pekInherited,TInheritedExpr);
  933. AssertExpression('Inherited expr',theright,pekIdent,'myfunction');
  934. end;
  935. procedure TTestExpressions.SetUp;
  936. begin
  937. Inherited;
  938. FVariables:=TStringList.Create;
  939. end;
  940. procedure TTestExpressions.TearDown;
  941. begin
  942. FreeAndNil(FVariables);
  943. Inherited;
  944. end;
  945. procedure TTestExpressions.SetExpression(const AExpression: String);
  946. Var
  947. I : Integer;
  948. begin
  949. StartProgram(ExtractFileUnitName(MainFilename));
  950. if FVariables.Count=0 then
  951. DeclareVar('integer');
  952. Add('Var');
  953. For I:=0 to FVariables.Count-1 do
  954. Add(' '+Fvariables[I]);
  955. Add('begin');
  956. Add(' a:='+AExpression+';');
  957. end;
  958. procedure TTestExpressions.ParseExpression;
  959. begin
  960. ParseModule;
  961. AssertEquals('Have program',TPasProgram,Module.ClassType);
  962. AssertNotNull('Have program section',PasProgram.ProgramSection);
  963. AssertNotNull('Have initialization section',PasProgram.InitializationSection);
  964. AssertEquals('Have initialization statement',1,PasProgram.InitializationSection.Elements.Count);
  965. AssertNotNull('Have initialization statement',PasProgram.InitializationSection.Elements[0]);
  966. AssertEquals('Assignment statement',TPasImplAssign,TObject(PasProgram.InitializationSection.Elements[0]).ClassType);
  967. FTheExpr:=TPasImplAssign(PasProgram.InitializationSection.Elements[0]).Right;
  968. AssertNotNull('Have assignment expression',FTheExpr);
  969. end;
  970. procedure TTestExpressions.ParseExpression(const AExpression: String);
  971. begin
  972. SetExpression(AExpression);
  973. ParseExpression;
  974. end;
  975. function TTestExpressions.AssertBinaryExpr(const Msg: String; Op: TExprOpCode;
  976. out ALeft, ARight: TPasExpr): TBinaryExpr;
  977. begin
  978. Result:=AssertBinaryExpr(Msg,TheExpr,Op,ALeft,ARight);
  979. end;
  980. function TTestExpressions.AssertBinaryExpr(const Msg: String; AExpr: TPasExpr;
  981. Op: TExprOpCode; out ALeft, ARight: TPasExpr): TBinaryExpr;
  982. begin
  983. AssertExpression(Msg+' is binary',AExpr,pekBinary,TBinaryExpr);
  984. Result:=AExpr as TBinaryExpr;
  985. AssertEquals(Msg+' opcode OK',Op,Result.OpCode);
  986. ALeft:=Result.Left;
  987. ARight:=Result.Right;
  988. AssertNotNull('Have left',ALeft);
  989. AssertNotNull('Have right',ARight);
  990. TAssert.AssertSame('Result.left.parent=B',Result,Result.Left.Parent);
  991. TAssert.AssertSame('Result.right.parent=B',Result,Result.Right.Parent);
  992. end;
  993. function TTestExpressions.AssertUnaryExpr(const Msg: String; Op: TExprOpCode;
  994. out AOperand : TPasExpr): TUnaryExpr;
  995. begin
  996. Result:=AssertUnaryExpr(Msg,TheExpr,OP,AOperand);
  997. end;
  998. function TTestExpressions.AssertUnaryExpr(const Msg: String; AExpr: TPasExpr;
  999. Op: TExprOpCode; out AOperand: TPasExpr): TUnaryExpr;
  1000. begin
  1001. AssertExpression(Msg+' is unary',AExpr,pekUnary,TUnaryExpr);
  1002. Result:=AExpr as TUnaryExpr;
  1003. AssertEquals(Msg+' opcode OK',Op,Result.OpCode);
  1004. AOperand:=Result.Operand;
  1005. AssertNotNull('Have left',AOperand);
  1006. end;
  1007. procedure TTestExpressions.TestSubIdentStrWithFormat;
  1008. Var
  1009. P : TParamsExpr;
  1010. B : TBinaryExpr;
  1011. begin
  1012. DeclareVar('string','a');
  1013. DeclareVar('integer','i');
  1014. ParseExpression('system.str(i:0:3,a)');
  1015. P:=TParamsExpr(AssertExpression('Params',TheExpr,pekFuncParams,TParamsExpr));
  1016. TAssert.AssertSame('P.value.parent=P',P,P.Value.Parent);
  1017. AssertEquals('2 argument',2,Length(p.params));
  1018. AssertExpression('Simple identifier',p.params[0],pekIdent,'i');
  1019. AssertExpression('Simple identifier',p.params[1],pekIdent,'a');
  1020. TAssert.AssertSame('P.params[0].parent=P',P,P.params[0].Parent);
  1021. TAssert.AssertSame('P.params[1].parent=P',P,P.params[1].Parent);
  1022. B:=TBinaryExpr(AssertExpression('Binary identifier',P.Value,pekBinary,TBinaryExpr));
  1023. AssertExpression('Name of unit',B.Left,pekIdent,'system');
  1024. AssertExpression('Name of function',B.Right,pekIdent,'str');
  1025. TAssert.AssertSame('B.left.parent=B',B,B.Left.Parent);
  1026. TAssert.AssertSame('B.right.parent=B',B,B.Right.Parent);
  1027. end;
  1028. procedure TTestExpressions.TestAPlusCallB;
  1029. var
  1030. B: TBinaryExpr;
  1031. P: TParamsExpr;
  1032. begin
  1033. DeclareVar('string','a');
  1034. DeclareVar('integer','b');
  1035. ParseExpression('a+b(1)');
  1036. B:=TBinaryExpr(AssertExpression('Binary identifier',TheExpr,pekBinary,TBinaryExpr));
  1037. AssertExpression('left a',B.Left,pekIdent,'a');
  1038. TAssert.AssertSame('B.left.parent=B',B,B.Left.Parent);
  1039. TAssert.AssertSame('B.right.parent=B',B,B.Right.Parent);
  1040. P:=TParamsExpr(AssertExpression('Params',B.Right,pekFuncParams,TParamsExpr));
  1041. TAssert.AssertSame('P.value.parent=P',P,P.Value.Parent);
  1042. AssertEquals('1 argument',1,Length(p.params));
  1043. AssertExpression('param 1',p.params[0],pekNumber,'1');
  1044. end;
  1045. procedure TTestExpressions.TestAPlusBBracketFuncParams;
  1046. var
  1047. P: TParamsExpr;
  1048. B: TBinaryExpr;
  1049. begin
  1050. DeclareVar('string','a');
  1051. DeclareVar('integer','b');
  1052. ParseExpression('(a+b)(1)');
  1053. P:=TParamsExpr(AssertExpression('Params',TheExpr,pekFuncParams,TParamsExpr));
  1054. TAssert.AssertSame('P.value.parent=P',P,P.Value.Parent);
  1055. AssertEquals('1 argument',1,Length(p.params));
  1056. AssertExpression('param 1',p.params[0],pekNumber,'1');
  1057. B:=TBinaryExpr(AssertExpression('Binary identifier',P.Value,pekBinary,TBinaryExpr));
  1058. TAssert.AssertSame('B.left.parent=B',B,B.Left.Parent);
  1059. TAssert.AssertSame('B.right.parent=B',B,B.Right.Parent);
  1060. AssertExpression('left a',B.Left,pekIdent,'a');
  1061. AssertExpression('right b',B.Right,pekIdent,'b');
  1062. end;
  1063. procedure TTestExpressions.TestAPlusBBracketArrayParams;
  1064. var
  1065. B: TBinaryExpr;
  1066. P: TParamsExpr;
  1067. begin
  1068. DeclareVar('string','a');
  1069. DeclareVar('integer','b');
  1070. ParseExpression('(a+b)[1]');
  1071. P:=TParamsExpr(AssertExpression('Params',TheExpr,pekArrayParams,TParamsExpr));
  1072. TAssert.AssertSame('P.value.parent=P',P,P.Value.Parent);
  1073. AssertEquals('1 argument',1,Length(p.params));
  1074. AssertExpression('param 1',p.params[0],pekNumber,'1');
  1075. B:=TBinaryExpr(AssertExpression('Binary identifier',P.Value,pekBinary,TBinaryExpr));
  1076. TAssert.AssertSame('B.left.parent=B',B,B.Left.Parent);
  1077. TAssert.AssertSame('B.right.parent=B',B,B.Right.Parent);
  1078. AssertExpression('left a',B.Left,pekIdent,'a');
  1079. AssertExpression('right b',B.Right,pekIdent,'b');
  1080. end;
  1081. procedure TTestExpressions.TestAPlusBBracketDotC;
  1082. var
  1083. B, PlusB: TBinaryExpr;
  1084. begin
  1085. DeclareVar('string','a');
  1086. DeclareVar('integer','b');
  1087. ParseExpression('(a+b).c');
  1088. B:=TBinaryExpr(AssertExpression('Binary identifier',TheExpr,pekBinary,TBinaryExpr));
  1089. AssertEquals('().',eopSubIdent,B.OpCode);
  1090. TAssert.AssertSame('B.left.parent=B',B,B.Left.Parent);
  1091. TAssert.AssertSame('B.right.parent=B',B,B.Right.Parent);
  1092. AssertExpression('right c',B.Right,pekIdent,'c');
  1093. PlusB:=TBinaryExpr(AssertExpression('Binary identifier',B.Left,pekBinary,TBinaryExpr));
  1094. TAssert.AssertSame('PlusB.left.parent=PlusB',PlusB,PlusB.Left.Parent);
  1095. TAssert.AssertSame('PlusB.right.parent=PlusB',PlusB,PlusB.Right.Parent);
  1096. AssertExpression('left a',PlusB.Left,pekIdent,'a');
  1097. AssertExpression('right b',PlusB.Right,pekIdent,'b');
  1098. end;
  1099. procedure TTestExpressions.TestADotKeyWord;
  1100. begin
  1101. Add('{$MODE DELPHI}');
  1102. Add('Type TEnum = (&in,&of);');
  1103. Add('Var a : TEnum;');
  1104. Add('begin');
  1105. Add(' a:=Tenum.in;');
  1106. ParseExpression;
  1107. AssertExpression('Binary identifier',TheExpr,pekBinary,TBinaryExpr);
  1108. end;
  1109. procedure TTestExpressions.TestADotKeyWordOnlyDelphi;
  1110. begin
  1111. Add('Type TEnum = (&in,&of);');
  1112. Add('Var a : TEnum;');
  1113. Add('begin');
  1114. Add(' a:=Tenum.in;');
  1115. AssertException(EParserError,@ParseExpression);
  1116. end;
  1117. procedure TTestExpressions.TestADotBDotC;
  1118. var
  1119. B, SubB: TBinaryExpr;
  1120. begin
  1121. ParseExpression('a.b.c');
  1122. B:=TBinaryExpr(AssertExpression('Binary identifier',TheExpr,pekBinary,TBinaryExpr));
  1123. AssertEquals('dot expr',eopSubIdent,B.OpCode);
  1124. TAssert.AssertSame('B.left.parent=B',B,B.Left.Parent);
  1125. TAssert.AssertSame('B.right.parent=B',B,B.Right.Parent);
  1126. AssertExpression('right c',B.Right,pekIdent,'c');
  1127. SubB:=TBinaryExpr(AssertExpression('Binary identifier',B.Left,pekBinary,TBinaryExpr));
  1128. TAssert.AssertSame('PlusB.left.parent=PlusB',SubB,SubB.Left.Parent);
  1129. TAssert.AssertSame('PlusB.right.parent=PlusB',SubB,SubB.Right.Parent);
  1130. AssertExpression('left a',SubB.Left,pekIdent,'a');
  1131. AssertExpression('right b',SubB.Right,pekIdent,'b');
  1132. end;
  1133. procedure TTestExpressions.TestADotBBracketC;
  1134. var
  1135. P: TParamsExpr;
  1136. B: TBinaryExpr;
  1137. begin
  1138. ParseExpression('a.b[c]');
  1139. P:=TParamsExpr(AssertExpression('ArrayParams',TheExpr,pekArrayParams,TParamsExpr));
  1140. B:=TBinaryExpr(AssertExpression('Binary identifier',P.Value,pekBinary,TBinaryExpr));
  1141. AssertEquals('dot expr',eopSubIdent,B.OpCode);
  1142. TAssert.AssertSame('B.left.parent=B',B,B.Left.Parent);
  1143. TAssert.AssertSame('B.right.parent=B',B,B.Right.Parent);
  1144. AssertExpression('left a',B.Left,pekIdent,'a');
  1145. AssertExpression('right b',B.Right,pekIdent,'b');
  1146. AssertEquals('length(p.Params)',length(p.Params),1);
  1147. AssertExpression('first param c',p.Params[0],pekIdent,'c');
  1148. end;
  1149. procedure TTestExpressions.TestSelfDotBBracketC;
  1150. var
  1151. P: TParamsExpr;
  1152. B: TBinaryExpr;
  1153. begin
  1154. ParseExpression('self.b[c]');
  1155. P:=TParamsExpr(AssertExpression('ArrayParams',TheExpr,pekArrayParams,TParamsExpr));
  1156. B:=TBinaryExpr(AssertExpression('Binary identifier',P.Value,pekBinary,TBinaryExpr));
  1157. AssertEquals('dot expr',eopSubIdent,B.OpCode);
  1158. TAssert.AssertSame('B.left.parent=B',B,B.Left.Parent);
  1159. TAssert.AssertSame('B.right.parent=B',B,B.Right.Parent);
  1160. AssertEquals('left self',TSelfExpr,B.Left.classtype);
  1161. AssertExpression('right b',B.Right,pekIdent,'b');
  1162. AssertEquals('length(p.Params)',length(p.Params),1);
  1163. AssertExpression('first param c',p.Params[0],pekIdent,'c');
  1164. end;
  1165. procedure TTestExpressions.TestAasBDotCBracketFuncParams;
  1166. var
  1167. P: TParamsExpr;
  1168. B, AsExpr: TBinaryExpr;
  1169. begin
  1170. ParseExpression('(a as b).c(d)');
  1171. P:=TParamsExpr(AssertExpression('FuncParams',TheExpr,pekFuncParams,TParamsExpr));
  1172. AssertEquals('length(p.Params)',length(p.Params),1);
  1173. AssertExpression('first param d',p.Params[0],pekIdent,'d');
  1174. B:=TBinaryExpr(AssertExpression('Upper Binary identifier',P.Value,pekBinary,TBinaryExpr));
  1175. AssertEquals('dot c expr',eopSubIdent,B.OpCode);
  1176. TAssert.AssertSame('B.left.parent=B',B,B.Left.Parent);
  1177. TAssert.AssertSame('B.right.parent=B',B,B.Right.Parent);
  1178. AssertExpression('dot c',b.Right,pekIdent,'c');
  1179. AsExpr:=TBinaryExpr(AssertExpression('lower binary identifier',B.Left,pekBinary,TBinaryExpr));
  1180. AssertEquals('AS expr',eopAs,AsExpr.OpCode);
  1181. TAssert.AssertSame('AsExpr.left.parent=AsExpr',AsExpr,AsExpr.Left.Parent);
  1182. TAssert.AssertSame('AsExpr.right.parent=AsExpr',AsExpr,AsExpr.Right.Parent);
  1183. AssertExpression('left AS a',AsExpr.Left,pekIdent,'a');
  1184. AssertExpression('right AS b',AsExpr.Right,pekIdent,'b');
  1185. end;
  1186. procedure TTestExpressions.TestParseAdhocExpression;
  1187. var
  1188. ExprElement: TPasExpr;
  1189. BinaryExpression: TBinaryExpr;
  1190. begin
  1191. // Unlike the other tests, this is not about the parser, but about the
  1192. // ability to parse an expression on it's own. Without any further context.
  1193. Add('True=False');
  1194. StartParsing;
  1195. Parser.NextToken;
  1196. Parser.ParseAdhocExpression(ExprElement);
  1197. BinaryExpression := AssertExpression('Some expression, parsed separately',ExprElement,pekBinary,TBinaryExpr) as TBinaryExpr;
  1198. AssertExpression('Some expression, parsed separately, left part', BinaryExpression.Left, pekBoolConst, TBoolConstExpr);
  1199. AssertExpression('Some expression, parsed separately, right part',BinaryExpression.Right, pekBoolConst, TBoolConstExpr);
  1200. end;
  1201. initialization
  1202. RegisterTest(TTestExpressions);
  1203. end.