diff --git a/build_system/clerk_driver.ml b/build_system/clerk_driver.ml index 5e6ea162..ec3c983a 100644 --- a/build_system/clerk_driver.ml +++ b/build_system/clerk_driver.ml @@ -196,6 +196,11 @@ type catala_build_item = { let catala_suffix_regex = Re.(compile (seq [str ".catala_"; group (seq [alpha; alpha]); eos])) +let test_command_re = + let open Re in + compile @@ + seq [bos; char '$'; rep space; str "catala"; rep space; group (rep1 notnl); char '\n'] + let scan_catala_file (file : File.t) (lang : Cli.backend_lang) : catala_build_item = let module L = Surface.Lexer_common in @@ -226,15 +231,17 @@ let scan_catala_file (file : File.t) (lang : Cli.backend_lang) : cmd = [] } in let err n = - [Format.asprintf "" File.format file n] + [Format.asprintf "'invalid test syntax at %a:%d'" File.format file n] in match Seq.uncons lines with - | Some ((str, L.LINE_ANY), lines) - when String.starts_with ~prefix:"catala " str -> - let cmd = String.trim (String.remove_prefix ~prefix:"catala " str) in - let cmd, lines, n = parse_block lines (n+1) [cmd] in - { test with cmd = List.flatten (List.map (String.split_on_char ' ') cmd) }, - lines, (n+1) + | Some ((str, L.LINE_ANY), lines) -> + (match Re.exec_opt test_command_re str with + | Some args_grp -> + let cmd = String.trim (Re.Group.get args_grp 1) in + let cmd, lines, n = parse_block lines (n+1) [cmd] in + { test with cmd = List.flatten (List.map (String.split_on_char ' ') cmd) }, + lines, (n+1) + | None -> { test with cmd = err n}, lines, n+1) | Some (_, lines) -> { test with cmd = err n}, lines, n+1 | None -> @@ -569,10 +576,11 @@ let gen_build_statements (item: catala_build_item) : Nj.ninja = let vars = vars @ [ Var.test_id, [test.id]; Var.test_command, test.cmd; - Var.test_out, [Filename.dirname src / Filename.basename src -.- "out" / !Var.test_id]; + Var.test_out, [src /../ "output" / Filename.basename src -.- test.id]; ] in Nj.build "out-test" ~inputs ~implicit_in ~outputs:["outtest@"^src^"@"^test.id] ~vars :: - Nj.build "out-reset" ~inputs ~implicit_in ~outputs:["outtest-reset@"^src^"@"^test.id] ~implicit_out:[!Var.test_out] ~vars :: + Nj.build "out-reset" ~inputs ~implicit_in ~outputs:[!Var.test_out] + ~implicit_out:["outtest-reset@"^src^"@"^test.id] ~vars :: acc ) [] item.legacy_tests diff --git a/build_system/clerk_runtest.ml b/build_system/clerk_runtest.ml index fc77fdf1..9e2b0e94 100644 --- a/build_system/clerk_runtest.ml +++ b/build_system/clerk_runtest.ml @@ -114,7 +114,7 @@ let [@ocamlformat "disable"] rec scan_for_inline_tests Re.(compile @@ seq [ - seq [char '$'; rep space; str "catala"; group (rep1 notnl); + seq [char '$'; rep space; str "catala"; rep space; group (rep1 notnl); char '\n']; group (non_greedy (rep any)); seq [bol; str "```\n"]; diff --git a/compiler/surface/lexer.cppo.ml b/compiler/surface/lexer.cppo.ml index 38e0f8a5..67c7a64c 100644 --- a/compiler/surface/lexer.cppo.ml +++ b/compiler/surface/lexer.cppo.ml @@ -820,14 +820,17 @@ let line_dir_arg_re = let lex_line (lexbuf : lexbuf) : (string * L.line_token) option = match%sedlex lexbuf with | eof -> None - | "```catala-test", hspace, Star (Compl '\n'), ('\n' | eof) -> + | "```catala-test-inline", Star hspace, ('\n' | eof) -> + Some (Utf8.lexeme lexbuf, LINE_INLINE_TEST) + | "```catala-test", Star (Compl '\n'), ('\n' | eof) -> let str = Utf8.lexeme lexbuf in (try let id = Re.Group.get (Re.exec line_test_id_re str) 1 in Some (str, LINE_TEST id) - with Not_found -> Some (str, LINE_ANY)) - | "```catala-test-inline", Star hspace, ('\n' | eof) -> - Some (Utf8.lexeme lexbuf, LINE_INLINE_TEST) + with Not_found -> + Message.emit_spanned_warning (Pos.from_lpos (lexing_positions lexbuf)) + "Ignored invalid test section, must have an explicit `{ id = \"name\" }` specification"; + Some (str, LINE_ANY)) | "```", Star hspace, ('\n' | eof) -> Some (Utf8.lexeme lexbuf, LINE_BLOCK_END) | '>', Star hspace, MR_LAW_INCLUDE, Star hspace, ':', Plus (Compl '\n'), ('\n' | eof) -> diff --git a/tests/test_modules/good/mod_def.catala_en b/tests/test_modules/good/mod_def.catala_en index 4313e178..5fba6c5b 100644 --- a/tests/test_modules/good/mod_def.catala_en +++ b/tests/test_modules/good/mod_def.catala_en @@ -27,3 +27,7 @@ scope S: $ catala typecheck --disable_warnings [RESULT] Typechecking successful! ``` + +```catala-test { id="ml" } +$ catala ocaml --disable_warnings -o - +``` diff --git a/tests/test_modules/good/output/mod_def.ml b/tests/test_modules/good/output/mod_def.ml new file mode 100644 index 00000000..a31a196e --- /dev/null +++ b/tests/test_modules/good/output/mod_def.ml @@ -0,0 +1,52 @@ + +(** This file has been generated by the Catala compiler, do not edit! *) + +open Runtime_ocaml.Runtime + +[@@@ocaml.warning "-4-26-27-32-41-42"] + +module Enum1 = struct + type t = + | Yes of unit + | No of unit + | Maybe of unit + end + +module S = struct + type t = {sr: money; e1: Enum1.t} +end + +module S_in = struct + type t = unit +end + + + +let s (s_in: S_in.t) : S.t = + let sr_: money = + try + (handle_default + {filename = ""; start_line=0; start_column=1; + end_line=0; end_column=1; law_headings=[]} ([||]) + (fun (_: unit) -> true) + (fun (_: unit) -> money_of_cents_string "100000")) + with + EmptyError -> (raise (NoValueProvided + {filename = "tests/test_modules/good/mod_def.catala_en"; start_line=12; + start_column=10; end_line=12; end_column=12; + law_headings=["Test modules + inclusions 1"]})) in + let e1_: Enum1.t = + try + (handle_default + {filename = ""; start_line=0; start_column=1; + end_line=0; end_column=1; law_headings=[]} ([||]) + (fun (_: unit) -> true) (fun (_: unit) -> Enum1.Maybe ())) + with + EmptyError -> (raise (NoValueProvided + {filename = "tests/test_modules/good/mod_def.catala_en"; start_line=13; + start_column=10; end_line=13; end_column=12; + law_headings=["Test modules + inclusions 1"]})) in + {S.sr = sr_; S.e1 = e1_} + +let half_ : integer -> decimal = + fun (x_: integer) -> o_div_int_int x_ (integer_of_string "2")