first commit

test/cram/bug1.scfg

@@ -0,0 +1,10 @@
+"" {
+    "" {
+    ""
+  }
+  "" {
+    ""
+  }
+  "" ""
+  ""
+}

test/cram/bug2.scfg

@@ -0,0 +1 @@
+

test/cram/bug3.scfg

@@ -0,0 +1 @@
+edff

test/cram/dune

@@ -0,0 +1,10 @@
+(cram
+ (deps
+  %{bin:scfg}
+  bug1.scfg
+  bug2.scfg
+  bug3.scfg
+  lex_error.scfg
+  parse_start_with_newline.scfg
+  (glob_files parse_error*.scfg)
+  test1.scfg))

test/cram/lex_error.scfg

@@ -0,0 +1,2 @@
+a "b
+"

test/cram/parse_error1.scfg

@@ -0,0 +1 @@
+a { } }

test/cram/parse_error2.scfg

@@ -0,0 +1 @@
+a {

test/cram/parse_error3.scfg

@@ -0,0 +1 @@
+a }

test/cram/parse_error4.scfg

@@ -0,0 +1 @@
+a {}

test/cram/parse_start_with_newline.scfg

@@ -0,0 +1,4 @@
+
+wo lo lo {
+  a b c
+}

test/cram/test.t

@@ -0,0 +1,65 @@
+test 1:
+  $ dune exec -- scfg test1.scfg
+  train Shinkansen {
+    model E5 {
+      max-speed 320km/h
+      weight 453.5t
+      lines-served Tōhoku Hokkaido
+    }
+    model E7 {
+      max-speed 275km/h
+      weight 540t
+      lines-served Hokuriku Jōetsu
+    }
+    escapetests "A random line" "abracket{line" "anotherbracket}line" 'aquote"line' "anesc\\line" "asq'line" 'adq"line' 'asinglequote"{} \line' 'asinglequote"justewithadq' "dq\"and'sq"
+    emptytests "" ""
+    "an escaped name" a b c
+    namewithoutparam
+    p "unesc\nnewline" "unesc\rcr" "unesc\ttab"
+    q "new line \n" "cr \r" "tab \t"
+  }
+test 2:
+  $ dune exec -- scfg parse_start_with_newline.scfg
+  wo lo lo {
+    a b c
+  }
+lex error 1:
+  $ dune exec -- scfg lex_error.scfg
+  File lex_error.scfg, line 1, character 2: unexpected lexeme `"`
+  [1]
+parse error 1:
+  $ dune exec -- scfg parse_error1.scfg
+  File parse_error1.scfg, line 1, character 2: unexpected lexeme `{`
+  [1]
+parse error 2:
+  $ dune exec -- scfg parse_error2.scfg
+  File parse_error2.scfg, line 2, character 0: unexpected token EOF
+  [1]
+parse error 3:
+  $ dune exec -- scfg parse_error3.scfg
+  File parse_error3.scfg, line 1, character 2: unexpected lexeme `}`
+  [1]
+parse error 4:
+  $ dune exec -- scfg parse_error4.scfg
+  File parse_error4.scfg, line 1, character 2: unexpected lexeme `{`
+  [1]
+bug 1:
+  $ dune exec -- scfg bug1.scfg
+  "" {
+    "" {
+      ""
+    }
+    "" {
+      ""
+    }
+    "" ""
+    ""
+  }
+bug 2:
+  $ dune exec -- scfg bug2.scfg
+  
+
+
+bug 3:
+  $ dune exec -- scfg bug3.scfg
+  edff

test/cram/test1.scfg

@@ -0,0 +1,22 @@
+train "Shinkansen" {
+	model "E5" {
+		max-speed 320km/h
+		weight 453.5t
+
+		lines-served "Tōhoku" "Hokkaido"
+	}
+
+	model "E7" {
+		max-speed 275km/h
+		weight 540t
+
+		lines-served "Hokuriku" "Jōetsu"
+	}
+
+	escapetests "A random line" abracket\{line anotherbracket\}line aquote\"line anesc\\line asq\'line adq\"line 'asinglequote"{} \line' 'asinglequote"justewithadq' "dq\"and'sq"
+	emptytests "" ''
+	"an escaped name" a b c
+	namewithoutparam
+	p unesc\nnewline unesc\rcr unesc\ttab
+	q "new line \n" "cr \r" "tab \t"
+}

test/fuzz/dune

@@ -0,0 +1,6 @@
+(executable
+ (name fuzz)
+ (modules fuzz gen)
+ (flags
+  (:standard -open Prelude))
+ (libraries crowbar fmt prelude scfg))

test/fuzz/fuzz.ml

@@ -0,0 +1,18 @@
+open Scfg
+
+let () = Random.self_init ()
+
+let () =
+  Crowbar.add_test ~name:"Print and parse fuzzing" [ Gen.config ] (fun config ->
+    let printed = Fmt.str "%a" Pp.config config in
+    match Parse.from_string printed with
+    | Error (`Msg msg) ->
+      Crowbar.failf "%s on the given input@\n***`%S`@\n***`%s`@\n" msg printed
+        printed
+    | Ok config -> (
+      let printed = Fmt.str "%a" Pp.config config in
+      match Parse.from_string printed with
+      | Error (`Msg msg) ->
+        Crowbar.failf "%s on the given input@\n***`%S`@\n***`%s`@\n" msg printed
+          printed
+      | Ok parsed -> Crowbar.check_eq ~pp:Pp.config config parsed ) )

