unikernel/duniverse/ocaml-cstruct/ppx_test/basic.expected

@@ -0,0 +1,15 @@
+deadbeef deadbeef
+foo = {
+  a = 0x7
+  b = 0x2c
+  c = 0xbeef
+  d = <buffer uint8_t[8] d>
+61 62 63 64 65 66 67 68
+
+}
+"\007\000,\000\000\190\239abcdefgh"
+with_ignored_field = {
+  a = 0x1
+  c = 0x3
+
+}

unikernel/duniverse/ocaml-cstruct/ppx_test/basic.ml

@@ -0,0 +1,191 @@
+(*
+ * Copyright (c) 2016 Hannes Mehnert <hannes@mehnert.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+[%%cstruct
+type foo = {
+  a : uint8_t;
+  b : uint16_t;
+  c : uint32_t;
+  d : uint8_t [@len 8]
+} [@@big_endian]
+]
+
+[%%cstruct
+type bar = {
+  a : uint8_t;
+  b : uint16_t;
+  c : uint32_t;
+  d : uint8_t [@len 8]
+} [@@big_endian]
+]
+
+[%%cstruct
+type lbar = {
+  a : uint8_t;
+  b : uint16_t;
+  c : uint32_t;
+  d : uint8_t [@len 8]
+} [@@little_endian]
+]
+
+(* see #72
+[%%cstruct
+type hbar = {
+  a : uint8_t;
+  b : uint16_t;
+  c : uint32_t;
+  d : uint8_t [@len 8]
+} [@@host_endian]
+]
+*)
+
+[%%cstruct
+type bibar = {
+  a : uint8_t;
+  b : uint16_t;
+  c : uint32_t;
+  d : uint8_t [@len 8]
+} [@@bi_endian]
+]
+
+(** This should not emit any warnings *)
+[%%cstruct
+type unused = {
+  a : uint8_t;
+  b : uint16_t;
+  c : uint32_t;
+  d : uint8_t;
+  e : uint8_t; [@len 16]
+} [@@big_endian]
+]
+
+let set_with_ignored_field__b = true
+
+let _ : bool = set_with_ignored_field__b
+
+[%%cstruct
+type with_ignored_field = {
+  a : uint8_t;
+  _b : uint8_t;
+  c : uint8_t;
+} [@@little_endian]
+]
+
+let _ : bool = set_with_ignored_field__b
+
+(** This should not emit any warnings either *)
+[%%cenum
+type unused_cenum =
+  | DROPPED [@id 0xfffe]
+  | ERROR   [@id 0xffff]
+  | OKAY    [@id 0]
+  | NULL    [@id 1]
+  [@@int16_t] [@@sexp]
+]
+
+(** Duplicate _ fields are OK *)
+[%%cstruct
+type with_several_ignored =
+{ x : int8_t
+; _y : int8_t
+; z : int8_t
+; _y : int8_t
+} [@@little_endian]
+]
+
+let tests () =
+  (* Test basic set/get functions *)
+  let be = Cstruct.of_bigarray (Bigarray.(Array1.create char c_layout sizeof_foo)) in
+  for i = 0 to 255 do
+    set_bar_a be i;
+    assert(get_bar_a be = i)
+  done;
+  let le = Cstruct.of_bigarray (Bigarray.(Array1.create char c_layout sizeof_bar)) in
+  for i = 0 to 255 do
+    set_foo_a le i;
+    assert(get_foo_a le = i)
+  done;
+  let bibe = Cstruct.of_bigarray (Bigarray.(Array1.create char c_layout BE.sizeof_bibar)) in
+  for i = 0 to 255 do
+    BE.set_bibar_a bibe i;
+    assert(BE.get_bibar_a bibe = i)
+  done;
+  let bile = Cstruct.of_bigarray (Bigarray.(Array1.create char c_layout LE.sizeof_bibar)) in
+  for i = 0 to 255 do
+    LE.set_bibar_a bile i;
+    assert(LE.get_bibar_a bile = i)
+  done;
+  let be = Cstruct.of_bigarray (Bigarray.(Array1.create char c_layout sizeof_foo)) in
+  for i = 0 to 65535 do
+    set_bar_b be i;
+    assert(get_bar_b be = i)
+  done;
+  let le = Cstruct.of_bigarray(Bigarray.(Array1.create char c_layout sizeof_bar)) in
+  for i = 0 to 65535 do
+    set_foo_b le i;
+    assert(get_foo_b le = i)
+  done;
+  let bibe = Cstruct.of_bigarray (Bigarray.(Array1.create char c_layout BE.sizeof_bibar)) in
+  for i = 0 to 65535 do
+    BE.set_bibar_a bibe i;
+    assert(BE.get_bibar_a bibe = i mod 256)
+  done;
+  let bile = Cstruct.of_bigarray (Bigarray.(Array1.create char c_layout LE.sizeof_bibar)) in
+  for i = 0 to 65535 do
+    LE.set_bibar_a bile i;
+    assert(LE.get_bibar_a bile = i mod 256)
+  done;
+  let be = Cstruct.of_bigarray (Bigarray.(Array1.create char c_layout sizeof_foo)) in
+  let rec fn = function
+   |i when i < 0l -> ()
+   |i ->
+      set_bar_c be i;
+      assert(get_bar_c be = i);
+      fn (Int32.sub i 0x10l)
+  in fn 0xffffffff_l;
+  let le = Cstruct.of_bigarray (Bigarray.(Array1.create char c_layout sizeof_bar)) in
+  let rec fn = function
+   |i when i < 0l -> ()
+   |i ->
+      set_foo_c le i;
+      assert(get_foo_c le = i);
+      fn (Int32.sub i 0x10l)
+  in fn 0xffffffff_l;
+  (* Get/set buffers and blits *)
+  let s1 = "deadbeef" in
+  set_foo_d s1 0 be;
+  assert(copy_foo_d be = s1);
+  let sb1 = get_foo_d be in
+  blit_bar_d sb1 0 le;
+  assert(copy_bar_d le = s1);
+  Printf.printf "%s %s\n" (copy_foo_d be) (copy_bar_d le);
+  (* Create sub-view and shift it back *)
+  let be = Cstruct.of_bigarray (Bigarray.(Array1.create char c_layout sizeof_foo)) in
+  set_foo_a be 7;
+  set_foo_b be 44;
+  set_foo_c be 0xbeef_l;
+  set_foo_d "abcdefgh" 0 be;
+  (* get a subview *)
+  let be2 = Cstruct.shift be 3 in
+  assert(Cstruct.BE.get_uint32 be2 0 = 0xbeef_l);
+  assert(Cstruct.BE.get_uint32 be 3 = 0xbeef_l);
+  assert(get_foo_b be = 44);
+  assert(get_foo_a be = 7);
+  hexdump_foo be;
+  print_endline (Sexplib.Sexp.to_string_hum (Cstruct_sexp.sexp_of_t be));
+  hexdump_with_ignored_field (Cstruct.of_hex "010203")
+
+let () = tests ()

unikernel/duniverse/ocaml-cstruct/ppx_test/dune

@@ -0,0 +1,7 @@
+(tests
+ (names pcap basic enum)
+ (deps http.cap)
+ (libraries cstruct-unix sexplib cstruct-sexp)
+ (preprocess
+  (pps ppx_cstruct))
+ (package ppx_cstruct))

unikernel/duniverse/ocaml-cstruct/ppx_test/enum.ml

@@ -0,0 +1,95 @@
+(*
+ * Copyright (c) 2016 Hannes Mehnert <hannes@mehnert.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+[%%cenum
+type foo64 =
+  | ONE64
+  | TWO64
+  | THREE64
+  [@@uint64_t] [@@sexp]
+]
+
+[%%cenum
+type bar64 =
+  | ONE64
+  | TWO64 [@id 0xfffffffffffffffeL]
+  | THREE64
+  [@@uint64_t] [@@sexp]
+]
+
+[%%cenum
+type foo32 =
+  | ONE32
+  | TWO32 [@id 0xfffffffel]
+  | THREE32
+  [@@uint32_t]
+]
+
+[%%cenum
+type bar16 =
+  | ONE [@id 1]
+  | TWO
+  | FOUR [@id 4]
+  | FIVE
+  [@@uint16_t]
+]
+
+[%%cenum
+type foo16 =
+  | ONE16
+  | TWO16
+  | THREE16
+  [@@uint16_t]
+]
+
+[%%cenum
+type foo8 =
+  | ONE8
+  | TWO8
+  | THREE8
+  [@@uint8_t]
+]
+
+[%%cenum
+type reversed =
+  | ONE_R [@id 2]
+  | TWO_R [@id 1]
+  [@@uint8_t]
+]
+
+let tests () =
+  ignore(int_to_foo64 2L);
+  ignore(int_to_foo32 1l);
+  ignore(int_to_foo16 1);
+  ignore(int_to_foo8 1);
+  ignore(foo64_to_int ONE64);
+  ignore(foo32_to_int ONE32);
+  ignore(foo16_to_int ONE16);
+  ignore(foo8_to_int ONE8);
+  assert(bar16_to_int FOUR = 4);
+  assert(bar16_to_int FIVE = 5);
+  assert(foo32_to_int TWO32   = 0xfffffffel);
+  assert(foo32_to_int THREE32 = 0xffffffffl);
+  assert(int_to_foo32 0xfffffffel = Some (TWO32));
+  assert(int_to_foo32 0xffffffffl = Some (THREE32));
+  assert(string_to_foo16 "ONE16" = Some ONE16);
+  assert(foo8_to_string ONE8 = "ONE8");
+  assert(compare_foo8 ONE8 TWO8 = -1);
+  assert(compare_foo8 TWO8 ONE8 = 1);
+  assert(compare_foo8 TWO8 TWO8 = 0);
+  assert(compare_reversed ONE_R TWO_R = 1)
+
+let () = tests ()

unikernel/duniverse/ocaml-cstruct/ppx_test/errors/README.md

@@ -0,0 +1,15 @@
+This tests error cases for `ppx_cstruct`.
+
+It only deals with the errors raised by the ppx itself (such as when the type is
+not supported), not errors in the generated code.
+
+To add a test case:
+
+- create a file in this directory named `something.ml` with the error case
+- create an empty file named `something.ml.expected`
+- don't forget to add these files to git
+- run `dune runtest`: it displays a diff on `dune.inc`
+- run `dune promote`: it updates `dune.inc` with the generated test case
+- run `dune runtest`: it runs the test and displays a diff against the empty
+  expected output
+- run `dune promote`: it updates `something.ml.expected`

unikernel/duniverse/ocaml-cstruct/ppx_test/errors/cenum_id_payload.ml

@@ -0,0 +1,4 @@
+[%%cenum
+  type t = A [@id ""]
+  [@@uint8_t]
+]

unikernel/duniverse/ocaml-cstruct/ppx_test/errors/cenum_id_payload.ml.expected

@@ -0,0 +1 @@
+Error: ppx_cstruct: invalid id

unikernel/duniverse/ocaml-cstruct/ppx_test/errors/cenum_invalid_type.ml

@@ -0,0 +1,4 @@
+[%%cenum
+  type t = A of int
+  [@@uint8_t]
+]

unikernel/duniverse/ocaml-cstruct/ppx_test/errors/cenum_invalid_type.ml.expected

@@ -0,0 +1 @@
+Error: ppx_cstruct: invalid cenum variant

unikernel/duniverse/ocaml-cstruct/ppx_test/errors/cenum_no_attribute.ml

@@ -0,0 +1,4 @@
+[%%cenum
+  type t =
+    | A
+]

unikernel/duniverse/ocaml-cstruct/ppx_test/errors/cenum_no_attribute.ml.expected

@@ -0,0 +1 @@
+Error: ppx_cstruct: invalid cenum attributes

unikernel/duniverse/ocaml-cstruct/ppx_test/errors/cenum_not_a_variant.ml

@@ -0,0 +1,5 @@
+[%%cenum
+  type t =
+    { x : uint8_t
+    }
+]

unikernel/duniverse/ocaml-cstruct/ppx_test/errors/cenum_not_a_variant.ml.expected

@@ -0,0 +1 @@
+Error: ppx_cstruct: expected variant type

unikernel/duniverse/ocaml-cstruct/ppx_test/errors/cenum_unknown_attribute.ml

@@ -0,0 +1,5 @@
+[%%cenum
+  type t =
+    | A
+  [@@uint9_t]
+]

unikernel/duniverse/ocaml-cstruct/ppx_test/errors/cenum_unknown_attribute.ml.expected

@@ -0,0 +1 @@
+Error: ppx_cstruct: enum: unknown width specifier uint9_t

unikernel/duniverse/ocaml-cstruct/ppx_test/errors/cstruct_attribute_payload.ml

@@ -0,0 +1,6 @@
+[%%cstruct
+  type t =
+    { a : uint8_t
+    }
+  [@@little_endian ""]
+]

unikernel/duniverse/ocaml-cstruct/ppx_test/errors/cstruct_attribute_payload.ml.expected

@@ -0,0 +1 @@
+Error: ppx_cstruct: no attribute payload expected

unikernel/duniverse/ocaml-cstruct/ppx_test/errors/cstruct_duplicate_field.ml

@@ -0,0 +1,7 @@
+[%%cstruct
+type dup = {
+  x : uint8_t;
+  y : uint8_t;
+  x : uint8_t;
+} [@@little_endian]
+]

unikernel/duniverse/ocaml-cstruct/ppx_test/errors/cstruct_duplicate_field.ml.expected

@@ -0,0 +1 @@
+Error: ppx_cstruct: field x is present several times in this type

unikernel/duniverse/ocaml-cstruct/ppx_test/errors/cstruct_len_int32.ml

@@ -0,0 +1,6 @@
+[%%cstruct
+  type t = {
+    a: uint8_t [@len 8l]
+  }
+  [@@little_endian]
+]

unikernel/duniverse/ocaml-cstruct/ppx_test/errors/cstruct_len_int32.ml.expected

@@ -0,0 +1 @@
+Error: ppx_cstruct: [@len] argument should be an integer

unikernel/duniverse/ocaml-cstruct/ppx_test/errors/cstruct_len_not_int.ml

@@ -0,0 +1,6 @@
+[%%cstruct
+  type t = {
+    a: uint8_t [@len ""]
+  }
+  [@@little_endian]
+]

unikernel/duniverse/ocaml-cstruct/ppx_test/errors/cstruct_len_not_int.ml.expected

@@ -0,0 +1 @@
+Error: ppx_cstruct: [@len] argument should be an integer

unikernel/duniverse/ocaml-cstruct/ppx_test/errors/cstruct_len_zero.ml

@@ -0,0 +1,6 @@
+[%%cstruct
+  type t = {
+    a: uint8_t [@len 0]
+  }
+  [@@little_endian]
+]

unikernel/duniverse/ocaml-cstruct/ppx_test/errors/cstruct_len_zero.ml.expected

@@ -0,0 +1 @@
+Error: ppx_cstruct: [@len] argument should be > 0

unikernel/duniverse/ocaml-cstruct/ppx_test/errors/cstruct_multiple_len.ml

@@ -0,0 +1,6 @@
+[%%cstruct
+  type t = {
+    a : (uint8_t [@len 2]) [@len 3]
+  }
+  [@@little_endian]
+]

unikernel/duniverse/ocaml-cstruct/ppx_test/errors/cstruct_multiple_len.ml.expected

@@ -0,0 +1 @@
+Error: ppx_cstruct: multiple field length attribute

unikernel/duniverse/ocaml-cstruct/ppx_test/errors/cstruct_not_a_record.ml

@@ -0,0 +1,3 @@
+[%%cstruct
+  type t = int
+]

unikernel/duniverse/ocaml-cstruct/ppx_test/errors/cstruct_not_a_record.ml.expected

@@ -0,0 +1 @@
+Error: ppx_cstruct: record type declaration expected

unikernel/duniverse/ocaml-cstruct/ppx_test/errors/cstruct_not_an_identifier.ml

@@ -0,0 +1,6 @@
+[%%cstruct
+  type t = {
+    a : uint8_t list
+  }
+  [@@little_endian]
+]

unikernel/duniverse/ocaml-cstruct/ppx_test/errors/cstruct_not_an_identifier.ml.expected

@@ -0,0 +1 @@
+Error: ppx_cstruct: type identifier expected

unikernel/duniverse/ocaml-cstruct/ppx_test/errors/cstruct_several_attributes.ml

@@ -0,0 +1,7 @@
+[%%cstruct
+  type t =
+    { a : uint8_t
+    }
+  [@@little_endian]
+  [@@other_attr]
+]

unikernel/duniverse/ocaml-cstruct/ppx_test/errors/cstruct_several_attributes.ml.expected

@@ -0,0 +1 @@
+Error: ppx_cstruct: too many attributes

unikernel/duniverse/ocaml-cstruct/ppx_test/errors/cstruct_unknown_endian.ml

@@ -0,0 +1,6 @@
+[%%cstruct
+  type t =
+  { a : uint8_t
+  }
+[@@unknown_endian]
+]

unikernel/duniverse/ocaml-cstruct/ppx_test/errors/cstruct_unknown_endian.ml.expected

@@ -0,0 +1 @@
+Error: ppx_cstruct: unknown endian unknown_endian, should be little_endian, big_endian, host_endian or bi_endian

unikernel/duniverse/ocaml-cstruct/ppx_test/errors/cstruct_unknown_type.ml

@@ -0,0 +1,6 @@
+[%%cstruct
+  type t =
+  { a : uint9_t
+  }
+[@@little_endian]
+]

unikernel/duniverse/ocaml-cstruct/ppx_test/errors/cstruct_unknown_type.ml.expected

@@ -0,0 +1 @@
+Error: ppx_cstruct: Unknown type uint9_t

unikernel/duniverse/ocaml-cstruct/ppx_test/errors/dune

@@ -0,0 +1,27 @@
+(executable
+ (name pp)
+ (modules pp)
+ (preprocess
+  (action
+   (run %{bin:cppo} -V OCAML:%{ocaml_version} %{input-file})))
+ (libraries ppx_cstruct ocaml-migrate-parsetree))
+
+(executable
+ (name gen_tests)
+ (modules gen_tests))
+
+(include dune.inc)
+
+(rule
+ (targets dune.inc.gen)
+ (deps
+  (source_tree .))
+ (action
+  (with-stdout-to
+   %{targets}
+   (run ./gen_tests.exe))))
+
+(rule
+ (alias runtest)
+ (action
+  (diff dune.inc dune.inc.gen)))

unikernel/duniverse/ocaml-cstruct/ppx_test/errors/dune.inc

@@ -0,0 +1,224 @@
+
+(rule
+  (deps pp.exe (:input cenum_id_payload.ml))
+  (targets cenum_id_payload.ml.errors)
+  (action
+    (progn
+      (with-stderr-to %{targets}
+        (run ./pp.exe -no-color --impl %{input}))
+      (bash "sed -i.bak '1d' %{targets}"))))
+(rule
+  (alias runtest)
+  (package ppx_cstruct)
+  (action
+    (diff cenum_id_payload.ml.expected cenum_id_payload.ml.errors)))
+
+(rule
+  (deps pp.exe (:input cenum_invalid_type.ml))
+  (targets cenum_invalid_type.ml.errors)
+  (action
+    (progn
+      (with-stderr-to %{targets}
+        (run ./pp.exe -no-color --impl %{input}))
+      (bash "sed -i.bak '1d' %{targets}"))))
+(rule
+  (alias runtest)
+  (package ppx_cstruct)
+  (action
+    (diff cenum_invalid_type.ml.expected cenum_invalid_type.ml.errors)))
+
+(rule
+  (deps pp.exe (:input cenum_no_attribute.ml))
+  (targets cenum_no_attribute.ml.errors)
+  (action
+    (progn
+      (with-stderr-to %{targets}
+        (run ./pp.exe -no-color --impl %{input}))
+      (bash "sed -i.bak '1d' %{targets}"))))
+(rule
+  (alias runtest)
+  (package ppx_cstruct)
+  (action
+    (diff cenum_no_attribute.ml.expected cenum_no_attribute.ml.errors)))
+
+(rule
+  (deps pp.exe (:input cenum_not_a_variant.ml))
+  (targets cenum_not_a_variant.ml.errors)
+  (action
+    (progn
+      (with-stderr-to %{targets}
+        (run ./pp.exe -no-color --impl %{input}))
+      (bash "sed -i.bak '1d' %{targets}"))))
+(rule
+  (alias runtest)
+  (package ppx_cstruct)
+  (action
+    (diff cenum_not_a_variant.ml.expected cenum_not_a_variant.ml.errors)))
+
+(rule
+  (deps pp.exe (:input cenum_unknown_attribute.ml))
+  (targets cenum_unknown_attribute.ml.errors)
+  (action
+    (progn
+      (with-stderr-to %{targets}
+        (run ./pp.exe -no-color --impl %{input}))
+      (bash "sed -i.bak '1d' %{targets}"))))
+(rule
+  (alias runtest)
+  (package ppx_cstruct)
+  (action
+    (diff cenum_unknown_attribute.ml.expected cenum_unknown_attribute.ml.errors)))
+
+(rule
+  (deps pp.exe (:input cstruct_attribute_payload.ml))
+  (targets cstruct_attribute_payload.ml.errors)
+  (action
+    (progn
+      (with-stderr-to %{targets}
+        (run ./pp.exe -no-color --impl %{input}))
+      (bash "sed -i.bak '1d' %{targets}"))))
+(rule
+  (alias runtest)
+  (package ppx_cstruct)
+  (action
+    (diff cstruct_attribute_payload.ml.expected cstruct_attribute_payload.ml.errors)))
+
+(rule
+  (deps pp.exe (:input cstruct_duplicate_field.ml))
+  (targets cstruct_duplicate_field.ml.errors)
+  (action
+    (progn
+      (with-stderr-to %{targets}
+        (run ./pp.exe -no-color --impl %{input}))
+      (bash "sed -i.bak '1d' %{targets}"))))
+(rule
+  (alias runtest)
+  (package ppx_cstruct)
+  (action
+    (diff cstruct_duplicate_field.ml.expected cstruct_duplicate_field.ml.errors)))
+
+(rule
+  (deps pp.exe (:input cstruct_len_int32.ml))
+  (targets cstruct_len_int32.ml.errors)
+  (action
+    (progn
+      (with-stderr-to %{targets}
+        (run ./pp.exe -no-color --impl %{input}))
+      (bash "sed -i.bak '1d' %{targets}"))))
+(rule
+  (alias runtest)
+  (package ppx_cstruct)
+  (action
+    (diff cstruct_len_int32.ml.expected cstruct_len_int32.ml.errors)))
+
+(rule
+  (deps pp.exe (:input cstruct_len_not_int.ml))
+  (targets cstruct_len_not_int.ml.errors)
+  (action
+    (progn
+      (with-stderr-to %{targets}
+        (run ./pp.exe -no-color --impl %{input}))
+      (bash "sed -i.bak '1d' %{targets}"))))
+(rule
+  (alias runtest)
+  (package ppx_cstruct)
+  (action
+    (diff cstruct_len_not_int.ml.expected cstruct_len_not_int.ml.errors)))
+
+(rule
+  (deps pp.exe (:input cstruct_len_zero.ml))
+  (targets cstruct_len_zero.ml.errors)
+  (action
+    (progn
+      (with-stderr-to %{targets}
+        (run ./pp.exe -no-color --impl %{input}))
+      (bash "sed -i.bak '1d' %{targets}"))))
+(rule
+  (alias runtest)
+  (package ppx_cstruct)
+  (action
+    (diff cstruct_len_zero.ml.expected cstruct_len_zero.ml.errors)))
+
+(rule
+  (deps pp.exe (:input cstruct_multiple_len.ml))
+  (targets cstruct_multiple_len.ml.errors)
+  (action
+    (progn
+      (with-stderr-to %{targets}
+        (run ./pp.exe -no-color --impl %{input}))
+      (bash "sed -i.bak '1d' %{targets}"))))
+(rule
+  (alias runtest)
+  (package ppx_cstruct)
+  (action
+    (diff cstruct_multiple_len.ml.expected cstruct_multiple_len.ml.errors)))
+
+(rule
+  (deps pp.exe (:input cstruct_not_a_record.ml))
+  (targets cstruct_not_a_record.ml.errors)
+  (action
+    (progn
+      (with-stderr-to %{targets}
+        (run ./pp.exe -no-color --impl %{input}))
+      (bash "sed -i.bak '1d' %{targets}"))))
+(rule
+  (alias runtest)
+  (package ppx_cstruct)
+  (action
+    (diff cstruct_not_a_record.ml.expected cstruct_not_a_record.ml.errors)))
+
+(rule
+  (deps pp.exe (:input cstruct_not_an_identifier.ml))
+  (targets cstruct_not_an_identifier.ml.errors)
+  (action
+    (progn
+      (with-stderr-to %{targets}
+        (run ./pp.exe -no-color --impl %{input}))
+      (bash "sed -i.bak '1d' %{targets}"))))
+(rule
+  (alias runtest)
+  (package ppx_cstruct)
+  (action
+    (diff cstruct_not_an_identifier.ml.expected cstruct_not_an_identifier.ml.errors)))
+
+(rule
+  (deps pp.exe (:input cstruct_several_attributes.ml))
+  (targets cstruct_several_attributes.ml.errors)
+  (action
+    (progn
+      (with-stderr-to %{targets}
+        (run ./pp.exe -no-color --impl %{input}))
+      (bash "sed -i.bak '1d' %{targets}"))))
+(rule
+  (alias runtest)
+  (package ppx_cstruct)
+  (action
+    (diff cstruct_several_attributes.ml.expected cstruct_several_attributes.ml.errors)))
+
+(rule
+  (deps pp.exe (:input cstruct_unknown_endian.ml))
+  (targets cstruct_unknown_endian.ml.errors)
+  (action
+    (progn
+      (with-stderr-to %{targets}
+        (run ./pp.exe -no-color --impl %{input}))
+      (bash "sed -i.bak '1d' %{targets}"))))
+(rule
+  (alias runtest)
+  (package ppx_cstruct)
+  (action
+    (diff cstruct_unknown_endian.ml.expected cstruct_unknown_endian.ml.errors)))
+
+(rule
+  (deps pp.exe (:input cstruct_unknown_type.ml))
+  (targets cstruct_unknown_type.ml.errors)
+  (action
+    (progn
+      (with-stderr-to %{targets}
+        (run ./pp.exe -no-color --impl %{input}))
+      (bash "sed -i.bak '1d' %{targets}"))))
+(rule
+  (alias runtest)
+  (package ppx_cstruct)
+  (action
+    (diff cstruct_unknown_type.ml.expected cstruct_unknown_type.ml.errors)))

unikernel/duniverse/ocaml-cstruct/ppx_test/errors/gen_tests.ml

@@ -0,0 +1,31 @@
+let output_stanzas name =
+  Printf.printf
+    {|
+(rule
+  (deps pp.exe (:input %s))
+  (targets %s.errors)
+  (action
+    (progn
+      (with-stderr-to %%{targets}
+        (run ./pp.exe -no-color --impl %%{input}))
+      (bash "sed -i.bak '1d' %%{targets}"))))
+(rule
+  (alias runtest)
+  (package ppx_cstruct)
+  (action
+    (diff %s.expected %s.errors)))
+|}
+    name name name name
+
+let is_test = function
+  | "pp.ml" -> false
+  | "pp.pp.ml" -> false
+  | "gen_tests.ml" -> false
+  | e -> Filename.check_suffix e ".ml"
+
+let () =
+  Sys.readdir "."
+  |> Array.to_list
+  |> List.sort String.compare
+  |> List.filter is_test
+  |> List.iter output_stanzas

unikernel/duniverse/ocaml-cstruct/ppx_test/errors/pp.ml

@@ -0,0 +1,11 @@
+(* we can just use exit from 4.07 onwards, but 4.06
+ * and earlier executed at_exit recursively *)
+external sys_exit : int -> 'a = "caml_sys_exit"
+let () = at_exit (fun () -> sys_exit 0)
+
+#if OCAML_VERSION >= (4,8,0)
+let () = Clflags.(error_style := Some Short)
+#endif
+
+let () = Clflags.(color := Some Never)
+let () = Ppxlib.Driver.standalone ()

unikernel/duniverse/ocaml-cstruct/ppx_test/pcap.ml

@@ -0,0 +1,169 @@
+(*
+ * Copyright (c) 2012-2016 Anil Madhavapeddy <anil@recoil.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+[%%cstruct
+type pcap_header = {
+  magic_number: uint32_t;   (* magic number *)
+  version_major: uint16_t;  (* major version number *)
+  version_minor: uint16_t;  (* minor version number *)
+  thiszone: uint32_t;       (* GMT to local correction *)
+  sigfigs: uint32_t;        (* accuracy of timestamps *)
+  snaplen: uint32_t;        (* max length of captured packets, in octets *)
+  network: uint32_t;        (* data link type *)
+} [@@little_endian]]
+
+[%%cstruct
+type pcap_packet = {
+  ts_sec: uint32_t;         (* timestamp seconds *)
+  ts_usec: uint32_t;        (* timestamp microseconds *)
+  incl_len: uint32_t;       (* number of octets of packet saved in file *)
+  orig_len: uint32_t;       (* actual length of packet *)
+} [@@little_endian]]
+
+[%%cstruct
+type ethernet = {
+  dst: uint8_t [@len 6];
+  src: uint8_t [@len 6];
+  ethertype: uint16_t;
+} [@@big_endian]]
+
+[%%cstruct
+type ipv4 = {
+  hlen_version: uint8_t;
+  tos: uint8_t;
+  len: uint16_t;
+  id: uint16_t;
+  off: uint16_t;
+  ttl: uint8_t;
+  proto: uint8_t;
+  csum: uint16_t;
+  src: uint8_t [@len 4];
+  dst: uint8_t [@len 4];
+} [@@big_endian]]
+
+[%%cstruct
+type tcpv4 = {
+  src_port: uint16_t;
+  dst_port: uint16_t;
+  seqnum: uint32_t;
+  acknum: uint32_t;
+  offset_flags: uint16_t;
+  window: uint16_t;
+  checksum: uint16_t;
+  urg: uint16_t;
+} [@@big_endian]]
+
+let mac_to_string buf =
+  let i n = Cstruct.get_uint8 buf n in
+  Printf.sprintf "%.2x:%.2x:%.2x:%.2x:%.2x:%.2x"
+    (i 0) (i 1) (i 2) (i 3) (i 4) (i 5)
+
+open Printf
+
+let print_packet p =
+  let dst_mac = mac_to_string (get_ethernet_dst p) in
+  let src_mac = mac_to_string (get_ethernet_src p) in
+  let ethertype = get_ethernet_ethertype p in
+  printf "ether %s -> %s etype %x\n" src_mac dst_mac ethertype;
+  match ethertype with
+  |0x0800 -> begin
+     let ip = Cstruct.shift p sizeof_ethernet in
+     let version = get_ipv4_hlen_version ip lsr 4 in
+     let hlen = (get_ipv4_hlen_version ip land 0xf) * 4 in
+     let ttl = get_ipv4_ttl ip in
+     let proto = get_ipv4_proto ip in
+     printf "ipv%d hlen %d ttl %d proto %d\n" version hlen ttl proto;
+     match proto with
+     |6 -> begin (* tcp *)
+       let tcp = Cstruct.shift ip sizeof_ipv4 in
+       let off = 0 in
+       let x = get_tcpv4_offset_flags tcp in
+       let data_offset = (x lsr 12) * 4 in
+       let options =
+         match data_offset - sizeof_tcpv4 with
+         |0 -> 0
+         |n -> n (* TODO parse *)
+       in
+       let payload = Cstruct.shift tcp data_offset in
+       let fin = (x land 1) = 1 in
+       let syn = (x land 2) = 2 in
+       let flags = "?" in
+       let src_port = get_tcpv4_src_port tcp in
+       let dst_port = get_tcpv4_dst_port tcp in
+       let seqnum = get_tcpv4_seqnum tcp in
+       let acknum = get_tcpv4_acknum tcp in
+       let window = get_tcpv4_window tcp in
+       printf "tcpv4 port %d->%d seq %lu ack %lu win %d off %d flags %s opt %d fin %b syn %b payload_len=%d\n"
+         src_port dst_port seqnum
+         acknum window off flags options fin syn (Cstruct.length payload);
+       ()
+     end
+     |_ -> printf "unknown ip proto %d\n" proto
+  end
+  |x -> printf "unknown body %x\n" x
+
+let print_pcap_packet (hdr,pkt) =
+  let ts_sec = get_pcap_packet_ts_sec hdr in
+  let ts_usec = get_pcap_packet_ts_usec hdr in
+  let incl_len = get_pcap_packet_incl_len hdr in
+  let orig_len = get_pcap_packet_orig_len hdr in
+  printf "\n** %lu.%lu  bytes %lu (of %lu)\n"
+    ts_sec ts_usec incl_len orig_len;
+  print_packet pkt
+
+let print_pcap_header buf =
+  let magic = get_pcap_header_magic_number buf in
+  let endian =
+    match magic with
+    |0xa1b2c3d4l -> "bigendian"
+    |0xd4c3b2a1l -> "littlendian"
+    |_ -> "not a pcap file"
+  in
+  let version_major = get_pcap_header_version_major buf in
+  let version_minor = get_pcap_header_version_minor buf in
+  let thiszone = get_pcap_header_thiszone buf in
+  let sigfis = get_pcap_header_sigfigs buf in
+  let snaplen = get_pcap_header_snaplen buf in
+  let header_network = get_pcap_header_network buf in
+  printf "pcap_header (len %d)\n" sizeof_pcap_header;
+  printf "magic_number %lx (%s)\n%!" magic endian;
+  printf "version %d %d\n" version_major version_minor;
+  printf "timezone shift %lu\n" thiszone;
+  printf "timestamp accuracy %lu\n" sigfis;
+  printf "snaplen %lu\n" snaplen;
+  printf "lltype %lx\n" header_network
+
+let parse () =
+  printf "start parse\n%!";
+  let fd = Unix.(openfile "http.cap" [O_RDONLY] 0) in
+  let t = Unix_cstruct.of_fd fd in
+  printf "total pcap file length %d\n%!" (Cstruct.length t);
+
+  let header, body = Cstruct.split t sizeof_pcap_header in
+  print_pcap_header header;
+
+  let packets = Cstruct.iter
+    (fun buf -> Some (sizeof_pcap_packet + Int32.to_int (get_pcap_packet_incl_len buf)))
+    (fun buf -> buf, Cstruct.shift buf sizeof_pcap_packet)
+    body
+  in
+  let num_packets = Cstruct.fold
+    (fun a packet -> print_pcap_packet packet; (a+1))
+    packets 0
+  in
+  printf "num_packets %d\n%!" num_packets
+
+let () = parse ()

unikernel/duniverse/ocaml-cstruct/ppx_test/with-lwt/dune

@@ -0,0 +1,5 @@
+(executables
+ (names ppx_cstruct_and_lwt)
+ (preprocess
+  (pps lwt_ppx ppx_cstruct))
+ (libraries cstruct lwt lwt.unix))

unikernel/duniverse/ocaml-cstruct/ppx_test/with-lwt/ppx_cstruct_and_lwt.ml

@@ -0,0 +1,15 @@
+[%%cstruct type foo = {
+  magic: uint8_t [@len 16];
+}[@@little_endian]]
+
+[%%cenum
+type foo64 =
+  | ONE64
+  | TWO64
+  | THREE64
+  [@@uint64_t]
+]
+
+let foo = 
+  let%lwt foo = Lwt.return () in 
+  Lwt.return foo

unikernel/duniverse/ocaml-cstruct/ppx_test/with-sexp/dune

@@ -0,0 +1,11 @@
+(executable
+ (name ppx_cstruct_and_sexp)
+ (preprocess
+  (pps ppx_cstruct ppx_sexp_conv -- -no-check))
+ (libraries cstruct sexplib cstruct-sexp))
+
+(rule
+ (alias runtest)
+ (package ppx_cstruct)
+ (action
+  (run ./ppx_cstruct_and_sexp.exe)))

unikernel/duniverse/ocaml-cstruct/ppx_test/with-sexp/ppx_cstruct_and_sexp.ml

@@ -0,0 +1,11 @@
+[%%cstruct type foo = {
+  magic: uint8_t [@len 16];
+}[@@little_endian]]
+
+open Sexplib.Std
+type t = int [@@deriving sexp]
+
+type bar = {
+  buf: Cstruct_sexp.t;
+  string: string;
+} [@@deriving sexp]