← Back to branch summary

~ubuntu-branches/ubuntu/vivid/typerep/vivid

« back to all changes in this revision

Viewing changes to generics/sexprep/test/test_sexprep.ml

  • Committer: Package Import Robot
  • Author(s): Hilko Bengen
  • Date: 2014-09-24 23:51:02 UTC
  • Revision ID: package-import@ubuntu.com-20140924235102-0qeq851f02otnnxp
Tags: upstream-111.17.00
Import upstream version 111.17.00

Show diffs side-by-side

added added

removed removed

Lines of Context:
generics/sexprep/test/test_sexprep.ml
 
1
open Core.Std
 
2
open Typerep_experimental.Std
 
3
 
 
4
module S = Sexprep
 
5
 
 
6
(* Tests to make sure we can deserialize values we serialized *)
 
7
(* Tests to make sure we can deserialize values serialized by with sexp *)
 
8
(* Tests to make sure with sexp can deserialize values serialized by us *)
 
9
TEST_MODULE = struct
 
10
 
 
11
  let t_of_sexp_of_sexp_of_t typerep value =
 
12
    let `generic t_of_sexp = S.t_of_sexp typerep in
 
13
    let `generic sexp_of_t = S.sexp_of_t typerep in
 
14
    t_of_sexp (sexp_of_t value)
 
15
 
 
16
  let check_untyped value typerep =
 
17
    let `generic t_of_sexp = S.t_of_sexp typerep in
 
18
    let `generic sexp_of_t = S.sexp_of_t typerep in
 
19
    let `generic sexp_of_un =
 
20
      Sexprep.Tagged.Sexp_of.of_typestruct (Type_struct.of_typerep typerep)
 
21
    in
 
22
    let `generic un_of_sexp =
 
23
      Sexprep.Tagged.Of_sexp.of_typestruct (Type_struct.of_typerep typerep)
 
24
    in
 
25
    let new_value = t_of_sexp (sexp_of_un (un_of_sexp (sexp_of_t value))) in
 
26
    Polymorphic_compare.equal new_value value
 
27
 
 
28
  let check_typerep value typerep =
 
29
    let str = t_of_sexp_of_sexp_of_t typerep value in
 
30
    Polymorphic_compare.equal value str
 
31
 
 
32
  let check_obj_typerep (type a) (value:a) (typerep:a Typerep.t) =
 
33
    let `generic sexp_of_t = S.sexp_of_t typerep in
 
34
    let sexp = sexp_of_t value in
 
35
    let typestruct = Type_struct.of_typerep typerep in
 
36
    let typerep_of_t = Type_struct.recreate_dynamically_typerep_for_test typerep in
 
37
    let objstruct = Type_struct.of_typerep typerep_of_t in
 
38
    let fail = ref false in
 
39
    let () =
 
40
      let `generic t_of_sexp = S.t_of_sexp typerep_of_t in
 
41
      let obj_value = t_of_sexp sexp in
 
42
      if not (Polymorphic_compare.equal obj_value value) then begin
 
43
        fail := true;
 
44
        Printf.printf "typestruct: %s\n"
 
45
          (Sexp.to_string_hum (Type_struct.sexp_of_t typestruct));
 
46
        Printf.printf "objstruct: %s\n"
 
47
          (Sexp.to_string_hum (Type_struct.sexp_of_t objstruct));
 
48
        Printf.printf "polymorphic equality failed obj_value: %S\n%!"
 
49
          (Sexp.to_string_hum sexp)
 
50
      end
 
51
    in
 
52
    let () =
 
