tcexprparser.pas 44 KB

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