From ad19fd7cbd94b80da080d4ca07590c855b707c8e Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Fri, 24 Apr 2009 15:02:53 -0500
Subject: [PATCH 01/24] Web 2.0 style assoc syntax. H{ "foo" => 1 "bar" => { 2
3 } }
---
extra/pair-rocket/authors.txt | 1 +
extra/pair-rocket/pair-rocket-docs.factor | 15 +++++++++++++++
extra/pair-rocket/pair-rocket-tests.factor | 9 +++++++++
extra/pair-rocket/pair-rocket.factor | 6 ++++++
extra/pair-rocket/summary.txt | 1 +
5 files changed, 32 insertions(+)
create mode 100644 extra/pair-rocket/authors.txt
create mode 100644 extra/pair-rocket/pair-rocket-docs.factor
create mode 100644 extra/pair-rocket/pair-rocket-tests.factor
create mode 100644 extra/pair-rocket/pair-rocket.factor
create mode 100644 extra/pair-rocket/summary.txt
diff --git a/extra/pair-rocket/authors.txt b/extra/pair-rocket/authors.txt
new file mode 100644
index 0000000000..f13c9c1e77
--- /dev/null
+++ b/extra/pair-rocket/authors.txt
@@ -0,0 +1 @@
+Joe Groff
diff --git a/extra/pair-rocket/pair-rocket-docs.factor b/extra/pair-rocket/pair-rocket-docs.factor
new file mode 100644
index 0000000000..d66df62347
--- /dev/null
+++ b/extra/pair-rocket/pair-rocket-docs.factor
@@ -0,0 +1,15 @@
+! (c)2009 Joe Groff bsd license
+USING: help.markup help.syntax multiline ;
+IN: pair-rocket
+
+HELP: =>
+{ $syntax "a => b" }
+{ $description "Constructs a two-element array from the objects immediately before and after the " { $snippet "=>" } ". This syntax can be used inside sequence and assoc literals." }
+{ $examples
+{ $unchecked-example <" USING: pair-rocket prettyprint ;
+
+H{ "foo" => 1 "bar" => 2 } .
+"> <" H{ { "foo" 1 } { "bar" 2 } } "> }
+}
+;
+
diff --git a/extra/pair-rocket/pair-rocket-tests.factor b/extra/pair-rocket/pair-rocket-tests.factor
new file mode 100644
index 0000000000..0e3d27beb1
--- /dev/null
+++ b/extra/pair-rocket/pair-rocket-tests.factor
@@ -0,0 +1,9 @@
+USING: kernel pair-rocket tools.test ;
+IN: pair-rocket.tests
+
+[ { "a" 1 } ] [ "a" => 1 ] unit-test
+[ { { "a" } { 1 } } ] [ { "a" } => { 1 } ] unit-test
+[ { drop 1 } ] [ drop => 1 ] unit-test
+
+[ H{ { "zippity" 5 } { "doo" 2 } { "dah" 7 } } ]
+[ H{ "zippity" => 5 "doo" => 2 "dah" => 7 } ] unit-test
diff --git a/extra/pair-rocket/pair-rocket.factor b/extra/pair-rocket/pair-rocket.factor
new file mode 100644
index 0000000000..3bd8a098f6
--- /dev/null
+++ b/extra/pair-rocket/pair-rocket.factor
@@ -0,0 +1,6 @@
+! (c)2009 Joe Groff bsd license
+USING: arrays kernel parser sequences ;
+IN: pair-rocket
+
+SYNTAX: => dup pop scan-object 2array parsed ;
+
diff --git a/extra/pair-rocket/summary.txt b/extra/pair-rocket/summary.txt
new file mode 100644
index 0000000000..79c8d60149
--- /dev/null
+++ b/extra/pair-rocket/summary.txt
@@ -0,0 +1 @@
+H{ "foo" => 1 "bar" => 2 } style literal syntax
From 5e5042fe5ff15fa5e4b4d60ccefa6cb3e8d9b9d8 Mon Sep 17 00:00:00 2001
From: Doug Coleman <erg@jobim.local>
Date: Fri, 24 Apr 2009 19:01:26 -0500
Subject: [PATCH 02/24] fix help-lint, compilation issue in
io.directories.search
---
basis/io/directories/search/search.factor | 30 +++++++++++------------
1 file changed, 15 insertions(+), 15 deletions(-)
diff --git a/basis/io/directories/search/search.factor b/basis/io/directories/search/search.factor
index 2202f7aa08..f7d18306f8 100755
--- a/basis/io/directories/search/search.factor
+++ b/basis/io/directories/search/search.factor
@@ -39,55 +39,55 @@ TUPLE: directory-iterator path bfs queue ;
dup directory?
[ name>> over push-directory-entries next-directory-entry ]
[ nip ] if
- ] if ; recursive
+ ] if ;
-:: iterate-directory-entries ( iter quot -- directory-entry/f )
+:: iterate-directory-entries ( iter quot: ( obj -- obj ) -- directory-entry/f )
iter next-directory-entry [
- quot call( obj -- obj )
+ quot call
[ iter quot iterate-directory-entries ] unless*
] [
f
] if* ; inline recursive
: iterate-directory ( iter quot -- path/f )
- [ name>> ] prepose iterate-directory-entries ;
+ [ name>> ] prepose iterate-directory-entries ; inline
: setup-traversal ( path bfs quot -- iterator quot' )
- [ <directory-iterator> ] dip [ f ] compose ;
+ [ <directory-iterator> ] dip [ f ] compose ; inline
PRIVATE>
: each-file ( path bfs? quot -- )
- setup-traversal iterate-directory drop ;
+ setup-traversal iterate-directory drop ; inline
: each-directory-entry ( path bfs? quot -- )
- setup-traversal iterate-directory-entries drop ;
+ setup-traversal iterate-directory-entries drop ; inline
: recursive-directory-files ( path bfs? -- paths )
- [ ] accumulator [ each-file ] dip ;
+ [ ] accumulator [ each-file ] dip ; inline
-: recursive-directory-entries ( path bfs? -- paths )
- [ ] accumulator [ each-directory-entry ] dip ;
+: recursive-directory-entries ( path bfs? -- directory-entries )
+ [ ] accumulator [ each-directory-entry ] dip ; inline
: find-file ( path bfs? quot -- path/f )
[ <directory-iterator> ] dip
- [ keep and ] curry iterate-directory ;
+ [ keep and ] curry iterate-directory ; inline
: find-all-files ( path quot -- paths/f )
[ f <directory-iterator> ] dip pusher
- [ [ f ] compose iterate-directory drop ] dip ;
+ [ [ f ] compose iterate-directory drop ] dip ; inline
ERROR: file-not-found path bfs? quot ;
: find-file-throws ( path bfs? quot -- path )
- 3dup find-file dup [ 2nip nip ] [ drop file-not-found ] if ;
+ 3dup find-file dup [ 2nip nip ] [ drop file-not-found ] if ; inline
: find-in-directories ( directories bfs? quot -- path'/f )
'[ _ [ _ _ find-file-throws ] attempt-all ]
- [ drop f ] recover ;
+ [ drop f ] recover ; inline
: find-all-in-directories ( directories quot -- paths/f )
- '[ _ find-all-files ] map concat ;
+ '[ _ find-all-files ] map concat ; inline
: link-size/0 ( path -- n )
[ link-info size-on-disk>> ] [ 2drop 0 ] recover ;
From f24bf512890bc009b47f54113e395eada3510606 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.internal.stack-effects.com>
Date: Sat, 25 Apr 2009 16:52:23 -0500
Subject: [PATCH 03/24] mason: some fixes
---
extra/mason/notify/notify.factor | 4 ++--
extra/mason/report/report.factor | 2 +-
2 files changed, 3 insertions(+), 3 deletions(-)
diff --git a/extra/mason/notify/notify.factor b/extra/mason/notify/notify.factor
index 6bf4ae090d..96e31c4a45 100644
--- a/extra/mason/notify/notify.factor
+++ b/extra/mason/notify/notify.factor
@@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: arrays accessors io io.sockets io.encodings.utf8 io.files
io.launcher kernel make mason.config mason.common mason.email
-mason.twitter namespaces sequences ;
+mason.twitter namespaces sequences prettyprint ;
IN: mason.notify
: status-notify ( input-file args -- )
@@ -38,7 +38,7 @@ IN: mason.notify
f { "test" } status-notify ;
: notify-report ( status -- )
- [ "Build finished with status: " write print flush ]
+ [ "Build finished with status: " write . flush ]
[
[ "report" utf8 file-contents ] dip email-report
"report" { "report" } status-notify
diff --git a/extra/mason/report/report.factor b/extra/mason/report/report.factor
index edc8416235..64d31b4368 100644
--- a/extra/mason/report/report.factor
+++ b/extra/mason/report/report.factor
@@ -28,7 +28,7 @@ IN: mason.report
common-report
_ call( -- xml )
[XML <html><body><-><-></body></html> XML]
- pprint-xml
+ write-xml
] with-file-writer ; inline
:: failed-report ( error file what -- status )
From 66b4d42e133a412bbf6f844fab4168ed16804440 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.internal.stack-effects.com>
Date: Sat, 25 Apr 2009 17:03:50 -0500
Subject: [PATCH 04/24] math.blas: use gfortran by default on linux-x86-64
since latest ubuntu blas packages are compiled with gfortran abi
---
basis/math/blas/config/config.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/basis/math/blas/config/config.factor b/basis/math/blas/config/config.factor
index 327c546963..09f736c036 100644
--- a/basis/math/blas/config/config.factor
+++ b/basis/math/blas/config/config.factor
@@ -18,7 +18,7 @@ blas-fortran-abi [
{ [ os netbsd? cpu x86.64? and ] [ g95-abi ] }
{ [ os windows? cpu x86.64? and ] [ gfortran-abi ] }
{ [ os freebsd? ] [ gfortran-abi ] }
- { [ os linux? cpu x86.32? and ] [ gfortran-abi ] }
+ { [ os linux? ] [ gfortran-abi ] }
[ f2c-abi ]
} cond
] initialize
From 2330ec3042f986abd8714837ca359563ad5f6c55 Mon Sep 17 00:00:00 2001
From: Doug Coleman <erg@jobim.local>
Date: Sat, 25 Apr 2009 18:59:03 -0500
Subject: [PATCH 05/24] use ui.images drawing code in images.viewer
---
extra/images/viewer/viewer.factor | 25 +++++++++----------------
1 file changed, 9 insertions(+), 16 deletions(-)
diff --git a/extra/images/viewer/viewer.factor b/extra/images/viewer/viewer.factor
index cf9e9c836a..2818c16f9f 100644
--- a/extra/images/viewer/viewer.factor
+++ b/extra/images/viewer/viewer.factor
@@ -2,33 +2,26 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors images images.loader io.pathnames kernel namespaces
opengl opengl.gl opengl.textures sequences strings ui ui.gadgets
-ui.gadgets.panes ui.render ;
+ui.gadgets.panes ui.render ui.images ;
IN: images.viewer
-TUPLE: image-gadget < gadget { image image } ;
+TUPLE: image-gadget < gadget image-name ;
M: image-gadget pref-dim*
- image>> dim>> ;
-
-: draw-image ( image -- )
- 0 0 glRasterPos2i 1.0 -1.0 glPixelZoom
- [ dim>> first2 ] [ component-order>> component-order>format ] [ bitmap>> ] tri
- glDrawPixels ;
+ image-name>> image-dim ;
M: image-gadget draw-gadget* ( gadget -- )
- image>> draw-image ;
+ image-name>> draw-image ;
-: <image-gadget> ( image -- gadget )
+: <image-gadget> ( image-name -- gadget )
\ image-gadget new
- swap >>image ;
+ swap >>image-name ;
: image-window ( path -- gadget )
- [ load-image <image-gadget> dup ] [ open-window ] bi ;
+ [ <image-name> <image-gadget> dup ] [ open-window ] bi ;
GENERIC: image. ( object -- )
-M: string image. ( image -- ) load-image image. ;
+M: string image. ( image -- ) <image-name> <image-gadget> gadget. ;
-M: pathname image. ( image -- ) load-image image. ;
-
-M: image image. ( image -- ) <image-gadget> gadget. ;
+M: pathname image. ( image -- ) <image-name> <image-gadget> gadget. ;
From 2484ea07b0f7de236bbb5260116a8243f35ea453 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 25 Apr 2009 19:22:00 -0500
Subject: [PATCH 06/24] support read-only mmap
---
basis/io/mmap/functor/functor.factor | 12 ++++++++----
basis/io/mmap/mmap-docs.factor | 8 +++++++-
basis/io/mmap/mmap.factor | 24 ++++++++++++++++++++----
basis/io/mmap/unix/unix.factor | 7 ++++++-
basis/io/mmap/windows/windows.factor | 11 ++++++++++-
5 files changed, 51 insertions(+), 11 deletions(-)
diff --git a/basis/io/mmap/functor/functor.factor b/basis/io/mmap/functor/functor.factor
index 21b3d294c9..a80ce3bc82 100644
--- a/basis/io/mmap/functor/functor.factor
+++ b/basis/io/mmap/functor/functor.factor
@@ -9,13 +9,14 @@ SLOT: length
: mapped-file>direct ( mapped-file type -- alien length )
[ [ address>> ] [ length>> ] bi ] dip
- heap-size [ 1- + ] keep /i ;
+ heap-size [ 1 - + ] keep /i ;
FUNCTOR: define-mapped-array ( T -- )
-<mapped-A> DEFINES <mapped-${T}-array>
-<A> IS <direct-${T}-array>
-with-mapped-A-file DEFINES with-mapped-${T}-file
+<mapped-A> DEFINES <mapped-${T}-array>
+<A> IS <direct-${T}-array>
+with-mapped-A-file DEFINES with-mapped-${T}-file
+with-mapped-A-file-reader DEFINES with-mapped-${T}-file-reader
WHERE
@@ -25,4 +26,7 @@ WHERE
: with-mapped-A-file ( path quot -- )
'[ <mapped-A> @ ] with-mapped-file ; inline
+: with-mapped-A-file-reader ( path quot -- )
+ '[ <mapped-A> @ ] with-mapped-file-reader ; inline
+
;FUNCTOR
diff --git a/basis/io/mmap/mmap-docs.factor b/basis/io/mmap/mmap-docs.factor
index f0adb47321..1da82e42e2 100644
--- a/basis/io/mmap/mmap-docs.factor
+++ b/basis/io/mmap/mmap-docs.factor
@@ -18,7 +18,13 @@ HELP: <mapped-file>
HELP: with-mapped-file
{ $values { "path" "a pathname string" } { "quot" { $quotation "( mmap -- )" } } }
-{ $contract "Opens a file and maps its contents into memory, passing the " { $link mapped-file } " instance to the quotation. The mapped file is disposed of when the quotation returns, or if an error is thrown." }
+{ $contract "Opens a file for read/write access and maps its contents into memory, passing the " { $link mapped-file } " instance to the quotation. The mapped file is disposed of when the quotation returns, or if an error is thrown." }
+{ $notes "This is a low-level word, because " { $link mapped-file } " objects simply expose their base address and length. Most applications should use " { $link "io.mmap.arrays" } " instead." }
+{ $errors "Throws an error if a memory mapping could not be established." } ;
+
+HELP: with-mapped-file-reader
+{ $values { "path" "a pathname string" } { "quot" { $quotation "( mmap -- )" } } }
+{ $contract "Opens a file for read-only access and maps its contents into memory, passing the " { $link mapped-file } " instance to the quotation. The mapped file is disposed of when the quotation returns, or if an error is thrown." }
{ $notes "This is a low-level word, because " { $link mapped-file } " objects simply expose their base address and length. Most applications should use " { $link "io.mmap.arrays" } " instead." }
{ $errors "Throws an error if a memory mapping could not be established." } ;
diff --git a/basis/io/mmap/mmap.factor b/basis/io/mmap/mmap.factor
index 1a58471514..e03d5fb30b 100644
--- a/basis/io/mmap/mmap.factor
+++ b/basis/io/mmap/mmap.factor
@@ -8,14 +8,27 @@ IN: io.mmap
TUPLE: mapped-file address handle length disposed ;
-HOOK: (mapped-file) os ( path length -- address handle )
+HOOK: (mapped-file-reader) os ( path length -- address handle )
+HOOK: (mapped-file-r/w) os ( path length -- address handle )
ERROR: bad-mmap-size path size ;
-: <mapped-file> ( path -- mmap )
+<PRIVATE
+
+: prepare-mapped-file ( path -- path' n )
[ normalize-path ] [ file-info size>> ] bi
- dup 0 <= [ bad-mmap-size ] when
- [ (mapped-file) ] keep
+ dup 0 <= [ bad-mmap-size ] when ;
+
+PRIVATE>
+
+: <mapped-file-reader> ( path -- mmap )
+ prepare-mapped-file
+ [ (mapped-file-reader) ] keep
+ f mapped-file boa ;
+
+: <mapped-file> ( path -- mmap )
+ prepare-mapped-file
+ [ (mapped-file-r/w) ] keep
f mapped-file boa ;
HOOK: close-mapped-file io-backend ( mmap -- )
@@ -25,6 +38,9 @@ M: mapped-file dispose* ( mmap -- ) close-mapped-file ;
: with-mapped-file ( path quot -- )
[ <mapped-file> ] dip with-disposal ; inline
+: with-mapped-file-reader ( path quot -- )
+ [ <mapped-file-reader> ] dip with-disposal ; inline
+
{
{ [ os unix? ] [ "io.mmap.unix" require ] }
{ [ os winnt? ] [ "io.mmap.windows" require ] }
diff --git a/basis/io/mmap/unix/unix.factor b/basis/io/mmap/unix/unix.factor
index 0fa8e1151f..0424321b84 100644
--- a/basis/io/mmap/unix/unix.factor
+++ b/basis/io/mmap/unix/unix.factor
@@ -13,11 +13,16 @@ IN: io.mmap.unix
[ 0 mmap dup MAP_FAILED = [ (io-error) ] when ] keep
] with-destructors ;
-M: unix (mapped-file)
+M: unix (mapped-file-r/w)
{ PROT_READ PROT_WRITE } flags
{ MAP_FILE MAP_SHARED } flags
mmap-open ;
+M: unix (mapped-file-reader)
+ { PROT_READ } flags
+ { MAP_FILE MAP_SHARED } flags
+ mmap-open ;
+
M: unix close-mapped-file ( mmap -- )
[ [ address>> ] [ length>> ] bi munmap io-error ]
[ handle>> close-file ]
diff --git a/basis/io/mmap/windows/windows.factor b/basis/io/mmap/windows/windows.factor
index fcdf416511..ebd8109d14 100644
--- a/basis/io/mmap/windows/windows.factor
+++ b/basis/io/mmap/windows/windows.factor
@@ -28,7 +28,7 @@ M: win32-mapped-file dispose
C: <win32-mapped-file> win32-mapped-file
-M: windows (mapped-file)
+M: windows (mapped-file-r/w)
[
{ GENERIC_WRITE GENERIC_READ } flags
OPEN_ALWAYS
@@ -37,6 +37,15 @@ M: windows (mapped-file)
-rot <win32-mapped-file>
] with-destructors ;
+M: windows (mapped-file-reader)
+ [
+ GENERIC_READ
+ OPEN_ALWAYS
+ { PAGE_READONLY SEC_COMMIT } flags
+ FILE_MAP_READ mmap-open
+ -rot <win32-mapped-file>
+ ] with-destructors ;
+
M: windows close-mapped-file ( mapped-file -- )
[
[ handle>> &dispose drop ]
From 345b27a67327d9db425b3c8f3f208105ef1121ab Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sat, 25 Apr 2009 19:22:03 -0500
Subject: [PATCH 07/24] dog tag for pair-rocket
---
extra/pair-rocket/pair-rocket-tests.factor | 1 +
1 file changed, 1 insertion(+)
diff --git a/extra/pair-rocket/pair-rocket-tests.factor b/extra/pair-rocket/pair-rocket-tests.factor
index 0e3d27beb1..695e50ea7e 100644
--- a/extra/pair-rocket/pair-rocket-tests.factor
+++ b/extra/pair-rocket/pair-rocket-tests.factor
@@ -1,3 +1,4 @@
+! (c)2009 Joe Groff bsd license
USING: kernel pair-rocket tools.test ;
IN: pair-rocket.tests
From 90d40a7650c16dda91e8bc01c33676a8cb0c71cd Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 25 Apr 2009 19:22:46 -0500
Subject: [PATCH 08/24] calculate a magic number in md5
---
basis/checksums/md5/md5.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/basis/checksums/md5/md5.factor b/basis/checksums/md5/md5.factor
index 04c6c2497e..29620b089d 100644
--- a/basis/checksums/md5/md5.factor
+++ b/basis/checksums/md5/md5.factor
@@ -14,7 +14,7 @@ IN: checksums.md5
SYMBOLS: a b c d old-a old-b old-c old-d ;
: T ( N -- Y )
- sin abs 4294967296 * >integer ; foldable
+ sin abs 32 2^ * >integer ; foldable
: initialize-md5 ( -- )
0 bytes-read set
From 592a840c52ad322ef7cf2841e06ea02d1cfd7563 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sat, 25 Apr 2009 19:22:47 -0500
Subject: [PATCH 09/24] a syntax pearl for literal string arrays
---
extra/qw/authors.txt | 1 +
extra/qw/qw-docs.factor | 11 +++++++++++
extra/qw/qw-tests.factor | 5 +++++
extra/qw/qw.factor | 5 +++++
extra/qw/summary.txt | 1 +
5 files changed, 23 insertions(+)
create mode 100644 extra/qw/authors.txt
create mode 100644 extra/qw/qw-docs.factor
create mode 100644 extra/qw/qw-tests.factor
create mode 100644 extra/qw/qw.factor
create mode 100644 extra/qw/summary.txt
diff --git a/extra/qw/authors.txt b/extra/qw/authors.txt
new file mode 100644
index 0000000000..f13c9c1e77
--- /dev/null
+++ b/extra/qw/authors.txt
@@ -0,0 +1 @@
+Joe Groff
diff --git a/extra/qw/qw-docs.factor b/extra/qw/qw-docs.factor
new file mode 100644
index 0000000000..8af2c14f1e
--- /dev/null
+++ b/extra/qw/qw-docs.factor
@@ -0,0 +1,11 @@
+USING: help.markup help.syntax multiline ;
+IN: qw
+
+HELP: qw{
+{ $syntax "qw{ lorem ipsum }" }
+{ $description "Marks the beginning of a literal array of strings. Component strings are delimited by whitespace." }
+{ $examples
+{ $unchecked-example <" USING: prettyprint qw ;
+qw{ pop quiz my hive of big wild ex tranny jocks } . ">
+<" { "pop" "quiz" "my" "hive" "of" "big" "wild" "ex" "tranny" "jocks" } "> }
+} ;
diff --git a/extra/qw/qw-tests.factor b/extra/qw/qw-tests.factor
new file mode 100644
index 0000000000..c9d9208751
--- /dev/null
+++ b/extra/qw/qw-tests.factor
@@ -0,0 +1,5 @@
+! (c)2009 Joe Groff bsd license
+USING: qw tools.test ;
+IN: qw.tests
+
+[ { "zippity" "doo" "dah" } ] [ qw{ zippity doo dah } ] unit-test
diff --git a/extra/qw/qw.factor b/extra/qw/qw.factor
new file mode 100644
index 0000000000..ce96587c92
--- /dev/null
+++ b/extra/qw/qw.factor
@@ -0,0 +1,5 @@
+! (c)2009 Joe Groff bsd license
+USING: lexer parser ;
+IN: qw
+
+SYNTAX: qw{ "}" parse-tokens parsed ;
diff --git a/extra/qw/summary.txt b/extra/qw/summary.txt
new file mode 100644
index 0000000000..8c31961dc8
--- /dev/null
+++ b/extra/qw/summary.txt
@@ -0,0 +1 @@
+Perlish syntax for literal arrays of whitespace-delimited strings (qw{ foo bar })
From a1fc4616e93dfa85cb991c7d0f9a446fcd312493 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sat, 25 Apr 2009 19:24:01 -0500
Subject: [PATCH 10/24] dog tag again
---
extra/qw/qw-docs.factor | 1 +
1 file changed, 1 insertion(+)
diff --git a/extra/qw/qw-docs.factor b/extra/qw/qw-docs.factor
index 8af2c14f1e..4709ef620d 100644
--- a/extra/qw/qw-docs.factor
+++ b/extra/qw/qw-docs.factor
@@ -1,3 +1,4 @@
+! (c)2009 Joe Groff bsd license
USING: help.markup help.syntax multiline ;
IN: qw
From 71f2e997a6febc2787413bcb28877aac99a4f953 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 25 Apr 2009 19:26:16 -0500
Subject: [PATCH 11/24] use read-only mmap in id3. save id3 parsing errors
---
extra/id3/id3.factor | 21 ++++++++++++---------
1 file changed, 12 insertions(+), 9 deletions(-)
diff --git a/extra/id3/id3.factor b/extra/id3/id3.factor
index a5671a5822..6025af4926 100644
--- a/extra/id3/id3.factor
+++ b/extra/id3/id3.factor
@@ -6,7 +6,7 @@ combinators math.ranges unicode.categories byte-arrays
io.encodings.string io.encodings.utf16 assocs math.parser
combinators.short-circuit fry namespaces combinators.smart
splitting io.encodings.ascii arrays io.files.info unicode.case
-io.directories.search literals math.functions ;
+io.directories.search literals math.functions continuations ;
IN: id3
<PRIVATE
@@ -205,7 +205,9 @@ CONSTANT: id3v1+-offset $[ 128 227 + ]
drop
] if ;
-: (mp3>id3) ( path -- id3v2/f )
+PRIVATE>
+
+: mp3>id3 ( path -- id3v2/f )
[
[ <id3> ] dip
{
@@ -213,12 +215,7 @@ CONSTANT: id3v1+-offset $[ 128 227 + ]
[ dup id3v1+? [ read-v1+-tags merge-id3v1 ] [ drop ] if ]
[ dup id3v2? [ read-v2-tags ] [ drop ] if ]
} cleave
- ] with-mapped-uchar-file ;
-
-PRIVATE>
-
-: mp3>id3 ( path -- id3/f )
- dup file-info size>> 0 <= [ drop f ] [ (mp3>id3) ] if ;
+ ] with-mapped-uchar-file-reader ;
: find-id3-frame ( id3 name -- obj/f )
swap frames>> at* [ data>> ] when ;
@@ -239,8 +236,14 @@ PRIVATE>
: find-mp3s ( path -- seq )
[ >lower ".mp3" tail? ] find-all-files ;
+ERROR: id3-parse-error path error ;
+
+: (mp3-paths>id3s) ( seq -- seq' )
+ [ dup [ mp3>id3 ] [ \ id3-parse-error boa ] recover ] { } map>assoc ;
+
: mp3-paths>id3s ( seq -- seq' )
- [ dup mp3>id3 ] { } map>assoc ;
+ (mp3-paths>id3s)
+ [ dup second id3-parse-error? [ f over set-second ] when ] map ;
: parse-mp3-directory ( path -- seq )
find-mp3s mp3-paths>id3s ;
From c44349c74eaca7dea0b41ec86673625ce8480248 Mon Sep 17 00:00:00 2001
From: Doug Coleman <erg@jobim.local>
Date: Sat, 25 Apr 2009 19:32:44 -0500
Subject: [PATCH 12/24] test read-only mmap
---
basis/io/mmap/mmap-tests.factor | 1 +
1 file changed, 1 insertion(+)
diff --git a/basis/io/mmap/mmap-tests.factor b/basis/io/mmap/mmap-tests.factor
index a4d55f3c1e..0e1cd1a036 100644
--- a/basis/io/mmap/mmap-tests.factor
+++ b/basis/io/mmap/mmap-tests.factor
@@ -7,6 +7,7 @@ IN: io.mmap.tests
[ ] [ "12345" "mmap-test-file.txt" temp-file ascii set-file-contents ] unit-test
[ ] [ "mmap-test-file.txt" temp-file [ CHAR: 2 0 pick set-nth drop ] with-mapped-char-file ] unit-test
[ 5 ] [ "mmap-test-file.txt" temp-file [ length ] with-mapped-char-file ] unit-test
+[ 5 ] [ "mmap-test-file.txt" temp-file [ length ] with-mapped-char-file-reader ] unit-test
[ "22345" ] [ "mmap-test-file.txt" temp-file ascii file-contents ] unit-test
[ "mmap-test-file.txt" temp-file delete-file ] ignore-errors
From 3f764fc8720469b77ed3d37b7069d5bc0b8e675a Mon Sep 17 00:00:00 2001
From: Doug Coleman <erg@jobim.local>
Date: Sat, 25 Apr 2009 20:02:41 -0500
Subject: [PATCH 13/24] fix file mode for read only mmap in unix
---
basis/io/mmap/unix/unix.factor | 13 +++++--------
1 file changed, 5 insertions(+), 8 deletions(-)
diff --git a/basis/io/mmap/unix/unix.factor b/basis/io/mmap/unix/unix.factor
index 0424321b84..7d12d52361 100644
--- a/basis/io/mmap/unix/unix.factor
+++ b/basis/io/mmap/unix/unix.factor
@@ -4,26 +4,23 @@ USING: alien io io.files kernel math math.bitwise system unix
io.backend.unix io.ports io.mmap destructors locals accessors ;
IN: io.mmap.unix
-: open-r/w ( path -- fd ) O_RDWR file-mode open-file ;
-
-:: mmap-open ( path length prot flags -- alien fd )
+:: mmap-open ( path length prot flags open-mode -- alien fd )
[
f length prot flags
- path open-r/w [ <fd> |dispose drop ] keep
+ path open-mode file-mode open-file [ <fd> |dispose drop ] keep
[ 0 mmap dup MAP_FAILED = [ (io-error) ] when ] keep
] with-destructors ;
M: unix (mapped-file-r/w)
{ PROT_READ PROT_WRITE } flags
{ MAP_FILE MAP_SHARED } flags
- mmap-open ;
+ O_RDWR mmap-open ;
M: unix (mapped-file-reader)
{ PROT_READ } flags
{ MAP_FILE MAP_SHARED } flags
- mmap-open ;
+ O_RDONLY mmap-open ;
M: unix close-mapped-file ( mmap -- )
[ [ address>> ] [ length>> ] bi munmap io-error ]
- [ handle>> close-file ]
- bi ;
+ [ handle>> close-file ] bi ;
From e32869b0c305cfea8f932fc2856399aab04c26f0 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sat, 25 Apr 2009 20:07:54 -0500
Subject: [PATCH 14/24] =?UTF-8?q?r=C3=B4les?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
---
extra/roles/roles-tests.factor | 55 +++++++++++++++++++++++++++
extra/roles/roles.factor | 69 ++++++++++++++++++++++++++++++++++
2 files changed, 124 insertions(+)
create mode 100644 extra/roles/roles-tests.factor
create mode 100644 extra/roles/roles.factor
diff --git a/extra/roles/roles-tests.factor b/extra/roles/roles-tests.factor
new file mode 100644
index 0000000000..aaa197f5ed
--- /dev/null
+++ b/extra/roles/roles-tests.factor
@@ -0,0 +1,55 @@
+! (c)2009 Joe Groff bsd license
+USING: accessors classes.tuple compiler.units kernel qw roles sequences
+tools.test ;
+IN: roles.tests
+
+ROLE: fork tines ;
+ROLE: spoon bowl ;
+ROLE: instrument tone ;
+ROLE: tuning-fork <{ fork instrument } volume ;
+
+TUPLE: utensil handle ;
+
+! role consumption and tuple inheritance can be mixed
+TUPLE: foon <{ utensil fork spoon } ;
+TUPLE: tuning-spork <{ utensil spoon tuning-fork } ;
+
+! role class testing
+[ t ] [ fork role? ] unit-test
+[ f ] [ foon role? ] unit-test
+
+! roles aren't tuple classes by themselves and can't be instantiated
+[ f ] [ fork tuple-class? ] unit-test
+[ fork new ] must-fail
+
+! tuples which consume roles fall under their class
+[ t ] [ foon new fork? ] unit-test
+[ t ] [ foon new spoon? ] unit-test
+[ f ] [ foon new tuning-fork? ] unit-test
+[ f ] [ foon new instrument? ] unit-test
+
+[ t ] [ tuning-spork new fork? ] unit-test
+[ t ] [ tuning-spork new spoon? ] unit-test
+[ t ] [ tuning-spork new tuning-fork? ] unit-test
+[ t ] [ tuning-spork new instrument? ] unit-test
+
+! consumed role slots are placed in tuples in order
+[ qw{ handle tines bowl } ] [ foon all-slots [ name>> ] map ] unit-test
+[ qw{ handle bowl tines tone volume } ] [ tuning-spork all-slots [ name>> ] map ] unit-test
+
+! can't combine roles whose slots overlap
+ROLE: bong bowl ;
+SYMBOL: spong
+
+[ [ spong { spoon bong } { } define-tuple-class-with-roles ] with-compilation-unit ]
+[ role-slot-overlap? ] must-fail-with
+
+[ [ spong { spoon bong } { } define-role ] with-compilation-unit ]
+[ role-slot-overlap? ] must-fail-with
+
+! can't try to inherit multiple tuple classes
+TUPLE: tool blade ;
+SYMBOL: knife
+
+[ knife { utensil tool } { } define-tuple-class-with-roles ]
+[ multiple-inheritance-attempted? ] must-fail-with
diff --git a/extra/roles/roles.factor b/extra/roles/roles.factor
new file mode 100644
index 0000000000..f9ce808eb8
--- /dev/null
+++ b/extra/roles/roles.factor
@@ -0,0 +1,69 @@
+! (c)2009 Joe Groff bsd license
+USING: accessors arrays classes classes.mixin classes.parser
+classes.tuple classes.tuple.parser combinators
+combinators.short-circuit kernel lexer make parser sequences
+sets strings words ;
+IN: roles
+
+ERROR: role-slot-overlap class slots ;
+ERROR: multiple-inheritance-attempted classes ;
+
+PREDICATE: role < class
+ { [ mixin-class? ] [ "role-slots" word-prop >boolean ] } 1&& ;
+
+: parse-role-definition ( -- class superroles slots )
+ CREATE-CLASS scan {
+ { ";" [ { } { } ] }
+ { "<" [ scan-word 1array [ parse-tuple-slots ] { } make ] }
+ { "<{" [ \ } parse-until >array [ parse-tuple-slots ] { } make ] }
+ [ { } swap [ parse-slot-name [ parse-tuple-slots ] when ] { } make ]
+ } case ;
+
+: slot-name ( name/array -- name )
+ dup string? [ ] [ first ] if ;
+: slot-names ( array -- names )
+ [ slot-name ] map ;
+
+: role-slots ( role -- slots )
+ [ "superroles" word-prop [ role-slots ] map concat ]
+ [ "role-slots" word-prop ] bi append ;
+
+: role-or-tuple-slot-names ( role-or-tuple -- names )
+ dup role?
+ [ role-slots slot-names ]
+ [ all-slots [ name>> ] map ] if ;
+
+: check-for-slot-overlap ( class roles-and-superclass slots -- )
+ [ [ role-or-tuple-slot-names ] map concat ] [ slot-names ] bi* append
+ duplicates dup empty? [ 2drop ] [ role-slot-overlap ] if ;
+
+: roles>slots ( roles-and-superclass slots -- superclass slots' )
+ [
+ [ role? ] partition
+ dup length {
+ { 0 [ drop tuple ] }
+ { 1 [ first ] }
+ [ drop multiple-inheritance-attempted ]
+ } case
+ swap [ role-slots ] map concat
+ ] dip append ;
+
+: add-to-roles ( class roles -- )
+ [ add-mixin-instance ] with each ;
+
+: (define-role) ( class superroles slots -- )
+ [ "superroles" set-word-prop ] [ "role-slots" set-word-prop ] bi-curry*
+ [ define-mixin-class ] tri ;
+
+: define-role ( class superroles slots -- )
+ [ check-for-slot-overlap ] [ (define-role) ] [ drop add-to-roles ] 3tri ;
+
+: define-tuple-class-with-roles ( class roles-and-superclass slots -- )
+ [ check-for-slot-overlap ]
+ [ roles>slots define-tuple-class ]
+ [ drop [ role? ] filter add-to-roles ] 3tri ;
+
+SYNTAX: ROLE: parse-role-definition define-role ;
+SYNTAX: TUPLE: parse-role-definition define-tuple-class-with-roles ;
+
+
From 32d2377df1f0799354e0d21bcae371e5d41d239b Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sat, 25 Apr 2009 20:18:45 -0500
Subject: [PATCH 15/24] test method dispatch on roles
---
extra/roles/roles-tests.factor | 12 ++++++++++++
1 file changed, 12 insertions(+)
diff --git a/extra/roles/roles-tests.factor b/extra/roles/roles-tests.factor
index aaa197f5ed..fcbc20db16 100644
--- a/extra/roles/roles-tests.factor
+++ b/extra/roles/roles-tests.factor
@@ -53,3 +53,15 @@ SYMBOL: knife
[ knife { utensil tool } { } define-tuple-class-with-roles ]
[ multiple-inheritance-attempted? ] must-fail-with
+
+! make sure method dispatch works
+GENERIC: poke ( pokee poker -- result )
+GENERIC: scoop ( scoopee scooper -- result )
+GENERIC: tune ( tunee tuner -- result )
+
+M: fork poke drop " got poked" append ;
+M: spoon scoop drop " got scooped" append ;
+M: instrument tune drop " got tuned" append ;
+
+[ "potato got poked" "potato got scooped" "potato got tuned" ]
+[ "potato" tuning-spork new [ poke ] [ scoop ] [ tune ] 2tri ] unit-test
From 81bef5d62c6f893110871211798168eb5b4f709b Mon Sep 17 00:00:00 2001
From: Doug Coleman <erg@jobim.local>
Date: Sat, 25 Apr 2009 21:03:12 -0500
Subject: [PATCH 16/24] fix help lint for id3
---
extra/id3/id3.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/extra/id3/id3.factor b/extra/id3/id3.factor
index 6025af4926..79df00ff5e 100644
--- a/extra/id3/id3.factor
+++ b/extra/id3/id3.factor
@@ -207,7 +207,7 @@ CONSTANT: id3v1+-offset $[ 128 227 + ]
PRIVATE>
-: mp3>id3 ( path -- id3v2/f )
+: mp3>id3 ( path -- id3/f )
[
[ <id3> ] dip
{
From 395e4267fd68142716861ec4468441092ddbfc28 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sat, 25 Apr 2009 21:20:19 -0500
Subject: [PATCH 17/24] docs for roles
---
extra/roles/authors.txt | 1 +
extra/roles/roles-docs.factor | 48 +++++++++++++++++++++++++++++++++++
extra/roles/summary.txt | 1 +
3 files changed, 50 insertions(+)
create mode 100644 extra/roles/authors.txt
create mode 100644 extra/roles/roles-docs.factor
create mode 100644 extra/roles/summary.txt
diff --git a/extra/roles/authors.txt b/extra/roles/authors.txt
new file mode 100644
index 0000000000..f13c9c1e77
--- /dev/null
+++ b/extra/roles/authors.txt
@@ -0,0 +1 @@
+Joe Groff
diff --git a/extra/roles/roles-docs.factor b/extra/roles/roles-docs.factor
new file mode 100644
index 0000000000..412a7b8dcb
--- /dev/null
+++ b/extra/roles/roles-docs.factor
@@ -0,0 +1,48 @@
+! (c)2009 Joe Groff bsd license
+USING: classes.mixin help.markup help.syntax kernel multiline roles ;
+IN: roles
+
+HELP: ROLE:
+{ $syntax <" ROLE: name slots... ;
+ROLE: name < role slots... ;
+ROLE: name <{ roles... } slots... ; "> }
+{ $description "Defines a new " { $link role } ". " { $link tuple } " classes which inherit this role will contain the specified " { $snippet "slots" } " as well as the slots associated with the optional inherited " { $snippet "roles" } "."
+$nl
+"Slot specifiers take one of the following three forms:"
+{ $list
+ { { $snippet "name" } " - a slot which can hold any object, with no attributes" }
+ { { $snippet "{ name attributes... }" } " - a slot which can hold any object, with optional attributes" }
+ { { $snippet "{ name class attributes... }" } " - a slot specialized to a specific class, with optional attributes" }
+}
+"Slot attributes are lists of slot attribute specifiers followed by values; a slot attribute specifier is one of " { $link initial: } " or " { $link read-only } ". See " { $link "tuple-declarations" } " for details." } ;
+
+HELP: TUPLE:
+{ $syntax <" TUPLE: name slots ;
+TUPLE: name < estate slots ;
+TUPLE: name <{ estates... } slots... ; "> }
+{ $description "Defines a new " { $link tuple } " class."
+$nl
+"The list of inherited " { $snippet "estates" } " is optional; a single tuple superclass and/or a set of " { $link role } "s can be specified. If no superclass is provided, it defaults to " { $link tuple } "."
+$nl
+"Slot specifiers take one of the following three forms:"
+{ $list
+ { { $snippet "name" } " - a slot which can hold any object, with no attributes" }
+ { { $snippet "{ name attributes... }" } " - a slot which can hold any object, with optional attributes" }
+ { { $snippet "{ name class attributes... }" } " - a slot specialized to a specific class, with optional attributes" }
+}
+"Slot attributes are lists of slot attribute specifiers followed by values; a slot attribute specifier is one of " { $link initial: } " or " { $link read-only } ". See " { $link "tuple-declarations" } " for details." } ;
+
+{
+ POSTPONE: ROLE:
+ POSTPONE: TUPLE:
+} related-words
+
+HELP: role
+{ $class-description "The superclass of all role classes. A " { $snippet "role" } " is a " { $link mixin-class } " that includes a set of slot definitions that can be added to " { $link tuple } " classes alongside other " { $snippet "role" } "s." } ;
+
+HELP: multiple-inheritance-attempted
+{ $class-description "This error is thrown if a " { $link POSTPONE: TUPLE: } " definition attempts to inherit more than one " { $link tuple } " class." } ;
+
+HELP: role-slot-overlap
+{ $class-description "This error is thrown if a " { $link POSTPONE: TUPLE: } " or " { $link POSTPONE: ROLE: } " definition attempts to inherit a set of " { $link role } "s in which more than one attempts to define the same slot." } ;
+
diff --git a/extra/roles/summary.txt b/extra/roles/summary.txt
new file mode 100644
index 0000000000..a14aae4838
--- /dev/null
+++ b/extra/roles/summary.txt
@@ -0,0 +1 @@
+Mixins for tuples
From bada2176bc6af9bd3cd736aaaf639dcd01bbad1b Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 25 Apr 2009 21:21:15 -0500
Subject: [PATCH 18/24] use new locals syntax in calendar, add routine for
calculating easter
---
basis/calendar/calendar-tests.factor | 9 +++-
basis/calendar/calendar.factor | 64 +++++++++++++++++++---------
2 files changed, 52 insertions(+), 21 deletions(-)
diff --git a/basis/calendar/calendar-tests.factor b/basis/calendar/calendar-tests.factor
index 256b4e1b42..8d1071122d 100644
--- a/basis/calendar/calendar-tests.factor
+++ b/basis/calendar/calendar-tests.factor
@@ -1,5 +1,5 @@
USING: arrays calendar kernel math sequences tools.test
-continuations system math.order threads ;
+continuations system math.order threads accessors ;
IN: calendar.tests
[ f ] [ 2004 12 32 0 0 0 instant <timestamp> valid-timestamp? ] unit-test
@@ -163,3 +163,10 @@ IN: calendar.tests
[ t ] [ now 50 milliseconds sleep now before? ] unit-test
[ t ] [ now 50 milliseconds sleep now swap after? ] unit-test
[ t ] [ now 50 milliseconds sleep now 50 milliseconds sleep now swapd between? ] unit-test
+
+[ 4 12 ] [ 2009 easter [ month>> ] [ day>> ] bi ] unit-test
+[ 4 2 ] [ 1961 easter [ month>> ] [ day>> ] bi ] unit-test
+
+[ f ] [ now dup midnight eq? ] unit-test
+[ f ] [ now dup easter eq? ] unit-test
+[ f ] [ now dup beginning-of-year eq? ] unit-test
diff --git a/basis/calendar/calendar.factor b/basis/calendar/calendar.factor
index 7a03fe4408..4b58b1b496 100644
--- a/basis/calendar/calendar.factor
+++ b/basis/calendar/calendar.factor
@@ -1,8 +1,8 @@
! Copyright (C) 2007 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays classes.tuple combinators combinators.short-circuit
- kernel locals math math.functions math.order namespaces sequences strings
- summary system threads vocabs.loader ;
+USING: accessors arrays classes.tuple combinators
+combinators.short-circuit kernel locals math math.functions
+math.order sequences summary system threads vocabs.loader ;
IN: calendar
HOOK: gmt-offset os ( -- hours minutes seconds )
@@ -94,26 +94,50 @@ CONSTANT: day-abbreviations3
:: julian-day-number ( year month day -- n )
#! Returns a composite date number
#! Not valid before year -4800
- [let* | a [ 14 month - 12 /i ]
- y [ year 4800 + a - ]
- m [ month 12 a * + 3 - ] |
- day 153 m * 2 + 5 /i + 365 y * +
- y 4 /i + y 100 /i - y 400 /i + 32045 -
- ] ;
+ 14 month - 12 /i :> a
+ year 4800 + a - :> y
+ month 12 a * + 3 - :> m
+
+ day 153 m * 2 + 5 /i + 365 y * +
+ y 4 /i + y 100 /i - y 400 /i + 32045 - ;
:: julian-day-number>date ( n -- year month day )
#! Inverse of julian-day-number
- [let* | a [ n 32044 + ]
- b [ 4 a * 3 + 146097 /i ]
- c [ a 146097 b * 4 /i - ]
- d [ 4 c * 3 + 1461 /i ]
- e [ c 1461 d * 4 /i - ]
- m [ 5 e * 2 + 153 /i ] |
- 100 b * d + 4800 -
- m 10 /i + m 3 +
- 12 m 10 /i * -
- e 153 m * 2 + 5 /i - 1+
- ] ;
+ n 32044 + :> a
+ 4 a * 3 + 146097 /i :> b
+ a 146097 b * 4 /i - :> c
+ 4 c * 3 + 1461 /i :> d
+ c 1461 d * 4 /i - :> e
+ 5 e * 2 + 153 /i :> m
+
+ 100 b * d + 4800 -
+ m 10 /i + m 3 +
+ 12 m 10 /i * -
+ e 153 m * 2 + 5 /i - 1+ ;
+
+GENERIC: easter ( obj -- obj' )
+
+:: easter-month-day ( year -- month day )
+ year 19 mod :> a
+ year 100 /mod :> c :> b
+ b 4 /mod :> e :> d
+ b 8 + 25 /i :> f
+ b f - 1 + 3 /i :> g
+ 19 a * b + d - g - 15 + 30 mod :> h
+ c 4 /mod :> k :> i
+ 32 2 e * + 2 i * + h - k - 7 mod :> l
+ a 11 h * + 22 l * + 451 /i :> m
+
+ h l + 7 m * - 114 + 31 /mod 1 + :> day :> month
+ month day ;
+
+M: integer easter ( year -- timestamp )
+ dup easter-month-day <date> ;
+
+M: timestamp easter ( timestamp -- timestamp )
+ clone
+ dup year>> easter-month-day
+ swapd >>day swap >>month ;
: >date< ( timestamp -- year month day )
[ year>> ] [ month>> ] [ day>> ] tri ;
From cdb17b74333d3cd13f6516cb46ea4d60d4b2dc99 Mon Sep 17 00:00:00 2001
From: Doug Coleman <erg@jobim.local>
Date: Sun, 26 Apr 2009 00:45:03 -0500
Subject: [PATCH 19/24] make fasta work again
---
extra/benchmark/fasta/fasta.factor | 8 ++++----
1 file changed, 4 insertions(+), 4 deletions(-)
diff --git a/extra/benchmark/fasta/fasta.factor b/extra/benchmark/fasta/fasta.factor
index 2ae5ada8a1..f457b90c30 100755
--- a/extra/benchmark/fasta/fasta.factor
+++ b/extra/benchmark/fasta/fasta.factor
@@ -46,8 +46,8 @@ CONSTANT: homo-sapiens
}
: make-cumulative ( freq -- chars floats )
- dup keys >byte-array
- swap values >double-array unclip [ + ] accumulate swap suffix ;
+ [ keys >byte-array ]
+ [ values >double-array ] bi unclip [ + ] accumulate swap suffix ;
:: select-random ( seed chars floats -- seed elt )
floats seed random -rot
@@ -55,7 +55,7 @@ CONSTANT: homo-sapiens
chars nth-unsafe ; inline
: make-random-fasta ( seed len chars floats -- seed )
- [ rot drop select-random ] 2curry B{ } map-as print ; inline
+ [ rot drop select-random ] 2curry "" map-as print ; inline
: write-description ( desc id -- )
">" write write bl print ; inline
@@ -71,7 +71,7 @@ CONSTANT: homo-sapiens
:: make-repeat-fasta ( k len alu -- k' )
[let | kn [ alu length ] |
- len [ k + kn mod alu nth-unsafe ] B{ } map-as print
+ len [ k + kn mod alu nth-unsafe ] "" map-as print
k len +
] ; inline
From a25376278b4cf396fb81c9fbe8b4f36cd112a12c Mon Sep 17 00:00:00 2001
From: Doug Coleman <erg@jobim.local>
Date: Sun, 26 Apr 2009 00:45:14 -0500
Subject: [PATCH 20/24] set error-summary? to true by default
---
basis/listener/listener.factor | 2 ++
1 file changed, 2 insertions(+)
diff --git a/basis/listener/listener.factor b/basis/listener/listener.factor
index d96e0df6c1..68777f2f73 100644
--- a/basis/listener/listener.factor
+++ b/basis/listener/listener.factor
@@ -62,6 +62,8 @@ SYMBOL: max-stack-items
SYMBOL: error-summary?
+t error-summary? set-global
+
<PRIVATE
: title. ( string -- )
From acd312ab19b44a50acb2b22b6d65762805859bb9 Mon Sep 17 00:00:00 2001
From: erg <erg@ubuntubox.(none)>
Date: Sun, 26 Apr 2009 00:51:47 -0500
Subject: [PATCH 21/24] fix IN: for compiler tests
---
basis/compiler/tests/alien.factor | 2 +-
basis/compiler/tests/codegen.factor | 4 ++--
basis/compiler/tests/curry.factor | 2 +-
basis/compiler/tests/float.factor | 2 +-
basis/compiler/tests/folding.factor | 2 +-
basis/compiler/tests/intrinsics.factor | 2 +-
basis/compiler/tests/optimizer.factor | 2 +-
basis/compiler/tests/peg-regression-2.factor | 4 ++--
basis/compiler/tests/peg-regression.factor | 2 +-
basis/compiler/tests/redefine0.factor | 2 +-
basis/compiler/tests/redefine1.factor | 2 +-
basis/compiler/tests/redefine10.factor | 2 +-
basis/compiler/tests/redefine11.factor | 2 +-
basis/compiler/tests/redefine15.factor | 2 +-
basis/compiler/tests/redefine2.factor | 2 +-
basis/compiler/tests/redefine3.factor | 2 +-
basis/compiler/tests/redefine4.factor | 2 +-
basis/compiler/tests/redefine5.factor | 2 +-
basis/compiler/tests/redefine6.factor | 2 +-
basis/compiler/tests/redefine7.factor | 2 +-
basis/compiler/tests/redefine8.factor | 2 +-
basis/compiler/tests/redefine9.factor | 2 +-
basis/compiler/tests/reload.factor | 2 +-
basis/compiler/tests/simple.factor | 2 +-
basis/compiler/tests/spilling.factor | 2 +-
basis/compiler/tests/stack-trace.factor | 2 +-
basis/compiler/tests/tuples.factor | 2 +-
27 files changed, 29 insertions(+), 29 deletions(-)
diff --git a/basis/compiler/tests/alien.factor b/basis/compiler/tests/alien.factor
index 4d7882ad08..42ed90d64a 100755
--- a/basis/compiler/tests/alien.factor
+++ b/basis/compiler/tests/alien.factor
@@ -5,7 +5,7 @@ continuations effects namespaces.private io io.streams.string
memory system threads tools.test math accessors combinators
specialized-arrays.float alien.libraries io.pathnames
io.backend ;
-IN: compiler.tests
+IN: compiler.tests.alien
<<
: libfactor-ffi-tests-path ( -- string )
diff --git a/basis/compiler/tests/codegen.factor b/basis/compiler/tests/codegen.factor
index 2e02e5476c..c746fdfb45 100644
--- a/basis/compiler/tests/codegen.factor
+++ b/basis/compiler/tests/codegen.factor
@@ -4,7 +4,7 @@ sequences sequences.private tools.test namespaces.private
slots.private sequences.private byte-arrays alien
alien.accessors layouts words definitions compiler.units io
combinators vectors grouping make ;
-IN: compiler.tests
+IN: compiler.tests.codegen
! Originally, this file did black box testing of templating
! optimization. We now have a different codegen, but the tests
@@ -281,4 +281,4 @@ TUPLE: cucumber ;
M: cucumber equal? "The cucumber has no equal" throw ;
-[ t ] [ [ cucumber ] compile-call cucumber eq? ] unit-test
\ No newline at end of file
+[ t ] [ [ cucumber ] compile-call cucumber eq? ] unit-test
diff --git a/basis/compiler/tests/curry.factor b/basis/compiler/tests/curry.factor
index 2d1f15b9a8..32611ba87a 100644
--- a/basis/compiler/tests/curry.factor
+++ b/basis/compiler/tests/curry.factor
@@ -1,6 +1,6 @@
USING: tools.test quotations math kernel sequences
assocs namespaces make compiler.units compiler ;
-IN: compiler.tests
+IN: compiler.tests.curry
[ 3 ] [ 5 [ [ 2 - ] curry call ] compile-call ] unit-test
[ 3 ] [ [ 5 [ 2 - ] curry call ] compile-call ] unit-test
diff --git a/basis/compiler/tests/float.factor b/basis/compiler/tests/float.factor
index b439b5f6a4..1a604dbd8e 100644
--- a/basis/compiler/tests/float.factor
+++ b/basis/compiler/tests/float.factor
@@ -1,4 +1,4 @@
-IN: compiler.tests
+IN: compiler.tests.float
USING: compiler.units compiler kernel kernel.private memory math
math.private tools.test math.floats.private ;
diff --git a/basis/compiler/tests/folding.factor b/basis/compiler/tests/folding.factor
index fe2f801de2..5050ce1950 100644
--- a/basis/compiler/tests/folding.factor
+++ b/basis/compiler/tests/folding.factor
@@ -1,6 +1,6 @@
USING: eval tools.test compiler.units vocabs multiline words
kernel classes.mixin arrays ;
-IN: compiler.tests
+IN: compiler.tests.folding
! Calls to generic words were not folded away.
diff --git a/basis/compiler/tests/intrinsics.factor b/basis/compiler/tests/intrinsics.factor
index 93860db924..a6e827ea33 100644
--- a/basis/compiler/tests/intrinsics.factor
+++ b/basis/compiler/tests/intrinsics.factor
@@ -6,7 +6,7 @@ sbufs strings.private slots.private alien math.order
alien.accessors alien.c-types alien.syntax alien.strings
namespaces libc sequences.private io.encodings.ascii
classes compiler ;
-IN: compiler.tests
+IN: compiler.tests.intrinsics
! Make sure that intrinsic ops compile to correct code.
[ ] [ 1 [ drop ] compile-call ] unit-test
diff --git a/basis/compiler/tests/optimizer.factor b/basis/compiler/tests/optimizer.factor
index 99bdb18812..bd7008f909 100644
--- a/basis/compiler/tests/optimizer.factor
+++ b/basis/compiler/tests/optimizer.factor
@@ -5,7 +5,7 @@ quotations classes classes.algebra classes.tuple.private
continuations growable namespaces hints alien.accessors
compiler.tree.builder compiler.tree.optimizer sequences.deep
compiler ;
-IN: optimizer.tests
+IN: compiler.tests.optimizer
GENERIC: xyz ( obj -- obj )
M: array xyz xyz ;
diff --git a/basis/compiler/tests/peg-regression-2.factor b/basis/compiler/tests/peg-regression-2.factor
index 1efadba3aa..7929d9e6f6 100644
--- a/basis/compiler/tests/peg-regression-2.factor
+++ b/basis/compiler/tests/peg-regression-2.factor
@@ -1,4 +1,4 @@
-IN: compiler.tests
+IN: compiler.tests.peg-regression-2
USING: peg.ebnf strings tools.test ;
GENERIC: <times> ( times -- term' )
@@ -12,4 +12,4 @@ Regexp = Times:t => [[ t <times> ]]
;EBNF
-[ "foo" ] [ "a" parse-regexp ] unit-test
\ No newline at end of file
+[ "foo" ] [ "a" parse-regexp ] unit-test
diff --git a/basis/compiler/tests/peg-regression.factor b/basis/compiler/tests/peg-regression.factor
index 56a4021eed..e107135305 100644
--- a/basis/compiler/tests/peg-regression.factor
+++ b/basis/compiler/tests/peg-regression.factor
@@ -5,7 +5,7 @@
! end of a compilation unit.
USING: kernel accessors peg.ebnf ;
-IN: compiler.tests
+IN: compiler.tests.peg-regression
TUPLE: pipeline-expr background ;
diff --git a/basis/compiler/tests/redefine0.factor b/basis/compiler/tests/redefine0.factor
index 87b63aa029..3d7a05a74b 100644
--- a/basis/compiler/tests/redefine0.factor
+++ b/basis/compiler/tests/redefine0.factor
@@ -104,4 +104,4 @@ quot global delete-at
\ test-11 forget
\ quot forget
] with-compilation-unit
-] unit-test
\ No newline at end of file
+] unit-test
diff --git a/basis/compiler/tests/redefine1.factor b/basis/compiler/tests/redefine1.factor
index a28b183fb6..af0fd52a47 100644
--- a/basis/compiler/tests/redefine1.factor
+++ b/basis/compiler/tests/redefine1.factor
@@ -1,7 +1,7 @@
USING: accessors compiler compiler.units tools.test math parser
kernel sequences sequences.private classes.mixin generic
definitions arrays words assocs eval strings ;
-IN: compiler.tests
+IN: compiler.tests.redefine1
GENERIC: method-redefine-generic-1 ( a -- b )
diff --git a/basis/compiler/tests/redefine10.factor b/basis/compiler/tests/redefine10.factor
index faae7b8ed1..66edd75097 100644
--- a/basis/compiler/tests/redefine10.factor
+++ b/basis/compiler/tests/redefine10.factor
@@ -1,6 +1,6 @@
USING: eval tools.test compiler.units vocabs multiline words
kernel ;
-IN: compiler.tests
+IN: compiler.tests.redefine10
! Mixin redefinition did not recompile all necessary words.
diff --git a/basis/compiler/tests/redefine11.factor b/basis/compiler/tests/redefine11.factor
index 57f9f9caf0..dbec57e3d5 100644
--- a/basis/compiler/tests/redefine11.factor
+++ b/basis/compiler/tests/redefine11.factor
@@ -1,6 +1,6 @@
USING: eval tools.test compiler.units vocabs multiline words
kernel classes.mixin arrays ;
-IN: compiler.tests
+IN: compiler.tests.redefine11
! Mixin redefinition did not recompile all necessary words.
diff --git a/basis/compiler/tests/redefine15.factor b/basis/compiler/tests/redefine15.factor
index 797460a411..33aa080bac 100644
--- a/basis/compiler/tests/redefine15.factor
+++ b/basis/compiler/tests/redefine15.factor
@@ -17,4 +17,4 @@ DEFER: word-1
[ \ word-3 [ [ 2 + ] bi@ ] (( a b -- c d )) define-declared ] with-compilation-unit
-[ 2 3 ] [ 0 word-4 ] unit-test
\ No newline at end of file
+[ 2 3 ] [ 0 word-4 ] unit-test
diff --git a/basis/compiler/tests/redefine2.factor b/basis/compiler/tests/redefine2.factor
index 6a7b7a6941..f74ba46fd4 100644
--- a/basis/compiler/tests/redefine2.factor
+++ b/basis/compiler/tests/redefine2.factor
@@ -1,4 +1,4 @@
-IN: compiler.tests
+IN: compiler.tests.redefine2
USING: compiler compiler.units tools.test math parser kernel
sequences sequences.private classes.mixin generic definitions
arrays words assocs eval words.symbol ;
diff --git a/basis/compiler/tests/redefine3.factor b/basis/compiler/tests/redefine3.factor
index 87ab100879..a5962ff91a 100644
--- a/basis/compiler/tests/redefine3.factor
+++ b/basis/compiler/tests/redefine3.factor
@@ -1,4 +1,4 @@
-IN: compiler.tests
+IN: compiler.tests.redefine3
USING: accessors compiler compiler.units tools.test math parser
kernel sequences sequences.private classes.mixin generic
definitions arrays words assocs eval ;
diff --git a/basis/compiler/tests/redefine4.factor b/basis/compiler/tests/redefine4.factor
index 88b40f0c5a..5e0c6c0270 100644
--- a/basis/compiler/tests/redefine4.factor
+++ b/basis/compiler/tests/redefine4.factor
@@ -1,4 +1,4 @@
-IN: compiler.tests
+IN: compiler.tests.redefine4
USING: io.streams.string kernel tools.test eval ;
: declaration-test-1 ( -- a ) 3 ; flushable
diff --git a/basis/compiler/tests/redefine5.factor b/basis/compiler/tests/redefine5.factor
index c390f9a1ec..7613987852 100644
--- a/basis/compiler/tests/redefine5.factor
+++ b/basis/compiler/tests/redefine5.factor
@@ -1,6 +1,6 @@
USING: eval tools.test compiler.units vocabs multiline words
kernel ;
-IN: compiler.tests
+IN: compiler.tests.redefine5
! Regression: if dispatch was eliminated but method was not inlined,
! compiled usage information was not recorded.
diff --git a/basis/compiler/tests/redefine6.factor b/basis/compiler/tests/redefine6.factor
index 7f1be973e7..fdf3e7edbb 100644
--- a/basis/compiler/tests/redefine6.factor
+++ b/basis/compiler/tests/redefine6.factor
@@ -1,6 +1,6 @@
USING: eval tools.test compiler.units vocabs multiline words
kernel ;
-IN: compiler.tests
+IN: compiler.tests.redefine6
! Mixin redefinition did not recompile all necessary words.
diff --git a/basis/compiler/tests/redefine7.factor b/basis/compiler/tests/redefine7.factor
index d6dfdf20fd..cfe29603f9 100644
--- a/basis/compiler/tests/redefine7.factor
+++ b/basis/compiler/tests/redefine7.factor
@@ -1,6 +1,6 @@
USING: eval tools.test compiler.units vocabs multiline words
kernel ;
-IN: compiler.tests
+IN: compiler.tests.redefine7
! Mixin redefinition did not recompile all necessary words.
diff --git a/basis/compiler/tests/redefine8.factor b/basis/compiler/tests/redefine8.factor
index 3499c5070a..a79bfb5af5 100644
--- a/basis/compiler/tests/redefine8.factor
+++ b/basis/compiler/tests/redefine8.factor
@@ -1,6 +1,6 @@
USING: eval tools.test compiler.units vocabs multiline words
kernel ;
-IN: compiler.tests
+IN: compiler.tests.redefine8
! Mixin redefinition did not recompile all necessary words.
diff --git a/basis/compiler/tests/redefine9.factor b/basis/compiler/tests/redefine9.factor
index 25ed5f15db..2598246472 100644
--- a/basis/compiler/tests/redefine9.factor
+++ b/basis/compiler/tests/redefine9.factor
@@ -1,6 +1,6 @@
USING: eval tools.test compiler.units vocabs multiline words
kernel generic.math ;
-IN: compiler.tests
+IN: compiler.tests.redefine9
! Mixin redefinition did not recompile all necessary words.
diff --git a/basis/compiler/tests/reload.factor b/basis/compiler/tests/reload.factor
index b2b65b5868..62c7c31bc2 100644
--- a/basis/compiler/tests/reload.factor
+++ b/basis/compiler/tests/reload.factor
@@ -1,4 +1,4 @@
-IN: compiler.tests
+IN: compiler.tests.reload
USE: vocabs.loader
! "parser" reload
diff --git a/basis/compiler/tests/simple.factor b/basis/compiler/tests/simple.factor
index 11b27979d5..82cc97e0f6 100644
--- a/basis/compiler/tests/simple.factor
+++ b/basis/compiler/tests/simple.factor
@@ -1,7 +1,7 @@
USING: compiler compiler.units tools.test kernel kernel.private
sequences.private math.private math combinators strings alien
arrays memory vocabs parser eval ;
-IN: compiler.tests
+IN: compiler.tests.simple
! Test empty word
[ ] [ [ ] compile-call ] unit-test
diff --git a/basis/compiler/tests/spilling.factor b/basis/compiler/tests/spilling.factor
index 4092352fd5..2ec6fbde95 100644
--- a/basis/compiler/tests/spilling.factor
+++ b/basis/compiler/tests/spilling.factor
@@ -1,6 +1,6 @@
USING: math.private kernel combinators accessors arrays
generalizations tools.test ;
-IN: compiler.tests
+IN: compiler.tests.spilling
: float-spill-bug ( a -- b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b )
{
diff --git a/basis/compiler/tests/stack-trace.factor b/basis/compiler/tests/stack-trace.factor
index b317ed3eb5..1cb11571ef 100755
--- a/basis/compiler/tests/stack-trace.factor
+++ b/basis/compiler/tests/stack-trace.factor
@@ -1,4 +1,4 @@
-IN: compiler.tests
+IN: compiler.tests.stack-trace
USING: compiler tools.test namespaces sequences
kernel.private kernel math continuations continuations.private
words splitting grouping sorting accessors ;
diff --git a/basis/compiler/tests/tuples.factor b/basis/compiler/tests/tuples.factor
index caa214b70c..fc249d99db 100644
--- a/basis/compiler/tests/tuples.factor
+++ b/basis/compiler/tests/tuples.factor
@@ -1,4 +1,4 @@
-IN: compiler.tests
+IN: compiler.tests.tuples
USING: kernel tools.test compiler.units compiler ;
TUPLE: color red green blue ;
From dd15bd0fee3df59f137754361cb8647b198a561a Mon Sep 17 00:00:00 2001
From: Doug Coleman <erg@jobim.local>
Date: Sun, 26 Apr 2009 01:25:19 -0500
Subject: [PATCH 22/24] fix morse for characters that don't exist like "\n".
"resource:core/kernel/kernel.factor" utf8 file-contents play-as-morse listen
to factor!
---
extra/morse/morse-tests.factor | 1 +
extra/morse/morse.factor | 11 +++++++----
2 files changed, 8 insertions(+), 4 deletions(-)
diff --git a/extra/morse/morse-tests.factor b/extra/morse/morse-tests.factor
index fd52df1c4d..13818a06a0 100644
--- a/extra/morse/morse-tests.factor
+++ b/extra/morse/morse-tests.factor
@@ -41,3 +41,4 @@ IN: morse.tests
MORSE] ] unit-test
! [ ] [ "sos" 0.075 play-as-morse* ] unit-test
! [ ] [ "Factor rocks!" play-as-morse ] unit-test
+! [ ] [ "\n" play-as-morse ] unit-test
diff --git a/extra/morse/morse.factor b/extra/morse/morse.factor
index ef4b9d4b88..20989f2f2f 100644
--- a/extra/morse/morse.factor
+++ b/extra/morse/morse.factor
@@ -3,13 +3,15 @@
USING: accessors ascii assocs biassocs combinators hashtables kernel lists literals math namespaces make multiline openal parser sequences splitting strings synth synth.buffers ;
IN: morse
+ERROR: no-morse-code ch ;
+
<PRIVATE
CONSTANT: dot-char CHAR: .
CONSTANT: dash-char CHAR: -
CONSTANT: char-gap-char CHAR: \s
CONSTANT: word-gap-char CHAR: /
-CONSTANT: unknown-char CHAR: ?
+CONSTANT: unknown-char "?"
PRIVATE>
@@ -74,10 +76,10 @@ CONSTANT: morse-code-table $[
]
: ch>morse ( ch -- morse )
- ch>lower morse-code-table at [ unknown-char ] unless* ;
+ ch>lower morse-code-table at unknown-char or ;
: morse>ch ( str -- ch )
- morse-code-table value-at [ char-gap-char ] unless* ;
+ morse-code-table value-at char-gap-char or ;
<PRIVATE
@@ -148,12 +150,13 @@ CONSTANT: beep-freq 880
source get source-play
] with-scope ; inline
-: play-char ( ch -- )
+: play-char ( string -- )
[ intra-char-gap ] [
{
{ dot-char [ dot ] }
{ dash-char [ dash ] }
{ word-gap-char [ intra-char-gap ] }
+ [ drop intra-char-gap ]
} case
] interleave ;
From 28cacc8d610cec9d605f47c9daba3a47d1bf0fac Mon Sep 17 00:00:00 2001
From: Doug Coleman <erg@jobim.local>
Date: Sun, 26 Apr 2009 02:23:33 -0500
Subject: [PATCH 23/24] fix some compiler tests
---
basis/compiler/tests/redefine1.factor | 4 ++--
basis/compiler/tests/redefine2.factor | 2 +-
basis/compiler/tests/redefine3.factor | 2 +-
basis/compiler/tests/redefine4.factor | 2 +-
4 files changed, 5 insertions(+), 5 deletions(-)
diff --git a/basis/compiler/tests/redefine1.factor b/basis/compiler/tests/redefine1.factor
index af0fd52a47..6bb623cac4 100644
--- a/basis/compiler/tests/redefine1.factor
+++ b/basis/compiler/tests/redefine1.factor
@@ -11,7 +11,7 @@ M: integer method-redefine-generic-1 3 + ;
[ 6 ] [ method-redefine-test-1 ] unit-test
-[ ] [ "IN: compiler.tests USE: math M: fixnum method-redefine-generic-1 4 + ;" eval( -- ) ] unit-test
+[ ] [ "IN: compiler.tests.redefine1 USE: math M: fixnum method-redefine-generic-1 4 + ;" eval( -- ) ] unit-test
[ 7 ] [ method-redefine-test-1 ] unit-test
@@ -27,7 +27,7 @@ M: integer method-redefine-generic-2 3 + ;
[ 6 ] [ method-redefine-test-2 ] unit-test
-[ ] [ "IN: compiler.tests USE: kernel USE: math M: fixnum method-redefine-generic-2 4 + ; USE: strings M: string method-redefine-generic-2 drop f ;" eval( -- ) ] unit-test
+[ ] [ "IN: compiler.tests.redefine1 USE: kernel USE: math M: fixnum method-redefine-generic-2 4 + ; USE: strings M: string method-redefine-generic-2 drop f ;" eval( -- ) ] unit-test
[ 7 ] [ method-redefine-test-2 ] unit-test
diff --git a/basis/compiler/tests/redefine2.factor b/basis/compiler/tests/redefine2.factor
index f74ba46fd4..9112a1e1af 100644
--- a/basis/compiler/tests/redefine2.factor
+++ b/basis/compiler/tests/redefine2.factor
@@ -5,7 +5,7 @@ arrays words assocs eval words.symbol ;
DEFER: redefine2-test
-[ ] [ "USE: sequences USE: kernel IN: compiler.tests TUPLE: redefine2-test ; M: redefine2-test nth 2drop 3 ; INSTANCE: redefine2-test sequence" eval( -- ) ] unit-test
+[ ] [ "USE: sequences USE: kernel IN: compiler.tests.redefine2 TUPLE: redefine2-test ; M: redefine2-test nth 2drop 3 ; INSTANCE: redefine2-test sequence" eval( -- ) ] unit-test
[ t ] [ \ redefine2-test symbol? ] unit-test
diff --git a/basis/compiler/tests/redefine3.factor b/basis/compiler/tests/redefine3.factor
index a5962ff91a..51ce33c1bd 100644
--- a/basis/compiler/tests/redefine3.factor
+++ b/basis/compiler/tests/redefine3.factor
@@ -18,7 +18,7 @@ M: empty-mixin sheeple drop "wake up" ;
[ t ] [ object \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test
[ f ] [ empty-mixin \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test
-[ ] [ "IN: compiler.tests USE: arrays INSTANCE: array empty-mixin" eval( -- ) ] unit-test
+[ ] [ "IN: compiler.tests.redefine3 USE: arrays INSTANCE: array empty-mixin" eval( -- ) ] unit-test
[ "wake up" ] [ sheeple-test ] unit-test
[ f ] [ object \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test
diff --git a/basis/compiler/tests/redefine4.factor b/basis/compiler/tests/redefine4.factor
index 5e0c6c0270..2320f64af6 100644
--- a/basis/compiler/tests/redefine4.factor
+++ b/basis/compiler/tests/redefine4.factor
@@ -7,6 +7,6 @@ USING: io.streams.string kernel tools.test eval ;
[ "" ] [ [ declaration-test ] with-string-writer ] unit-test
-[ ] [ "IN: compiler.tests USE: io : declaration-test-1 ( -- a ) \"X\" write f ;" eval( -- ) ] unit-test
+[ ] [ "IN: compiler.tests.redefine4 USE: io : declaration-test-1 ( -- a ) \"X\" write f ;" eval( -- ) ] unit-test
[ "X" ] [ [ declaration-test ] with-string-writer ] unit-test
From fc8b04466a70e6729b964976945d4438979bd588 Mon Sep 17 00:00:00 2001
From: Doug Coleman <erg@jobim.local>
Date: Sun, 26 Apr 2009 03:26:15 -0500
Subject: [PATCH 24/24] fix morse unit test
---
extra/morse/morse-tests.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/extra/morse/morse-tests.factor b/extra/morse/morse-tests.factor
index 13818a06a0..f1da7ce139 100644
--- a/extra/morse/morse-tests.factor
+++ b/extra/morse/morse-tests.factor
@@ -3,7 +3,7 @@
USING: arrays morse strings tools.test ;
IN: morse.tests
-[ CHAR: ? ] [ CHAR: \\ ch>morse ] unit-test
+[ "?" ] [ CHAR: \\ ch>morse ] unit-test
[ "..." ] [ CHAR: s ch>morse ] unit-test
[ CHAR: s ] [ "..." morse>ch ] unit-test
[ CHAR: \s ] [ "..--..--.." morse>ch ] unit-test