53
      let `generic sexp_of_t = S.sexp_of_t typerep_of_t in
 
54
      let obj_sexp = sexp_of_t value in
 
55
      let obj_str = Sexp.to_string_hum obj_sexp in
 
56
      let value_str = Sexp.to_string_hum sexp in
 
57
      if not (String.equal obj_str value_str) then begin
 
58
        fail := true;
 
59
        Printf.printf "typestruct: %s\n"
 
60
          (Sexp.to_string_hum (Type_struct.sexp_of_t typestruct));
 
61
        Printf.printf "objstruct: %s\n"
 
62
          (Sexp.to_string_hum (Type_struct.sexp_of_t objstruct));
 
63
        Printf.printf "sexp equality failed obj_value:\nvalue sexp:\n%s\nobj sexp\n%s\n%!"
 
64
          value_str
 
65
          obj_str
 
66
      end
 
67
    in
 
68
    not !fail
 
69
 
 
70
  let check value typerep =
 
71
    if (check_typerep value typerep)
 
72
      && (check_untyped value typerep)
 
73
      && (check_obj_typerep value typerep)
 
74
    then true else
 
75
    begin
 
76
      let `generic sexp_of_t = S.sexp_of_t typerep in
 
77
      let `generic t_of_sexp = S.t_of_sexp typerep in
 
78
      let sexp = sexp_of_t value in
 
79
      let second_sexp = sexp_of_t (t_of_sexp sexp) in
 
80
      print_endline "sexp:";
 
81
      print_endline (Sexp.to_string_hum sexp);
 
82
      print_endline "sexp of (t of (sexp of t)):";
 
83
      print_endline (Sexp.to_string_hum second_sexp);
 
84
      false
 
85
    end
 
86
 
 
87
  let check_of_sexp value typerep sexp_of_t =
 
88
    let `generic t_of_sexp = S.t_of_sexp typerep in
 
89
    Polymorphic_compare.equal value (t_of_sexp (sexp_of_t value))
 
90
 
 
91
  let check_of_t value typerep t_of_sexp =
 
92
    let `generic sexp_of_t = S.sexp_of_t typerep in
 
93
    Polymorphic_compare.equal value (t_of_sexp (sexp_of_t value))
 
94
 
 
95
  TEST_UNIT =
 
96
    let module M = struct
 
97
      type t = int with typerep, sexp
 
98
    end in
 
99
    let value = 5 in
 
100
    assert(check value M.typerep_of_t);
 
101
    assert(check_of_sexp value M.typerep_of_t M.sexp_of_t);
 
102
    assert(check_of_t value M.typerep_of_t M.t_of_sexp)
 
103
 
 
104
  TEST_UNIT =
 
105
    let module M = struct
 
106
      type t = int32 with typerep, sexp
 
107
    end in
 
108
    let value = Int32.of_int_exn 5 in
 
109
    assert(check value M.typerep_of_t);
 
110
    assert(check_of_sexp value M.typerep_of_t M.sexp_of_t);
 
111
    assert(check_of_t value M.typerep_of_t M.t_of_sexp)
 
112
 
 
113
  TEST_UNIT =
 
114
    let module M = struct
 
115
      type t = int64 with typerep, sexp
 
116
    end in
 
117
    let value = Int64.of_int_exn 5 in
 
118
    assert(check value M.typerep_of_t);
 
119
    assert(check_of_sexp value M.typerep_of_t M.sexp_of_t);
 
120
    assert(check_of_t value M.typerep_of_t M.t_of_sexp)
 
121
 
 
122
  TEST_UNIT =
 
123
    let module M = struct
 
124
      type t = char with typerep, sexp
 
125
    end in
 
126
    let value = 'c' in
 
127
    assert(check value M.typerep_of_t);
 
128
    assert(check_of_sexp value M.typerep_of_t M.sexp_of_t);
 
129
    assert(check_of_t value M.typerep_of_t M.t_of_sexp)
 
130
 
 
131
  TEST_UNIT =
 
132
    let module M = struct
 
133
      type t = float with typerep, sexp
 
134
    end in
 
135
    let value = 543.02 in
 
136
    assert(check value M.typerep_of_t);
 
137
    assert(check_of_sexp value M.typerep_of_t M.sexp_of_t);
 
138
    assert(check_of_t value M.typerep_of_t M.t_of_sexp)
 
139
 
 
140
  TEST_UNIT =
 
141
    let module M = struct
 
142
      type t = string with typerep, sexp
 
143
    end in
 
144
    let value = "Hello, world!" in
 
145
    assert(check value M.typerep_of_t);
 
146
    assert(check_of_sexp value M.typerep_of_t M.sexp_of_t);
 
147
    assert(check_of_t value M.typerep_of_t M.t_of_sexp)
 
148
 
 
149
  TEST_UNIT =
 
150
    let module M = struct
 
151
      type t = bool with typerep, sexp
 
152
    end in
 
153
    assert(check true M.typerep_of_t);
 
154
    assert(check false M.typerep_of_t);
 
155
    assert(check_of_sexp true M.typerep_of_t M.sexp_of_t);
 
156
    assert(check_of_sexp false M.typerep_of_t M.sexp_of_t);
 
157
    assert(check_of_t true M.typerep_of_t M.t_of_sexp);
 
158
    assert(check_of_t false M.typerep_of_t M.t_of_sexp)
 
159
 
 
160
  TEST_UNIT =
 
161
    let module M = struct
 
162
      type t = unit with typerep, sexp
 
163
    end in
 
164
    assert(check () M.typerep_of_t);
 
165
    assert(check_of_sexp () M.typerep_of_t M.sexp_of_t);
 
166
    assert(check_of_t () M.typerep_of_t M.t_of_sexp)
 
167
 
 
168
  TEST_UNIT =
 
169
    let module M = struct
 
170
      type 'a t = 'a option with typerep, sexp
 
171
    end in
 
172
    assert(check None (M.typerep_of_t typerep_of_int));
 
173
    assert(check (Some 5) (M.typerep_of_t typerep_of_int));
 
174
    assert(check_of_sexp None
 
175
      (M.typerep_of_t typerep_of_int) (M.sexp_of_t sexp_of_int));
 
176
    assert(check_of_sexp (Some 5)
 
177
      (M.typerep_of_t typerep_of_int) (M.sexp_of_t sexp_of_int));
 
178
    assert(check_of_t None
 
179
      (M.typerep_of_t typerep_of_int) (M.t_of_sexp int_of_sexp));
 
180
    assert(check_of_t (Some 5)
 
181
      (M.typerep_of_t typerep_of_int) (M.t_of_sexp int_of_sexp))
 
182
 
 
183
  TEST_UNIT =
 
184
    let module M = struct
 
185
      type 'a t = 'a list with typerep, sexp
 
186
    end in
 
187
    assert(check [] (M.typerep_of_t typerep_of_int));
 
188
    assert(check [1;2;6;5;4;3] (M.typerep_of_t typerep_of_int));
 
189
    assert(check_of_sexp [] (M.typerep_of_t typerep_of_int) (M.sexp_of_t sexp_of_int));
 
190
    assert(check_of_sexp [1;2;6;5;4;3]
 
191
      (M.typerep_of_t typerep_of_int) (M.sexp_of_t sexp_of_int));
 
192
    assert(check_of_t [] (M.typerep_of_t typerep_of_int) (M.t_of_sexp int_of_sexp));
 
193
    assert(check_of_t [1;2;6;5;4;3]
 
194
      (M.typerep_of_t typerep_of_int) (M.t_of_sexp int_of_sexp))
 
195
 
 
196
  TEST_UNIT =
 
197
    let module M = struct
 
198
      type 'a t = 'a array with typerep, sexp
 
199
    end in
 
200
    assert(check [||] (M.typerep_of_t typerep_of_int));
 
201
    assert(check [|1;2;6;5;4;3|] (M.typerep_of_t typerep_of_int));
 
202
    assert(check_of_sexp [||]
 
203
      (M.typerep_of_t typerep_of_int) (M.sexp_of_t sexp_of_int));
 
204
    assert(check_of_sexp [|1;2;6;5;4;3|]
 
205
      (M.typerep_of_t typerep_of_int) (M.sexp_of_t sexp_of_int));
 
206
    assert(check_of_t [||] (M.typerep_of_t typerep_of_int) (M.t_of_sexp int_of_sexp));
 
207
    assert(check_of_t [|1;2;6;5;4;3|]
 
208
      (M.typerep_of_t typerep_of_int) (M.t_of_sexp int_of_sexp))
 
209
 
 
210
  TEST_UNIT =
 
211
    let module M = struct
 
212
      type 'a t = 'a ref with typerep, sexp
 
213
    end in
 
214
    assert(check (ref 6) (M.typerep_of_t typerep_of_int));
 
215
    assert(check_of_sexp (ref 6)
 
216
      (M.typerep_of_t typerep_of_int) (M.sexp_of_t sexp_of_int));
 
217
    assert(check_of_t (ref 6) (M.typerep_of_t typerep_of_int) (M.t_of_sexp int_of_sexp))
 
218
 
 
219
  TEST_UNIT =
 
220
    let module M = struct
 
221
      type 'a t = 'a lazy_t with typerep, sexp
 
222
    end in
 
223
    let value = lazy 42 in
 
224
    let typerep = M.typerep_of_t typerep_of_int in
 
225
    let sexp_of_t = M.sexp_of_t sexp_of_int in
 
226
    let t_of_sexp = M.t_of_sexp int_of_sexp in
 
227
    let `generic sexp_of_x = S.sexp_of_t typerep in
 
228
    let `generic x_of_sexp = S.t_of_sexp typerep in
 
229
    assert (Int.equal (Lazy.force value) (Lazy.force (x_of_sexp (sexp_of_x value))));
 
230
    assert (Int.equal (Lazy.force value) (Lazy.force (x_of_sexp (sexp_of_t value))));
 
231
    assert (Int.equal (Lazy.force value) (Lazy.force (t_of_sexp (sexp_of_x value))));
 
232
  ;;
 
233
 
 
234
 
 
235
  TEST_UNIT =
 
236
    let module M = struct
 
237
      type 'a t = {foo:'a; bar:float} with typerep, sexp
 
238
    end in
 
239
    assert(check {M.foo=5;bar=43.25} (M.typerep_of_t typerep_of_int));
 
240
    assert(check_of_sexp {M.foo=5;bar=43.25}
 
241
      (M.typerep_of_t typerep_of_int) (M.sexp_of_t sexp_of_int));
 
242
    assert( check_of_t {M.foo=5;bar=43.25}
 
243
      (M.typerep_of_t typerep_of_int) (M.t_of_sexp int_of_sexp))
 
244
 
 
245
 
 
246
  TEST_UNIT =
 
247
    let module M = struct
 
248
      type ('a, 'b) t = ('a * 'b) with typerep, sexp
 
249
    end in
 
250
    assert(check (5,45.67)
 
251
      (M.typerep_of_t typerep_of_int typerep_of_float));
 
252
    assert(check_of_sexp (5,45.67)
 
253
      (M.typerep_of_t typerep_of_int typerep_of_float)
 
254
      (M.sexp_of_t sexp_of_int sexp_of_float));
 
255
    assert(check_of_t (5,45.67)
 
256
      (M.typerep_of_t typerep_of_int typerep_of_float)
 
257
      (M.t_of_sexp int_of_sexp float_of_sexp))
 
258
 
 
259
  TEST_UNIT =
 
260
    let module M = struct
 
261
      type ('a, 'b, 'c) t = ('a * 'b * 'c) with typerep, sexp
 
262
    end in
 
263
    assert(check (5,45,3.14159)
 
264
      (M.typerep_of_t typerep_of_int typerep_of_int typerep_of_float));
 
265
    assert(check_of_sexp (5,45,3.14159)
 
266
      (M.typerep_of_t typerep_of_int typerep_of_int typerep_of_float)
 
267
      (M.sexp_of_t sexp_of_int sexp_of_int sexp_of_float));
 
268
    assert(check_of_t (5,45,3.14159)
 
269
      (M.typerep_of_t typerep_of_int typerep_of_int typerep_of_float)
 
270
      (M.t_of_sexp int_of_sexp int_of_sexp float_of_sexp))
 
271
 
 
272
 
 
273
  TEST_UNIT =
 
274
    let module M = struct
 
275
      type ('a, 'b, 'c, 'd) t = ('a * 'b * 'c * 'd) with typerep, sexp
 
276
    end in
 
277
    assert(check (5,45,3.14159,1.14159)
 
278
      (M.typerep_of_t typerep_of_int typerep_of_int typerep_of_float typerep_of_float));
 
279
    assert(check_of_sexp (5,45,3.14159,1.14159)
 
280
      (M.typerep_of_t typerep_of_int typerep_of_int typerep_of_float typerep_of_float)
 
281
      (M.sexp_of_t sexp_of_int sexp_of_int sexp_of_float sexp_of_float));
 
282
    assert(check_of_t (5,45,3.14159,1.14159)
 
283
      (M.typerep_of_t typerep_of_int typerep_of_int typerep_of_float typerep_of_float)
 
284
      (M.t_of_sexp int_of_sexp int_of_sexp float_of_sexp float_of_sexp))
 
285
 
 
286
 
 
287
  TEST_UNIT =
 
288
    let module M = struct
 
289
      type ('a, 'b, 'c, 'd, 'e) t = ('a * 'b * 'c * 'd * 'e) with typerep, sexp
 
290
    end in
 
291
    assert(check (5,45,3.14159,1.14159,"hi")
 
292
      (M.typerep_of_t typerep_of_int typerep_of_int
 
293
                      typerep_of_float typerep_of_float
 
294
                      typerep_of_string));
 
295
    assert(check_of_sexp (5,45,3.14159,1.14159,"hi")
 
296
      (M.typerep_of_t typerep_of_int typerep_of_int
 
297
                      typerep_of_float typerep_of_float
 
298
                      typerep_of_string)
 
299
      (M.sexp_of_t sexp_of_int sexp_of_int
 
300
                   sexp_of_float sexp_of_float
 
301
                   sexp_of_string));
 
302
    assert(check_of_t (5,45,3.14159,1.14159,"hi")
 
303
      (M.typerep_of_t typerep_of_int typerep_of_int
 
304
                      typerep_of_float typerep_of_float
 
305
                      typerep_of_string)
 
306
      (M.t_of_sexp int_of_sexp int_of_sexp
 
307
                  float_of_sexp float_of_sexp
 
308
                  string_of_sexp))
 
309
 
 
310
 
 
311
  TEST_UNIT =
 
312
    let module M = struct
 
313
      type 'a t =
 
314
        | Foo
 
315
        | Bar of 'a
 
316
        | Baz of int * int
 
317
        | Bee
 
318
        | Bax of (int * int)
 
319
        | Baa of 'a * 'a
 
320
        | Bab of ('a * 'a) with typerep, sexp
 
321
    end in
 
322
    (* sexprep serialize and deserialize *)
 
323
    assert(check M.Foo (M.typerep_of_t typerep_of_int));
 
324
    assert(check (M.Bar 651) (M.typerep_of_t typerep_of_int));
 
325
    assert(check (M.Bar "651") (M.typerep_of_t typerep_of_string));
 
326
    assert(check M.Bee (M.typerep_of_t typerep_of_bool));
 
327
    assert(check (M.Baz (651,54)) (M.typerep_of_t typerep_of_int));
 
328
    assert(check (M.Bax (651,54)) (M.typerep_of_t typerep_of_int));
 
329
    assert(check (M.Baa (651,54)) (M.typerep_of_t typerep_of_int));
 
330
    assert(check (M.Bab (651,54)) (M.typerep_of_t typerep_of_int));
 
331
    (* sexplib serialize; sexprep deserialize *)
 
332
    assert(check_of_sexp M.Foo (M.typerep_of_t typerep_of_int) (M.sexp_of_t sexp_of_int));
 
333
    assert(check_of_sexp (M.Bar 651) (M.typerep_of_t typerep_of_int) (M.sexp_of_t sexp_of_int));
 
334
    assert(check_of_sexp (M.Baz (651,54))
 
335
      (M.typerep_of_t typerep_of_int)
 
336
      (M.sexp_of_t sexp_of_int));
 
337
    assert(check_of_sexp (M.Bax (651,54))
 
338
      (M.typerep_of_t typerep_of_int)
 
339
      (M.sexp_of_t sexp_of_int));
 
340
    assert(check_of_sexp (M.Baa (651,54))
 
341
      (M.typerep_of_t typerep_of_int)
 
342
      (M.sexp_of_t sexp_of_int));
 
343
    assert(check_of_sexp (M.Bab (651,54))
 
344
      (M.typerep_of_t typerep_of_int)
 
345
      (M.sexp_of_t sexp_of_int));
 
346
    (* sexprep serialize; sexplib deserialize *)
 
347
    assert(check_of_t M.Foo (M.typerep_of_t typerep_of_int) (M.t_of_sexp int_of_sexp));
 
348
    assert(check_of_t (M.Bar 651) (M.typerep_of_t typerep_of_int) (M.t_of_sexp int_of_sexp));
 
349
    assert(check_of_t (M.Baz (651,54))
 
350
      (M.typerep_of_t typerep_of_int)
 
351
      (M.t_of_sexp int_of_sexp));
 
352
    assert(check_of_t (M.Bax (651,54))
 
353
      (M.typerep_of_t typerep_of_int)
 
354
      (M.t_of_sexp int_of_sexp));
 
355
    assert(check_of_t (M.Baa (651,54))
 
356
      (M.typerep_of_t typerep_of_int)
 
357
      (M.t_of_sexp int_of_sexp));
 
358
    assert(check_of_t (M.Bab (651,54))
 
359
      (M.typerep_of_t typerep_of_int)
 
360
      (M.t_of_sexp int_of_sexp))
 
361
 
 
362
  TEST_UNIT =
 
363
    let module M = struct
 
364
      type t =
 
365
        | Foo
 
366
        | Bar of int
 
367
        | Baz of int * int
 
368
        | Bax of (int * int)
 
369
        with typerep, sexp
 
370
    end in
 
371
    (* sexprep serialize and deserialize *)
 
372
    assert(check M.Foo M.typerep_of_t);
 
373
    assert(check (M.Bar 651) M.typerep_of_t);
 
374
    assert(check (M.Baz (651,54)) M.typerep_of_t);
 
375
    assert(check (M.Bax (651,54)) M.typerep_of_t);
 
376
    (* sexplib serialize; sexprep deserialize *)
 
377
    assert(check_of_sexp M.Foo M.typerep_of_t M.sexp_of_t);
 
378
    assert(check_of_sexp (M.Bar 651) M.typerep_of_t M.sexp_of_t);
 
379
    assert(check_of_sexp (M.Baz (651,54)) M.typerep_of_t M.sexp_of_t);
 
380
    assert(check_of_sexp (M.Bax (651,54)) M.typerep_of_t M.sexp_of_t);
 
381
    (* sexprep serialize; sexplib deserialize *)
 
382
    assert(check_of_t M.Foo M.typerep_of_t M.t_of_sexp);
 
383
    assert(check_of_t (M.Bar 651) M.typerep_of_t M.t_of_sexp);
 
384
    assert(check_of_t (M.Baz (651,54)) M.typerep_of_t M.t_of_sexp);
 
385
    assert(check_of_t (M.Bax (651,54)) M.typerep_of_t M.t_of_sexp)
 
386
 
 
387
  TEST_UNIT =
 
388
    let module M = struct
 
389
      type t = Leaf | Node of t * t with typerep,sexp
 
390
    end in
 
391
    let rec producer n =
 
392
      if n > 0
 
393
      then M.Node (producer (n-1), producer (n-1))
 
394
      else M.Leaf
 
395
    in
 
396
    let value = producer 15 in
 
397
    assert(check value M.typerep_of_t);
 
398
    assert(check_of_sexp value M.typerep_of_t M.sexp_of_t);
 
399
    assert(check_of_t value M.typerep_of_t M.t_of_sexp);
 
400
 
 
401
  TEST_UNIT =
 
402
    let module M = struct
 
403
      type 'a t = [ `Foo | `Bar of 'a ] with typerep
 
404
    end in
 
405
    let typerep = M.typerep_of_t typerep_of_unit in
 
406
    assert(check `Foo typerep) ;
 
