Skip to content

Commit 67bd374

Browse files
seliopouseliopou
committed
qc: Move helper functions to Arbitrary_Base
Arbitrary_Base actually comes from frenetic-lang/ocaml-openflow. Pushing it down here to eliminate redundancy.
1 parent 640ce5b commit 67bd374

File tree

6 files changed

+117
-60
lines changed

6 files changed

+117
-60
lines changed

‎_oasis‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -39,6 +39,7 @@ Library quickcheck
3939
packet,
4040
quickcheck
4141
Modules:
42+
Arbitrary_Base,
4243
Packet_Arbitrary
4344

4445
Executable testtool

‎quickcheck/Arbitrary_Base.ml‎

Lines changed: 65 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,65 @@
1+
open QuickCheck
2+
module Gen = QuickCheck_gen
3+
4+
(* arbitrary instance for usigned integers, using `int` type. *)
5+
let arbitrary_uint = Gen.sized (fun n -> Gen.choose_int (0, n))
6+
7+
(* arbitrary instance for unsigned int4, using the `int` type. *)
8+
let arbitrary_uint4 = Gen.choose_int (0, 0xf)
9+
10+
(* arbitrary instance for unsigned int8, using the `int` type. *)
11+
let arbitrary_uint8 = Gen.choose_int (0, 0xff)
12+
13+
(* arbitrary instance for unsigned int12, using the `int` type. *)
14+
let arbitrary_uint12 = Gen.choose_int (0, 0xfff)
15+
16+
(* arbitrary instance for unsigned int16, using the `int` type. *)
17+
let arbitrary_uint16 = Gen.choose_int (0, 0xffff)
18+
19+
(* arbitrary instance for unsigned int32, using the `int32` type. *)
20+
let arbitrary_uint32 =
21+
let open Gen in
22+
arbitrary_uint16 >>= fun a ->
23+
arbitrary_uint16 >>= fun b ->
24+
let open Int32 in
25+
let hi = shift_left (of_int a) 16 in
26+
let lo = of_int b in
27+
ret_gen (logor hi lo)
28+
29+
(* arbitrary first `b` bits set in an Int32 *)
30+
let arbitrary_uint32_bits b =
31+
Gen.choose_int32 (Int32.zero, Int32.of_int ((0x1 lsl b) - 1) )
32+
33+
(* arbitrary instance for unsigned int48, using the `int64` type. *)
34+
let arbitrary_uint48 =
35+
let open Gen in
36+
arbitrary_uint16 >>= fun a ->
37+
arbitrary_uint16 >>= fun b ->
38+
arbitrary_uint16 >>= fun c ->
39+
let open Int64 in
40+
let hi = shift_left (of_int a) 32 in
41+
let mid = shift_left (of_int b) 16 in
42+
let lo = of_int c in
43+
ret_gen Int64.(logor (logor hi mid) lo)
44+
45+
(* arbitrary instance for unsigned int48, using the `int64` type. *)
46+
let arbitrary_uint64 =
47+
let open Gen in
48+
arbitrary_uint16 >>= fun a ->
49+
arbitrary_uint16 >>= fun b ->
50+
arbitrary_uint16 >>= fun c ->
51+
arbitrary_uint16 >>= fun d ->
52+
let open Int64 in
53+
let hi = shift_left (of_int a) 48 in
54+
let mid1 = shift_left (of_int b) 32 in
55+
let mid2 = shift_left (of_int c) 16 in
56+
let lo = of_int d in
57+
ret_gen Int64.(logor (logor hi (logor mid1 mid2)) lo)
58+
59+
60+
(* arbitrary instance for option type, favoring `Some` rather than `None` *)
61+
let arbitrary_option arb =
62+
let open Gen in
63+
frequency [
64+
(1, ret_gen None);
65+
(3, arb >>= fun e -> ret_gen (Some e)) ]

‎quickcheck/Arbitrary_Base.mli‎

