basis/refs/refs-tests.factor

   1 USING: boxes kernel namespaces refs tools.test ;
   2 IN: refs.tests
   3
   4 ! assoc-refs
   5 { 3 } [
   6     H{ { "a" 3 } } "a" <value-ref> get-ref
   7 ] unit-test
   8
   9 { 4 } [
  10     4 H{ { "a" 3 } } clone "a" <value-ref>
  11     [ set-ref ] keep
  12     get-ref
  13 ] unit-test
  14
  15 { "a" } [
  16     H{ { "a" 3 } } "a" <key-ref> get-ref
  17 ] unit-test
  18
  19 { H{ { "b" 3 } } } [
  20     "b" H{ { "a" 3 } } clone [
  21         "a" <key-ref>
  22         set-ref
  23     ] keep
  24 ] unit-test
  25
  26 SYMBOLS: lion giraffe elephant rabbit ;
  27
  28 ! obj-refs
  29 { rabbit } [ rabbit <obj-ref> get-ref ] unit-test
  30 { rabbit } [ f <obj-ref> rabbit set-ref* get-ref ] unit-test
  31 { rabbit } [ rabbit <obj-ref> take ] unit-test
  32 { rabbit f } [ rabbit <obj-ref> [ take ] keep get-ref ] unit-test
  33 { lion } [ rabbit <obj-ref> dup [ drop lion ] change-ref get-ref ] unit-test
  34
  35 ! var-refs
  36 { giraffe } [ [ giraffe rabbit set rabbit <var-ref> get-ref ] with-scope ] unit-test
  37
  38 { rabbit }
  39 [
  40     [
  41         lion rabbit set [
  42             rabbit rabbit set rabbit <var-ref> get-ref
  43         ] with-scope
  44     ] with-scope
  45 ] unit-test
  46
  47 { rabbit } [
  48     rabbit <var-ref>
  49     [
  50         lion rabbit set [
  51             rabbit rabbit set get-ref
  52         ] with-scope
  53     ] with-scope
  54 ] unit-test
  55
  56 { elephant } [
  57     rabbit <var-ref>
  58     [
  59         elephant rabbit set [
  60             rabbit rabbit set
  61         ] with-scope
  62         get-ref
  63     ] with-scope
  64 ] unit-test
  65
  66 { rabbit } [
  67     rabbit <var-ref>
  68     [
  69         elephant set-ref* [
  70             rabbit set-ref* get-ref
  71         ] with-scope
  72     ] with-scope
  73 ] unit-test
  74
  75 { elephant } [
  76     rabbit <var-ref>
  77     [
  78         elephant set-ref* [
  79             rabbit set-ref*
  80         ] with-scope
  81         get-ref
  82     ] with-scope
  83 ] unit-test
  84
  85 ! Top Hats
  86 { lion } [ lion rabbit set-global rabbit <global-var-ref> get-ref ] unit-test
  87 { giraffe } [ rabbit <global-var-ref> giraffe set-ref* get-ref ] unit-test
  88
  89 ! Tuple refs
  90 TUPLE: foo bar ;
  91 C: <foo> foo
  92
  93 : test-tuple ( -- tuple )
  94     rabbit <foo> ;
  95
  96 : test-slot-ref ( -- slot-ref )
  97     test-tuple 2 <slot-ref> ; ! hack!
  98
  99 { rabbit } [ test-slot-ref get-ref ] unit-test
 100 { lion } [ test-slot-ref lion set-ref* get-ref ] unit-test
 101
 102 ! Boxes as refs
 103 { rabbit } [ <box> rabbit set-ref* get-ref ] unit-test
 104 [ <box> rabbit set-ref* lion set-ref* ] must-fail
 105 [ <box> get-ref ] must-fail