scm/test/parser/sexpTest.ml

   1 open Base
   2 open Node
   3 open Sexp
   4 open OUnit
   5
   6 let pos x n a b =
   7   {(Node.ghost x) with
   8      Node.filename = "<string>";
   9      lineno        = n;
  10      start_pos     = a;
  11      end_pos       = b}
  12
  13 let rec eq lhs rhs =
  14     match lhs,rhs with
  15         Int {value=x}, Int {value=y} ->
  16           x = y
  17       | String {value=x}, String {value=y} ->
  18           x = y
  19       | Float  {value=x}, Float {value=y} ->
  20           x = y
  21       | Bool   {value=x}, Bool  {value=y} ->
  22           x = y
  23       | Symbol {value=x}, Symbol  {value=y} ->
  24           x = y
  25       | List   {value=x}, List  {value=y} ->
  26           List.for_all2 eq x y
  27       | _ ->
  28           false
  29
  30 let ok sexp str =
  31   let sexp' =
  32     of_string str in
  33     OUnit.assert_equal
  34       ~cmp:(fun a b -> List.for_all2 eq a b)
  35       ~printer:(String.concat ";\n" $ List.map Sexp.to_string)
  36       sexp
  37       sexp'
  38
  39 let int n =
  40   Int (Node.ghost n)
  41 let string s =
  42   String (Node.ghost s)
  43 let bool b =
  44   Bool (Node.ghost b)
  45 let float f =
  46   Float (Node.ghost f)
  47 let symbol s =
  48   Symbol (Node.ghost s)
  49 let list l =
  50   List (Node.ghost l)
  51
  52 let _ =
  53   ("S expression module test" >::: [
  54      "pos" >::
  55        (fun () ->
  56           assert_equal
  57             ~printer:(String.concat ";\n" $ List.map Sexp.to_string)
  58             [Int    (pos 42    0 0 2);
  59              String (pos "str" 1 0 5);
  60              Float  (pos 42.0  2 0 4);
  61              Bool   (pos true  3 0 2);
  62              Bool   (pos false 3 3 5);
  63              Symbol (pos "hoge" 4 0 4);
  64              List   (pos [Symbol (pos "a" 5 1 2);
  65                           Symbol (pos "b" 5 3 4);
  66                           Symbol (pos "c" 5 5 6)] 5 0 7)] @@
  67             of_string "42
  68 \"str\"
  69 42.0
  70 #t #f
  71 hoge
  72 (a b c)");
  73      "empty" >::
  74        (fun () ->
  75           ok [] "";
  76           ok [] "; foo bar");
  77      "int" >::
  78        (fun () ->
  79           ok [int 42]   "42";
  80           ok [int ~-42] "-42");
  81      "bool" >::
  82        (fun () ->
  83           ok [bool true]  "#t";
  84           ok [bool false] "#f");
  85      "float" >::
  86        (fun () ->
  87           ok [float 42.]  "42.";
  88           ok [float 42.5] "42.5");
  89      "string" >::
  90        (fun () ->
  91           ok [string ""]       "\"\"";
  92           ok [string "foo"]    "\"foo\"";
  93           ok [string "foo\"x"] "\"foo\\\"x\"";
  94           ok [string "foo\""]  "\"foo\\\"\"");
  95      "symbol" >::
  96        (fun () ->
  97           ok [string "foo"] "\"foo\"";
  98           ok [string "+"]   "\"+\"";
  99           ok [symbol "."]   ".");
 100      "+" >::
 101        (fun () ->
 102           ok [list [symbol "+"; int 1; int 2]]
 103             "(+ 1 2)");
 104      "call" >::
 105        (fun () ->
 106           ok [list [symbol "print"; string "hello"]]
 107             "(print \"hello\")");
 108      "bracket" >::
 109        (fun () ->
 110           ok [list [symbol "print"; string "hello"]]
 111             "[print \"hello\"]");
 112      "quote" >::
 113        (fun () ->
 114           ok [list [symbol "quote"; symbol "hello"]]
 115             "(quote hello)";
 116           ok [list [symbol "quote"; symbol "hello"]]
 117             "'hello")
 118    ]) +> run_test_tt
 119