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