Lines changed: 31 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,31 @@
1+
open QuickCheck
2+
3+
(* arbitrary instance for usigned integers. Still uses the `int` type. *)
4+
val arbitrary_uint : int arbitrary
5+
6+
(* arbitrary instance for unsigned int4, using the `int` type. *)
7+
val arbitrary_uint4 : int arbitrary
8+
9+
(* arbitrary instance for unsigned int8, using the `int` type. *)
10+
val arbitrary_uint8 : int arbitrary
11+
12+
(* arbitrary instance for unsigned int12, using the `int` type. *)
13+
val arbitrary_uint12 : int arbitrary
14+
15+
(* arbitrary instance for unsigned int16, using the `int` type. *)
16+
val arbitrary_uint16 : int arbitrary
17+
18+
(* arbitrary instance for unsigned int32, using the `int32` type. *)
19+
val arbitrary_uint32 : int32 arbitrary
20+
21+
(* arbitrary first [b] bits for unsigned int32 type. [b] must be less than 32. *)
22+
val arbitrary_uint32_bits : int -> int32 arbitrary
23+
24+
(* arbitrary instance for unsigned int48, using the `int64` type. *)
25+
val arbitrary_uint48 : int64 arbitrary
26+
27+
(* arbitrary instance for unsigned int64, using the `int64` type. *)
28+
val arbitrary_uint64 : int64 arbitrary
29+
30+
(* arbitrary instance for option type, favoring `Some` rather than `None` *)
31+
val arbitrary_option : 'a arbitrary -> 'a option arbitrary

‎quickcheck/Packet_Arbitrary.ml‎

Lines changed: 13 additions & 47 deletions
Original file line numberDiff line numberDiff line change
@@ -2,44 +2,10 @@ open Packet
22
open QuickCheck
33
module Gen = QuickCheck_gen
44

5-
(* arbitrary first `b` bits set in an Int32 *)
6-
let arbitrary_uint32_bits b =
7-
Gen.choose_int32 (Int32.zero, Int32.of_int ((0x1 lsl b) - 1) )
5+
open Arbitrary_Base
86

9-
(* arbitrary instance for uint3, using the `int32` type. *)
10-
let arbitrary_uint4 = arbitrary_uint32_bits 4
11-
12-
(* arbitrary instance for uint8, using the `int32` type. *)
13-
let arbitrary_uint8 = arbitrary_uint32_bits 8
14-
15-
(* arbitrary instance for uint12, using the `int32` type. *)
16-
let arbitrary_uint12 = arbitrary_uint32_bits 12
17-
18-
(* arbitrary instance for uint16, using the `int32` type. *)
19-
let arbitrary_uint16 = arbitrary_uint32_bits 16
20-
21-
(* arbitrary instance for uint32, using the `int32` type. *)
22-
let arbitrary_uint32 =
23-
let open Gen in
24-
arbitrary_uint16 >>= fun w16_1 ->
25-
arbitrary_uint16 >>= fun w16_2 ->
26-
ret_gen Int32.(logor (shift_left w16_1 16) w16_2)
27-
28-
let choose_int64 = Gen.lift_gen QuickCheck_util.Random.int64_range
29-
30-
(* arbitrary instance for uint48, using the `int64` type. *)
31-
let arbitrary_int48 =
32-
choose_int64 (Int64.zero, 0xffffffffffL)
33-
34-
(* arbitrary instance for option type, favoring `Some` rather than `None` *)
35-
let arbitrary_option arb =
36-
let open Gen in
37-
frequency [
38-
(1, ret_gen None);
39-
(3, arb >>= fun e -> ret_gen (Some e)) ]
40-
41-
let arbitrary_dlAddr = arbitrary_int48
42-
let arbitrary_nwAddr = arbitrary_int32
7+
let arbitrary_dlAddr = arbitrary_uint48
8+
let arbitrary_nwAddr = arbitrary_uint32
439

4410
let arbitrary_dlVlan =
4511
let open Gen in
@@ -49,9 +15,11 @@ let arbitrary_dlVlan =
4915
| Some w16 ->
5016
arbitrary_uint32_bits 3 >>= fun w4 ->
5117
arbitrary_bool >>= fun b ->
52-
ret_gen (Some (Int32.to_int w16), b, Int32.to_int w4)
18+
ret_gen (Some w16, b, Int32.to_int w4)
5319
end
5420

