Remove dependency on ppx_expect and use alcotest instead

This commit is contained in:
Denis Merigoux 2023-04-21 10:37:31 +02:00
parent f877544368
commit 107ff95dc4
No known key found for this signature in database
GPG Key ID: EE99DCFA365C3EE3
7 changed files with 62 additions and 54 deletions

View File

@ -25,7 +25,6 @@
, zarith_stubs_js
, ocaml-crunch
, cohttp-lwt-unix
, ppx_expect
}:
buildDunePackage {
@ -63,7 +62,6 @@ buildDunePackage {
zarith
zarith_stubs_js
cohttp-lwt-unix
ppx_expect
];
# Currently there is no unit tests in catala and Cram tests are handled by clerk

View File

@ -32,7 +32,6 @@ depends: [
"ocamlfind" {!= "1.9.5"}
"ocamlgraph" {>= "1.8.8"}
"ppx_yojson_conv" {>= "0.14.0"}
"ppx_expect" {>= "0.14.0"}
"re" {>= "1.9.0"}
"sedlex" {>= "2.4"}
"uutf" {>= "1.0.3"}

View File

@ -28,6 +28,11 @@
catala.runtime_ocaml
catala.runtime_jsoo))
(executable
(name tests)
(modules tests)
(libraries catala.driver alcotest))
(rule
(target custom_linking.sexp)
(mode fallback)
@ -54,3 +59,9 @@
(alias
(name catala)
(deps catala.exe))
(rule
(alias runtest)
(package catala)
(action
(run ./tests.exe)))

View File

@ -1,10 +1,9 @@
(library
(name lcalc)
(public_name catala.lcalc)
(libraries bindlib ubase dcalc scopelang catala.runtime_ocaml)
(inline_tests)
(libraries bindlib ubase dcalc scopelang catala.runtime_ocaml alcotest)
(preprocess
(pps visitors.ppx ppx_expect)))
(pps visitors.ppx)))
(documentation
(package catala)

View File

@ -205,23 +205,18 @@ let optimize_program (p : 'm program) : untyped program =
lift_optim peephole_expr;
])
let%expect_test _ =
let test_lcalc_optims1 () =
Cli.call_unstyled (fun _ ->
let x = Var.make "x" in
let enumT = EnumName.fresh ("t", Pos.no_pos) in
let consA = EnumConstructor.fresh ("A", Pos.no_pos) in
let consB = EnumConstructor.fresh ("B", Pos.no_pos) in
let consC = EnumConstructor.fresh ("C", Pos.no_pos) in
let consD = EnumConstructor.fresh ("D", Pos.no_pos) in
let nomark = Untyped { pos = Pos.no_pos } in
let injA = Expr.einj (Expr.evar x nomark) consA enumT nomark in
(* let injB = Expr.einj (Expr.evar x nomark) consB enumT nomark in *)
let injC = Expr.einj (Expr.evar x nomark) consC enumT nomark in
let injD = Expr.einj (Expr.evar x nomark) consD enumT nomark in
let cases : ('a, 't) boxed_gexpr EnumConstructor.Map.t =
EnumConstructor.Map.of_seq
@@ List.to_seq
@ -230,26 +225,20 @@ let%expect_test _ =
consB, Expr.eabs (Expr.bind [| x |] injD) [TAny, Pos.no_pos] nomark;
]
in
let matchA = Expr.ematch injA enumT cases nomark in
Format.printf "before=%a\n"
(Print.expr_debug ~debug:false)
(Expr.unbox matchA);
Format.print_flush ();
Format.printf "after=%a\n"
(Print.expr_debug ~debug:false)
(Expr.unbox (iota_expr (Expr.unbox matchA)));
[%expect
{|
before=match (A x)
with
| A (λ (x: any) C x)
| B (λ (x: any) D x)
after=C
x
|}])
Alcotest.(check string)
"same string"
"before=match (A x)\n\
\ with\n\
\ | A (λ (x: any) C x)\n\
\ | B (λ (x: any) D x)\n\
after=C\n\
x"
(Format.asprintf "before=%a\nafter=%a"
(Print.expr_debug ~debug:false)
(Expr.unbox matchA)
(Print.expr_debug ~debug:false)
(Expr.unbox (iota_expr (Expr.unbox matchA)))))
let cases_of_list l : ('a, 't) boxed_gexpr EnumConstructor.Map.t =
EnumConstructor.Map.of_seq
@ -262,7 +251,7 @@ let cases_of_list l : ('a, 't) boxed_gexpr EnumConstructor.Map.t =
[TAny, Pos.no_pos]
(Untyped { pos = Pos.no_pos }) ))
let%expect_test _ =
let test_lcalc_optims2 () =
Cli.call_unstyled (fun _ ->
let enumT = EnumName.fresh ("t", Pos.no_pos) in
let consA = EnumConstructor.fresh ("A", Pos.no_pos) in
@ -297,25 +286,22 @@ let%expect_test _ =
(cases_of_list [consA, injC; consB, injD])
nomark
in
Format.printf "before=@[%a@]@."
(Print.expr_debug ~debug:false)
(Expr.unbox matchA);
Format.printf "after=%a@."
(Print.expr_debug ~debug:false)
(Expr.unbox (iota2_expr (Expr.unbox matchA)));
[%expect
{|
before=match
(match 1
with
| A (λ (x: any) A 20)
| B (λ (x: any) B B x))
with
| A (λ (x: any) C x)
| B (λ (x: any) D x)
after=match 1
with
| A (λ (x: any) C 20)
| B (λ (x: any) D B x) |}])
Alcotest.(check string)
"same string "
"before=match\n\
\ (match 1\n\
\ with\n\
\ | A (λ (x: any) A 20)\n\
\ | B (λ (x: any) B B x))\n\
\ with\n\
\ | A (λ (x: any) C x)\n\
\ | B (λ (x: any) D x)\n\
after=match 1\n\
\ with\n\
\ | A (λ (x: any) C 20)\n\
\ | B (λ (x: any) D B x)\n"
(Format.asprintf "before=@[%a@]@.after=%a@."
(Print.expr_debug ~debug:false)
(Expr.unbox matchA)
(Print.expr_debug ~debug:false)
(Expr.unbox (iota2_expr (Expr.unbox matchA)))))

View File

@ -43,3 +43,8 @@ open Ast
val optimize_program : 'm program -> Shared_ast.untyped program
(** Warning/todo: no effort was yet made to ensure correct propagation of type
annotations in the typed case *)
(**{1 Tests}*)
val test_lcalc_optims2 : unit -> unit
val test_lcalc_optims1 : unit -> unit

10
compiler/tests.ml Normal file
View File

@ -0,0 +1,10 @@
let _ =
let open Alcotest in
run "Optimizations"
[
( "Lcalc",
[
test_case "#1" `Quick Lcalc.Optimizations.test_lcalc_optims1;
test_case "#2" `Quick Lcalc.Optimizations.test_lcalc_optims2;
] );
]