Delete empty unit tests files, remove 1- and 1+, reorder IN: lines in a lot of places...

[factor.git] / basis / functors / functors-tests.factor

diff --git a/basis/functors/functors-tests.factor b/basis/functors/functors-tests.factor
index a5f3042b38e6eaf669e50689e0f1a1521e7937f8..a21313312bbb173e8bd38731e4fa0cd38bd91684 100644 (file)
--- a/basis/functors/functors-tests.factor
+++ b/basis/functors/functors-tests.factor
@@ -1,18 +1,19 @@
+USING: functors tools.test math words kernel multiline parser
+io.streams.string generic ;
 IN: functors.tests
-USING: functors tools.test math words kernel ;
 
 <<
 
 FUNCTOR: define-box ( T -- )
 
-B DEFINES ${T}-box
+B DEFINES-CLASS ${T}-box
 <B> DEFINES <${B}>
 
 WHERE
 
 TUPLE: B { value T } ;
 
-C: <B> B
+C: <B> B ( T -- B )
 
 ;FUNCTOR
 
@@ -42,8 +43,6 @@ WHERE
 
 >>
 
-\ sqsq must-infer
-
 [ 16 ] [ 2 sqsq ] unit-test
 
 <<
@@ -62,4 +61,93 @@ WHERE
 
 >>
 
-[ 4 ] [ 1 3 blah ] unit-test
\ No newline at end of file
+[ 4 ] [ 1 3 blah ] unit-test
+
+<<
+
+FUNCTOR: symbol-test ( W -- )
+
+W DEFINES ${W}
+
+WHERE
+
+SYMBOL: W
+
+;FUNCTOR
+
+"blorgh" symbol-test
+
+>>
+
+[ blorgh ] [ blorgh ] unit-test
+
+<<
+
+FUNCTOR: generic-test ( W -- )
+
+W DEFINES ${W}
+
+WHERE
+
+GENERIC: W ( a -- b )
+M: object W ;
+M: integer W 1 + ;
+
+;FUNCTOR
+
+"snurv" generic-test
+
+>>
+
+[ 2   ] [ 1   snurv ] unit-test
+[ 3.0 ] [ 3.0 snurv ] unit-test
+
+! Does replacing an ordinary word with a functor-generated one work?
+[ [ ] ] [
+    <" IN: functors.tests
+
+    TUPLE: some-tuple ;
+    : some-word ( -- ) ;
+    GENERIC: some-generic ( a -- b )
+    M: some-tuple some-generic ;
+    SYMBOL: some-symbol
+    "> <string-reader> "functors-test" parse-stream
+] unit-test
+
+: test-redefinition ( -- )
+    [ t ] [ "some-word" "functors.tests" lookup >boolean ] unit-test
+    [ t ] [ "some-tuple" "functors.tests" lookup >boolean ] unit-test
+    [ t ] [ "some-generic" "functors.tests" lookup >boolean ] unit-test
+    [ t ] [
+        "some-tuple" "functors.tests" lookup
+        "some-generic" "functors.tests" lookup method >boolean
+    ] unit-test ;
+    [ t ] [ "some-symbol" "functors.tests" lookup >boolean ] unit-test
+
+test-redefinition
+
+FUNCTOR: redefine-test ( W -- )
+
+W-word DEFINES ${W}-word
+W-tuple DEFINES-CLASS ${W}-tuple
+W-generic DEFINES ${W}-generic
+W-symbol DEFINES ${W}-symbol
+
+WHERE
+
+TUPLE: W-tuple ;
+: W-word ( -- ) ;
+GENERIC: W-generic ( a -- b )
+M: W-tuple W-generic ;
+SYMBOL: W-symbol
+
+;FUNCTOR
+
+[ [ ] ] [
+    <" IN: functors.tests
+    << "some" redefine-test >>
+    "> <string-reader> "functors-test" parse-stream
+] unit-test
+
+test-redefinition
+