[TESTS][LAMBDA] Add test generator (to fix)

tests/lambda/GRAMMAR

 expr = id
 | integer
-| `true
-| `false
+| "`true"
+| "`false"
 | string
 | abstr
 | "let" string ":" type_id "=" expr "in" expr ":" type_id
@@ -16,17 +16,21 @@ expr = id
 | "(" expr ")"
 | "[" listexpr "]"
 | "match" expr ":" type_id "with" "|" match_value "->" expr branches
+;;
 
 sigma = (* empty *)
 | ";" id "/" type_id
+;;
 
 listexpr = (* empty *)
 | expr
 | listexpr ";" listexpr
+;;
 
 abstr = "fun" id id ":" type_id params ":" type_id "->" expr
 | "fun" "_" id ":" type_id params ":" type_id "->" expr
 | "fun" type_id "|" match_value "->" expr branches
+;;
 
 match_value = id ":" type_id
 | integer
@@ -34,27 +38,32 @@ match_value = id ":" type_id
 | match_value "," match_value
 | match_value "::" match_value
 | "(" match_value ")"
+;;
 
 params = (* empty *)
 | id ":" type_id params
+;;
 
 branches = (* empty *)
 | "|" match_value "->" expr branches
+;;
 
 (* Note: The first character of an id is lower case (or '_'), the first
    character of a type is upper case *)
 
-id = [a-z_][A-Za-z0-9_]*
+id = LIDENT (* [a-z_][A-Za-z0-9_]* *)
+;;
 
-type_id = [A-Z][A-Za-z0-9_]*
-| "'"[A-Z][A-Za-z0-9_]* "{" id "/" type_id sigma "}"
+type_id = LIDENT
+| "'" LIDENT "{" id "/" type_id sigma "}"
 | "[" complex_type_id "]"
 | "(" complex_type_id ")"
+;;
 