test/fuzz/gen.ml

@@ -0,0 +1,21 @@
+open Crowbar
+
+let ( let* ) = dynamic_bind
+
+let ( let+ ) = map
+
+let unicode_bytes =
+  let+ values = [ list1 uchar ] in
+  let buf = Buffer.create (List.length values) in
+  List.iter (fun u -> Buffer.add_utf_8_uchar buf u) values;
+  Buffer.contents buf
+
+let directive =
+  fix (fun directive ->
+    let* name = unicode_bytes in
+    let* params = list unicode_bytes in
+    let+ children = [ list directive ] in
+    let open Scfg.Types in
+    { name; params; children } )
+
+let config = list directive

test/unit/dune

@@ -0,0 +1,5 @@
+(test
+ (name main)
+ (modules main)
+ (libraries fpath prelude scfg)
+ (deps query.scfg test_chan.scfg))

test/unit/main.ml

@@ -0,0 +1,115 @@
+open Scfg
+
+(** Testing other functions in Parse module. *)
+let () =
+  let chan = open_in "test_chan.scfg" in
+  match Parse.from_channel chan with
+  | Error _e -> assert false
+  | Ok config ->
+    let expected = "a b c" in
+    let s = Format.asprintf "%a" Pp.config config in
+    assert (s = expected)
+
+let () =
+  let s = {|a b c|} in
+  match Parse.from_string s with
+  | Error (`Msg e) ->
+    Format.eprintf "ERROR: %s@\n" e;
+    assert false
+  | Ok config ->
+    let expected = {|a b c|} in
+    let s = Format.asprintf "%a" Pp.config config in
+    assert (s = expected)
+
+(** Testing queries. *)
+let file =
+  match Fpath.of_string "query.scfg" with
+  | Error _e -> assert false
+  | Ok file -> file
+
+let () =
+  let config =
+    match Parse.from_file file with
+    | Error _e -> assert false
+    | Ok config -> config
+  in
+  assert (List.length config = 5);
+  let n1 = Query.get_dirs "n1" config in
+  assert (List.length n1 = 2);
+  let n11 = Query.get_dir "n1" n1 in
+  let n11 = match n11 with None -> assert false | Some n11 -> n11 in
+  let n12 =
+    match Query.get_dir "n1.2" n11.children with
+    | None -> assert false
+    | Some n12 -> n12
+  in
+  let pn12 =
+    match Query.get_params 2 n12 with
+    | Error _e -> assert false
+    | Ok pn12 -> pn12
+  in
+  assert (pn12 = [ "p1"; "p2" ]);
+  begin match Query.get_params 3 n12 with
+  | Error (`Msg "directive n1.2: want 3 params, got only 2") -> ()
+  | Error _ | Ok _ -> assert false
+  end;
+  begin match Query.get_param 0 n12 with
+  | Error _ -> assert false
+  | Ok p -> assert (p = "p1")
+  end;
+  match Query.get_param 5 n12 with
+  | Error (`Msg "directive n1.2: want param at index 5, got only 2") -> ()
+  | Error _ | Ok _ -> assert false
+
+(** Testing schema. *)
+module Test_schema = struct
+  open Schema
+
+  let rev_string : (string, param) t -> (string, param) t =
+    let decode =
+     fun s ->
+      let len = String.length s in
+      let s_rev = String.init len (fun i -> String.get s (len - i - 1)) in
+      Ok s_rev
+    in
+    custom decode
+
+  let len_string : (string, param) t -> (int, param) t =
+    let decode = fun s -> String.length s |> Result.ok in
+    custom decode
+
+  let schema =
+    directive "dir" (t3 bool string string)
+      (t2
+         (directive "dir_1"
+            (t2 bool (rev_string string))
+            (directive "dir_1_1" nil nil) )
+         (directive "dir_2" (t2 string (len_string string)) nil) )
+
+  let txt =
+    Parse.from_string
+      {|dir true str1 "str2" {
+  dir_1 false naquadah {
+    dir_1_1
+  }
+  dir_2 str3 four
+  }|}
+    |> Result.get_ok
+
+  let () =
+    let v = conv schema txt |> Result.get_ok in
+    assert (
+      v
+      = { name = "dir"
+        ; params = (true, "str1", "str2")
+        ; children =
+            ( { name = "dir_1"
+              ; params = (false, "hadauqan")
+              ; children = { name = "dir_1_1"; params = Nil; children = Nil }
+              }
+            , { name = "dir_2"; params = ("str3", 4); children = Nil } )
+        } );
+    ()
+end
+
+let () = Format.printf "all tests OK! 🐱"

test/unit/query.scfg

@@ -0,0 +1,11 @@
+n1 p1 p2 {
+  n1.2 p1 p2
+  n1.3 p1 p2
+}
+n1 p3 p4 {
+  n1.2 p3 p4
+  n1.3 p3 p4
+}
+a b c
+a c d
+gggggggggggggggg g g g

test/unit/test_chan.scfg

@@ -0,0 +1 @@
+a b c