mirror of
https://github.com/CatalaLang/catala.git
synced 2024-11-08 07:51:43 +03:00
Implement reversing the dependencies for tests
This works for the `--reset` option, but I have some doubts about it.
This commit is contained in:
Louis Gesbert
parent
4cc3bd7e1d
commit
378669b09e
@ -171,7 +171,7 @@ let readdir_sort (dirname : string) : string array =
|
||||
let dirs = Sys.readdir dirname in
|
||||
Array.fast_sort String.compare dirs;
|
||||
dirs
|
||||
with Sys_error _ -> Array.make 0 ""
|
||||
with Sys_error _ -> [||]
|
||||
|
||||
type test = {
|
||||
text_before : string;
|
||||
@ -184,81 +184,148 @@ type test = {
|
||||
}
|
||||
|
||||
type file_tests = {
|
||||
filename : string;
|
||||
tests : test list;
|
||||
text_after : string; (** Verbatim of everything following the last test *)
|
||||
}
|
||||
|
||||
let inline_test_start_key = "```catala-test-inline"
|
||||
(* Matches both test starts and includes; discriminate by checking [Group.get g
|
||||
1], which will be defined only for includes (and equal to the included
|
||||
file) *)
|
||||
let test_scan_rex =
|
||||
let open Re in
|
||||
let inline_test_start_key = str "```catala-test-inline" in
|
||||
let include_regexp =
|
||||
(* TODO: we match on "Inclu*" which will work for now but may not scale to
|
||||
new languages. The reasonable alternative would be to run the appropriate
|
||||
lexer on all files, but it might not yet be worth the added complexity
|
||||
(?) *)
|
||||
seq
|
||||
[
|
||||
char '>';
|
||||
rep1 blank;
|
||||
str "Inclu";
|
||||
rep1 alpha;
|
||||
rep blank;
|
||||
char ':';
|
||||
rep blank;
|
||||
group (rep1 notnl);
|
||||
]
|
||||
in
|
||||
compile
|
||||
(seq [bol; alt [inline_test_start_key; include_regexp]; rep blank; eol])
|
||||
|
||||
let has_inline_tests (file : string) : bool =
|
||||
let checkfile parents file =
|
||||
let file = try Unix.realpath file with Unix.Unix_error _ -> file in
|
||||
if List.mem file parents then
|
||||
Message.raise_error "@[<hv 2>Cyclic file inclusion:@ %a@]"
|
||||
(Format.pp_print_list
|
||||
~pp_sep:(fun ppf () -> Format.fprintf ppf " %a@ " String.format "→")
|
||||
Format.pp_print_string)
|
||||
(List.rev (file :: parents));
|
||||
(file :: parents), file
|
||||
|
||||
let with_in_channel_safe parents file f =
|
||||
try File.with_in_channel file f
|
||||
with Sys_error err ->
|
||||
Message.raise_error "Could not open file %S:@ %s@ %a" file err
|
||||
(Format.pp_print_list ~pp_sep:Format.pp_print_space (fun ppf f ->
|
||||
Format.fprintf ppf "included from %S" f))
|
||||
parents
|
||||
|
||||
let rec has_inline_tests ?(parents = []) (file : string) : bool =
|
||||
let parents, file = checkfile parents file in
|
||||
let rec aux ic =
|
||||
match input_line ic with
|
||||
| exception End_of_file -> false
|
||||
| li -> String.starts_with ~prefix:inline_test_start_key li || aux ic
|
||||
| li -> (
|
||||
match Re.exec_opt test_scan_rex li with
|
||||
| None -> aux ic
|
||||
| Some gr -> (
|
||||
match Re.Group.get_opt gr 1 with
|
||||
| None -> true
|
||||
| Some incl ->
|
||||
let incl_file = File.(Filename.dirname file / incl) in
|
||||
aux ic
|
||||
||
|
||||
(close_in ic;
|
||||
has_inline_tests ~parents incl_file)))
|
||||
in
|
||||
File.with_in_channel file aux
|
||||
with_in_channel_safe parents file aux
|
||||
|
||||
let [@ocamlformat "disable"] scan_for_inline_tests (file : string)
|
||||
: file_tests option =
|
||||
File.with_in_channel file
|
||||
@@ fun ic ->
|
||||
(* Matches something of the form: {v
|
||||
let [@ocamlformat "disable"] rec scan_for_inline_tests ?(parents=[]) (file : string)
|
||||
: file_tests list =
|
||||
let parents, file = checkfile parents file in
|
||||
let read_file ic =
|
||||
(* Matches something of the form: {v
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s A
|
||||
... output from catala ...
|
||||
#return code 10#
|
||||
```
|
||||
v} *)
|
||||
let test_start_rex =
|
||||
Re.(compile (seq [bol; str inline_test_start_key; rep space; char '\n']))
|
||||
in
|
||||
let test_content_rex =
|
||||
Re.compile
|
||||
Re.(
|
||||
seq
|
||||
[
|
||||
seq [char '$'; rep space; str "catala"; group (rep1 notnl);
|
||||
char '\n'];
|
||||
group (non_greedy (rep any));
|
||||
seq [bol; str "```\n"];
|
||||
])
|
||||
in
|
||||
let file_str = really_input_string ic (in_channel_length ic) in
|
||||
let rec scan acc pos0 =
|
||||
try
|
||||
let header = Re.exec ~pos:pos0 test_start_rex file_str in
|
||||
let pos = Re.Group.stop header 0 in
|
||||
let test_contents =
|
||||
try Re.exec ~pos test_content_rex file_str
|
||||
with Not_found ->
|
||||
let line =
|
||||
String.fold_left
|
||||
(fun n -> function '\n' -> n + 1 | _ -> n)
|
||||
1
|
||||
(String.sub file_str 0 pos)
|
||||
$ catala Interpret -s A
|
||||
... output from catala ...
|
||||
#return code 10#
|
||||
```
|
||||
v} *)
|
||||
let test_content_rex =
|
||||
Re.(compile @@
|
||||
seq
|
||||
[
|
||||
seq [char '$'; rep space; str "catala"; group (rep1 notnl);
|
||||
char '\n'];
|
||||
group (non_greedy (rep any));
|
||||
seq [bol; str "```\n"];
|
||||
])
|
||||
in
|
||||
let file_str = really_input_string ic (in_channel_length ic) in
|
||||
let rec scan incls acc pos_scan pos_block =
|
||||
try
|
||||
let scan_grp = Re.exec ~pos:pos_scan test_scan_rex file_str in
|
||||
let pos = Re.Group.stop scan_grp 0 in
|
||||
match Re.Group.get_opt scan_grp 1 with
|
||||
| Some incl ->
|
||||
let incl_file = File.(Filename.dirname file / incl) in
|
||||
scan (incl_file::incls) acc (Re.Group.stop scan_grp 0) pos_block
|
||||
| None ->
|
||||
let test_contents =
|
||||
try Re.exec ~pos test_content_rex file_str
|
||||
with Not_found ->
|
||||
let line =
|
||||
String.fold_left
|
||||
(fun n -> function '\n' -> n + 1 | _ -> n)
|
||||
1
|
||||
(String.sub file_str 0 pos)
|
||||
in
|
||||
Message.raise_error "Bad inline-test format at %s line %d" file line
|
||||
in
|
||||
Message.raise_error "Bad inline-test format at %s line %d" file line
|
||||
in
|
||||
let params =
|
||||
List.filter (( <> ) "")
|
||||
(String.split_on_char ' ' (Re.Group.get test_contents 1))
|
||||
in
|
||||
let out_start = Re.Group.start test_contents 2 in
|
||||
let test =
|
||||
{ text_before = String.sub file_str pos0 (out_start - pos0); params }
|
||||
in
|
||||
scan (test :: acc) (Re.Group.stop test_contents 2)
|
||||
with Not_found -> (
|
||||
match acc with
|
||||
| [] -> None
|
||||
| tests ->
|
||||
Some
|
||||
{
|
||||
tests = List.rev tests;
|
||||
text_after = String.sub file_str pos0 (String.length file_str - pos0);
|
||||
})
|
||||
let params =
|
||||
List.filter (( <> ) "")
|
||||
(String.split_on_char ' ' (Re.Group.get test_contents 1))
|
||||
in
|
||||
let out_start = Re.Group.start test_contents 2 in
|
||||
let test =
|
||||
{ text_before = String.sub file_str pos_block (out_start - pos_block);
|
||||
params }
|
||||
in
|
||||
let pos_next = Re.Group.stop test_contents 2 in
|
||||
scan incls (test :: acc) pos_next pos_next
|
||||
with Not_found -> (
|
||||
match acc with
|
||||
| [] -> List.rev incls, []
|
||||
| tests ->
|
||||
List.rev incls,
|
||||
[{
|
||||
filename = file;
|
||||
tests = List.rev tests;
|
||||
text_after =
|
||||
String.sub file_str pos_block
|
||||
(String.length file_str - pos_block);
|
||||
}])
|
||||
in
|
||||
scan [] [] 0 0
|
||||
in
|
||||
scan [] 0
|
||||
let incls, tests = with_in_channel_safe parents file read_file in
|
||||
List.fold_left (fun tests incfile ->
|
||||
List.rev_append (scan_for_inline_tests ~parents incfile) tests)
|
||||
(List.rev tests) incls
|
||||
|> List.rev
|
||||
|
||||
(** Given a file, looks in the relative [output] directory if there are files
|
||||
with the same base name that contain expected outputs for different *)
|
||||
@ -617,9 +684,13 @@ let run_inline_tests
|
||||
(catala_exe : string)
|
||||
(catala_opts : string list) =
|
||||
match scan_for_inline_tests file with
|
||||
| None -> Message.emit_warning "No inline tests found in %s" file
|
||||
| Some file_tests ->
|
||||
let run oc =
|
||||
| [] -> Message.emit_warning "No inline tests found in %s" file
|
||||
| file_tests ->
|
||||
Message.emit_debug "@[<v 2>Running tests:@ %a@]"
|
||||
(Format.pp_print_list (fun ppf t -> Format.fprintf ppf "- @[<hov>%s:@ %d tests@]"
|
||||
t.filename (List.length t.tests)))
|
||||
file_tests;
|
||||
let run test oc =
|
||||
List.iter
|
||||
(fun test ->
|
||||
output_string oc test.text_before;
|
||||
@ -664,18 +735,21 @@ let run_inline_tests
|
||||
in
|
||||
if return_code <> 0 then
|
||||
Printf.fprintf oc "#return code %d#\n" return_code)
|
||||
file_tests.tests;
|
||||
output_string oc file_tests.text_after;
|
||||
test.tests;
|
||||
output_string oc test.text_after;
|
||||
flush oc
|
||||
in
|
||||
if reset then (
|
||||
let out = file ^ ".out" in
|
||||
(try File.with_out_channel out run
|
||||
with e ->
|
||||
Sys.remove out;
|
||||
raise e);
|
||||
Sys.rename out file)
|
||||
else run stdout
|
||||
List.iter
|
||||
(fun test ->
|
||||
if reset then (
|
||||
let out = test.filename ^ ".out" in
|
||||
(try File.with_out_channel out (run test)
|
||||
with e ->
|
||||
Sys.remove out;
|
||||
raise e);
|
||||
Sys.rename out test.filename)
|
||||
else run test stdout)
|
||||
file_tests
|
||||
|
||||
(**{1 Running}*)
|
||||
|
||||
|
||||
@ -9,16 +9,16 @@ CLERK=_build/default/build_system/clerk.exe --exe "_build/default/compiler/catal
|
||||
################################
|
||||
|
||||
pass_all_tests:
|
||||
@cd ..;OCAMLRUNPARAM= $(CLERK) examples
|
||||
@cd ..; $(CLERK) examples
|
||||
|
||||
reset_all_tests: CLERK_OPTS+=--reset
|
||||
reset_all_tests:
|
||||
@cd ..;OCAMLRUNPARAM= $(CLERK) examples
|
||||
@cd ..; $(CLERK) examples
|
||||
|
||||
%.catala_en %.catala_fr %.catala_pl: .FORCE
|
||||
# Here we cd to the root of the Catala repository such that the paths \
|
||||
# displayed in error messages start with `examples/` uniformly.
|
||||
@cd ..;OCAMLRUNPARAM= $(CLERK) examples/$@
|
||||
@cd ..; $(CLERK) examples/$@
|
||||
|
||||
.FORCE:
|
||||
|
||||
|
||||
@ -17,8 +17,8 @@ CLERK=_build/default/build_system/clerk.exe --exe "_build/default/compiler/catal
|
||||
@cd ..; $(CLERK) tests/$@
|
||||
|
||||
pass_all_tests:
|
||||
@cd ..;OCAMLRUNPARAM= $(CLERK) tests
|
||||
@cd ..; $(CLERK) tests
|
||||
|
||||
reset_all_tests: CLERK_OPTS+=--reset
|
||||
reset_all_tests:
|
||||
@cd ..;OCAMLRUNPARAM= $(CLERK) tests
|
||||
@cd ..; $(CLERK) tests
|
||||
|
||||
Loading…
Reference in New Issue
Block a user