]> gitweb.factorcode.org Git - factor.git/commitdiff
Unit test fixes
authorSlava Pestov <slava@shill.local>
Sat, 14 Nov 2009 05:00:50 +0000 (23:00 -0600)
committerSlava Pestov <slava@shill.local>
Sat, 14 Nov 2009 05:00:50 +0000 (23:00 -0600)
basis/calendar/calendar-docs.factor
basis/quoted-printable/quoted-printable-tests.factor
basis/tools/profiler/profiler-tests.factor
core/classes/algebra/algebra-tests.factor
core/classes/algebra/algebra.factor
core/memory/memory-tests.factor
core/words/words-docs.factor
core/words/words-tests.factor
extra/multi-methods/tests/definitions.factor

index 8cb1e751b26fde2202ad6c3967f847cfd6a77e8d..b774e79b8bbbba1528574b5a7026b67c2b88cf6a 100644 (file)
@@ -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
index 5825ebe252b37bfb7186ccfc0c29485cabd067b4..2a3239c72faa20d0c12e654b63a1162e46122220 100644 (file)
@@ -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
index 7f44a6138c2e6d8822c435a3af5687490a559755..6e5177fbae9088df87b844b137cb4a271d0f8948 100644 (file)
@@ -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
index e2f4d4305fe0bdd53675948831a0c6feba7388f3..c016b0169bf22808088a86abbd700c94c738fa78 100644 (file)
@@ -39,6 +39,9 @@ INTERSECTION: generic-class generic class ;
 \r
 UNION: union-with-one-member a ;\r
 \r
+MIXIN: mixin-with-one-member\r
+INSTANCE: union-with-one-member mixin-with-one-member\r
+\r
 ! class<=\r
 [ t ] [ \ fixnum \ integer class<= ] unit-test\r
 [ t ] [ \ fixnum \ fixnum class<= ] unit-test\r
@@ -176,6 +179,22 @@ UNION: union-with-one-member a ;
 \r
 [ f ] [ sa sb classes-intersect? ] unit-test\r
 \r
+[ t ] [ a union-with-one-member classes-intersect? ] unit-test\r
+[ f ] [ fixnum union-with-one-member classes-intersect? ] unit-test\r
+[ t ] [ object union-with-one-member classes-intersect? ] unit-test\r
+\r
+[ t ] [ union-with-one-member a classes-intersect? ] unit-test\r
+[ f ] [ union-with-one-member fixnum classes-intersect? ] unit-test\r
+[ t ] [ union-with-one-member object classes-intersect? ] unit-test\r
+\r
+[ t ] [ a mixin-with-one-member classes-intersect? ] unit-test\r
+[ f ] [ fixnum mixin-with-one-member classes-intersect? ] unit-test\r
+[ t ] [ object mixin-with-one-member classes-intersect? ] unit-test\r
+\r
+[ t ] [ mixin-with-one-member a classes-intersect? ] unit-test\r
+[ f ] [ mixin-with-one-member fixnum classes-intersect? ] unit-test\r
+[ t ] [ mixin-with-one-member object classes-intersect? ] unit-test\r
+\r
 ! class=\r
 [ t ] [ null class-not object class= ] unit-test\r
 \r
index c08239849fa24623a943c22da81e13f85704848c..e98470cd837e3760a60bfd26f8478e6c20d789e2 100755 (executable)
@@ -36,8 +36,8 @@ GENERIC: (flatten-class) ( class -- )
 \r
 : normalize-class ( class -- class' )\r
     {\r
-        { [ dup members ] [ members <anonymous-union> ] }\r
-        { [ dup participants ] [ participants <anonymous-intersection> ] }\r
+        { [ dup members ] [ members <anonymous-union> normalize-class ] }\r
+        { [ dup participants ] [ participants <anonymous-intersection> normalize-class ] }\r
         [ ]\r
     } cond ;\r
 \r
index 8ecf673b8a70ee8b8eb0d72a898415f6c0788ed9..45e6090e773877981357c1bcae3ed312b3ab3ac3 100755 (executable)
@@ -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
index d88761db1fade3ff2b9e6c8054f722f7699e98ff..a13bfb0740015a37f6949f5987de5f875446b213 100644 (file)
@@ -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
 
index fec9c14830087ff08e1cfd4926b41b2afcb09a27..cb4ecb1e06b7f523aaf7d14086556fffaf5f2473 100755 (executable)
@@ -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
index a483a492b3f1ed69f073ea9dca760c082318b343..b0ab2c1bc3499788995bfbd99a83eb7f83153f77 100644 (file)
@@ -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
+[
+    [ "fake-{ }" ] [ { } \ fake method-word-name ] unit-test
 
-[ H{ { "multi-method-generic" fake } { "multi-method-specializer" { } } } ]
-[ { } \ fake method-word-props ] unit-test
+    [ H{ { "multi-method-generic" fake } { "multi-method-specializer" { } } } ]
+    [ { } \ fake method-word-props ] unit-test
 
-[ t ] [ { } \ fake <method> method-body? ] 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