21+
let arbitrary_tpPort = Arbitrary_Base.arbitrary_uint16
22+
5523
let arbitrary_dl_unparsable_len l =
5624
let li = Int32.to_int l in
5725
Gen.ret_gen (Unparsable(li, Cstruct.create li))
@@ -122,21 +90,19 @@ let arbitrary_ip arbitrary_tp =
12290
arbitrary_nwAddr >>= fun nwDst ->
12391
arbitrary_tp >>= fun tp ->
12492
ret_gen {
125-
tos = Int32.to_int tos
126-
; ident = Int32.to_int ident
93+
tos = tos
94+
; ident = ident
12795
; flags = flags
12896
; frag = Int32.to_int frag
129-
; ttl = Int32.to_int ttl
97+
; ttl = ttl
13098
(* Dummy checksum, as the library currently does not verify it *)
131-
; chksum = Int32.to_int chksum
99+
; chksum = chksum
132100
; src = nwSrc
133101
; dst = nwDst
134102
; tp = tp
135103
; options = empty_bytes
136104
}
137105

138-
let arbitrary_tpPort = Gen.map_gen Int32.to_int arbitrary_uint16
139-
140106
let arbitrary_tcp_flags =
141107
let open Gen in
142108
let open Tcp.Flags in
@@ -194,10 +160,10 @@ let arbitrary_tcp arbitrary_payload =
194160
; dst = dst
195161
; seq = seq
196162
; ack = ack
197-
; offset = Int32.to_int offset
163+
; offset = offset
198164
; flags = flags
199-
; window = Int32.to_int window
165+
; window = window
200166
; chksum = 0
201-
; urgent = Int32.to_int urgent
167+
; urgent = urgent
202168
; payload = payload
203169
}

‎quickcheck/quickcheck.mllib‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
# OASIS_START
2-
# DO NOT EDIT (digest: efc75b648e29fe9a8789eaa30621aa1d)
2+
# DO NOT EDIT (digest: 3499f600304ecd041e197c40293470fb)
3+
Arbitrary_Base
34
Packet_Arbitrary
45
# OASIS_STOP

‎setup.ml‎

Lines changed: 5 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
(* setup.ml generated for the first time by OASIS v0.3.0 *)
22

33
(* OASIS_START *)
4-
(* DO NOT EDIT (digest: 3daa6b2eb51a4ad4a3c363d15e290382) *)
4+
(* DO NOT EDIT (digest: f87c376e87f25a9fc98f6cd66fb6017f) *)
55
(*
66
Regenerated by OASIS v0.4.1
77
Visit http://oasis.forge.ocamlcore.org for more information and
@@ -6752,14 +6752,7 @@ let setup_t =
67526752
copyrights = [];
67536753
maintainers = [];
67546754
authors =
6755-
[
6756-
"Spiridon Eliopoulos";
6757-
"Andrew Ferguson";
6758-
"Nate Foster";
6759-
"Arjun Guha";
6760-
"Mark Reitblatt";
6761-
"and Cole Schlesinger"
6762-
];
6755+
["https://github.com/frenetic-lang/ocaml-packet/contributors"];
67636756
homepage = None;
67646757
synopsis =
67656758
"Serialization for some common network packets, including\nethernet frames, IP, TCP, and ARP.";
@@ -6911,7 +6904,7 @@ let setup_t =
69116904
bs_nativeopt = [(OASISExpr.EBool true, [])]
69126905
},
69136906
{
6914-
lib_modules = ["Packet_Arbitrary"];
6907+
lib_modules = ["Arbitrary_Base"; "Packet_Arbitrary"];
69156908
lib_pack = false;
69166909
lib_internal_modules = [];
69176910
lib_findlib_parent = Some "packet";
@@ -6999,14 +6992,14 @@ let setup_t =
69996992
};
70006993
oasis_fn = Some "_oasis";
70016994
oasis_version = "0.4.1";
7002-
oasis_digest = Some "\246\148\213{d\144\203\0220\1813c\017\138\142V";
6995+
oasis_digest = Some "\129\135(\162[lG\161\213&4\027wZ\159J";
70036996
oasis_exec = None;
70046997
oasis_setup_args = [];
70056998
setup_update = false
70066999
};;
70077000

70087001
let setup () = BaseSetup.setup setup_t;;
70097002

7010-
# 7011 "setup.ml"
7003+
# 7004 "setup.ml"
70117004
(* OASIS_STOP *)
70127005
let () = setup ();;

0 commit comments

Comments
 (0)