Commit ae56a9e0 authored by Julien Lopez's avatar Julien Lopez
Browse files

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

parent 9d95ac98
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]+ *)
......@@ -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)
......@@ -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
......
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
<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)
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 ""
exception Error
val init : Parse.expr list -> unit
val get_test : unit -> string
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
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
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
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment