]> gitweb.factorcode.org Git - factor.git/blobdiff - core/slots/slots-tests.factor
Delete empty unit tests files, remove 1- and 1+, reorder IN: lines in a lot of places...
[factor.git] / core / slots / slots-tests.factor
index 16196bf844696ec0baa7972db006e8897d4a4176..81251d728fd75b755461b811116641fb2a314b97 100644 (file)
@@ -1,13 +1,14 @@
+USING: math accessors slots strings generic.single kernel
+tools.test generic words parser eval math.functions ;
 IN: slots.tests
-USING: math accessors slots strings generic.standard kernel tools.test ;
 
 TUPLE: r/w-test foo ;
 
-TUPLE: r/o-test { "foo" read-only: t } ;
+TUPLE: r/o-test { foo read-only } ;
 
 [ r/o-test new 123 >>foo ] [ no-method? ] must-fail-with
 
-TUPLE: decl-test { "foo" integer } ;
+TUPLE: decl-test { foo integer } ;
 
 [ decl-test new 1.0 >>foo ] [ bad-slot-value? ] must-fail-with
 
@@ -16,3 +17,35 @@ TUPLE: hello length ;
 [ 3 ] [ "xyz" length>> ] unit-test
 
 [ "xyz" 4 >>length ] [ no-method? ] must-fail-with
+
+[ t ] [ r/o-test \ foo>> method "foldable" word-prop ] unit-test
+[ t ] [ r/o-test \ foo>> method "flushable" word-prop ] unit-test
+
+[ f ] [ r/w-test \ foo>> method "foldable" word-prop ] unit-test
+[ t ] [ r/w-test \ foo>> method "flushable" word-prop ] unit-test
+
+! See if declarations are cleared on redefinition
+[ ] [ "IN: slots.tests TUPLE: r/w-test { foo read-only } ;" eval( -- ) ] unit-test
+
+[ t ] [ r/w-test \ foo>> method "foldable" word-prop ] unit-test
+[ t ] [ r/w-test \ foo>> method "flushable" word-prop ] unit-test
+
+[ ] [ "IN: slots.tests TUPLE: r/w-test foo ;" eval( -- ) ] unit-test
+
+[ f ] [ r/w-test \ foo>> method "foldable" word-prop ] unit-test
+[ t ] [ r/w-test \ foo>> method "flushable" word-prop ] unit-test
+
+! Test protocol slots
+SLOT: my-protocol-slot-test
+
+TUPLE: protocol-slot-test-tuple x ;
+
+M: protocol-slot-test-tuple my-protocol-slot-test>> x>> sq ;
+M: protocol-slot-test-tuple (>>my-protocol-slot-test) [ sqrt ] dip (>>x) ;
+
+[ 9 ] [ T{ protocol-slot-test-tuple { x 3 } } my-protocol-slot-test>> ] unit-test
+
+[ 4.0 ] [
+    T{ protocol-slot-test-tuple { x 3 } } clone
+    [ 7 + ] change-my-protocol-slot-test x>>
+] unit-test