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 alien.c-types
   8 combinators.short-circuit literals ;
   9 SPECIALIZED-ARRAY: double
  10 IN: serialize.tests
  11
  12 : (test-serialize-cell) ( n -- ? )
  13     dup
  14     binary [ serialize-cell ] with-byte-writer
  15     binary [ deserialize-cell ] with-byte-reader = ;
  16
  17 : test-serialize-cell ( a -- ? )
  18     2^ random (test-serialize-cell) ;
  19
  20 { t } [
  21     100 [
  22         drop
  23         {
  24             [ 40 [        test-serialize-cell ] all-integers? ]
  25             [  4 [ 40 *   test-serialize-cell ] all-integers? ]
  26             [  4 [ 400 *  test-serialize-cell ] all-integers? ]
  27             [  4 [ 4000 * test-serialize-cell ] all-integers? ]
  28         } 0&&
  29     ] all-integers?
  30 ] unit-test
  31
  32 { t } [ 2000 [
  33         2^ 3 [ 1 - + (test-serialize-cell) ] with all-integers?
  34     ] all-integers?
  35 ] unit-test
  36
  37 TUPLE: serialize-test a b ;
  38
  39 C: <serialize-test> serialize-test
  40
  41 CONSTANT: objects
  42     {
  43         f
  44         t
  45         0
  46         -50
  47         20
  48         5.25
  49         -5.25
  50         C{ 1 2 }
  51         1/2
  52         "test"
  53         { 1 2 "three" }
  54         V{ 1 2 "three" }
  55         SBUF" hello world"
  56         "hello \u012345 unicode"
  57         \ dup
  58         [ \ dup dup ]
  59         T{ serialize-test f "a" 2 }
  60         B{ 50 13 55 64 1 }
  61         ?{ t f t f f t f }
  62         double-array{ 1.0 3.0 4.0 1.0 2.35 0.33 }
  63         << 1 [ 2 ] curry suffix! >>
  64         { { "a" "bc" } { "de" "fg" } }
  65         H{ { "a" "bc" } { "de" "fg" } }
  66     }
  67
  68 : check-serialize-1 ( obj -- ? )
  69     "=====" print
  70     dup class-of .
  71     dup .
  72     dup
  73     object>bytes
  74     bytes>object
  75     dup . = ;
  76
  77 : check-serialize-2 ( obj -- ? )
  78     dup number? over wrapper? or [
  79         drop t ! we don't care if numbers aren't interned
  80     ] [
  81         "=====" print
  82         dup class-of .
  83         dup 2array dup .
  84         object>bytes
  85         bytes>object dup .
  86         first2 eq?
  87     ] if ;
  88
  89 { t } [ objects [ check-serialize-1 ] all? ] unit-test
  90
  91 { t } [ objects [ check-serialize-2 ] all? ] unit-test
  92
  93 { t } [ pi check-serialize-1 ] unit-test
  94 [ serialize ] must-infer
  95 [ deserialize ] must-infer
  96
  97 { t } [
  98     V{ } dup dup push
  99     object>bytes
 100     bytes>object
 101     dup first eq?
 102 ] unit-test
 103
 104 { t } [
 105     H{ } dup dup dup set-at
 106     object>bytes
 107     bytes>object
 108     dup keys first eq?
 109 ] unit-test
 110
 111 ! Changed the serialization of numbers in [2^1008;2^1024[
 112 ! check backwards compatibility
 113 ${ 1008 2^ } [ B{
 114     255 1 127 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
 115     0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
 116     0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
 117     0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
 118     0 0 0 0 0 0 0 0 0 0 0 0
 119 } binary [ deserialize-cell ] with-byte-reader ] unit-test
 120
 121 ${ 1024 2^ 1 - } [ B{
 122     255 1 128 255 255 255 255 255 255 255 255 255 255 255 255
 123     255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
 124     255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
 125     255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
 126     255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
 127     255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
 128     255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
 129     255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
 130     255 255 255 255 255 255 255 255 255 255 255
 131 } binary [ deserialize-cell ] with-byte-reader ] unit-test