unikernel/duniverse/ppxlib/test/patterns_as_and_drop/dune

@@ -0,0 +1,14 @@
+(rule
+ (package ppxlib)
+ (alias runtest)
+ (enabled_if
+  (>= %{ocaml_version} "4.10.0"))
+ (deps
+  (:test test.ml)
+  (package ppxlib))
+ (action
+  (chdir
+   %{project_root}
+   (progn
+    (run expect-test %{test})
+    (diff? %{test} %{test}.corrected)))))

unikernel/duniverse/ppxlib/test/patterns_as_and_drop/test.ml

@@ -0,0 +1,127 @@
+[@@@ocamlformat "disable"]
+
+open Ppxlib
+
+(* Simple demo without [as__] and [drop] *)
+let ___1 =
+  let loc = Location.none in
+  let ast = [%expr List.length xs = 0] in
+  let pat =
+    let open Ast_pattern in
+    let length () =
+      pexp_apply
+        (pexp_ident (ldot (lident (string "List")) (string "length")))
+        ((nolabel ** __) ^:: nil)
+    in
+    let zero () = pexp_constant (pconst_integer (string "0") none) in
+
+    pexp_apply
+      (pexp_ident (lident (string "=")))
+      ((nolabel ** length ()) ^:: (nolabel ** zero ()) ^:: nil)
+  in
+
+  Ast_pattern.parse pat loc ast
+    ~on_error:(fun () -> "Error")
+    (fun _length_argument -> "Success. As expected")
+
+[%%expect{|
+val ___1 : string = "Success. As expected"
+|}]
+
+(* We could use [as__] to capture whole [List.length ...] expression,
+   and use [drop] to ignore length's argument *)
+let ___2 =
+  let loc = Location.none in
+  let ast = [%expr List.length xs = 0] in
+
+  let pat =
+    let open Ast_pattern in
+    let length () =
+      as__
+        (pexp_apply
+           (pexp_ident (ldot (lident (string "List")) (string "length")))
+           ((nolabel ** drop) ^:: nil))
+    in
+    let zero () = as__ (pexp_constant (pconst_integer (string "0") none)) in
+
+    pexp_apply
+      (pexp_ident (lident (string "=")))
+      ((nolabel ** length ()) ^:: (nolabel ** zero ()) ^:: nil)
+  in
+
+  Ast_pattern.parse pat loc ast
+    ~on_error:(fun () -> "error")
+    (fun l r ->
+      Format.asprintf "Success with '%a' and '%a'. As expected" Pprintast.expression l Pprintast.expression r
+      )
+
+[%%expect{|
+val ___2 : string = "Success with 'List.length xs' and '0'. As expected"
+|}]
+
+(* Pitfall. If we forget unit argument and will use [as__], the success case
+   will be fired before the error case. *)
+let ___3 =
+  let loc = Location.none in
+  let ast = [%expr 1] in
+
+  let pat () =
+    let open Ast_pattern in
+    as__ (pexp_constant (pconst_integer (string "0") none))
+  in
+  let rez = Buffer.create 100 in
+  Ast_pattern.parse (pat ()) loc ast
+    ~on_error:(fun () -> Printf.bprintf rez "An error")
+    (fun zero_expr -> Buffer.add_string rez
+      (Format.asprintf "Successfully got '%a' but error right after that (NOT EXPECTED). " Pprintast.expression zero_expr));
+  Buffer.contents rez
+
+[%%expect{|
+val ___3 : string =
+  "Successfully got '1' but error right after that (NOT EXPECTED). An error"
+|}]
+
+(* To avoid the pitfall above we could add extra () to delay evaluation *)
+let ___4 =
+  let loc = Location.none in
+  let ast = [%expr 1] in
+
+  let pat () =
+    let open Ast_pattern in
+    as__ (pexp_constant (pconst_integer (string "0") none))
+  in
+  Ast_pattern.parse (pat ()) loc ast
+    ~on_error:(fun () () -> "Error, as expected")
+    (fun _zero_expr () -> "Success and error after that\n%!")
+    ()
+
+[%%expect{|
+val ___4 : string = "Error, as expected"
+|}]
+
+(* But this pitfall is not introduced by [as__], it existed before too. *)
+let ___5 =
+  let loc = Location.none in
+  let ast = [%expr string_of_int 43] in
+  let pat =
+    let open Ast_pattern in
+    pexp_apply
+      (pexp_ident (lident __))
+      ((nolabel ** eint (int 42)) ^::
+       (nolabel ** (pexp_ident (lident __))) ^::
+       nil)
+  in
+
+  let b = Buffer.create 10 in
+  let () = Ast_pattern.parse pat loc ast
+    ~on_error:(fun () -> Buffer.add_string b "It's an error")
+    (fun s ->
+        Printf.bprintf b "Partial success with '%s', but actually not, because... " s;
+        (fun _ -> Printf.bprintf b "no, it's total success"))
+    in
+  Buffer.contents b
+
+[%%expect{|
+val ___5 : string =
+  "Partial success with 'string_of_int', but actually not, because... It's an error"
+|}]