tcexprparser.pas 41 KB

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