Unit test fixes

basis/calendar/calendar-docs.factor

@@ -32,7 +32,7 @@ HELP: month-names
 { $warning "Do not use this array for looking up a month name directly. Use month-name instead." } ;
 
 HELP: month-name
-{ $values { "n" integer } { "string" string } }
+{ $values { "obj" { $or integer timestamp } } { "string" string } }
 { $description "Looks up the month name and returns it as a string.  January has an index of 1 instead of zero." } ;
 
 HELP: month-abbreviations
@@ -46,11 +46,11 @@ HELP: month-abbreviation
 
 
 HELP: day-names
-{ $values { "array" array } }
+{ $values { "value" array } }
 { $description "Returns an array with the English names of the days of the week." } ;
 
 HELP: day-name
-{ $values { "n" integer } { "string" string } }
+{ $values { "obj" { $or integer timestamp } } { "string" string } }
 { $description "Looks up the day name and returns it as a string." } ;
 
 HELP: day-abbreviations2

basis/quoted-printable/quoted-printable-tests.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2009 Daniel Ehrenberg
 ! See http://factorcode.org/license.txt for BSD license.
 USING: tools.test quoted-printable io.encodings.string
-sequences splitting kernel ;
+sequences splitting kernel io.encodings.8-bit.latin2 ;
 IN: quoted-printable.tests
 
 [ """José was the

basis/tools/profiler/profiler-tests.factor

@@ -60,7 +60,7 @@ IN: tools.profiler.tests
 
 [ [ gensym execute ] profile ] [ T{ undefined } = ] must-fail-with
 
-: crash-bug-1 ( -- x ) "hi" "bye" <word> ;
+: crash-bug-1 ( -- x ) "hi" <uninterned-word> ;
 : crash-bug-2 ( -- ) 100000 [ crash-bug-1 drop ] times ;
 
 [ ] [ [ crash-bug-2 ] profile ] unit-test

core/classes/algebra/algebra-tests.factor

@@ -39,6 +39,9 @@ INTERSECTION: generic-class generic class ;
 
 UNION: union-with-one-member a ;
 
+MIXIN: mixin-with-one-member
+INSTANCE: union-with-one-member mixin-with-one-member
+
 ! class<=
 [ t ] [ \ fixnum \ integer class<= ] unit-test
 [ t ] [ \ fixnum \ fixnum class<= ] unit-test
@@ -176,6 +179,22 @@ UNION: union-with-one-member a ;
 
 [ f ] [ sa sb classes-intersect? ] unit-test
 
+[ t ] [ a union-with-one-member classes-intersect? ] unit-test
+[ f ] [ fixnum union-with-one-member classes-intersect? ] unit-test
+[ t ] [ object union-with-one-member classes-intersect? ] unit-test
+
+[ t ] [ union-with-one-member a classes-intersect? ] unit-test
+[ f ] [ union-with-one-member fixnum classes-intersect? ] unit-test
+[ t ] [ union-with-one-member object classes-intersect? ] unit-test
+
+[ t ] [ a mixin-with-one-member classes-intersect? ] unit-test
+[ f ] [ fixnum mixin-with-one-member classes-intersect? ] unit-test
+[ t ] [ object mixin-with-one-member classes-intersect? ] unit-test
+
+[ t ] [ mixin-with-one-member a classes-intersect? ] unit-test
+[ f ] [ mixin-with-one-member fixnum classes-intersect? ] unit-test
+[ t ] [ mixin-with-one-member object classes-intersect? ] unit-test
+
 ! class=
 [ t ] [ null class-not object class= ] unit-test
 

core/classes/algebra/algebra.factor

@@ -36,8 +36,8 @@ GENERIC: (flatten-class) ( class -- )
 
 : normalize-class ( class -- class' )
     {
-        { [ dup members ] [ members <anonymous-union> ] }
-        { [ dup participants ] [ participants <anonymous-intersection> ] }
+        { [ dup members ] [ members <anonymous-union> normalize-class ] }
+        { [ dup participants ] [ participants <anonymous-intersection> normalize-class ] }
         [ ]
     } cond ;
 

core/memory/memory-tests.factor

@@ -31,4 +31,4 @@ TUPLE: testing x y z ;
 2 [ [ [ 3 throw ] instances ] must-fail ] times
 
 ! Bug found on Windows build box, having too many words in the image breaks 'become'
-[ ] [ 100000 [ f f <word> ] replicate { } { } become drop ] unit-test
+[ ] [ 100000 [ f <uninterned-word> ] replicate { } { } become drop ] unit-test

core/words/words-docs.factor

@@ -238,7 +238,8 @@ $low-level-note
 
 HELP: <word> ( name vocab -- word )
 { $values { "name" string } { "vocab" string } { "word" word } }
-{ $description "Allocates an uninterned word with the specified name and vocabulary, and a blank word property hashtable. User code should call " { $link gensym } " to create uninterned words and " { $link create } " to create interned words." } ;
+{ $description "Allocates an uninterned word with the specified name and vocabulary, and a blank word property hashtable. User code should call " { $link gensym } " to create uninterned words and " { $link create } " to create interned words." }
+{ $notes "This word must be called from inside " { $link with-compilation-unit } "." } ;
 
 HELP: gensym
 { $values { "word" word } }
@@ -279,12 +280,14 @@ HELP: check-create
 
 HELP: create
 { $values { "name" string } { "vocab" string } { "word" word } }
-{ $description "Creates a new word. If the vocabulary already contains a word with the requested name, outputs the existing word. The vocabulary must exist already; if it does not, you must call " { $link create-vocab } " first." } ;
+{ $description "Creates a new word. If the vocabulary already contains a word with the requested name, outputs the existing word. The vocabulary must exist already; if it does not, you must call " { $link create-vocab } " first." }
+{ $notes "This word must be called from inside " { $link with-compilation-unit } ". Parsing words should call " { $link create-in } " instead of this word." } ;
 
 HELP: constructor-word
 { $values { "name" string } { "vocab" string } { "word" word } }
 { $description "Creates a new word, surrounding " { $snippet "name" } " in angle brackets." }
-{ $examples { $example "USING: prettyprint words ;" "\"salmon\" \"scratchpad\" constructor-word ." "<salmon>" } } ;
+{ $notes "This word must be called from inside " { $link with-compilation-unit } "." }
+{ $examples { $example "USING: compiler.units prettyprint words ;" "[ \"salmon\" \"scratchpad\" constructor-word ] with-compilation-unit ." "<salmon>" } } ;
 
 { POSTPONE: FORGET: forget forget* forget-vocab } related-words
 

core/words/words-tests.factor

@@ -25,7 +25,8 @@ DEFER: plist-test
     \ plist-test "sample-property" word-prop
 ] unit-test
 
-"create-test" "scratchpad" create { 1 2 } "testing" set-word-prop
+[ ] [ [ "create-test" "scratchpad" create { 1 2 } "testing" set-word-prop ] with-compilation-unit ] unit-test
+
 [ { 1 2 } ] [
     "create-test" "scratchpad" lookup "testing" word-prop
 ] unit-test
@@ -33,7 +34,7 @@ DEFER: plist-test
 [
     [ t ] [ \ array? "array?" "arrays" lookup = ] unit-test
 
-    [ ] [ "test-scope" "scratchpad" create drop ] unit-test
+    [ ] [ [ "test-scope" "scratchpad" create drop ] with-compilation-unit ] unit-test
 ] with-scope
 
 [ "test-scope" ] [
@@ -67,7 +68,7 @@ FORGET: another-forgotten
 DEFER: x
 [ x ] [ undefined? ] must-fail-with
 
-[ ] [ "no-loc" "words.tests" create drop ] unit-test
+[ ] [ [ "no-loc" "words.tests" create drop ] with-compilation-unit ] unit-test
 [ f ] [ "no-loc" "words.tests" lookup where ] unit-test
 
 [ ] [ "IN: words.tests : no-loc-2 ( -- ) ;" eval( -- ) ] unit-test

extra/multi-methods/tests/definitions.factor

@@ -6,14 +6,14 @@ DEFER: fake
 \ fake H{ } clone "multi-methods" set-word-prop
 << (( -- )) \ fake set-stack-effect >>
 
-[ "fake-{ }" ] [ { } \ fake method-word-name ] unit-test
-
-[ H{ { "multi-method-generic" fake } { "multi-method-specializer" { } } } ]
-[ { } \ fake method-word-props ] unit-test
-
-[ t ] [ { } \ fake <method> method-body? ] unit-test
-
 [
+    [ "fake-{ }" ] [ { } \ fake method-word-name ] unit-test
+
+    [ H{ { "multi-method-generic" fake } { "multi-method-specializer" { } } } ]
+    [ { } \ fake method-word-props ] unit-test
+
+    [ t ] [ { } \ fake <method> method-body? ] unit-test
+
     [ { } [ ] ] [ \ fake methods prepare-methods [ sort-methods ] dip ] unit-test
 
     [ t ] [ { } \ fake multi-dispatch-quot callable? ] unit-test