tcexprparser.pas 43 KB

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