-complex_type_id = [A-Z][A-Za-z0-9_]*
+complex_type_id = UIDENT (* [A-Z][A-Za-z0-9_]* *)
 (* One must precise a set of type substitutions on a type variable, at least a
    empty one : α = 'A{} *)
-| "'"[A-Z][A-Za-z0-9_]* "{" id "/" type_id sigma "}"
+| "'" UIDENT "{" id "/" type_id sigma "}"
 | complex_type_id "*" complex_type_id
 | complex_type_id "|" complex_type_id
 | complex_type_id "&" complex_type_id
@@ -62,5 +71,6 @@ complex_type_id = [A-Z][A-Za-z0-9_]*
 | complex_type_id "->" complex_type_id
 | "[" complex_type_id "]"
 | "(" complex_type_id ")"
+;;
 
-integer = [0-9]+
+integer = INTEGER (* [0-9]+ *)

tests/lambda/Makefile

@@ -25,7 +25,7 @@ RM		?= rm -f
 OUT		?= main.native
 OUTDEBUG	?= main.byte
 
-.PHONY: clean _import
+.PHONY: clean _import tests
 
 all: _import
 	$(COMPILER) -use-ocamlfind $(OUT)
@@ -33,6 +33,9 @@ all: _import
 debug: _import
 	$(COMPILER) -use-ocamlfind -tag debug $(OUTDEBUG)
 
+tests:
+	make -C tests
+
 _import:
 	@echo -n "Copying external files..."
 	@test -d $(EXTDIR) || mkdir $(EXTDIR)
@@ -40,5 +43,6 @@ _import:
 	@echo "done"
 
 clean:
+	make -C tests clean
 	$(COMPILER) -clean
 	test $(EXTDIR) = "src" || test $(EXTDIR) = "." || $(RM) -r $(EXTDIR)

tests/lambda/src/main.ml

@@ -306,7 +306,6 @@ let tests_eval = "CDuce runtime tests (Typed -> Lambda -> Value)" >:::
 	~printer:(fun x -> x) "(2, 5, {})"
 	(run_test_eval "(fun tail x : [Int] : [Int] -> match x : [Int] with
                      | (el : Int) :: (rest : [Int]) -> rest).[1; 2; 5]");
-      (* TODO: Fix this test, we need to define [] aka `nil *)
       assert_equal ~msg:"Test CDuce.runtime.list.last failed"
 	~printer:(fun x -> x) "7"
 	(run_test_eval "(fun f x : [Int] : [Int] -> match x : [Int] with

tests/lambda/tests/Makefile

+COMPILER	?= ocamlbuild
+SRCDIR		?= src
+
+RM		?= rm -f
+OUT		?= gen_test.native
+OUTDEBUG	?= gen_test.byte
+
+.PHONY: clean
+
+all:
+	$(COMPILER) -use-ocamlfind $(OUT)
+
+debug:
+	$(COMPILER) -use-ocamlfind -tag debug $(OUTDEBUG)
+
+clean:
+	$(COMPILER) -clean

tests/lambda/tests/_tags

+<src>: include
+<src/parse*>: pp(camlp4orf.opt), package(camlp4.lib)
+<src/compute*>: pp(camlp4orf.opt), package(camlp4.lib)
+<src/gen_test*>: pp(camlp4orf.opt), package(camlp4.lib)

tests/lambda/tests/src/compute.ml

+open Parse
+open Camlp4.PreCast
+
+module Rules = Map.Make(String)
+
+let rules = ref Rules.empty
+let arules = ref [||]
+
+exception Error
+
+let rec init l = match l with
+  | Rule(_, name, tokens) :: rest -> rules := Rules.add name tokens !rules;
+    arules := Array.append !arules [| name |]; init rest
+  | [] -> ()
+
+let rec get_state nb = function
+  | state :: rest -> if nb != 0 then get_state (nb - 1) rest else state
+  | _ -> assert false
+
+let rec g_ident nb res =
+  if nb = 0 then res else
+    let rand = Random.int 63 in
+    let res = res ^
+      (if rand < 26 then
+	 String.make 1 (char_of_int (int_of_char 'a' + rand))
+       else if rand < 52 then
+	 String.make 1 (char_of_int (int_of_char 'A' + rand))
+       else if rand < 62 then
+	 String.make 1 (char_of_int (int_of_char '0' + rand))
+       else "_"
+      )
+    in
+    g_ident (nb - 1) res
+
+let g_lident nb res =
+  if nb = 0 then res else
+    let rand = Random.int 27 in
+    let res = res ^ (if rand = 26 then "_"
+      else String.make 1 (char_of_int (int_of_char 'a' + rand))) in
+    g_ident (nb - 1) res
+
+let g_uident nb res =
+  if nb = 0 then res else
+    let rand = Random.int 26 in
+    let res = res ^ (String.make 1 (char_of_int (int_of_char 'A' + rand))) in
+    g_ident (nb - 1) res
+
+let rec g_token = function
+  | RefRule(loc, name) ->
+    let states =
+      try Rules.find name !rules
+      with Not_found ->
+	let l = Loc.start_line loc in
+	let cbegin = Loc.start_off loc - Loc.start_bol loc in
+	let cend = Loc.stop_off loc - Loc.start_bol loc in
+	Printf.eprintf "File %s, line %d, characters %d-%d:Unknown rule %s\n"
+	  (Loc.file_name loc) l cbegin cend name; raise Error
+    in g_states "" states
+  | String(_, s) -> s
+  | Special(loc, spe) -> match spe with
+      | "LIDENT" -> g_lident 3 ""
+      | "UIDENT" -> g_uident 3 ""
+      | "INTEGER" -> string_of_int (Random.int 1000)
+      | _ ->
+	let l = Loc.start_line loc in
+	let cbegin = Loc.start_off loc - Loc.start_bol loc in
+	let cend = Loc.stop_off loc - Loc.start_bol loc in
+	Printf.eprintf "File %s, line %d, characters %d-%d:Unknown special keyword %s\n"
+	  (Loc.file_name loc) l cbegin cend spe; raise Error
+
+and g_tokens res = function
+  | token :: rest -> g_tokens (res ^ (g_token token)) rest
+  | [] -> res
+
+and g_states res states =
+  let max_rand = List.length states in
+  let rand = Random.int (max_rand + 1) in
+  if rand != max_rand then g_tokens res (get_state rand states) else res
+
+let g_rule res =
+  Random.self_init();
+  let max_rand = Rules.cardinal !rules in
+  let rand = Random.int (max_rand + 1) in
+  if rand != max_rand then g_states res (Rules.find !arules.(rand) !rules)
+  else res
+
+let get_test () = g_rule ""

tests/lambda/tests/src/compute.mli

+exception Error
+
+val init : Parse.expr list -> unit
+val get_test : unit -> string

tests/lambda/tests/src/gen_test.ml

+open Printf
+open Parse
+open Camlp4.PreCast
+
+let load_file f =
+  let ic = open_in f in
+  let n = in_channel_length ic in
+  let s = String.create n in
+  really_input ic s 0 n;
+  close_in ic;
+  s;;
+
+let str, file =
+  if Array.length Sys.argv > 1 then load_file Sys.argv.(1), Sys.argv.(1)
+  else (eprintf "Fatal error: No input file\n"; exit 1)
+in
+try
+  let grammar = ExprParser.of_string str file in
+  Compute.init grammar;
+  let ex = Compute.get_test() in
+  printf "%s\n" ex
+with
+  | Compute.Error -> exit 3
+  | Loc.Exc_located (loc, exn) ->
+    let l = Loc.start_line loc in
+    let cbegin = Loc.start_off loc - Loc.start_bol loc in
+    let cend = Loc.stop_off loc - Loc.start_bol loc in
+    eprintf "File %s, line %d, characters %d-%d:\n" (Loc.file_name loc) l
+      cbegin cend; raise exn
+  | e -> eprintf "Runtime error.\n"; raise e

tests/lambda/tests/src/parse.ml

+open Camlp4.PreCast
+
+type expr =
+  | Rule of Loc.t * string * token list list
+and token =
+  | RefRule of Loc.t * string
+  | String of Loc.t * string
+  | Special of Loc.t * string
+
+module ExprParser = struct
+
+  let exp_eoi = Gram.Entry.mk "exp_eoi"
+
+    EXTEND Gram
+    GLOBAL: exp_eoi;
+
+    exp_eoi: [[e = LIST0 expression SEP ";;"; `EOI -> e]];
+
+    expression: [[ x = LIDENT; "="; l = LIST1 (LIST0 token) SEP "|" ->
+    Rule(_loc, x, l) ]];
+
+    token:
+      [
+	"refrule" NONA [ x = LIDENT -> RefRule(_loc, x) ]
+      | "string" NONA [ s = STRING -> String(_loc, s) ]
+      | "special" NONA [ x = UIDENT -> Special(_loc, x) ]
+      ];
+    END;;
+
+  let of_string s file = Gram.parse_string exp_eoi (Loc.mk file) s
+  let of_string_no_file s = Gram.parse_string exp_eoi Loc.ghost s
+end

tests/lambda/tests/src/parse.mli

+open Camlp4.PreCast
+
+type expr =
+  | Rule of Loc.t * string * token list list
+and token =
+  | RefRule of Loc.t * string
+  | String of Loc.t * string
+  | Special of Loc.t * string
+
+module ExprParser : sig
+  val of_string : string -> string -> expr list
+  val of_string_no_file : string -> expr list
+end