syntax.ml 29 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972
  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. let test_comment_string () =
  352. _test_instruction {|! {}|} [ Comment _position ];
  353. _test_instruction {|! ''|} [ Comment _position ];
  354. _test_instruction {|! ""|} [ Comment _position ];
  355. _test_instruction {|! {''}|} [ Comment _position ];
  356. _test_instruction {|! {""}|} [ Comment _position ];
  357. _test_instruction {|! "{"|} [ Comment _position ];
  358. _test_instruction {|! '{'|} [ Comment _position ];
  359. _test_instruction {|! "'"|} [ Comment _position ];
  360. _test_instruction {|! '"'|} [ Comment _position ];
  361. ()
  362. (** This test ensure that the unary operator is applied to the whole expression
  363. *)
  364. let test_precedence () =
  365. let index = None in
  366. let x = Ast.Ident { Ast.pos = _position; name = "X"; index }
  367. and y = Ast.Ident { Ast.pos = _position; name = "Y"; index } in
  368. _test_instruction "no x = y"
  369. Ast.[ Expression (Op (_position, No, BinaryOp (_position, Eq, x, y))) ]
  370. (** This test ensure that a ! is not considered as a comment in an
  371. expression *)
  372. let test_precedence2 () =
  373. let index = None in
  374. let x = { Ast.pos = _position; name = "X"; index }
  375. and y = Ast.Ident { Ast.pos = _position; name = "Y"; index } in
  376. _test_instruction "x = y ! 0"
  377. Ast.
  378. [
  379. Declaration
  380. ( _position,
  381. x,
  382. Eq',
  383. BinaryOp (_position, Neq, y, Integer (_position, "0")) );
  384. ]
  385. let test_if () =
  386. let index = Some Ast.(Integer (_position, "0")) in
  387. let args = Ast.(Ident { pos = _position; name = "$ARGS"; index })
  388. and expr1 = Ast.(Literal (_position, [ T.Text "blockA" ]))
  389. and expr2 =
  390. Ast.(Expression (Literal (_position, [ T.Text "You are in block A" ])))
  391. in
  392. _test_instruction {| if $ARGS[0] = 'blockA':
  393. 'You are in block A'
  394. end |}
  395. Ast.
  396. [
  397. If
  398. {
  399. loc = _position;
  400. then_ = (_position, BinaryOp (_position, Eq, args, expr1), [ expr2 ]);
  401. elifs = [];
  402. else_ = [];
  403. };
  404. ]
  405. let test_if_chained () =
  406. let value_0 = Ast.Integer (_position, "0") in
  407. _test_instruction {| if 0:
  408. 0
  409. end &! -- |}
  410. Ast.
  411. [
  412. If
  413. {
  414. loc = _position;
  415. then_ = (_position, value_0, [ Expression value_0 ]);
  416. elifs = [];
  417. else_ = [];
  418. };
  419. Comment _position;
  420. ]
  421. let test_if_equality () =
  422. _test_instruction {|
  423. if 0 = 0:
  424. end &! --
  425. |}
  426. [
  427. Ast.If
  428. {
  429. loc = _position;
  430. then_ =
  431. ( _position,
  432. Ast.BinaryOp
  433. ( _position,
  434. Qsp_syntax.T.Eq,
  435. Ast.Integer (_position, "0"),
  436. Ast.Integer (_position, "0") ),
  437. [] );
  438. elifs = [];
  439. else_ = [];
  440. };
  441. Ast.Comment _position;
  442. ]
  443. let test_if_inline () =
  444. let value_0 = Ast.Integer (_position, "0") in
  445. _test_instruction "if 0: 0 else 0"
  446. Ast.
  447. [
  448. If
  449. {
  450. loc = _position;
  451. then_ = (_position, value_0, [ Expression value_0 ]);
  452. elifs = [];
  453. else_ = [ Expression value_0 ];
  454. };
  455. ]
  456. let test_if_inline_comment () =
  457. let value_0 = Ast.Integer (_position, "0") in
  458. _test_instruction "if 0: 0 else 0 &! comment "
  459. Ast.
  460. [
  461. If
  462. {
  463. loc = _position;
  464. then_ = (_position, value_0, [ Expression value_0 ]);
  465. elifs = [];
  466. else_ = [ Expression value_0 ];
  467. };
  468. Comment _position;
  469. ]
  470. let test_if_inline_comment2 () =
  471. _test_instruction "if 0: 1 & !! Comment"
  472. [
  473. Ast.If
  474. {
  475. loc = _position;
  476. then_ =
  477. ( _position,
  478. Ast.Integer (_position, "0"),
  479. [
  480. Ast.Expression (Ast.Integer (_position, "1"));
  481. Ast.Comment _position;
  482. ] );
  483. elifs = [];
  484. else_ = [];
  485. };
  486. ]
  487. let test_if_inline_act () =
  488. _test_instruction "if 1 and hour >= 8: minut += 1 & act 'go': gt 'go'"
  489. [
  490. Ast.If
  491. {
  492. loc = _position;
  493. then_ =
  494. ( _position,
  495. Ast.BinaryOp
  496. ( _position,
  497. Qsp_syntax.T.And,
  498. Ast.Integer (_position, "1"),
  499. Ast.BinaryOp
  500. ( _position,
  501. Qsp_syntax.T.Gte,
  502. Ast.Ident
  503. { Ast.pos = _position; name = "HOUR"; index = None },
  504. Ast.Integer (_position, "8") ) ),
  505. [
  506. Ast.Declaration
  507. ( _position,
  508. { Ast.pos = _position; name = "MINUT"; index = None },
  509. Qsp_syntax.T.Inc,
  510. Ast.Integer (_position, "1") );
  511. Ast.Act
  512. {
  513. loc = _position;
  514. label = Ast.Literal (_position, [ T.Text "go" ]);
  515. statements =
  516. [
  517. Ast.Call
  518. ( _position,
  519. Qsp_syntax.T.Goto,
  520. [ Ast.Literal (_position, [ T.Text "go" ]) ] );
  521. ];
  522. };
  523. ] );
  524. elifs = [];
  525. else_ = [];
  526. };
  527. ]
  528. let test_if_multiline () =
  529. _test_instruction {|if 1 _
  530. and _hour >= 8: 1|}
  531. [
  532. Ast.If
  533. {
  534. loc = _position;
  535. then_ =
  536. ( _position,
  537. Ast.BinaryOp
  538. ( _position,
  539. Qsp_syntax.T.And,
  540. Ast.Integer (_position, "1"),
  541. Ast.BinaryOp
  542. ( _position,
  543. Qsp_syntax.T.Gte,
  544. Ast.Ident
  545. { Ast.pos = _position; name = "_HOUR"; index = None },
  546. Ast.Integer (_position, "8") ) ),
  547. [ Tree.Ast.Expression (Tree.Ast.Integer (_position, "1")) ] );
  548. elifs = [];
  549. else_ = [];
  550. };
  551. ]
  552. let test_if_inline_act2 () =
  553. _test_instruction "if 1: act 'go': gt 'go' &! comment "
  554. [
  555. Ast.If
  556. {
  557. loc = _position;
  558. then_ =
  559. ( _position,
  560. Ast.Integer (_position, "1"),
  561. [
  562. Ast.Act
  563. {
  564. loc = _position;
  565. label = Ast.Literal (_position, [ T.Text "go" ]);
  566. statements =
  567. [
  568. Ast.Call
  569. ( _position,
  570. Qsp_syntax.T.Goto,
  571. [ Ast.Literal (_position, [ T.Text "go" ]) ] );
  572. Ast.Comment _position;
  573. ];
  574. };
  575. ] );
  576. elifs = [];
  577. else_ = [];
  578. };
  579. ]
  580. let test_precedence3 () =
  581. let index = Some Ast.(Integer (_position, "0")) in
  582. let args = Ast.(Ident { pos = _position; name = "$ARGS"; index })
  583. and expr1 = Ast.(Literal (_position, [ T.Text "blockA" ]))
  584. and expr2 =
  585. Ast.(Expression (Literal (_position, [ T.Text "You are in block A" ])))
  586. and expr3 = Ast.(Expression (Integer (_position, "0"))) in
  587. _test_instruction {| if $ARGS[0] = 'blockA': 'You are in block A' & 0|}
  588. Ast.
  589. [
  590. If
  591. {
  592. loc = _position;
  593. then_ =
  594. ( _position,
  595. BinaryOp (_position, Eq, args, expr1),
  596. [ expr2; expr3 ] );
  597. elifs = [];
  598. else_ = [];
  599. };
  600. ]
  601. let test_gs () =
  602. _test_instruction "gs '123'"
  603. [
  604. Ast.(
  605. Call
  606. ( _position,
  607. Qsp_syntax.T.Gosub,
  608. [ Literal (_position, [ T.Text "123" ]) ] ));
  609. ]
  610. let test_gt () =
  611. _test_instruction "gt $curloc"
  612. [
  613. Ast.Call
  614. ( _position,
  615. Qsp_syntax.T.Goto,
  616. [ Ast.Ident { Ast.pos = _position; name = "$CURLOC"; index = None } ]
  617. );
  618. ]
  619. let test_nl () =
  620. _test_instruction "*NL 'It'"
  621. [
  622. Ast.Call
  623. ( _position,
  624. Qsp_syntax.T.Nl',
  625. [ Ast.Literal (_position, [ T.Text "It" ]) ] );
  626. ]
  627. let test_function () =
  628. _test_instruction "iif(123, 1, 0)"
  629. [
  630. Ast.(
  631. Expression
  632. (Function
  633. ( _position,
  634. Iif,
  635. [
  636. Integer (_position, "123");
  637. Integer (_position, "1");
  638. Integer (_position, "0");
  639. ] )));
  640. ]
  641. (** Include a space before the parameters *)
  642. let test_function2 () =
  643. _test_instruction "rand (0, 1)"
  644. [
  645. Ast.(
  646. Expression
  647. (Function
  648. ( _position,
  649. Rand,
  650. [ Integer (_position, "0"); Integer (_position, "1") ] )));
  651. ]
  652. (** The RND function does not have parens after the name *)
  653. let test_rnd () =
  654. _test_instruction "rnd"
  655. [ Tree.Ast.Expression (Tree.Ast.Function (_position, T.Rnd, [])) ]
  656. let test_precedence4 () =
  657. _test_instruction "trim()" Ast.[ Expression (Function (_position, Trim, [])) ]
  658. (** This should not be a keyword without arguments, followed by an expression *)
  659. let test_precedence5 () =
  660. _test_instruction "clear()" Ast.[ Call (_position, Qsp_syntax.T.Clear, []) ]
  661. let test_precedence6 () =
  662. _test_instruction "(1 = 0 and 2 ! 3)"
  663. [
  664. Ast.Expression
  665. (Ast.BinaryOp
  666. ( _position,
  667. And,
  668. Ast.BinaryOp
  669. ( _position,
  670. Eq,
  671. Ast.Integer (_position, "1"),
  672. Ast.Integer (_position, "0") ),
  673. Ast.BinaryOp
  674. ( _position,
  675. Neq,
  676. Ast.Integer (_position, "2"),
  677. Ast.Integer (_position, "3") ) ));
  678. ]
  679. (** An identifier cannot start by a number *0 is a product and not an
  680. identifier *)
  681. let test_operator () =
  682. let index = None in
  683. let a = { Ast.pos = _position; name = "A"; index }
  684. and value_0 = Ast.Integer (_position, "0") in
  685. _test_instruction "a *0"
  686. Ast.[ Expression (BinaryOp (_position, Product, Ident a, value_0)) ]
  687. let test_operator2 () =
  688. let value_0 = Ast.Integer (_position, "0") in
  689. _test_instruction "0 *rand()"
  690. Ast.
  691. [
  692. Expression
  693. (BinaryOp (_position, Product, value_0, Function (_position, Rand, [])));
  694. ]
  695. let test_dyneval () =
  696. _test_instruction "dyneval ''"
  697. [
  698. Ast.Expression
  699. (Ast.Function
  700. (_position, Dyneval, [ Ast.Literal (_position, [ T.Text "" ]) ]));
  701. ]
  702. (** The parens after input are considered as arguments for the function, not a
  703. following expression.
  704. This expression is a boolean.
  705. *)
  706. let test_input () =
  707. _test_instruction "( input('') = '' )"
  708. [
  709. Tree.Ast.Expression
  710. (Tree.Ast.BinaryOp
  711. ( _position,
  712. Eq,
  713. Tree.Ast.Function
  714. ( _position,
  715. Input,
  716. [ Tree.Ast.Literal (_position, [ T.Text "" ]) ] ),
  717. Tree.Ast.Literal (_position, [ T.Text "" ]) ));
  718. ]
  719. let test_mutiple_inline_ifs () =
  720. _test_instruction "if 1 > 0: 1 else if 1 < 0: 0"
  721. [
  722. Tree.Ast.If
  723. {
  724. loc = _position;
  725. then_ =
  726. ( _position,
  727. Tree.Ast.BinaryOp
  728. ( _position,
  729. Gt,
  730. Tree.Ast.Integer (_position, "1"),
  731. Tree.Ast.Integer (_position, "0") ),
  732. [ Tree.Ast.Expression (Tree.Ast.Integer (_position, "1")) ] );
  733. elifs = [];
  734. else_ =
  735. [
  736. Tree.Ast.If
  737. {
  738. loc = _position;
  739. then_ =
  740. ( _position,
  741. Tree.Ast.BinaryOp
  742. ( _position,
  743. Lt,
  744. Tree.Ast.Integer (_position, "1"),
  745. Tree.Ast.Integer (_position, "0") ),
  746. [
  747. Tree.Ast.Expression (Tree.Ast.Integer (_position, "0"));
  748. ] );
  749. elifs = [];
  750. else_ = [];
  751. };
  752. ];
  753. };
  754. ]
  755. (** The boolean comparaison has greater precedence than arithmetic operator *)
  756. let test_precedence7 () =
  757. _test_instruction "(1 + 1 = '')"
  758. [
  759. Tree.Ast.Expression
  760. (Tree.Ast.BinaryOp
  761. ( _position,
  762. Eq,
  763. Tree.Ast.BinaryOp
  764. ( _position,
  765. Plus,
  766. Tree.Ast.Integer (_position, "1"),
  767. Tree.Ast.Integer (_position, "1") ),
  768. Tree.Ast.Literal (_position, [ T.Text "" ]) ));
  769. ]
  770. (** The OR operator has greater precedence than boolean comparaison *)
  771. let test_precedence8 () =
  772. _test_instruction "(0 = 1 or 0 = 1)"
  773. [
  774. Tree.Ast.Expression
  775. (Tree.Ast.BinaryOp
  776. ( _position,
  777. Or,
  778. Tree.Ast.BinaryOp
  779. ( _position,
  780. Eq,
  781. Tree.Ast.Integer (_position, "0"),
  782. Tree.Ast.Integer (_position, "1") ),
  783. Tree.Ast.BinaryOp
  784. ( _position,
  785. Eq,
  786. Tree.Ast.Integer (_position, "0"),
  787. Tree.Ast.Integer (_position, "1") ) ));
  788. ]
  789. (** Test showing the - should be considered as an operator and cannot be
  790. aggregated inside the integer value. *)
  791. let minus_operator () =
  792. _test_instruction {|day-7|}
  793. [
  794. Tree.Ast.Expression
  795. (Tree.Ast.BinaryOp
  796. ( _position,
  797. T.Minus,
  798. Tree.Ast.Ident
  799. { Tree.Ast.pos = _position; name = "DAY"; index = None },
  800. Tree.Ast.Integer (_position, "7") ));
  801. ]
  802. (** STATTXT was considered as a function and raised an error in the syntax *)
  803. let test_stattxt () =
  804. _test_instruction "$value = $stattxt"
  805. [
  806. Tree.Ast.Declaration
  807. ( _position,
  808. { Tree.Ast.pos = _position; name = "$VALUE"; index = None },
  809. T.Eq',
  810. Tree.Ast.Ident
  811. { Tree.Ast.pos = _position; name = "$STATTXT"; index = None } );
  812. ]
  813. let test_syntax =
  814. ( "Syntax",
  815. [
  816. Alcotest.test_case "Location" `Quick test_empty_location;
  817. Alcotest.test_case "Location" `Quick test_location_without_space;
  818. Alcotest.test_case "Location" `Quick test_location_without_database;
  819. Alcotest.test_case " Numeric expression" `Quick test_numeric_expression;
  820. Alcotest.test_case "-Numeric expression" `Quick
  821. test_negative_numeric_expression;
  822. Alcotest.test_case "-Numeric expression2" `Quick
  823. test_negative_numeric_expression2;
  824. Alcotest.test_case "Minus op" `Quick minus_operator;
  825. Alcotest.test_case "$Variable expression" `Quick test_str_variable;
  826. Alcotest.test_case " Variable expression" `Quick test_variable;
  827. Alcotest.test_case "Indexed Variable expression" `Quick
  828. test_indexed_variable;
  829. Alcotest.test_case "Let instruction" `Quick test_let_literal;
  830. Alcotest.test_case "Set array_append" `Quick test_set_array_append;
  831. Alcotest.test_case "Variable_assignation" `Quick test_direct_assignation;
  832. Alcotest.test_case "Command assignation" `Quick test_command_assignation;
  833. Alcotest.test_case "Variable_assignation2" `Quick test_assignation2;
  834. Alcotest.test_case "Literal" `Quick test_literal;
  835. Alcotest.test_case "Literal2" `Quick test_qutoted_literal;
  836. Alcotest.test_case "Literal3" `Quick test_multilie_literal;
  837. Alcotest.test_case "Concat Literal" `Quick test_concat_literal;
  838. Alcotest.test_case "Nested Literal" `Quick test_nested_literal;
  839. Alcotest.test_case "Multiline1" `Quick test_multiline1;
  840. Alcotest.test_case "Multiline2" `Quick test_multiline2;
  841. Alcotest.test_case "Equality" `Quick test_equality;
  842. Alcotest.test_case "Plus" `Quick test_plus;
  843. Alcotest.test_case "Plus_litt" `Quick test_plus_litt;
  844. Alcotest.test_case "PlusChained" `Quick test_concat;
  845. Alcotest.test_case "Mod operator" `Quick test_mod;
  846. Alcotest.test_case "If" `Quick test_if;
  847. Alcotest.test_case "If_chained" `Quick test_if_chained;
  848. Alcotest.test_case "If_equality" `Quick test_if_equality;
  849. Alcotest.test_case "If inline" `Quick test_if_inline;
  850. Alcotest.test_case "If inline &!" `Quick test_if_inline_comment;
  851. Alcotest.test_case "If inline & !!" `Quick test_if_inline_comment2;
  852. Alcotest.test_case "If : act" `Quick test_if_inline_act;
  853. Alcotest.test_case "If _ and " `Quick test_if_multiline;
  854. Alcotest.test_case "If : act: &!" `Quick test_if_inline_act2;
  855. Alcotest.test_case "Precedence1" `Quick test_precedence;
  856. Alcotest.test_case "Precedence2" `Quick test_precedence2;
  857. Alcotest.test_case "Precedence3" `Quick test_precedence3;
  858. Alcotest.test_case "Call gs" `Quick test_gs;
  859. Alcotest.test_case "Call gt" `Quick test_gt;
  860. Alcotest.test_case "Call nl" `Quick test_nl;
  861. Alcotest.test_case "Function iif" `Quick test_function;
  862. Alcotest.test_case "Function rand" `Quick test_function2;
  863. Alcotest.test_case "Function rnd" `Quick test_rnd;
  864. Alcotest.test_case "Precedence4" `Quick test_precedence4;
  865. Alcotest.test_case "Precedence5" `Quick test_precedence5;
  866. Alcotest.test_case "Precedence6" `Quick test_precedence6;
  867. Alcotest.test_case "Operator" `Quick test_operator;
  868. Alcotest.test_case "Operator2" `Quick test_operator2;
  869. Alcotest.test_case "Dyneval" `Quick test_dyneval;
  870. Alcotest.test_case "Input" `Quick test_input;
  871. Alcotest.test_case "inline if else if" `Quick test_mutiple_inline_ifs;
  872. Alcotest.test_case "Precedence7" `Quick test_precedence7;
  873. Alcotest.test_case "Precedence8" `Quick test_precedence8;
  874. Alcotest.test_case "stattxt" `Quick test_stattxt;
  875. ] )
  876. let test_comments =
  877. ( "Comments",
  878. [
  879. Alcotest.test_case "Simple Comment" `Quick test_comment;
  880. Alcotest.test_case "& Comment" `Quick test_comment2;
  881. Alcotest.test_case "Double Comment" `Quick test_comment3;
  882. Alcotest.test_case "Comment vs operation" `Quick test_comment4;
  883. Alcotest.test_case "Comment5" `Quick test_comment5;
  884. Alcotest.test_case "Comment6" `Quick test_comment6;
  885. Alcotest.test_case "Multiline Comment" `Quick test_long_comment;
  886. Alcotest.test_case "Comments with strings" `Quick test_comment_string;
  887. ] )