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