407
    assert(check (`Bar ()) typerep)
 
408
 
 
409
  module Rev_option : sig
 
410
    type 'a t with typerep
 
411
    val of_option : 'a option -> 'a t
 
412
    val register : unit -> unit
 
413
  end = struct
 
414
    module T = struct
 
415
      type 'a t = 'a option with typerep(abstract)
 
416
    end
 
417
    include T
 
418
 
 
419
    let of_option t = t
 
420
 
 
421
    let t_of_sexp a_of_sexp sexp =
 
422
      match sexp with
 
423
      | Sexp.Atom ("enon" | "enoN") -> None
 
424
      | Sexp.List [el]
 
425
      | Sexp.List [el ; Sexp.Atom ("emos" | "emoS")] -> Some (a_of_sexp el)
 
426
      | _ -> assert false
 
427
 
 
428
    let sexp_of_t sexp_of_a a =
 
429
      match a with
 
430
      | None -> Sexp.Atom "enoN"
 
431
      | Some a -> Sexp.List [sexp_of_a a ; Sexp.Atom "emoS"]
 
432
 
 
433
    let register () =
 
434
    Type_struct.Generic.register1 (module struct
 
435
      include T
 
436
      let compute = fun t -> Type_struct.Option t
 
437
    end : Type_struct.Generic.S1);
 
438
    S.Of_sexp.register1 (module struct
 
439
      include T
 
440
      let compute = t_of_sexp
 
441
    end : S.Of_sexp.S1);
 
442
    S.Sexp_of.register1 (module struct
 
443
      include T
 
444
      let compute = sexp_of_t
 
445
    end : S.Sexp_of.S1)
 
446
  end
 
447
 
 
448
  TEST_UNIT =
 
449
    let module A = struct
 
450
      type t = int Rev_option.t with typerep
 
451
    end in
 
452
    assert (
 
453
      try
 
454
        ignore (check (Rev_option.of_option None) A.typerep_of_t);
 
455
        false
 
456
      with S.Of_sexp.Not_implemented _ -> true);
 
457
    Rev_option.register ();
 
458
    assert (check_typerep (Rev_option.of_option None) A.typerep_of_t);
 
459
    assert (check_typerep (Rev_option.of_option (Some 0)) A.typerep_of_t);
 
460
    assert (check_typerep (Rev_option.of_option (Some 42)) A.typerep_of_t);
 
461
  ;;
 
462
 
 
463
  TEST_UNIT =
 
464
    let module Rev_int : sig
 
465
      type t = int with typerep
 
466
      val register : unit -> unit
 
467
    end = struct
 
468
      module T = struct
 
469
        type t = int with typerep
 
470
      end
 
471
      include T
 
472
 
 
473
      exception Parse_error of Sexp.t with sexp
 
474
 
 
475
      let t_of_sexp = function
 
476
      | Sexp.Atom str ->
 
477
        let str' = String.copy str in
 
478
        let len = String.length str in
 
479
        let rec aux index index' =
 
480
          if index >= len then () else begin
 
481
            str'.[index] <- str.[index'];
 
482
            aux (succ index) (pred index')
 
483
          end
 
484
        in
 
485
        aux 0 (pred len);
 
486
        int_of_string str'
 
487
 
 
488
      | Sexp.List _ as sexp -> raise (Parse_error sexp)
 
489
 
 
490
      let register () =
 
491
        Type_struct.Generic.register0 (module struct
 
492
          include T
 
493
          let compute = Type_struct.Int
 
494
        end : Type_struct.Generic.S0);
 
495
        S.Of_sexp.register typerep_of_t t_of_sexp
 
496
    end in
 
497
    assert (check 421 Rev_int.typerep_of_t);
 
498
    Rev_int.register();
 
499
    let `generic t_of_sexp = S.t_of_sexp Rev_int.typerep_of_t in
 
500
    let `generic sexp_of_t = S.sexp_of_t Rev_int.typerep_of_t in
 
501
    assert (Int.equal 421 (t_of_sexp (sexp_of_t 124)));
 
502
  ;;
 
503
 
 
504
end