basis/serialize/serialize-tests.factor

   1 ! Copyright (C) 2006 Chris Double.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 !
   4 USING: tools.test kernel serialize io io.streams.byte-array
   5 alien arrays byte-arrays bit-arrays specialized-arrays
   6 sequences math prettyprint parser classes math.constants
   7 io.encodings.binary random assocs serialize.private ;
   8 SPECIALIZED-ARRAY: double
   9 IN: serialize.tests
  10
  11 : test-serialize-cell ( a -- ? )
  12     2^ random dup
  13     binary [ serialize-cell ] with-byte-writer
  14     binary [ deserialize-cell ] with-byte-reader = ;
  15
  16 [ t ] [
  17     100 [
  18         drop
  19         40 [        test-serialize-cell ] all?
  20          4 [ 40 *   test-serialize-cell ] all?
  21          4 [ 400 *  test-serialize-cell ] all?
  22          4 [ 4000 * test-serialize-cell ] all?
  23         and and and
  24     ] all?
  25 ] unit-test
  26
  27 TUPLE: serialize-test a b ;
  28
  29 C: <serialize-test> serialize-test
  30
  31 CONSTANT: objects
  32     {
  33         f
  34         t
  35         0
  36         -50
  37         20
  38         5.25
  39         -5.25
  40         C{ 1 2 }
  41         1/2
  42         "test"
  43         { 1 2 "three" }
  44         V{ 1 2 "three" }
  45         SBUF" hello world"
  46         "hello \u123456 unicode"
  47         \ dup
  48         [ \ dup dup ]
  49         T{ serialize-test f "a" 2 }
  50         B{ 50 13 55 64 1 }
  51         ?{ t f t f f t f }
  52         double-array{ 1.0 3.0 4.0 1.0 2.35 0.33 }
  53         << 1 [ 2 ] curry parsed >>
  54         { { "a" "bc" } { "de" "fg" } }
  55         H{ { "a" "bc" } { "de" "fg" } }
  56     }
  57
  58 : check-serialize-1 ( obj -- ? )
  59     "=====" print
  60     dup class .
  61     dup .
  62     dup
  63     object>bytes
  64     bytes>object
  65     dup . = ;
  66
  67 : check-serialize-2 ( obj -- ? )
  68     dup number? over wrapper? or [
  69         drop t ! we don't care if numbers aren't interned
  70     ] [
  71         "=====" print
  72         dup class .
  73         dup 2array dup .
  74         object>bytes
  75         bytes>object dup .
  76         first2 eq?
  77     ] if ;
  78
  79 [ t ] [ objects [ check-serialize-1 ] all? ] unit-test
  80
  81 [ t ] [ objects [ check-serialize-2 ] all? ] unit-test
  82
  83 [ t ] [ pi check-serialize-1 ] unit-test
  84 [ serialize ] must-infer
  85 [ deserialize ] must-infer
  86
  87 [ t ] [
  88     V{ } dup dup push
  89     object>bytes
  90     bytes>object
  91     dup first eq?
  92 ] unit-test
  93
  94 [ t ] [
  95     H{ } dup dup dup set-at
  96     object>bytes
  97     bytes>object
  98     dup keys first eq?
  99 ] unit-test