syntax.ml 29 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958
  1. module Tree = Qsp_syntax.Tree
  2. module Ast = Tree.Ast
  3. module Check = Qsp_syntax.Check
  4. module S = Qsp_syntax.S
  5. module T = Qsp_syntax.T
  6. let location_id, e1 = Check.build (module Tree)
  7. module Parser = Check.Make (struct
  8. let t = [| e1 |]
  9. end)
  10. let _position = (Lexing.dummy_pos, Lexing.dummy_pos)
  11. type 'a location = 'a * 'a Ast.statement list [@@deriving eq, show]
  12. let get_location :
  13. (S.pos location, Qsp_syntax.Report.t) result -> S.pos location = function
  14. | Ok e -> e
  15. | Error e ->
  16. let msg = Format.asprintf "%a" Qsp_syntax.Report.pp e in
  17. raise (Failure msg)
  18. (** Run the parser with the given expression and return the result *)
  19. let parse : string -> (S.pos location, Qsp_syntax.Report.t) result =
  20. fun content ->
  21. let lexing =
  22. Sedlexing.Latin1.from_string content |> Qparser.Lexbuf.from_lexbuf
  23. in
  24. let context = Parser.initialize () in
  25. Qparser.Analyzer.parse (module Parser) lexing context
  26. |> Result.map (fun v ->
  27. (* Uncatched excteptions here, but we are in the tests…
  28. If it’s fail here I have an error in the code. *)
  29. Array.get v.Qparser.Analyzer.content 0
  30. |> Check.get location_id |> Option.get)
  31. let location : S.pos location Alcotest.testable =
  32. let equal = equal_location (fun _ _ -> true) in
  33. let pp =
  34. pp_location (fun formater _ -> Format.fprintf formater "_position")
  35. in
  36. Alcotest.testable pp equal
  37. let test_empty_location () =
  38. let expected = (_position, [])
  39. and actual = get_location @@ parse {|# Location
  40. ------- |}
  41. and msg = "Empty location" in
  42. Alcotest.(check' location ~msg ~expected ~actual)
  43. let test_location_without_space () =
  44. let expected = (_position, [])
  45. and actual = get_location @@ parse {|#Location
  46. ------- |}
  47. and msg = "Empty location" in
  48. Alcotest.(check' location ~msg ~expected ~actual)
  49. let test_location_without_database () =
  50. let expected = (_position, [])
  51. and actual = get_location @@ parse {|# $Location
  52. ------- |}
  53. and msg = "Location without database" in
  54. let () = Alcotest.(check' location ~msg ~expected ~actual) in
  55. let actual = get_location @@ parse {|# !Location
  56. ------- |} in
  57. let () = Alcotest.(check' location ~msg ~expected ~actual) in
  58. let actual = get_location @@ parse {|# ^Location
  59. ------- |} in
  60. Alcotest.(check' location ~msg ~expected ~actual)
  61. let _test_instruction : string -> S.pos Ast.statement list -> unit =
  62. fun literal expected ->
  63. let expected = (_position, expected)
  64. and _location = Printf.sprintf {|# Location
  65. %s
  66. ------- |} literal in
  67. let actual = get_location @@ parse _location and msg = literal in
  68. Alcotest.(check' location ~msg ~expected ~actual)
  69. let test_numeric_expression () =
  70. _test_instruction "123" [ Expression (Integer (_position, "123")) ]
  71. let test_negative_numeric_expression () =
  72. _test_instruction "-123"
  73. [
  74. Tree.Ast.Expression
  75. (Tree.Ast.Op (_position, T.Neg, Tree.Ast.Integer (_position, "123")));
  76. ]
  77. let test_negative_numeric_expression2 () =
  78. let index = None in
  79. let var = { Ast.pos = _position; name = "CURTIMESUN"; index } in
  80. _test_instruction "-(780-CurTimeSun)"
  81. Ast.
  82. [
  83. Expression
  84. (Op
  85. ( _position,
  86. Neg,
  87. BinaryOp (_position, Minus, Integer (_position, "780"), Ident var)
  88. ));
  89. ]
  90. let test_str_variable () =
  91. let index = None in
  92. let var = { Ast.pos = _position; name = "$VALUE"; index } in
  93. _test_instruction "$value" [ Expression (Ident var) ]
  94. let test_variable () =
  95. let index = None in
  96. let var = { Ast.pos = _position; name = "VALUE"; index } in
  97. _test_instruction "value" [ Expression (Ident var) ]
  98. let test_indexed_variable () =
  99. let index = Some Ast.(Integer (_position, "1")) in
  100. let var = { Ast.pos = _position; name = "VALUE"; index } in
  101. _test_instruction "value[1]" [ Expression (Ident var) ]
  102. let test_let_literal () =
  103. let index = None in
  104. let var = { Ast.pos = _position; name = "VALUE"; index } in
  105. _test_instruction "let value = '123'"
  106. Ast.
  107. [
  108. Declaration (_position, var, Eq', Literal (_position, [ T.Text "123" ]));
  109. ]
  110. let test_set_array_append () =
  111. let var = { Ast.pos = _position; name = "$VALUE"; index = None } in
  112. _test_instruction "set $value[] = ''"
  113. Ast.
  114. [ Declaration (_position, var, Eq', Literal (_position, [ T.Text "" ])) ]
  115. let test_direct_assignation () =
  116. let index = None in
  117. let var = { Ast.pos = _position; name = "VALUE"; index } in
  118. _test_instruction "value = '123'"
  119. Ast.
  120. [
  121. Declaration (_position, var, Eq', Literal (_position, [ T.Text "123" ]));
  122. ]
  123. let test_command_assignation () =
  124. let index = None in
  125. let st_1 = { Ast.pos = _position; name = "ST_1"; index } in
  126. _test_instruction "st_1 = input 'Enter the amount'"
  127. Ast.
  128. [
  129. Declaration
  130. ( _position,
  131. st_1,
  132. Eq',
  133. Function
  134. ( _position,
  135. Input,
  136. [ Literal (_position, [ T.Text "Enter the amount" ]) ] ) );
  137. ]
  138. let test_assignation2 () =
  139. let index = None in
  140. let var = { Ast.pos = _position; name = "VALUE"; index } in
  141. _test_instruction "set value += 123"
  142. Ast.[ Declaration (_position, var, Inc, Integer (_position, "123")) ]
  143. let test_multilie_literal () =
  144. let index = None in
  145. let var = { Ast.pos = _position; name = "VALUE"; index } in
  146. _test_instruction {|
  147. value = {
  148. $a = '123'
  149. }|}
  150. Ast.
  151. [
  152. Declaration
  153. (_position, var, Eq', Literal (_position, [ T.Text "\n$a = '123'\n" ]));
  154. ]
  155. let test_nested_literal () =
  156. _test_instruction
  157. {|
  158. value = {
  159. {
  160. }
  161. }|}
  162. [
  163. Ast.Declaration
  164. ( _position,
  165. { Ast.pos = _position; name = "VALUE"; index = None },
  166. Qsp_syntax.T.Eq',
  167. Ast.Literal (_position, [ T.Text "\n\n {\n\n }\n" ]) );
  168. ]
  169. let test_concat_literal () =
  170. _test_instruction {|
  171. '123'
  172. +'456'
  173. |}
  174. [
  175. Ast.Expression (Ast.Literal (_position, [ T.Text "123" ]));
  176. Ast.Expression
  177. (Ast.Op
  178. ( _position,
  179. Qsp_syntax.T.Add,
  180. Ast.Literal (_position, [ T.Text "456" ]) ));
  181. ]
  182. let test_literal () =
  183. _test_instruction "'123'"
  184. [ Expression (Literal (_position, [ T.Text "123" ])) ]
  185. let test_qutoted_literal () =
  186. _test_instruction "'12''3'"
  187. [ Expression (Literal (_position, [ T.Text "12'3" ])) ]
  188. let test_multiline1 () =
  189. let content = {|
  190. apples = 5
  191. pears = 10
  192. |} in
  193. let index = None in
  194. let apples = { Ast.pos = _position; name = "APPLES"; index }
  195. and pears = { Ast.pos = _position; name = "PEARS"; index }
  196. and value_5 = Ast.Integer (_position, "5")
  197. and value_10 = Ast.Integer (_position, "10") in
  198. _test_instruction content
  199. Ast.
  200. [
  201. Declaration (_position, apples, Eq', value_5);
  202. Declaration (_position, pears, Eq', value_10);
  203. ]
  204. let test_multiline2 () =
  205. let content = "apples = 5 & pears = 10" in
  206. let index = None in
  207. let apples = { Ast.pos = _position; name = "APPLES"; index }
  208. and pears = { Ast.pos = _position; name = "PEARS"; index }
  209. and value_5 = Ast.Integer (_position, "5")
  210. and value_10 = Ast.Integer (_position, "10") in
  211. _test_instruction content
  212. [
  213. Declaration (_position, apples, Eq', value_5);
  214. Declaration (_position, pears, Eq', value_10);
  215. ]
  216. let test_equality () =
  217. let content = "apples = 5 = pears" in
  218. let index = None in
  219. let apples = { Ast.pos = _position; name = "APPLES"; index }
  220. and pears = { Ast.pos = _position; name = "PEARS"; index }
  221. and value_5 = Ast.Integer (_position, "5") in
  222. _test_instruction content
  223. [
  224. Declaration
  225. (_position, apples, Eq', BinaryOp (_position, Eq, value_5, Ident pears));
  226. ]
  227. let test_plus () =
  228. let content = {|
  229. apples = 5 + pears
  230. |} in
  231. let index = None in
  232. let apples = { Ast.pos = _position; name = "APPLES"; index }
  233. and pears = { Ast.pos = _position; name = "PEARS"; index }
  234. and value_5 = Ast.Integer (_position, "5") in
  235. _test_instruction content
  236. [
  237. Declaration
  238. ( _position,
  239. apples,
  240. Eq',
  241. BinaryOp (_position, Plus, value_5, Ident pears) );
  242. ]
  243. let test_plus_litt () =
  244. let content = {|
  245. 'five'+ pears
  246. |} in
  247. let index = None in
  248. let pears = { Ast.pos = _position; name = "PEARS"; index } in
  249. _test_instruction content
  250. [
  251. Ast.(
  252. Expression
  253. (BinaryOp
  254. ( _position,
  255. Plus,
  256. Literal (_position, [ T.Text "five" ]),
  257. Ident pears )));
  258. ]
  259. let test_concat () =
  260. let content = {|
  261. $firstName + ' ' + $lastName
  262. |} in
  263. _test_instruction content
  264. [
  265. Tree.Ast.Expression
  266. (Tree.Ast.BinaryOp
  267. ( _position,
  268. Plus,
  269. Tree.Ast.BinaryOp
  270. ( _position,
  271. Plus,
  272. Tree.Ast.Ident
  273. {
  274. Tree.Ast.pos = _position;
  275. name = "$FIRSTNAME";
  276. index = None;
  277. },
  278. Tree.Ast.Literal (_position, [ T.Text " " ]) ),
  279. Tree.Ast.Ident
  280. { Tree.Ast.pos = _position; name = "$LASTNAME"; index = None } ));
  281. ]
  282. let test_mod () =
  283. _test_instruction {|2 mod 1|}
  284. [
  285. Tree.Ast.Expression
  286. (Tree.Ast.BinaryOp
  287. ( _position,
  288. T.Mod,
  289. Tree.Ast.Integer (_position, "2"),
  290. Tree.Ast.Integer (_position, "1") ));
  291. ]
  292. let test_comment () = _test_instruction "! Comment" [ Comment _position ]
  293. let test_comment2 () =
  294. let index = None in
  295. let a = { Ast.pos = _position; name = "A"; index }
  296. and value_0 = Ast.Integer (_position, "0") in
  297. _test_instruction "a = 0 &! Comment"
  298. Ast.[ Declaration (_position, a, Eq', value_0); Comment _position ]
  299. let test_comment3 () = _test_instruction {|!!1234
  300. |} [ Comment _position ]
  301. (** The exclamation mark here is an operation and not a comment *)
  302. let test_comment4 () =
  303. let index = None in
  304. let a = { Ast.pos = _position; name = "A"; index }
  305. and value_0 = Ast.Integer (_position, "0") in
  306. _test_instruction "a = rand(0, 1) ! 0"
  307. [
  308. Ast.(
  309. Declaration
  310. ( _position,
  311. a,
  312. Eq',
  313. BinaryOp
  314. ( _position,
  315. Neq,
  316. Function
  317. ( _position,
  318. Rand,
  319. [ Integer (_position, "0"); Integer (_position, "1") ] ),
  320. value_0 ) ));
  321. ]
  322. let test_comment5 () =
  323. _test_instruction "a = rand() &! Comment"
  324. [
  325. Ast.Declaration
  326. ( _position,
  327. { Ast.pos = _position; name = "A"; index = None },
  328. Qsp_syntax.T.Eq',
  329. Ast.Function (_position, Rand, []) );
  330. Ast.Comment _position;
  331. ]
  332. let test_comment6 () =
  333. _test_instruction
  334. "gs 'stat' &!! It should be here, because some of the strigs have to be \
  335. initialized"
  336. [
  337. Ast.Call
  338. ( _position,
  339. Qsp_syntax.T.Gosub,
  340. [ Ast.Literal (_position, [ T.Text "stat" ]) ] );
  341. Ast.Comment _position;
  342. ]
  343. let test_long_comment () =
  344. _test_instruction
  345. {| !'this part of the comment is inside
  346. single quotes' but "this is still part
  347. of the same comment because sometimes
  348. life is unfair." Oh yeah, {curly brackets
  349. also count}. This is still the same comment. |}
  350. [ Comment _position ]
  351. (** This test ensure that the unary operator is applied to the whole expression
  352. *)
  353. let test_precedence () =
  354. let index = None in
  355. let x = Ast.Ident { Ast.pos = _position; name = "X"; index }
  356. and y = Ast.Ident { Ast.pos = _position; name = "Y"; index } in
  357. _test_instruction "no x = y"
  358. Ast.[ Expression (Op (_position, No, BinaryOp (_position, Eq, x, y))) ]
  359. (** This test ensure that a ! is not considered as a comment in an
  360. expression *)
  361. let test_precedence2 () =
  362. let index = None in
  363. let x = { Ast.pos = _position; name = "X"; index }
  364. and y = Ast.Ident { Ast.pos = _position; name = "Y"; index } in
  365. _test_instruction "x = y ! 0"
  366. Ast.
  367. [
  368. Declaration
  369. ( _position,
  370. x,
  371. Eq',
  372. BinaryOp (_position, Neq, y, Integer (_position, "0")) );
  373. ]
  374. let test_if () =
  375. let index = Some Ast.(Integer (_position, "0")) in
  376. let args = Ast.(Ident { pos = _position; name = "$ARGS"; index })
  377. and expr1 = Ast.(Literal (_position, [ T.Text "blockA" ]))
  378. and expr2 =
  379. Ast.(Expression (Literal (_position, [ T.Text "You are in block A" ])))
  380. in
  381. _test_instruction {| if $ARGS[0] = 'blockA':
  382. 'You are in block A'
  383. end |}
  384. Ast.
  385. [
  386. If
  387. {
  388. loc = _position;
  389. then_ = (_position, BinaryOp (_position, Eq, args, expr1), [ expr2 ]);
  390. elifs = [];
  391. else_ = [];
  392. };
  393. ]
  394. let test_if_chained () =
  395. let value_0 = Ast.Integer (_position, "0") in
  396. _test_instruction {| if 0:
  397. 0
  398. end &! -- |}
  399. Ast.
  400. [
  401. If
  402. {
  403. loc = _position;
  404. then_ = (_position, value_0, [ Expression value_0 ]);
  405. elifs = [];
  406. else_ = [];
  407. };
  408. Comment _position;
  409. ]
  410. let test_if_equality () =
  411. _test_instruction {|
  412. if 0 = 0:
  413. end &! --
  414. |}
  415. [
  416. Ast.If
  417. {
  418. loc = _position;
  419. then_ =
  420. ( _position,
  421. Ast.BinaryOp
  422. ( _position,
  423. Qsp_syntax.T.Eq,
  424. Ast.Integer (_position, "0"),
  425. Ast.Integer (_position, "0") ),
  426. [] );
  427. elifs = [];
  428. else_ = [];
  429. };
  430. Ast.Comment _position;
  431. ]
  432. let test_if_inline () =
  433. let value_0 = Ast.Integer (_position, "0") in
  434. _test_instruction "if 0: 0 else 0"
  435. Ast.
  436. [
  437. If
  438. {
  439. loc = _position;
  440. then_ = (_position, value_0, [ Expression value_0 ]);
  441. elifs = [];
  442. else_ = [ Expression value_0 ];
  443. };
  444. ]
  445. let test_if_inline_comment () =
  446. let value_0 = Ast.Integer (_position, "0") in
  447. _test_instruction "if 0: 0 else 0 &! comment "
  448. Ast.
  449. [
  450. If
  451. {
  452. loc = _position;
  453. then_ = (_position, value_0, [ Expression value_0 ]);
  454. elifs = [];
  455. else_ = [ Expression value_0 ];
  456. };
  457. Comment _position;
  458. ]
  459. let test_if_inline_comment2 () =
  460. _test_instruction "if 0: 1 & !! Comment"
  461. [
  462. Ast.If
  463. {
  464. loc = _position;
  465. then_ =
  466. ( _position,
  467. Ast.Integer (_position, "0"),
  468. [
  469. Ast.Expression (Ast.Integer (_position, "1"));
  470. Ast.Comment _position;
  471. ] );
  472. elifs = [];
  473. else_ = [];
  474. };
  475. ]
  476. let test_if_inline_act () =
  477. _test_instruction "if 1 and hour >= 8: minut += 1 & act 'go': gt 'go'"
  478. [
  479. Ast.If
  480. {
  481. loc = _position;
  482. then_ =
  483. ( _position,
  484. Ast.BinaryOp
  485. ( _position,
  486. Qsp_syntax.T.And,
  487. Ast.Integer (_position, "1"),
  488. Ast.BinaryOp
  489. ( _position,
  490. Qsp_syntax.T.Gte,
  491. Ast.Ident
  492. { Ast.pos = _position; name = "HOUR"; index = None },
  493. Ast.Integer (_position, "8") ) ),
  494. [
  495. Ast.Declaration
  496. ( _position,
  497. { Ast.pos = _position; name = "MINUT"; index = None },
  498. Qsp_syntax.T.Inc,
  499. Ast.Integer (_position, "1") );
  500. Ast.Act
  501. {
  502. loc = _position;
  503. label = Ast.Literal (_position, [ T.Text "go" ]);
  504. statements =
  505. [
  506. Ast.Call
  507. ( _position,
  508. Qsp_syntax.T.Goto,
  509. [ Ast.Literal (_position, [ T.Text "go" ]) ] );
  510. ];
  511. };
  512. ] );
  513. elifs = [];
  514. else_ = [];
  515. };
  516. ]
  517. let test_if_multiline () =
  518. _test_instruction {|if 1 _
  519. and _hour >= 8: 1|}
  520. [
  521. Ast.If
  522. {
  523. loc = _position;
  524. then_ =
  525. ( _position,
  526. Ast.BinaryOp
  527. ( _position,
  528. Qsp_syntax.T.And,
  529. Ast.Integer (_position, "1"),
  530. Ast.BinaryOp
  531. ( _position,
  532. Qsp_syntax.T.Gte,
  533. Ast.Ident
  534. { Ast.pos = _position; name = "_HOUR"; index = None },
  535. Ast.Integer (_position, "8") ) ),
  536. [ Tree.Ast.Expression (Tree.Ast.Integer (_position, "1")) ] );
  537. elifs = [];
  538. else_ = [];
  539. };
  540. ]
  541. let test_if_inline_act2 () =
  542. _test_instruction "if 1: act 'go': gt 'go' &! comment "
  543. [
  544. Ast.If
  545. {
  546. loc = _position;
  547. then_ =
  548. ( _position,
  549. Ast.Integer (_position, "1"),
  550. [
  551. Ast.Act
  552. {
  553. loc = _position;
  554. label = Ast.Literal (_position, [ T.Text "go" ]);
  555. statements =
  556. [
  557. Ast.Call
  558. ( _position,
  559. Qsp_syntax.T.Goto,
  560. [ Ast.Literal (_position, [ T.Text "go" ]) ] );
  561. Ast.Comment _position;
  562. ];
  563. };
  564. ] );
  565. elifs = [];
  566. else_ = [];
  567. };
  568. ]
  569. let test_precedence3 () =
  570. let index = Some Ast.(Integer (_position, "0")) in
  571. let args = Ast.(Ident { pos = _position; name = "$ARGS"; index })
  572. and expr1 = Ast.(Literal (_position, [ T.Text "blockA" ]))
  573. and expr2 =
  574. Ast.(Expression (Literal (_position, [ T.Text "You are in block A" ])))
  575. and expr3 = Ast.(Expression (Integer (_position, "0"))) in
  576. _test_instruction {| if $ARGS[0] = 'blockA': 'You are in block A' & 0|}
  577. Ast.
  578. [
  579. If
  580. {
  581. loc = _position;
  582. then_ =
  583. ( _position,
  584. BinaryOp (_position, Eq, args, expr1),
  585. [ expr2; expr3 ] );
  586. elifs = [];
  587. else_ = [];
  588. };
  589. ]
  590. let test_gs () =
  591. _test_instruction "gs '123'"
  592. [
  593. Ast.(
  594. Call
  595. ( _position,
  596. Qsp_syntax.T.Gosub,
  597. [ Literal (_position, [ T.Text "123" ]) ] ));
  598. ]
  599. let test_gt () =
  600. _test_instruction "gt $curloc"
  601. [
  602. Ast.Call
  603. ( _position,
  604. Qsp_syntax.T.Goto,
  605. [ Ast.Ident { Ast.pos = _position; name = "$CURLOC"; index = None } ]
  606. );
  607. ]
  608. let test_nl () =
  609. _test_instruction "*NL 'It'"
  610. [
  611. Ast.Call
  612. ( _position,
  613. Qsp_syntax.T.Nl',
  614. [ Ast.Literal (_position, [ T.Text "It" ]) ] );
  615. ]
  616. let test_function () =
  617. _test_instruction "iif(123, 1, 0)"
  618. [
  619. Ast.(
  620. Expression
  621. (Function
  622. ( _position,
  623. Iif,
  624. [
  625. Integer (_position, "123");
  626. Integer (_position, "1");
  627. Integer (_position, "0");
  628. ] )));
  629. ]
  630. (** Include a space before the parameters *)
  631. let test_function2 () =
  632. _test_instruction "rand (0, 1)"
  633. [
  634. Ast.(
  635. Expression
  636. (Function
  637. ( _position,
  638. Rand,
  639. [ Integer (_position, "0"); Integer (_position, "1") ] )));
  640. ]
  641. (** The RND function does not have parens after the name *)
  642. let test_rnd () =
  643. _test_instruction "rnd"
  644. [ Tree.Ast.Expression (Tree.Ast.Function (_position, T.Rnd, [])) ]
  645. let test_precedence4 () =
  646. _test_instruction "trim()" Ast.[ Expression (Function (_position, Trim, [])) ]
  647. (** This should not be a keyword without arguments, followed by an expression *)
  648. let test_precedence5 () =
  649. _test_instruction "clear()" Ast.[ Call (_position, Qsp_syntax.T.Clear, []) ]
  650. let test_precedence6 () =
  651. _test_instruction "(1 = 0 and 2 ! 3)"
  652. [
  653. Ast.Expression
  654. (Ast.BinaryOp
  655. ( _position,
  656. And,
  657. Ast.BinaryOp
  658. ( _position,
  659. Eq,
  660. Ast.Integer (_position, "1"),
  661. Ast.Integer (_position, "0") ),
  662. Ast.BinaryOp
  663. ( _position,
  664. Neq,
  665. Ast.Integer (_position, "2"),
  666. Ast.Integer (_position, "3") ) ));
  667. ]
  668. (** An identifier cannot start by a number *0 is a product and not an
  669. identifier *)
  670. let test_operator () =
  671. let index = None in
  672. let a = { Ast.pos = _position; name = "A"; index }
  673. and value_0 = Ast.Integer (_position, "0") in
  674. _test_instruction "a *0"
  675. Ast.[ Expression (BinaryOp (_position, Product, Ident a, value_0)) ]
  676. let test_operator2 () =
  677. let value_0 = Ast.Integer (_position, "0") in
  678. _test_instruction "0 *rand()"
  679. Ast.
  680. [
  681. Expression
  682. (BinaryOp (_position, Product, value_0, Function (_position, Rand, [])));
  683. ]
  684. let test_dyneval () =
  685. _test_instruction "dyneval ''"
  686. [
  687. Ast.Expression
  688. (Ast.Function
  689. (_position, Dyneval, [ Ast.Literal (_position, [ T.Text "" ]) ]));
  690. ]
  691. (** The parens after input are considered as arguments for the function, not a
  692. following expression.
  693. This expression is a boolean.
  694. *)
  695. let test_input () =
  696. _test_instruction "( input('') = '' )"
  697. [
  698. Tree.Ast.Expression
  699. (Tree.Ast.BinaryOp
  700. ( _position,
  701. Eq,
  702. Tree.Ast.Function
  703. ( _position,
  704. Input,
  705. [ Tree.Ast.Literal (_position, [ T.Text "" ]) ] ),
  706. Tree.Ast.Literal (_position, [ T.Text "" ]) ));
  707. ]
  708. let test_mutiple_inline_ifs () =
  709. _test_instruction "if 1 > 0: 1 else if 1 < 0: 0"
  710. [
  711. Tree.Ast.If
  712. {
  713. loc = _position;
  714. then_ =
  715. ( _position,
  716. Tree.Ast.BinaryOp
  717. ( _position,
  718. Gt,
  719. Tree.Ast.Integer (_position, "1"),
  720. Tree.Ast.Integer (_position, "0") ),
  721. [ Tree.Ast.Expression (Tree.Ast.Integer (_position, "1")) ] );
  722. elifs = [];
  723. else_ =
  724. [
  725. Tree.Ast.If
  726. {
  727. loc = _position;
  728. then_ =
  729. ( _position,
  730. Tree.Ast.BinaryOp
  731. ( _position,
  732. Lt,
  733. Tree.Ast.Integer (_position, "1"),
  734. Tree.Ast.Integer (_position, "0") ),
  735. [
  736. Tree.Ast.Expression (Tree.Ast.Integer (_position, "0"));
  737. ] );
  738. elifs = [];
  739. else_ = [];
  740. };
  741. ];
  742. };
  743. ]
  744. (** The boolean comparaison has greater precedence than arithmetic operator *)
  745. let test_precedence7 () =
  746. _test_instruction "(1 + 1 = '')"
  747. [
  748. Tree.Ast.Expression
  749. (Tree.Ast.BinaryOp
  750. ( _position,
  751. Eq,
  752. Tree.Ast.BinaryOp
  753. ( _position,
  754. Plus,
  755. Tree.Ast.Integer (_position, "1"),
  756. Tree.Ast.Integer (_position, "1") ),
  757. Tree.Ast.Literal (_position, [ T.Text "" ]) ));
  758. ]
  759. (** The OR operator has greater precedence than boolean comparaison *)
  760. let test_precedence8 () =
  761. _test_instruction "(0 = 1 or 0 = 1)"
  762. [
  763. Tree.Ast.Expression
  764. (Tree.Ast.BinaryOp
  765. ( _position,
  766. Or,
  767. Tree.Ast.BinaryOp
  768. ( _position,
  769. Eq,
  770. Tree.Ast.Integer (_position, "0"),
  771. Tree.Ast.Integer (_position, "1") ),
  772. Tree.Ast.BinaryOp
  773. ( _position,
  774. Eq,
  775. Tree.Ast.Integer (_position, "0"),
  776. Tree.Ast.Integer (_position, "1") ) ));
  777. ]
  778. (** Test showing the - should be considered as an operator and cannot be
  779. aggregated inside the integer value. *)
  780. let minus_operator () =
  781. _test_instruction {|day-7|}
  782. [
  783. Tree.Ast.Expression
  784. (Tree.Ast.BinaryOp
  785. ( _position,
  786. T.Minus,
  787. Tree.Ast.Ident
  788. { Tree.Ast.pos = _position; name = "DAY"; index = None },
  789. Tree.Ast.Integer (_position, "7") ));
  790. ]
  791. (** STATTXT was considered as a function and raised an error in the syntax *)
  792. let test_stattxt () =
  793. _test_instruction "$value = $stattxt"
  794. [
  795. Tree.Ast.Declaration
  796. ( _position,
  797. { Tree.Ast.pos = _position; name = "$VALUE"; index = None },
  798. T.Eq',
  799. Tree.Ast.Ident
  800. { Tree.Ast.pos = _position; name = "$STATTXT"; index = None } );
  801. ]
  802. let test_for_end () = _test_instruction {|for a = 1 to 10:
  803. end|} []
  804. let test =
  805. ( "Syntax",
  806. [
  807. Alcotest.test_case "Location" `Quick test_empty_location;
  808. Alcotest.test_case "Location" `Quick test_location_without_space;
  809. Alcotest.test_case "Location" `Quick test_location_without_database;
  810. Alcotest.test_case " Numeric expression" `Quick test_numeric_expression;
  811. Alcotest.test_case "-Numeric expression" `Quick
  812. test_negative_numeric_expression;
  813. Alcotest.test_case "-Numeric expression2" `Quick
  814. test_negative_numeric_expression2;
  815. Alcotest.test_case "Minus op" `Quick minus_operator;
  816. Alcotest.test_case "$Variable expression" `Quick test_str_variable;
  817. Alcotest.test_case " Variable expression" `Quick test_variable;
  818. Alcotest.test_case "Indexed Variable expression" `Quick
  819. test_indexed_variable;
  820. Alcotest.test_case "Let instruction" `Quick test_let_literal;
  821. Alcotest.test_case "Set array_append" `Quick test_set_array_append;
  822. Alcotest.test_case "Variable_assignation" `Quick test_direct_assignation;
  823. Alcotest.test_case "Command assignation" `Quick test_command_assignation;
  824. Alcotest.test_case "Variable_assignation2" `Quick test_assignation2;
  825. Alcotest.test_case "Literal" `Quick test_literal;
  826. Alcotest.test_case "Literal2" `Quick test_qutoted_literal;
  827. Alcotest.test_case "Literal3" `Quick test_multilie_literal;
  828. Alcotest.test_case "Concat Literal" `Quick test_concat_literal;
  829. Alcotest.test_case "Nested Literal" `Quick test_nested_literal;
  830. Alcotest.test_case "Multiline1" `Quick test_multiline1;
  831. Alcotest.test_case "Multiline2" `Quick test_multiline2;
  832. Alcotest.test_case "Equality" `Quick test_equality;
  833. Alcotest.test_case "Plus" `Quick test_plus;
  834. Alcotest.test_case "Plus_litt" `Quick test_plus_litt;
  835. Alcotest.test_case "PlusChained" `Quick test_concat;
  836. Alcotest.test_case "Mod operator" `Quick test_mod;
  837. Alcotest.test_case "Comment" `Quick test_comment;
  838. Alcotest.test_case "Comment2" `Quick test_comment2;
  839. Alcotest.test_case "Comment3" `Quick test_comment3;
  840. Alcotest.test_case "Comment4" `Quick test_comment4;
  841. Alcotest.test_case "Comment5" `Quick test_comment5;
  842. Alcotest.test_case "Comment6" `Quick test_comment6;
  843. Alcotest.test_case "Multiline Comment" `Quick test_long_comment;
  844. Alcotest.test_case "If" `Quick test_if;
  845. Alcotest.test_case "If_chained" `Quick test_if_chained;
  846. Alcotest.test_case "If_equality" `Quick test_if_equality;
  847. Alcotest.test_case "If inline" `Quick test_if_inline;
  848. Alcotest.test_case "If inline &!" `Quick test_if_inline_comment;
  849. Alcotest.test_case "If inline & !!" `Quick test_if_inline_comment2;
  850. Alcotest.test_case "If : act" `Quick test_if_inline_act;
  851. Alcotest.test_case "If _ and " `Quick test_if_multiline;
  852. Alcotest.test_case "If : act: &!" `Quick test_if_inline_act2;
  853. Alcotest.test_case "Precedence1" `Quick test_precedence;
  854. Alcotest.test_case "Precedence2" `Quick test_precedence2;
  855. Alcotest.test_case "Precedence3" `Quick test_precedence3;
  856. Alcotest.test_case "Call gs" `Quick test_gs;
  857. Alcotest.test_case "Call gt" `Quick test_gt;
  858. Alcotest.test_case "Call nl" `Quick test_nl;
  859. Alcotest.test_case "Function iif" `Quick test_function;
  860. Alcotest.test_case "Function rand" `Quick test_function2;
  861. Alcotest.test_case "Function rnd" `Quick test_rnd;
  862. Alcotest.test_case "Precedence4" `Quick test_precedence4;
  863. Alcotest.test_case "Precedence5" `Quick test_precedence5;
  864. Alcotest.test_case "Precedence6" `Quick test_precedence6;
  865. Alcotest.test_case "Operator" `Quick test_operator;
  866. Alcotest.test_case "Operator2" `Quick test_operator2;
  867. Alcotest.test_case "Dyneval" `Quick test_dyneval;
  868. Alcotest.test_case "Input" `Quick test_input;
  869. Alcotest.test_case "inline if else if" `Quick test_mutiple_inline_ifs;
  870. Alcotest.test_case "Precedence7" `Quick test_precedence7;
  871. Alcotest.test_case "Precedence8" `Quick test_precedence8;
  872. Alcotest.test_case "stattxt" `Quick test_stattxt;
  873. Alcotest.test_case "for ... end" `Quick test_for_end;
  874. ] )