From 2f7247334e943ec49374e0670820e2d198b25f94 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Thu, 28 Feb 2008 16:37:04 -0600
Subject: [PATCH 01/55] fix with-directory and write unit test
---
core/io/files/files-tests.factor | 2 ++
core/io/files/files.factor | 4 ++--
2 files changed, 4 insertions(+), 2 deletions(-)
diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor
index 92e148a854..f804d7c5ac 100755
--- a/core/io/files/files-tests.factor
+++ b/core/io/files/files-tests.factor
@@ -121,3 +121,5 @@ USING: tools.test io.files io threads kernel continuations ;
[ ] [ "copy-destination" temp-file delete-tree ] unit-test
[ ] [ "copy-tree-test" temp-file delete-tree ] unit-test
+
+[ t ] [ cwd "core" resource-path [ ] with-directory cwd = ] unit-test
diff --git a/core/io/files/files.factor b/core/io/files/files.factor
index 85f0621443..55eee65bbf 100755
--- a/core/io/files/files.factor
+++ b/core/io/files/files.factor
@@ -70,7 +70,7 @@ HOOK: cd io-backend ( path -- )
HOOK: cwd io-backend ( -- path )
: with-directory ( path quot -- )
- swap cd cwd [ cd ] curry [ ] cleanup ; inline
+ cwd [ cd ] curry rot cd [ ] cleanup ; inline
! Creating directories
HOOK: make-directory io-backend ( path -- )
@@ -209,4 +209,4 @@ HOOK: <file-appender> io-backend ( path -- stream )
{ [ winnt? ] [ "USERPROFILE" os-env ] }
{ [ wince? ] [ "" resource-path ] }
{ [ unix? ] [ "HOME" os-env ] }
- } cond ;
\ No newline at end of file
+ } cond ;
From 2753b2442af438446b971115f94220a99184c0ea Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Thu, 28 Feb 2008 16:37:27 -0600
Subject: [PATCH 02/55] fix io.files.temporary for windows
---
extra/io/files/temporary/backend/backend.factor | 2 +-
extra/io/files/temporary/temporary.factor | 10 +++-------
extra/io/windows/files/temporary/temporary.factor | 6 ++++--
3 files changed, 8 insertions(+), 10 deletions(-)
diff --git a/extra/io/files/temporary/backend/backend.factor b/extra/io/files/temporary/backend/backend.factor
index 0fe4068621..5c6900b3d2 100644
--- a/extra/io/files/temporary/backend/backend.factor
+++ b/extra/io/files/temporary/backend/backend.factor
@@ -1,5 +1,5 @@
USING: io.backend ;
IN: io.files.temporary.backend
-HOOK: (temporary-file) io-backend ( path prefix suffix -- stream path )
+HOOK: (temporary-file) io-backend ( path -- stream path )
HOOK: temporary-path io-backend ( -- path )
diff --git a/extra/io/files/temporary/temporary.factor b/extra/io/files/temporary/temporary.factor
index d46ddff8c6..5c5e72e83f 100644
--- a/extra/io/files/temporary/temporary.factor
+++ b/extra/io/files/temporary/temporary.factor
@@ -2,18 +2,14 @@ USING: kernel math math.bitfields combinators.lib math.parser
random sequences sequences.lib continuations namespaces
io.files io.backend io.nonblocking io arrays
io.files.temporary.backend system combinators vocabs.loader ;
-USE: tools.walker
IN: io.files.temporary
-: random-letter ( -- ch )
- 26 random { CHAR: a CHAR: A } random + ;
+: random-letter ( -- ch ) 26 random { CHAR: a CHAR: A } random + ;
: random-ch ( -- ch )
- { t f } random
- [ 10 random CHAR: 0 + ] [ random-letter ] if ;
+ { t f } random [ 10 random CHAR: 0 + ] [ random-letter ] if ;
-: random-name ( n -- string )
- [ drop random-ch ] "" map-as ;
+: random-name ( n -- string ) [ drop random-ch ] "" map-as ;
: <temporary-file> ( prefix suffix -- path duplex-stream )
temporary-path -rot
diff --git a/extra/io/windows/files/temporary/temporary.factor b/extra/io/windows/files/temporary/temporary.factor
index d96ff49e15..426cab367b 100644
--- a/extra/io/windows/files/temporary/temporary.factor
+++ b/extra/io/windows/files/temporary/temporary.factor
@@ -1,8 +1,10 @@
-USING: kernel system ;
+USING: io.files.temporary.backend io.nonblocking io.windows
+kernel system windows.kernel32 ;
+
IN: io.windows.files.temporary
M: windows-io (temporary-file) ( path -- stream )
- GENERIC_WRITE CREATE_NEW 0 open-file 0 <writer> ;
+ GENERIC_WRITE CREATE_NEW 0 open-file 0 <win32-file> <writer> ;
M: windows-io temporary-path ( -- path )
"TEMP" os-env ;
From c9b73f062b2266466ea8d250b27a49e82ac6d9cb Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Thu, 28 Feb 2008 23:46:27 -0600
Subject: [PATCH 03/55] Implement file-info
---
core/io/files/files.factor | 16 +++++++++++++++-
extra/io/unix/files/files.factor | 25 +++++++++++++++++++++++--
extra/unix/stat/macosx/macosx.factor | 4 ++++
extra/unix/stat/stat.factor | 23 +++++++++++++++++------
4 files changed, 59 insertions(+), 9 deletions(-)
diff --git a/core/io/files/files.factor b/core/io/files/files.factor
index 85f0621443..e20437fa85 100755
--- a/core/io/files/files.factor
+++ b/core/io/files/files.factor
@@ -1,10 +1,11 @@
! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-IN: io.files
USING: io.backend io.files.private io hashtables kernel math
memory namespaces sequences strings assocs arrays definitions
system combinators splitting sbufs continuations ;
+IN: io.files
+
! Pathnames
: path-separator? ( ch -- ? ) windows? "/\\" "/" ? member? ;
@@ -50,6 +51,19 @@ TUPLE: no-parent-directory path ;
{ [ t ] [ drop ] }
} cond ;
+TUPLE: file-info type size permissions modified ;
+
+HOOK: file-info io-backend ( path -- info )
+
+SYMBOL: +regular-file+
+SYMBOL: +directory+
+SYMBOL: +character-device+
+SYMBOL: +block-device+
+SYMBOL: +fifo+
+SYMBOL: +symbolic-link+
+SYMBOL: +socket+
+SYMBOL: +unknown+
+
! File metadata
: stat ( path -- directory? permissions length modified )
normalize-pathname (stat) ;
diff --git a/extra/io/unix/files/files.factor b/extra/io/unix/files/files.factor
index 7b1c97abbe..a5a4e64c03 100755
--- a/extra/io/unix/files/files.factor
+++ b/extra/io/unix/files/files.factor
@@ -1,8 +1,8 @@
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: io.backend io.nonblocking io.unix.backend io.files io
-unix unix.stat kernel math continuations math.bitfields byte-arrays
-alien ;
+ unix unix.stat kernel math continuations math.bitfields byte-arrays
+ alien combinators combinators.cleave calendar ;
IN: io.unix.files
@@ -68,3 +68,24 @@ M: unix-io delete-directory ( path -- )
M: unix-io copy-file ( from to -- )
>r dup file-permissions over r> (copy-file) chmod io-error ;
+
+: stat>type ( stat -- type )
+ stat-st_mode {
+ { [ dup S_ISREG ] [ +regular-file+ ] }
+ { [ dup S_ISDIR ] [ +directory+ ] }
+ { [ dup S_ISCHR ] [ +character-device+ ] }
+ { [ dup S_ISBLK ] [ +block-device+ ] }
+ { [ dup S_ISFIFO ] [ +fifo+ ] }
+ { [ dup S_ISLNK ] [ +symbolic-link+ ] }
+ { [ dup S_ISSOCK ] [ +socket+ ] }
+ { [ t ] [ +unknown+ ] }
+ } cond nip ;
+
+M: unix-io file-info ( path -- info )
+ stat* {
+ [ stat>type ]
+ [ stat-st_size ]
+ [ stat-st_mode ]
+ [ stat-st_mtim timespec-sec seconds unix-1970 time+ ]
+ } cleave
+ \ file-info construct-boa ;
diff --git a/extra/unix/stat/macosx/macosx.factor b/extra/unix/stat/macosx/macosx.factor
index 1cb3994708..3741a22413 100644
--- a/extra/unix/stat/macosx/macosx.factor
+++ b/extra/unix/stat/macosx/macosx.factor
@@ -27,3 +27,7 @@ C-STRUCT: stat
FUNCTION: int stat ( char* pathname, stat* buf ) ;
FUNCTION: int lstat ( char* pathname, stat* buf ) ;
+
+: stat-st_atim stat-st_atimespec ;
+: stat-st_mtim stat-st_mtimespec ;
+: stat-st_ctim stat-st_ctimespec ;
\ No newline at end of file
diff --git a/extra/unix/stat/stat.factor b/extra/unix/stat/stat.factor
index ca0736b6d4..204321f30c 100644
--- a/extra/unix/stat/stat.factor
+++ b/extra/unix/stat/stat.factor
@@ -1,5 +1,6 @@
-USING: kernel system combinators alien.syntax math vocabs.loader ;
+USING: kernel system combinators alien.syntax alien.c-types
+ math io.unix.backend vocabs.loader ;
IN: unix.stat
@@ -55,11 +56,21 @@ FUNCTION: int fchmod ( int fd, mode_t mode ) ;
FUNCTION: int mkdir ( char* path, mode_t mode ) ;
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+<<
+ os
+ {
+ { "linux" [ "unix.stat.linux" require ] }
+ { "macosx" [ "unix.stat.macosx" require ] }
+ [ drop ]
+ }
+ case
+>>
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-{
- { [ linux? ] [ "unix.stat.linux" require ] }
- { [ t ] [ ] }
-}
-cond
+: check-status ( n -- ) io-error ;
+: stat* ( pathname -- stat )
+ "stat" <c-object> dup >r
+ stat check-status
+ r> ;
From 499948047a774ca676c20808a4ab147fe259e863 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 29 Feb 2008 00:10:37 -0600
Subject: [PATCH 04/55] rename io.files.temporary to io.files.unique write
documentation
---
.../io/files/temporary/backend/backend.factor | 5 --
extra/io/files/temporary/temporary.factor | 36 -------------
extra/io/files/unique/backend/backend.factor | 5 ++
extra/io/files/unique/unique-docs.factor | 50 +++++++++++++++++++
extra/io/files/unique/unique.factor | 48 ++++++++++++++++++
.../io/unix/files/temporary/temporary.factor | 12 -----
extra/io/unix/files/unique/unique.factor | 12 +++++
extra/io/unix/unix.factor | 4 +-
.../temporary.factor => unique/unique.factor} | 4 +-
extra/io/windows/windows.factor | 8 +--
10 files changed, 123 insertions(+), 61 deletions(-)
delete mode 100644 extra/io/files/temporary/backend/backend.factor
delete mode 100644 extra/io/files/temporary/temporary.factor
create mode 100644 extra/io/files/unique/backend/backend.factor
create mode 100644 extra/io/files/unique/unique-docs.factor
create mode 100644 extra/io/files/unique/unique.factor
delete mode 100644 extra/io/unix/files/temporary/temporary.factor
create mode 100644 extra/io/unix/files/unique/unique.factor
rename extra/io/windows/files/{temporary/temporary.factor => unique/unique.factor} (63%)
diff --git a/extra/io/files/temporary/backend/backend.factor b/extra/io/files/temporary/backend/backend.factor
deleted file mode 100644
index 0fe4068621..0000000000
--- a/extra/io/files/temporary/backend/backend.factor
+++ /dev/null
@@ -1,5 +0,0 @@
-USING: io.backend ;
-IN: io.files.temporary.backend
-
-HOOK: (temporary-file) io-backend ( path prefix suffix -- stream path )
-HOOK: temporary-path io-backend ( -- path )
diff --git a/extra/io/files/temporary/temporary.factor b/extra/io/files/temporary/temporary.factor
deleted file mode 100644
index d46ddff8c6..0000000000
--- a/extra/io/files/temporary/temporary.factor
+++ /dev/null
@@ -1,36 +0,0 @@
-USING: kernel math math.bitfields combinators.lib math.parser
-random sequences sequences.lib continuations namespaces
-io.files io.backend io.nonblocking io arrays
-io.files.temporary.backend system combinators vocabs.loader ;
-USE: tools.walker
-IN: io.files.temporary
-
-: random-letter ( -- ch )
- 26 random { CHAR: a CHAR: A } random + ;
-
-: random-ch ( -- ch )
- { t f } random
- [ 10 random CHAR: 0 + ] [ random-letter ] if ;
-
-: random-name ( n -- string )
- [ drop random-ch ] "" map-as ;
-
-: <temporary-file> ( prefix suffix -- path duplex-stream )
- temporary-path -rot
- [ 10 random-name swap 3append path+ dup (temporary-file) ] 3curry
- 10 retry ;
-
-: with-temporary-file ( quot -- path )
- >r f f <temporary-file> r> with-stream ;
-
-: temporary-directory ( -- path )
- [ temporary-path 10 random-name path+ dup make-directory ] 10 retry ;
-
-: with-temporary-directory ( quot -- )
- >r temporary-directory r>
- [ with-directory ] 2keep drop delete-tree ;
-
-{
- { [ unix? ] [ "io.unix.files.temporary" ] }
- { [ windows? ] [ "io.windows.files.temporary" ] }
-} cond require
diff --git a/extra/io/files/unique/backend/backend.factor b/extra/io/files/unique/backend/backend.factor
new file mode 100644
index 0000000000..228b6881f9
--- /dev/null
+++ b/extra/io/files/unique/backend/backend.factor
@@ -0,0 +1,5 @@
+USING: io.backend ;
+IN: io.files.unique.backend
+
+HOOK: (make-unique-file) io-backend ( prefix suffix -- stream path )
+HOOK: temporary-path io-backend ( -- path )
diff --git a/extra/io/files/unique/unique-docs.factor b/extra/io/files/unique/unique-docs.factor
new file mode 100644
index 0000000000..61f960d9f7
--- /dev/null
+++ b/extra/io/files/unique/unique-docs.factor
@@ -0,0 +1,50 @@
+USING: help.markup help.syntax io io.nonblocking kernel math
+io.files.unique.private math.parser io.files ;
+IN: io.files.unique
+
+ARTICLE: "unique" "Making and using unique files"
+"Files:"
+{ $subsection make-unique-file }
+{ $subsection with-unique-file }
+{ $subsection with-temporary-file }
+"Directories:"
+{ $subsection make-unique-directory }
+{ $subsection with-unique-directory }
+{ $subsection with-temporary-directory } ;
+
+ABOUT: "unique"
+
+HELP: make-unique-file ( prefix suffix -- path stream )
+{ $values { "prefix" "a string" } { "suffix" "a string" }
+{ "path" "a pathname string" } { "stream" "an output stream" } }
+{ $description "Creates a file that is guaranteed not to exist in a platform-specific temporary directory. The file name is composed of a prefix, a number of random digits and letters, and the suffix. Returns the full pathname and a " { $link <writer> } " stream." }
+{ $errors "Throws an error if a new unique file cannot be created after a number of tries. Since each try generates a new random name, the most likely error is incorrect directory permissions on the temporary directory." }
+{ $see-also with-unique-file } ;
+
+HELP: make-unique-directory ( -- path )
+{ $values { "path" "a pathname string" } }
+{ $description "Creates a directory that is guaranteed not to exist in a platform-specific temporary directory and returns the full pathname." }
+{ $errors "Throws an error if the directory cannot be created after a number of tries. Since each try generates a new random name, the most likely error is incorrect directory permissions on the temporary directory." }
+{ $see-also with-unique-directory } ;
+
+HELP: with-unique-file ( quot -- path )
+{ $values { "quot" "a quotation" } { "path" "a pathname string" } }
+{ $description "Creates a file with " { $link make-unique-file } " and calls " { $link with-stream } " on the newly created file. Returns the full pathname after the stream has been closed." }
+{ $notes "The unique file will remain after calling this word." }
+{ $see-also with-temporary-file } ;
+
+HELP: with-unique-directory ( quot -- path )
+{ $values { "quot" "a quotation" } { "path" "a pathname string" } }
+{ $description "Creates a directory with " { $link make-unique-directory } " and calls " { $link with-directory } " on the newly created directory. Returns the full pathname after the quotation has been called." }
+{ $notes "The directory will remain after calling this word." }
+{ $see-also with-temporary-directory } ;
+
+HELP: with-temporary-file ( quot -- )
+{ $values { "quot" "a quotation" } }
+{ $description "Creates a file with " { $link make-unique-file } " and calls " { $link with-stream } " on the newly created file. The file is deleted after the quotation returns." }
+{ $see-also with-unique-file } ;
+
+HELP: with-temporary-directory ( quot -- )
+{ $values { "quot" "a quotation" } }
+{ $description "Creates a directory with " { $link make-unique-directory } " and calls " { $link with-directory } " on the newly created directory. The directory is deleted after the quotation returns." }
+{ $see-also with-unique-directory } ;
diff --git a/extra/io/files/unique/unique.factor b/extra/io/files/unique/unique.factor
new file mode 100644
index 0000000000..3a1c3c46b8
--- /dev/null
+++ b/extra/io/files/unique/unique.factor
@@ -0,0 +1,48 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel math math.bitfields combinators.lib math.parser
+random sequences sequences.lib continuations namespaces
+io.files io.backend io.nonblocking io arrays
+io.files.unique.backend system combinators vocabs.loader ;
+IN: io.files.unique
+
+<PRIVATE
+: random-letter ( -- ch )
+ 26 random { CHAR: a CHAR: A } random + ;
+
+: random-ch ( -- ch )
+ { t f } random
+ [ 10 random CHAR: 0 + ] [ random-letter ] if ;
+
+: random-name ( n -- string )
+ [ drop random-ch ] "" map-as ;
+
+: unique-length ( -- n ) 10 ; inline
+: unique-retries ( -- n ) 10 ; inline
+PRIVATE>
+
+: make-unique-file ( prefix suffix -- path stream )
+ temporary-path -rot
+ [
+ unique-length random-name swap 3append path+
+ dup (make-unique-file)
+ ] 3curry unique-retries retry ;
+
+: with-unique-file ( quot -- path )
+ >r f f make-unique-file r> with-stream ; inline
+
+: with-temporary-file ( quot -- )
+ with-unique-file delete-file ; inline
+
+: make-unique-directory ( -- path )
+ [
+ temporary-path unique-length random-name path+
+ dup make-directory
+ ] unique-retries retry ;
+
+: with-unique-directory ( quot -- path )
+ >r make-unique-directory r>
+ [ with-directory ] curry keep ; inline
+
+: with-temporary-directory ( quot -- )
+ with-unique-directory delete-tree ; inline
diff --git a/extra/io/unix/files/temporary/temporary.factor b/extra/io/unix/files/temporary/temporary.factor
deleted file mode 100644
index 0ac6d7605e..0000000000
--- a/extra/io/unix/files/temporary/temporary.factor
+++ /dev/null
@@ -1,12 +0,0 @@
-USING: kernel io.nonblocking io.unix.backend math.bitfields
-unix io.files.temporary.backend ;
-IN: io.unix.files.temporary
-
-: open-temporary-flags ( -- flags )
- { O_RDWR O_CREAT O_EXCL } flags ;
-
-M: unix-io (temporary-file) ( path -- duplex-stream )
- open-temporary-flags file-mode open dup io-error
- <writer> ;
-
-M: unix-io temporary-path ( -- path ) "/tmp" ;
diff --git a/extra/io/unix/files/unique/unique.factor b/extra/io/unix/files/unique/unique.factor
new file mode 100644
index 0000000000..185d9cd405
--- /dev/null
+++ b/extra/io/unix/files/unique/unique.factor
@@ -0,0 +1,12 @@
+USING: kernel io.nonblocking io.unix.backend math.bitfields
+unix io.files.unique.backend ;
+IN: io.unix.files.unique
+
+: open-unique-flags ( -- flags )
+ { O_RDWR O_CREAT O_EXCL } flags ;
+
+M: unix-io (make-unique-file) ( path -- duplex-stream )
+ open-unique-flags file-mode open dup io-error
+ <writer> ;
+
+M: unix-io temporary-path ( -- path ) "/tmp" ;
diff --git a/extra/io/unix/unix.factor b/extra/io/unix/unix.factor
index e740561cf9..a328a3baf4 100755
--- a/extra/io/unix/unix.factor
+++ b/extra/io/unix/unix.factor
@@ -1,6 +1,6 @@
USING: io.unix.backend io.unix.files io.unix.sockets io.timeouts
-io.unix.launcher io.unix.mmap io.backend combinators namespaces
-system vocabs.loader sequences ;
+io.unix.launcher io.unix.mmap io.backend io.files.temporary
+combinators namespaces system vocabs.loader sequences ;
"io.unix." os append require
diff --git a/extra/io/windows/files/temporary/temporary.factor b/extra/io/windows/files/unique/unique.factor
similarity index 63%
rename from extra/io/windows/files/temporary/temporary.factor
rename to extra/io/windows/files/unique/unique.factor
index d96ff49e15..01e654751e 100644
--- a/extra/io/windows/files/temporary/temporary.factor
+++ b/extra/io/windows/files/unique/unique.factor
@@ -1,7 +1,7 @@
USING: kernel system ;
-IN: io.windows.files.temporary
+IN: io.windows.files.unique
-M: windows-io (temporary-file) ( path -- stream )
+M: windows-io (make-unique-file) ( path -- stream )
GENERIC_WRITE CREATE_NEW 0 open-file 0 <writer> ;
M: windows-io temporary-path ( -- path )
diff --git a/extra/io/windows/windows.factor b/extra/io/windows/windows.factor
index 9f2f2db0a5..2c2ad66221 100755
--- a/extra/io/windows/windows.factor
+++ b/extra/io/windows/windows.factor
@@ -2,10 +2,10 @@
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types arrays destructors io io.backend
io.buffers io.files io.nonblocking io.sockets io.binary
-io.sockets.impl windows.errors strings io.streams.duplex kernel
-math namespaces sequences windows windows.kernel32
-windows.shell32 windows.types windows.winsock splitting
-continuations math.bitfields ;
+io.sockets.impl io.windows.files.temporary windows.errors
+strings io.streams.duplex kernel math namespaces sequences
+windows windows.kernel32 windows.shell32 windows.types
+windows.winsock splitting continuations math.bitfields ;
IN: io.windows
TUPLE: windows-nt-io ;
From edcda314bd2a6a89ed39d4c81acff182a0af0f0b Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 29 Feb 2008 00:11:01 -0600
Subject: [PATCH 05/55] add temporary files to docs
---
core/io/files/files-docs.factor | 1 +
1 file changed, 1 insertion(+)
diff --git a/core/io/files/files-docs.factor b/core/io/files/files-docs.factor
index c918641912..b8cf747106 100755
--- a/core/io/files/files-docs.factor
+++ b/core/io/files/files-docs.factor
@@ -87,6 +87,7 @@ ARTICLE: "io.files" "Basic file operations"
{ $subsection "fs-meta" }
{ $subsection "directories" }
{ $subsection "delete-move-copy" }
+{ $subsection "unique" }
{ $see-also "os" } ;
ABOUT: "io.files"
From 0102689b1e0cf6bc062f76a62c77498c6dd0159b Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 29 Feb 2008 00:11:50 -0600
Subject: [PATCH 06/55] make retry inline
---
extra/combinators/lib/lib.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/extra/combinators/lib/lib.factor b/extra/combinators/lib/lib.factor
index 019f4fe376..08336fd32e 100755
--- a/extra/combinators/lib/lib.factor
+++ b/extra/combinators/lib/lib.factor
@@ -170,4 +170,4 @@ MACRO: construct-slots ( assoc tuple-class -- tuple )
>r keep r> rot [ call ] [ 2drop f ] if ; inline
: retry ( quot n -- )
- swap [ drop ] swap compose attempt-all ;
+ swap [ drop ] swap compose attempt-all ; inline
From ad2d06806b16d38ac48bc56d110065cf4b2b42a2 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 29 Feb 2008 00:55:24 -0600
Subject: [PATCH 07/55] s/temporary/unique/
---
extra/io/unix/unix.factor | 2 +-
extra/io/windows/windows.factor | 2 +-
2 files changed, 2 insertions(+), 2 deletions(-)
diff --git a/extra/io/unix/unix.factor b/extra/io/unix/unix.factor
index a328a3baf4..11cdc0aa3b 100755
--- a/extra/io/unix/unix.factor
+++ b/extra/io/unix/unix.factor
@@ -1,5 +1,5 @@
USING: io.unix.backend io.unix.files io.unix.sockets io.timeouts
-io.unix.launcher io.unix.mmap io.backend io.files.temporary
+io.unix.launcher io.unix.mmap io.backend io.files.unique
combinators namespaces system vocabs.loader sequences ;
"io.unix." os append require
diff --git a/extra/io/windows/windows.factor b/extra/io/windows/windows.factor
index 2c2ad66221..06dbaf89f7 100755
--- a/extra/io/windows/windows.factor
+++ b/extra/io/windows/windows.factor
@@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types arrays destructors io io.backend
io.buffers io.files io.nonblocking io.sockets io.binary
-io.sockets.impl io.windows.files.temporary windows.errors
+io.sockets.impl io.windows.files.unique windows.errors
strings io.streams.duplex kernel math namespaces sequences
windows windows.kernel32 windows.shell32 windows.types
windows.winsock splitting continuations math.bitfields ;
From 869cfd54630a7259dfdab9d17e50aaefec6b36d8 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 29 Feb 2008 15:38:20 -0600
Subject: [PATCH 08/55] fix sqlite -- wasn't settin gthe bound? flag
---
extra/db/sqlite/sqlite.factor | 3 ++-
extra/db/tuples/tuples-tests.factor | 2 +-
2 files changed, 3 insertions(+), 2 deletions(-)
diff --git a/extra/db/sqlite/sqlite.factor b/extra/db/sqlite/sqlite.factor
index b980e99718..d873e98a95 100755
--- a/extra/db/sqlite/sqlite.factor
+++ b/extra/db/sqlite/sqlite.factor
@@ -64,7 +64,8 @@ M: sqlite-statement bind-tuple ( tuple statement -- )
[ sql-spec-type ] tri 3array
] with map
] keep
- [ set-statement-bind-params ] keep bind-statement* ;
+ [ set-statement-bind-params ] keep
+ t over set-statement-bound? bind-statement* ;
: last-insert-id ( -- id )
db get db-handle sqlite3_last_insert_rowid
diff --git a/extra/db/tuples/tuples-tests.factor b/extra/db/tuples/tuples-tests.factor
index c9e6d302e0..ade18286b4 100755
--- a/extra/db/tuples/tuples-tests.factor
+++ b/extra/db/tuples/tuples-tests.factor
@@ -81,7 +81,7 @@ person "PERSON"
1 "billy" 10 3.14 <assigned-person> the-person1 set
2 "johnny" 10 3.14 <assigned-person> the-person2 set
-test-sqlite
+! test-sqlite
! test-postgresql
TUPLE: paste n summary author channel mode contents timestamp annotations ;
From 93a8cbcac3fb462ade75625c8347c01c9b20f2a9 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 29 Feb 2008 15:41:54 -0600
Subject: [PATCH 09/55] fix a hack. oops
---
extra/db/sqlite/sqlite.factor | 6 +++---
extra/db/tuples/tuples-tests.factor | 2 +-
2 files changed, 4 insertions(+), 4 deletions(-)
diff --git a/extra/db/sqlite/sqlite.factor b/extra/db/sqlite/sqlite.factor
index d873e98a95..c03496530b 100755
--- a/extra/db/sqlite/sqlite.factor
+++ b/extra/db/sqlite/sqlite.factor
@@ -53,7 +53,8 @@ M: sqlite-result-set dispose ( result-set -- )
M: sqlite-statement bind-statement* ( statement -- )
dup statement-bound? [ dup reset-statement ] when
- [ statement-bind-params ] [ statement-handle ] bi sqlite-bind ;
+ [ statement-bind-params ] [ statement-handle ] bi
+ sqlite-bind ;
M: sqlite-statement bind-tuple ( tuple statement -- )
[
@@ -64,8 +65,7 @@ M: sqlite-statement bind-tuple ( tuple statement -- )
[ sql-spec-type ] tri 3array
] with map
] keep
- [ set-statement-bind-params ] keep
- t over set-statement-bound? bind-statement* ;
+ bind-statement ;
: last-insert-id ( -- id )
db get db-handle sqlite3_last_insert_rowid
diff --git a/extra/db/tuples/tuples-tests.factor b/extra/db/tuples/tuples-tests.factor
index ade18286b4..c9e6d302e0 100755
--- a/extra/db/tuples/tuples-tests.factor
+++ b/extra/db/tuples/tuples-tests.factor
@@ -81,7 +81,7 @@ person "PERSON"
1 "billy" 10 3.14 <assigned-person> the-person1 set
2 "johnny" 10 3.14 <assigned-person> the-person2 set
-! test-sqlite
+test-sqlite
! test-postgresql
TUPLE: paste n summary author channel mode contents timestamp annotations ;
From b7f9aac2106499deeb65db76d9977e3ac87200b8 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 29 Feb 2008 17:10:22 -0600
Subject: [PATCH 10/55] fix with-unique-file
---
extra/io/files/unique/unique.factor | 2 +-
extra/io/unix/unix.factor | 2 +-
extra/io/windows/files/unique/unique.factor | 2 +-
3 files changed, 3 insertions(+), 3 deletions(-)
diff --git a/extra/io/files/unique/unique.factor b/extra/io/files/unique/unique.factor
index 3a1c3c46b8..b39a14c7f5 100644
--- a/extra/io/files/unique/unique.factor
+++ b/extra/io/files/unique/unique.factor
@@ -29,7 +29,7 @@ PRIVATE>
] 3curry unique-retries retry ;
: with-unique-file ( quot -- path )
- >r f f make-unique-file r> with-stream ; inline
+ >r f f make-unique-file r> rot [ with-stream ] dip ; inline
: with-temporary-file ( quot -- )
with-unique-file delete-file ; inline
diff --git a/extra/io/unix/unix.factor b/extra/io/unix/unix.factor
index 11cdc0aa3b..b7111c5eac 100755
--- a/extra/io/unix/unix.factor
+++ b/extra/io/unix/unix.factor
@@ -1,5 +1,5 @@
USING: io.unix.backend io.unix.files io.unix.sockets io.timeouts
-io.unix.launcher io.unix.mmap io.backend io.files.unique
+io.unix.launcher io.unix.mmap io.backend io.unix.files.unique
combinators namespaces system vocabs.loader sequences ;
"io.unix." os append require
diff --git a/extra/io/windows/files/unique/unique.factor b/extra/io/windows/files/unique/unique.factor
index 01e654751e..5f11bf6142 100644
--- a/extra/io/windows/files/unique/unique.factor
+++ b/extra/io/windows/files/unique/unique.factor
@@ -1,4 +1,4 @@
-USING: kernel system ;
+USING: kernel system io.files.unqiue io.files.unique.backend ;
IN: io.windows.files.unique
M: windows-io (make-unique-file) ( path -- stream )
From ac6c91d5a626e7a47d9e23833131350d38e5f8e5 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 29 Feb 2008 17:44:53 -0600
Subject: [PATCH 11/55] fix bootstrap
---
extra/io/files/unique/unique.factor | 5 +++++
extra/io/unix/unix.factor | 2 +-
extra/io/windows/files/unique/unique.factor | 2 +-
extra/io/windows/windows.factor | 8 ++++----
4 files changed, 11 insertions(+), 6 deletions(-)
diff --git a/extra/io/files/unique/unique.factor b/extra/io/files/unique/unique.factor
index b39a14c7f5..1e77cd6814 100644
--- a/extra/io/files/unique/unique.factor
+++ b/extra/io/files/unique/unique.factor
@@ -46,3 +46,8 @@ PRIVATE>
: with-temporary-directory ( quot -- )
with-unique-directory delete-tree ; inline
+
+{
+ { [ unix? ] [ "io.unix.files.unique" ] }
+ { [ windows? ] [ "io.windows.files.unique" ] }
+} cond require
diff --git a/extra/io/unix/unix.factor b/extra/io/unix/unix.factor
index b7111c5eac..64e2cc3c3d 100755
--- a/extra/io/unix/unix.factor
+++ b/extra/io/unix/unix.factor
@@ -1,5 +1,5 @@
USING: io.unix.backend io.unix.files io.unix.sockets io.timeouts
-io.unix.launcher io.unix.mmap io.backend io.unix.files.unique
+io.unix.launcher io.unix.mmap io.backend
combinators namespaces system vocabs.loader sequences ;
"io.unix." os append require
diff --git a/extra/io/windows/files/unique/unique.factor b/extra/io/windows/files/unique/unique.factor
index 5f11bf6142..ae06090488 100644
--- a/extra/io/windows/files/unique/unique.factor
+++ b/extra/io/windows/files/unique/unique.factor
@@ -1,4 +1,4 @@
-USING: kernel system io.files.unqiue io.files.unique.backend ;
+USING: kernel system io.files.unique.backend ;
IN: io.windows.files.unique
M: windows-io (make-unique-file) ( path -- stream )
diff --git a/extra/io/windows/windows.factor b/extra/io/windows/windows.factor
index 06dbaf89f7..38b7d4829c 100755
--- a/extra/io/windows/windows.factor
+++ b/extra/io/windows/windows.factor
@@ -2,10 +2,10 @@
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types arrays destructors io io.backend
io.buffers io.files io.nonblocking io.sockets io.binary
-io.sockets.impl io.windows.files.unique windows.errors
-strings io.streams.duplex kernel math namespaces sequences
-windows windows.kernel32 windows.shell32 windows.types
-windows.winsock splitting continuations math.bitfields ;
+io.sockets.impl windows.errors strings io.streams.duplex
+kernel math namespaces sequences windows windows.kernel32
+windows.shell32 windows.types windows.winsock splitting
+continuations math.bitfields ;
IN: io.windows
TUPLE: windows-nt-io ;
From adf5cfda5904f5f655016f1ea77bc287203d3ed8 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 29 Feb 2008 18:04:09 -0600
Subject: [PATCH 12/55] clean up retry
---
extra/combinators/lib/lib.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/extra/combinators/lib/lib.factor b/extra/combinators/lib/lib.factor
index 08336fd32e..f65b94dc11 100755
--- a/extra/combinators/lib/lib.factor
+++ b/extra/combinators/lib/lib.factor
@@ -170,4 +170,4 @@ MACRO: construct-slots ( assoc tuple-class -- tuple )
>r keep r> rot [ call ] [ 2drop f ] if ; inline
: retry ( quot n -- )
- swap [ drop ] swap compose attempt-all ; inline
+ [ drop ] rot compose attempt-all ; inline
From 4f40f10b88fac030bd3a7cc9773589251c1c4e04 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 29 Feb 2008 18:04:20 -0600
Subject: [PATCH 13/55] fix stack effect
---
extra/io/files/unique/backend/backend.factor | 2 +-
extra/io/files/unique/unique.factor | 3 ++-
2 files changed, 3 insertions(+), 2 deletions(-)
diff --git a/extra/io/files/unique/backend/backend.factor b/extra/io/files/unique/backend/backend.factor
index 228b6881f9..b26557688b 100644
--- a/extra/io/files/unique/backend/backend.factor
+++ b/extra/io/files/unique/backend/backend.factor
@@ -1,5 +1,5 @@
USING: io.backend ;
IN: io.files.unique.backend
-HOOK: (make-unique-file) io-backend ( prefix suffix -- stream path )
+HOOK: (make-unique-file) io-backend ( path -- stream )
HOOK: temporary-path io-backend ( -- path )
diff --git a/extra/io/files/unique/unique.factor b/extra/io/files/unique/unique.factor
index 1e77cd6814..8c0666161e 100644
--- a/extra/io/files/unique/unique.factor
+++ b/extra/io/files/unique/unique.factor
@@ -22,11 +22,12 @@ IN: io.files.unique
PRIVATE>
: make-unique-file ( prefix suffix -- path stream )
+break
temporary-path -rot
[
unique-length random-name swap 3append path+
dup (make-unique-file)
- ] 3curry unique-retries retry ;
+ ] 3curry unique-retries retry break ;
: with-unique-file ( quot -- path )
>r f f make-unique-file r> rot [ with-stream ] dip ; inline
From a318a80b991e2a44ecff2f1d4a942114d2eb83da Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 29 Feb 2008 18:04:44 -0600
Subject: [PATCH 14/55] fix using
---
extra/io/windows/files/unique/unique.factor | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/extra/io/windows/files/unique/unique.factor b/extra/io/windows/files/unique/unique.factor
index ae06090488..dd0341162b 100644
--- a/extra/io/windows/files/unique/unique.factor
+++ b/extra/io/windows/files/unique/unique.factor
@@ -1,4 +1,5 @@
-USING: kernel system io.files.unique.backend ;
+USING: kernel system io.files.unique.backend
+windows.kernel32 io.windows io.nonblocking ;
IN: io.windows.files.unique
M: windows-io (make-unique-file) ( path -- stream )
From 2dffb31e53b18270cc5d5c686f9f997a3c8c0d7c Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 29 Feb 2008 18:05:38 -0600
Subject: [PATCH 15/55] remove debug info
---
extra/io/files/unique/unique.factor | 3 +--
1 file changed, 1 insertion(+), 2 deletions(-)
diff --git a/extra/io/files/unique/unique.factor b/extra/io/files/unique/unique.factor
index 8c0666161e..1e77cd6814 100644
--- a/extra/io/files/unique/unique.factor
+++ b/extra/io/files/unique/unique.factor
@@ -22,12 +22,11 @@ IN: io.files.unique
PRIVATE>
: make-unique-file ( prefix suffix -- path stream )
-break
temporary-path -rot
[
unique-length random-name swap 3append path+
dup (make-unique-file)
- ] 3curry unique-retries retry break ;
+ ] 3curry unique-retries retry ;
: with-unique-file ( quot -- path )
>r f f make-unique-file r> rot [ with-stream ] dip ; inline
From 316a8ad1ae6e07bcf4f766b72a3591135e308d9c Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 29 Feb 2008 18:20:45 -0600
Subject: [PATCH 16/55] fix io.files.unique
---
extra/io/windows/files/unique/unique.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/extra/io/windows/files/unique/unique.factor b/extra/io/windows/files/unique/unique.factor
index dd0341162b..0823c3f0f3 100644
--- a/extra/io/windows/files/unique/unique.factor
+++ b/extra/io/windows/files/unique/unique.factor
@@ -3,7 +3,7 @@ windows.kernel32 io.windows io.nonblocking ;
IN: io.windows.files.unique
M: windows-io (make-unique-file) ( path -- stream )
- GENERIC_WRITE CREATE_NEW 0 open-file 0 <writer> ;
+ GENERIC_WRITE CREATE_NEW 0 open-file 0 <win32-file> <writer> ;
M: windows-io temporary-path ( -- path )
"TEMP" os-env ;
From 373a88a77ad3214f7ab6ae21f3912fe373bbf5be Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Fri, 29 Feb 2008 19:10:30 -0600
Subject: [PATCH 17/55] Fix UI hang, add if-box combinator
---
core/boxes/boxes.factor | 3 +
core/vocabs/loader/loader.factor | 10 +-
extra/alarms/alarms.factor | 3 +-
extra/concurrency/flags/flags-tests.factor | 46 +++
extra/concurrency/flags/flags.factor | 10 +-
extra/help/help.factor | 10 +-
extra/http.good/authors.txt | 1 +
.../basic-authentication/authors.txt | 1 +
.../basic-authentication-docs.factor | 69 +++++
.../basic-authentication-tests.factor | 66 +++++
.../basic-authentication.factor | 65 ++++
.../basic-authentication/summary.txt | 1 +
extra/http.good/basic-authentication/tags.txt | 1 +
extra/http.good/client/authors.txt | 1 +
extra/http.good/client/client-tests.factor | 26 ++
extra/http.good/client/client.factor | 96 ++++++
extra/http.good/client/summary.txt | 1 +
extra/http.good/client/tags.txt | 2 +
extra/http.good/http-tests.factor | 115 ++++++++
extra/http.good/http.factor | 277 ++++++++++++++++++
extra/http.good/mime/authors.txt | 1 +
extra/http.good/mime/mime.factor | 34 +++
extra/http.good/server/authors.txt | 1 +
extra/http.good/server/server-tests.factor | 45 +++
extra/http.good/server/server.factor | 131 +++++++++
extra/http.good/server/summary.txt | 1 +
extra/http.good/server/tags.txt | 3 +
extra/http.good/server/templating/authors.txt | 2 +
.../server/templating/templating-tests.factor | 17 ++
.../server/templating/templating.factor | 96 ++++++
.../server/templating/test/bug.fhtml | 5 +
.../http.good/server/templating/test/bug.html | 2 +
.../server/templating/test/example.fhtml | 8 +
.../server/templating/test/example.html | 9 +
.../server/templating/test/stack.fhtml | 1 +
.../server/templating/test/stack.html | 2 +
extra/http.good/summary.txt | 1 +
extra/http.good/tags.txt | 2 +
extra/io/monitors/monitors.factor | 2 +-
extra/ui/windows/windows.factor | 10 +-
extra/vocabs/monitor/monitor.factor | 6 +-
41 files changed, 1158 insertions(+), 25 deletions(-)
create mode 100755 extra/concurrency/flags/flags-tests.factor
mode change 100644 => 100755 extra/concurrency/flags/flags.factor
create mode 100644 extra/http.good/authors.txt
create mode 100644 extra/http.good/basic-authentication/authors.txt
create mode 100644 extra/http.good/basic-authentication/basic-authentication-docs.factor
create mode 100644 extra/http.good/basic-authentication/basic-authentication-tests.factor
create mode 100644 extra/http.good/basic-authentication/basic-authentication.factor
create mode 100644 extra/http.good/basic-authentication/summary.txt
create mode 100644 extra/http.good/basic-authentication/tags.txt
create mode 100644 extra/http.good/client/authors.txt
create mode 100755 extra/http.good/client/client-tests.factor
create mode 100755 extra/http.good/client/client.factor
create mode 100644 extra/http.good/client/summary.txt
create mode 100644 extra/http.good/client/tags.txt
create mode 100755 extra/http.good/http-tests.factor
create mode 100755 extra/http.good/http.factor
create mode 100755 extra/http.good/mime/authors.txt
create mode 100644 extra/http.good/mime/mime.factor
create mode 100755 extra/http.good/server/authors.txt
create mode 100755 extra/http.good/server/server-tests.factor
create mode 100755 extra/http.good/server/server.factor
create mode 100644 extra/http.good/server/summary.txt
create mode 100644 extra/http.good/server/tags.txt
create mode 100644 extra/http.good/server/templating/authors.txt
create mode 100644 extra/http.good/server/templating/templating-tests.factor
create mode 100755 extra/http.good/server/templating/templating.factor
create mode 100644 extra/http.good/server/templating/test/bug.fhtml
create mode 100644 extra/http.good/server/templating/test/bug.html
create mode 100644 extra/http.good/server/templating/test/example.fhtml
create mode 100644 extra/http.good/server/templating/test/example.html
create mode 100644 extra/http.good/server/templating/test/stack.fhtml
create mode 100644 extra/http.good/server/templating/test/stack.html
create mode 100644 extra/http.good/summary.txt
create mode 100644 extra/http.good/tags.txt
diff --git a/core/boxes/boxes.factor b/core/boxes/boxes.factor
index 8197e57969..a989e091bb 100755
--- a/core/boxes/boxes.factor
+++ b/core/boxes/boxes.factor
@@ -19,3 +19,6 @@ TUPLE: box value full? ;
: ?box ( box -- value/f ? )
dup box-full? [ box> t ] [ drop f f ] if ;
+
+: if-box? ( box quot -- )
+ >r ?box r> [ drop ] if ; inline
diff --git a/core/vocabs/loader/loader.factor b/core/vocabs/loader/loader.factor
index 8bdd9b902f..57743ce9e1 100755
--- a/core/vocabs/loader/loader.factor
+++ b/core/vocabs/loader/loader.factor
@@ -4,7 +4,7 @@ USING: namespaces sequences io.files kernel assocs words vocabs
definitions parser continuations inspector debugger io io.styles
io.streams.lines hashtables sorting prettyprint source-files
arrays combinators strings system math.parser compiler.errors
-splitting ;
+splitting init ;
IN: vocabs.loader
SYMBOL: vocab-roots
@@ -175,7 +175,13 @@ SYMBOL: failures
: refresh ( prefix -- ) to-refresh do-refresh ;
-: refresh-all ( -- ) "" refresh ;
+SYMBOL: sources-changed?
+
+[ t sources-changed? set-global ] "vocabs.loader" add-init-hook
+
+: refresh-all ( -- )
+ sources-changed? get-global
+ [ "" refresh f sources-changed? set-global ] when ;
GENERIC: (load-vocab) ( name -- vocab )
diff --git a/extra/alarms/alarms.factor b/extra/alarms/alarms.factor
index a50e1817e1..d008b7b462 100755
--- a/extra/alarms/alarms.factor
+++ b/extra/alarms/alarms.factor
@@ -87,5 +87,4 @@ PRIVATE>
from-now f add-alarm ;
: cancel-alarm ( alarm -- )
- alarm-entry ?box
- [ alarms get-global heap-delete ] [ drop ] if ;
+ alarm-entry [ alarms get-global heap-delete ] if-box? ;
diff --git a/extra/concurrency/flags/flags-tests.factor b/extra/concurrency/flags/flags-tests.factor
new file mode 100755
index 0000000000..44934b59c4
--- /dev/null
+++ b/extra/concurrency/flags/flags-tests.factor
@@ -0,0 +1,46 @@
+IN: temporary
+USING: tools.test concurrency.flags kernel threads locals ;
+
+:: flag-test-1 ( -- )
+ [let | f [ <flag> ] |
+ [ f raise-flag ] "Flag test" spawn drop
+ f lower-flag
+ f flag-value?
+ ] ;
+
+[ f ] [ flag-test-1 ] unit-test
+
+:: flag-test-2 ( -- )
+ [let | f [ <flag> ] |
+ [ 1000 sleep f raise-flag ] "Flag test" spawn drop
+ f lower-flag
+ f flag-value?
+ ] ;
+
+[ f ] [ flag-test-2 ] unit-test
+
+:: flag-test-3 ( -- )
+ [let | f [ <flag> ] |
+ f raise-flag
+ f flag-value?
+ ] ;
+
+[ t ] [ flag-test-3 ] unit-test
+
+:: flag-test-4 ( -- )
+ [let | f [ <flag> ] |
+ [ f raise-flag ] "Flag test" spawn drop
+ f wait-for-flag
+ f flag-value?
+ ] ;
+
+[ t ] [ flag-test-4 ] unit-test
+
+:: flag-test-5 ( -- )
+ [let | f [ <flag> ] |
+ [ 1000 sleep f raise-flag ] "Flag test" spawn drop
+ f wait-for-flag
+ f flag-value?
+ ] ;
+
+[ t ] [ flag-test-5 ] unit-test
diff --git a/extra/concurrency/flags/flags.factor b/extra/concurrency/flags/flags.factor
old mode 100644
new mode 100755
index 888b617b85..d598bf0b59
--- a/extra/concurrency/flags/flags.factor
+++ b/extra/concurrency/flags/flags.factor
@@ -9,8 +9,8 @@ TUPLE: flag value? thread ;
: raise-flag ( flag -- )
dup flag-value? [
- dup flag-thread ?box
- [ resume ] [ drop t over set-flag-value? ] if
+ t over set-flag-value?
+ dup flag-thread [ resume ] if-box?
] unless drop ;
: wait-for-flag ( flag -- )
@@ -19,8 +19,4 @@ TUPLE: flag value? thread ;
] if ;
: lower-flag ( flag -- )
- dup flag-value? [
- f swap set-flag-value?
- ] [
- wait-for-flag
- ] if ;
+ dup wait-for-flag f swap set-flag-value? ;
diff --git a/extra/help/help.factor b/extra/help/help.factor
index 490374a384..9332e6aff8 100755
--- a/extra/help/help.factor
+++ b/extra/help/help.factor
@@ -132,13 +132,13 @@ M: word set-article-parent swap "help-parent" set-word-prop ;
nl
"Debugger commands:" print
nl
- ":help - documentation for this error" print
- ":s - data stack at exception time" print
- ":r - retain stack at exception time" print
- ":c - call stack at exception time" print
+ ":s - data stack at error time" print
+ ":r - retain stack at error time" print
+ ":c - call stack at error time" print
":edit - jump to source location (parse errors only)" print
- ":get ( var -- value ) accesses variables at time of the error" print ;
+ ":get ( var -- value ) accesses variables at time of the error" print
+ ":vars - list all variables at error time";
: :help ( -- )
error get delegates [ error-help ] map [ ] subset
diff --git a/extra/http.good/authors.txt b/extra/http.good/authors.txt
new file mode 100644
index 0000000000..1901f27a24
--- /dev/null
+++ b/extra/http.good/authors.txt
@@ -0,0 +1 @@
+Slava Pestov
diff --git a/extra/http.good/basic-authentication/authors.txt b/extra/http.good/basic-authentication/authors.txt
new file mode 100644
index 0000000000..44b06f94bc
--- /dev/null
+++ b/extra/http.good/basic-authentication/authors.txt
@@ -0,0 +1 @@
+Chris Double
diff --git a/extra/http.good/basic-authentication/basic-authentication-docs.factor b/extra/http.good/basic-authentication/basic-authentication-docs.factor
new file mode 100644
index 0000000000..68d6e6bf1d
--- /dev/null
+++ b/extra/http.good/basic-authentication/basic-authentication-docs.factor
@@ -0,0 +1,69 @@
+! Copyright (C) 2007 Chris Double.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax crypto.sha2 ;
+IN: http.basic-authentication
+
+HELP: realms
+{ $description
+ "A hashtable mapping a basic authentication realm (a string) "
+ "to either a quotation or a hashtable. The quotation has "
+ "stack effect ( username sha-256-string -- bool ). It "
+ "is expected to perform the user authentication when called." $nl
+ "If the realm maps to a hashtable then the hashtable should be a "
+ "mapping of usernames to sha-256 hashed passwords." $nl
+ "If the 'realms' variable does not exist in the current scope then "
+ "authentication will always fail." }
+{ $see-also add-realm with-basic-authentication } ;
+
+HELP: add-realm
+{ $values
+ { "data" "a quotation or a hashtable" } { "name" "a string" } }
+{ $description
+ "Adds the authentication data to the " { $link realms } ". 'data' can be "
+ "a quotation with stack effect ( username sha-256-string -- bool ) or "
+ "a hashtable mapping username strings to sha-256-string passwords." }
+{ $examples
+ { $code "H{ { \"admin\" \"...\" } { \"user\" \"...\" } } \"my-realm\" add-realm" }
+ { $code "[ \"...\" = swap \"admin\" = and ] \"my-realm\" add-realm" }
+}
+{ $see-also with-basic-authentication realms } ;
+
+HELP: with-basic-authentication
+{ $values
+ { "realm" "a string" } { "quot" "a quotation with stack effect ( -- )" } }
+{ $description
+ "Checks if the HTTP request has the correct authorisation headers "
+ "for basic authentication within the named realm. If the headers "
+ "are not present then a '401' HTTP response results from the "
+ "request, otherwise the quotation is called." }
+{ $examples
+{ $code "\"my-realm\" [\n serving-html \"<html><body>Success!</body></html>\" write\n] with-basic-authentication" } }
+{ $see-also add-realm realms }
+ ;
+
+ARTICLE: { "http-authentication" "basic-authentication" } "Basic Authentication"
+"The Basic Authentication system provides a simple browser based "
+"authentication method to web applications. When the browser requests "
+"a resource protected with basic authentication the server responds with "
+"a '401' response code which means the user is unauthorized."
+$nl
+"When the browser receives this it prompts the user for a username and "
+"password. This is sent back to the server in a special HTTP header. The "
+"server then checks this against its authentication information and either "
+"accepts or rejects the users request."
+$nl
+"Authentication is split up into " { $link realms } ". Each realm can have "
+"a different database of username and password information. A responder can "
+"require basic authentication by using the " { $link with-basic-authentication } " word."
+$nl
+"Username and password information can be maintained using " { $link realms } " and " { $link add-realm } "."
+$nl
+"All passwords on the server should be stored as sha-256 strings generated with the " { $link string>sha-256-string } " word."
+$nl
+"Note that Basic Authentication itself is insecure in that it "
+"sends the username and password as clear text (although it is "
+"base64 encoded this is not much help). To prevent eavesdropping "
+"it is best to use Basic Authentication with SSL." ;
+
+IN: http.basic-authentication
+ABOUT: { "http-authentication" "basic-authentication" }
diff --git a/extra/http.good/basic-authentication/basic-authentication-tests.factor b/extra/http.good/basic-authentication/basic-authentication-tests.factor
new file mode 100644
index 0000000000..318123b0b4
--- /dev/null
+++ b/extra/http.good/basic-authentication/basic-authentication-tests.factor
@@ -0,0 +1,66 @@
+! Copyright (c) 2007 Chris Double.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel crypto.sha2 http.basic-authentication tools.test
+ namespaces base64 sequences ;
+
+{ t } [
+ [
+ H{ } clone realms set
+ H{ { "admin" "5e884898da28047151d0e56f8dc6292773603d0d6aabbdd62a11ef721d1542d8" } } "test-realm" add-realm
+ "test-realm" "Basic " "admin:password" >base64 append authorization-ok?
+ ] with-scope
+] unit-test
+
+{ f } [
+ [
+ H{ } clone realms set
+ H{ { "admin" "5e884898da28047151d0e56f8dc6292773603d0d6aabbdd62a11ef721d1542d8" } } "test-realm" add-realm
+ "test-realm" "Basic " "admin:passwordx" >base64 append authorization-ok?
+ ] with-scope
+] unit-test
+
+{ f } [
+ [
+ H{ } clone realms set
+ H{ { "admin" "5e884898da28047151d0e56f8dc6292773603d0d6aabbdd62a11ef721d1542d8" } } "test-realm" add-realm
+ "test-realm" "Basic " "xadmin:password" >base64 append authorization-ok?
+ ] with-scope
+] unit-test
+
+{ t } [
+ [
+ H{ } clone realms set
+ [ "5e884898da28047151d0e56f8dc6292773603d0d6aabbdd62a11ef721d1542d8" = swap "admin" = and ] "test-realm" add-realm
+ "test-realm" "Basic " "admin:password" >base64 append authorization-ok?
+ ] with-scope
+] unit-test
+
+{ f } [
+ [
+ H{ } clone realms set
+ [ "5e884898da28047151d0e56f8dc6292773603d0d6aabbdd62a11ef721d1542d8" = swap "admin" = and ] "test-realm" add-realm
+ "test-realm" "Basic " "xadmin:password" >base64 append authorization-ok?
+ ] with-scope
+] unit-test
+
+{ f } [
+ [
+ H{ } clone realms set
+ [ "5e884898da28047151d0e56f8dc6292773603d0d6aabbdd62a11ef721d1542d8" = swap "admin" = and ] "test-realm" add-realm
+ "test-realm" "Basic " "admin:xpassword" >base64 append authorization-ok?
+ ] with-scope
+] unit-test
+
+{ f } [
+ [
+ f realms set
+ "test-realm" "Basic " "admin:password" >base64 append authorization-ok?
+ ] with-scope
+] unit-test
+
+{ f } [
+ [
+ H{ } clone realms set
+ "test-realm" "Basic " "admin:password" >base64 append authorization-ok?
+ ] with-scope
+] unit-test
diff --git a/extra/http.good/basic-authentication/basic-authentication.factor b/extra/http.good/basic-authentication/basic-authentication.factor
new file mode 100644
index 0000000000..e15ba9db16
--- /dev/null
+++ b/extra/http.good/basic-authentication/basic-authentication.factor
@@ -0,0 +1,65 @@
+! Copyright (c) 2007 Chris Double.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel base64 http.server crypto.sha2 namespaces assocs
+ quotations hashtables combinators splitting sequences
+ http.server.responders io html.elements ;
+IN: http.basic-authentication
+
+! 'realms' is a hashtable mapping a realm (a string) to
+! either a quotation or a hashtable. The quotation
+! has stack effect ( username sha-256-string -- bool ).
+! It should perform the user authentication. 'sha-256-string'
+! is the plain text password provided by the user passed through
+! 'string>sha-256-string'. If 'realms' maps to a hashtable then
+! it is a mapping of usernames to sha-256 hashed passwords.
+!
+! 'realms' can be set on a per vhost basis in the vhosts
+! table.
+!
+! If there are no realms then authentication fails.
+SYMBOL: realms
+
+: add-realm ( data name -- )
+ #! Add the named realm to the realms table.
+ #! 'data' should be a hashtable or a quotation.
+ realms get [ H{ } clone dup realms set ] unless*
+ set-at ;
+
+: user-authorized? ( username password realm -- bool )
+ realms get dup [
+ at {
+ { [ dup quotation? ] [ call ] }
+ { [ dup hashtable? ] [ swapd at = ] }
+ { [ t ] [ 3drop f ] }
+ } cond
+ ] [
+ 3drop drop f
+ ] if ;
+
+: authorization-ok? ( realm header -- bool )
+ #! Given the realm and the 'Authorization' header,
+ #! authenticate the user.
+ dup [
+ " " split dup first "Basic" = [
+ second base64> ":" split first2 string>sha-256-string rot
+ user-authorized?
+ ] [
+ 2drop f
+ ] if
+ ] [
+ 2drop f
+ ] if ;
+
+: authentication-error ( realm -- )
+ "401 Unauthorized" response
+ "Basic realm=\"" swap "\"" 3append "WWW-Authenticate" associate print-header
+ <html> <body>
+ "Username or Password is invalid" write
+ </body> </html> ;
+
+: with-basic-authentication ( realm quot -- )
+ #! Check if the user is authenticated in the given realm
+ #! to run the specified quotation. If not, use Basic
+ #! Authentication to ask for authorization details.
+ over "Authorization" header-param authorization-ok?
+ [ nip call ] [ drop authentication-error ] if ;
diff --git a/extra/http.good/basic-authentication/summary.txt b/extra/http.good/basic-authentication/summary.txt
new file mode 100644
index 0000000000..60cef7e630
--- /dev/null
+++ b/extra/http.good/basic-authentication/summary.txt
@@ -0,0 +1 @@
+HTTP Basic Authentication implementation
diff --git a/extra/http.good/basic-authentication/tags.txt b/extra/http.good/basic-authentication/tags.txt
new file mode 100644
index 0000000000..c0772185a0
--- /dev/null
+++ b/extra/http.good/basic-authentication/tags.txt
@@ -0,0 +1 @@
+web
diff --git a/extra/http.good/client/authors.txt b/extra/http.good/client/authors.txt
new file mode 100644
index 0000000000..1901f27a24
--- /dev/null
+++ b/extra/http.good/client/authors.txt
@@ -0,0 +1 @@
+Slava Pestov
diff --git a/extra/http.good/client/client-tests.factor b/extra/http.good/client/client-tests.factor
new file mode 100755
index 0000000000..5e407657a8
--- /dev/null
+++ b/extra/http.good/client/client-tests.factor
@@ -0,0 +1,26 @@
+USING: http.client http.client.private http tools.test
+tuple-syntax namespaces ;
+[ "localhost" 80 ] [ "localhost" parse-host ] unit-test
+[ "localhost" 8888 ] [ "localhost:8888" parse-host ] unit-test
+[ "/foo" "localhost" 8888 ] [ "http://localhost:8888/foo" parse-url ] unit-test
+[ "/" "localhost" 8888 ] [ "http://localhost:8888" parse-url ] unit-test
+
+[ "foo.txt" ] [ "http://www.paulgraham.com/foo.txt" download-name ] unit-test
+[ "foo.txt" ] [ "http://www.arcsucks.com/foo.txt?xxx" download-name ] unit-test
+[ "foo.txt" ] [ "http://www.arcsucks.com/foo.txt/" download-name ] unit-test
+[ "www.arcsucks.com" ] [ "http://www.arcsucks.com////" download-name ] unit-test
+
+[
+ TUPLE{ request
+ method: "GET"
+ host: "www.apple.com"
+ path: "/index.html"
+ port: 80
+ }
+] [
+ [
+ "http://www.apple.com/index.html"
+ <get-request>
+ request-with-url
+ ] with-scope
+] unit-test
diff --git a/extra/http.good/client/client.factor b/extra/http.good/client/client.factor
new file mode 100755
index 0000000000..8b74b6dc72
--- /dev/null
+++ b/extra/http.good/client/client.factor
@@ -0,0 +1,96 @@
+! Copyright (C) 2005, 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: assocs http kernel math math.parser namespaces sequences
+io io.sockets io.streams.string io.files io.timeouts strings
+splitting continuations assocs.lib calendar vectors hashtables
+accessors ;
+IN: http.client
+
+: parse-url ( url -- resource host port )
+ "http://" ?head [ "Only http:// supported" throw ] unless
+ "/" split1 [ "/" swap append ] [ "/" ] if*
+ swap parse-host ;
+
+<PRIVATE
+
+: store-path ( request path -- request )
+ "?" split1 >r >>path r> dup [ query>assoc ] when >>query ;
+
+! This is all pretty complex because it needs to handle
+! HTTP redirects, which might be absolute or relative
+: request-with-url ( url request -- request )
+ clone dup "request" set
+ swap parse-url >r >r store-path r> >>host r> >>port ;
+
+DEFER: (http-request)
+
+: absolute-redirect ( url -- request )
+ "request" get request-with-url ;
+
+: relative-redirect ( path -- request )
+ "request" get swap store-path ;
+
+: do-redirect ( response -- response stream )
+ dup response-code 300 399 between? [
+ header>> "location" peek-at
+ dup "http://" head? [
+ absolute-redirect
+ ] [
+ relative-redirect
+ ] if "GET" >>method (http-request)
+ ] [
+ stdio get
+ ] if ;
+
+: (http-request) ( request -- response stream )
+ dup host>> over port>> <inet> <client> stdio set
+ write-request flush read-response
+ do-redirect ;
+
+PRIVATE>
+
+: http-request ( url request -- response stream )
+ [
+ request-with-url
+ [
+ (http-request)
+ 1 minutes over set-timeout
+ ] [ ] [ stdio get dispose ] cleanup
+ ] with-scope ;
+
+: <get-request> ( -- request )
+ request construct-empty
+ "GET" >>method ;
+
+: http-get-stream ( url -- response stream )
+ <get-request> http-request ;
+
+: success? ( code -- ? ) 200 = ;
+
+: check-response ( response stream -- stream )
+ swap code>> success?
+ [ dispose "HTTP download failed" throw ] unless ;
+
+: http-get ( url -- string )
+ http-get-stream check-response contents ;
+
+: download-name ( url -- name )
+ file-name "?" split1 drop "/" ?tail drop ;
+
+: download-to ( url file -- )
+ #! Downloads the contents of a URL to a file.
+ swap http-get-stream check-response
+ [ swap <file-writer> stream-copy ] with-disposal ;
+
+: download ( url -- )
+ dup download-name download-to ;
+
+: <post-request> ( content-type content -- request )
+ request construct-empty
+ "POST" >>method
+ swap >>post-data
+ swap >>post-data-type ;
+
+: http-post ( content-type content url -- response string )
+ #! The content is URL encoded for you.
+ -rot url-encode <post-request> http-request contents ;
diff --git a/extra/http.good/client/summary.txt b/extra/http.good/client/summary.txt
new file mode 100644
index 0000000000..5609c916c4
--- /dev/null
+++ b/extra/http.good/client/summary.txt
@@ -0,0 +1 @@
+HTTP client
diff --git a/extra/http.good/client/tags.txt b/extra/http.good/client/tags.txt
new file mode 100644
index 0000000000..93e65ae758
--- /dev/null
+++ b/extra/http.good/client/tags.txt
@@ -0,0 +1,2 @@
+web
+network
diff --git a/extra/http.good/http-tests.factor b/extra/http.good/http-tests.factor
new file mode 100755
index 0000000000..9fa593053c
--- /dev/null
+++ b/extra/http.good/http-tests.factor
@@ -0,0 +1,115 @@
+USING: http tools.test multiline tuple-syntax
+io.streams.string kernel arrays splitting sequences ;
+IN: temporary
+
+[ "hello%20world" ] [ "hello world" url-encode ] unit-test
+[ "hello world" ] [ "hello%20world" url-decode ] unit-test
+[ "~hello world" ] [ "%7ehello+world" url-decode ] unit-test
+[ "" ] [ "%XX%XX%XX" url-decode ] unit-test
+[ "" ] [ "%XX%XX%X" url-decode ] unit-test
+
+[ "hello world" ] [ "hello+world" url-decode ] unit-test
+[ "hello world" ] [ "hello%20world" url-decode ] unit-test
+[ " ! " ] [ "%20%21%20" url-decode ] unit-test
+[ "hello world" ] [ "hello world%" url-decode ] unit-test
+[ "hello world" ] [ "hello world%x" url-decode ] unit-test
+[ "hello%20world" ] [ "hello world" url-encode ] unit-test
+[ "%20%21%20" ] [ " ! " url-encode ] unit-test
+
+[ "\u001234hi\u002045" ] [ "\u001234hi\u002045" url-encode url-decode ] unit-test
+
+STRING: read-request-test-1
+GET http://foo/bar HTTP/1.1
+Some-Header: 1
+Some-Header: 2
+Content-Length: 4
+
+blah
+;
+
+[
+ TUPLE{ request
+ method: "GET"
+ path: "bar"
+ query: f
+ version: "1.1"
+ header: H{ { "some-header" V{ "1" "2" } } { "content-length" V{ "4" } } }
+ post-data: "blah"
+ }
+] [
+ read-request-test-1 [
+ read-request
+ ] with-string-reader
+] unit-test
+
+STRING: read-request-test-1'
+GET bar HTTP/1.1
+content-length: 4
+some-header: 1
+some-header: 2
+
+blah
+;
+
+read-request-test-1' 1array [
+ read-request-test-1
+ [ read-request ] with-string-reader
+ [ write-request ] with-string-writer
+ ! normalize crlf
+ string-lines "\n" join
+] unit-test
+
+STRING: read-request-test-2
+HEAD http://foo/bar HTTP/1.0
+Host: www.sex.com
+;
+
+[
+ TUPLE{ request
+ method: "HEAD"
+ path: "bar"
+ query: f
+ version: "1.0"
+ header: H{ { "host" V{ "www.sex.com" } } }
+ host: "www.sex.com"
+ }
+] [
+ read-request-test-2 [
+ read-request
+ ] with-string-reader
+] unit-test
+
+STRING: read-response-test-1
+HTTP/1.0 404 not found
+Content-Type: text/html
+
+blah
+;
+
+[
+ TUPLE{ response
+ version: "1.0"
+ code: 404
+ message: "not found"
+ header: H{ { "content-type" V{ "text/html" } } }
+ }
+] [
+ read-response-test-1
+ [ read-response ] with-string-reader
+] unit-test
+
+
+STRING: read-response-test-1'
+HTTP/1.0 404 not found
+content-type: text/html
+
+
+;
+
+read-response-test-1' 1array [
+ read-response-test-1
+ [ read-response ] with-string-reader
+ [ write-response ] with-string-writer
+ ! normalize crlf
+ string-lines "\n" join
+] unit-test
diff --git a/extra/http.good/http.factor b/extra/http.good/http.factor
new file mode 100755
index 0000000000..4c2834b7ca
--- /dev/null
+++ b/extra/http.good/http.factor
@@ -0,0 +1,277 @@
+! Copyright (C) 2003, 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: hashtables io io.streams.string kernel math namespaces
+math.parser assocs sequences strings splitting ascii
+io.encodings.utf8 assocs.lib namespaces unicode.case combinators
+vectors sorting new-slots accessors calendar ;
+IN: http
+
+: http-port 80 ; inline
+
+: crlf "\r\n" write ;
+
+: header-line ( line -- )
+ ": " split1 dup [ swap >lower insert ] [ 2drop ] if ;
+
+: read-header-line ( -- )
+ readln dup
+ empty? [ drop ] [ header-line read-header-line ] if ;
+
+: read-header ( -- multi-assoc )
+ [ read-header-line ] H{ } make-assoc ;
+
+: write-header ( multi-assoc -- )
+ >alist sort-keys
+ [
+ swap write ": " write {
+ { [ dup number? ] [ number>string ] }
+ { [ dup timestamp? ] [ timestamp>http-string ] }
+ { [ dup string? ] [ ] }
+ } cond write crlf
+ ] multi-assoc-each crlf ;
+
+: url-quotable? ( ch -- ? )
+ #! In a URL, can this character be used without
+ #! URL-encoding?
+ dup letter?
+ over LETTER? or
+ over digit? or
+ swap "/_-." member? or ; foldable
+
+: push-utf8 ( ch -- )
+ 1string encode-utf8 [ CHAR: % , >hex 2 CHAR: 0 pad-left % ] each ;
+
+: url-encode ( str -- str )
+ [ [
+ dup url-quotable? [ , ] [ push-utf8 ] if
+ ] each ] "" make ;
+
+: url-decode-hex ( index str -- )
+ 2dup length 2 - >= [
+ 2drop
+ ] [
+ >r 1+ dup 2 + r> subseq hex> [ , ] when*
+ ] if ;
+
+: url-decode-% ( index str -- index str )
+ 2dup url-decode-hex >r 3 + r> ;
+
+: url-decode-+-or-other ( index str ch -- index str )
+ dup CHAR: + = [ drop CHAR: \s ] when , >r 1+ r> ;
+
+: url-decode-iter ( index str -- )
+ 2dup length >= [
+ 2drop
+ ] [
+ 2dup nth dup CHAR: % = [
+ drop url-decode-%
+ ] [
+ url-decode-+-or-other
+ ] if url-decode-iter
+ ] if ;
+
+: url-decode ( str -- str )
+ [ 0 swap url-decode-iter ] "" make decode-utf8 ;
+
+: query>assoc ( query -- assoc )
+ dup [
+ "&" split [
+ "=" split1 [ dup [ url-decode ] when ] 2apply
+ ] H{ } map>assoc
+ ] when ;
+
+: assoc>query ( hash -- str )
+ [ [ url-encode ] 2apply "=" swap 3append ] { } assoc>map
+ "&" join ;
+
+TUPLE: request
+host
+port
+method
+path
+query
+version
+header
+post-data
+post-data-type ;
+
+: <request>
+ request construct-empty
+ "1.0" >>version
+ http-port >>port ;
+
+: url>path ( url -- path )
+ url-decode "http://" ?head
+ [ "/" split1 "" or nip ] [ "/" ?head drop ] if ;
+
+: read-method ( request -- request )
+ " " read-until [ "Bad request: method" throw ] unless
+ >>method ;
+
+: read-query ( request -- request )
+ " " read-until
+ [ "Bad request: query params" throw ] unless
+ query>assoc >>query ;
+
+: read-url ( request -- request )
+ " ?" read-until {
+ { CHAR: \s [ dup empty? [ drop read-url ] [ url>path >>path ] if ] }
+ { CHAR: ? [ url>path >>path read-query ] }
+ [ "Bad request: URL" throw ]
+ } case ;
+
+: parse-version ( string -- version )
+ "HTTP/" ?head [ "Bad version" throw ] unless
+ dup { "1.0" "1.1" } member? [ "Bad version" throw ] unless ;
+
+: read-request-version ( request -- request )
+ readln [ CHAR: \s = ] left-trim
+ parse-version
+ >>version ;
+
+: read-request-header ( request -- request )
+ read-header >>header ;
+
+SYMBOL: max-post-request
+
+1024 256 * max-post-request set-global
+
+: content-length ( header -- n )
+ "content-length" peek-at string>number dup [
+ dup max-post-request get > [
+ "content-length > max-post-request" throw
+ ] when
+ ] when ;
+
+: read-post-data ( request -- request )
+ dup header>> content-length [ read >>post-data ] when* ;
+
+: parse-host ( string -- host port )
+ "." ?tail drop ":" split1
+ [ string>number ] [ http-port ] if* ;
+
+: extract-host ( request -- request )
+ dup header>> "host" peek-at parse-host >r >>host r> >>port ;
+
+: extract-post-data-type ( request -- request )
+ dup header>> "content-type" peek-at >>post-data-type ;
+
+: read-request ( -- request )
+ <request>
+ read-method
+ read-url
+ read-request-version
+ read-request-header
+ read-post-data
+ extract-host
+ extract-post-data-type ;
+
+: write-method ( request -- request )
+ dup method>> write bl ;
+
+: write-url ( request -- request )
+ dup path>> url-encode write
+ dup query>> dup assoc-empty? [ drop ] [
+ "?" write
+ assoc>query write
+ ] if ;
+
+: write-request-url ( request -- request )
+ write-url bl ;
+
+: write-version ( request -- request )
+ "HTTP/" write dup request-version write crlf ;
+
+: write-request-header ( request -- request )
+ dup header>> >hashtable
+ over host>> [ "host" replace-at ] when*
+ over post-data>> [ length "content-length" replace-at ] when*
+ over post-data-type>> [ "content-type" replace-at ] when*
+ write-header ;
+
+: write-post-data ( request -- request )
+ dup post-data>> [ write ] when* ;
+
+: write-request ( request -- )
+ write-method
+ write-url
+ write-version
+ write-request-header
+ write-post-data
+ flush
+ drop ;
+
+: request-url ( request -- url )
+ [
+ dup host>> [
+ "http://" write
+ dup host>> url-encode write
+ ":" write
+ dup port>> number>string write
+ ] when
+ "/" write
+ write-url
+ drop
+ ] with-string-writer ;
+
+TUPLE: response
+version
+code
+message
+header ;
+
+: <response>
+ response construct-empty
+ "1.0" >>version
+ H{ } clone >>header ;
+
+: read-response-version
+ " " read-until
+ [ "Bad response: version" throw ] unless
+ parse-version
+ >>version ;
+
+: read-response-code
+ " " read-until [ "Bad response: code" throw ] unless
+ string>number [ "Bad response: code" throw ] unless*
+ >>code ;
+
+: read-response-message
+ readln >>message ;
+
+: read-response-header
+ read-header >>header ;
+
+: read-response ( -- response )
+ <response>
+ read-response-version
+ read-response-code
+ read-response-message
+ read-response-header ;
+
+: write-response-version ( response -- response )
+ "HTTP/" write
+ dup version>> write bl ;
+
+: write-response-code ( response -- response )
+ dup code>> number>string write bl ;
+
+: write-response-message ( response -- response )
+ dup message>> write crlf ;
+
+: write-response-header ( response -- response )
+ dup header>> write-header ;
+
+: write-response ( respose -- )
+ write-response-version
+ write-response-code
+ write-response-message
+ write-response-header
+ flush
+ drop ;
+
+: set-response-header ( response value key -- response )
+ pick header>> -rot replace-at drop ;
+
+: set-content-type ( response content-type -- response )
+ "content-type" set-response-header ;
diff --git a/extra/http.good/mime/authors.txt b/extra/http.good/mime/authors.txt
new file mode 100755
index 0000000000..1901f27a24
--- /dev/null
+++ b/extra/http.good/mime/authors.txt
@@ -0,0 +1 @@
+Slava Pestov
diff --git a/extra/http.good/mime/mime.factor b/extra/http.good/mime/mime.factor
new file mode 100644
index 0000000000..3365127d87
--- /dev/null
+++ b/extra/http.good/mime/mime.factor
@@ -0,0 +1,34 @@
+! Copyright (C) 2004, 2005 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: io assocs kernel sequences math namespaces splitting ;
+
+IN: http.mime
+
+: file-extension ( filename -- extension )
+ "." split dup length 1 <= [ drop f ] [ peek ] if ;
+
+: mime-type ( filename -- mime-type )
+ file-extension "mime-types" get at "application/octet-stream" or ;
+
+H{
+ { "html" "text/html" }
+ { "txt" "text/plain" }
+ { "xml" "text/xml" }
+ { "css" "text/css" }
+
+ { "gif" "image/gif" }
+ { "png" "image/png" }
+ { "jpg" "image/jpeg" }
+ { "jpeg" "image/jpeg" }
+
+ { "jar" "application/octet-stream" }
+ { "zip" "application/octet-stream" }
+ { "tgz" "application/octet-stream" }
+ { "tar.gz" "application/octet-stream" }
+ { "gz" "application/octet-stream" }
+
+ { "pdf" "application/pdf" }
+
+ { "factor" "text/plain" }
+ { "fhtml" "application/x-factor-server-page" }
+} "mime-types" set-global
diff --git a/extra/http.good/server/authors.txt b/extra/http.good/server/authors.txt
new file mode 100755
index 0000000000..1901f27a24
--- /dev/null
+++ b/extra/http.good/server/authors.txt
@@ -0,0 +1 @@
+Slava Pestov
diff --git a/extra/http.good/server/server-tests.factor b/extra/http.good/server/server-tests.factor
new file mode 100755
index 0000000000..a67d21a640
--- /dev/null
+++ b/extra/http.good/server/server-tests.factor
@@ -0,0 +1,45 @@
+USING: http.server tools.test kernel namespaces accessors
+new-slots assocs.lib io http math sequences ;
+IN: temporary
+
+TUPLE: mock-responder ;
+
+: <mock-responder> ( path -- responder )
+ <responder> mock-responder construct-delegate ;
+
+M: mock-responder do-responder
+ 2nip
+ path>> on
+ [ "Hello world" print ]
+ "text/plain" <content> ;
+
+: check-dispatch ( tag path -- ? )
+ over off
+ <request> swap default-host get call-responder
+ write-response call get ;
+
+[
+ "" <dispatcher>
+ "foo" <mock-responder> add-responder
+ "bar" <mock-responder> add-responder
+ "baz/" <dispatcher>
+ "123" <mock-responder> add-responder
+ "default" <mock-responder> >>default
+ add-responder
+ default-host set
+
+ [ t ] [ "foo" "foo" check-dispatch ] unit-test
+ [ f ] [ "foo" "bar" check-dispatch ] unit-test
+ [ t ] [ "bar" "bar" check-dispatch ] unit-test
+ [ t ] [ "default" "baz/xxx" check-dispatch ] unit-test
+ [ t ] [ "123" "baz/123" check-dispatch ] unit-test
+
+ [ t ] [
+ <request>
+ "baz" >>path
+ "baz" default-host get call-responder
+ dup code>> 300 399 between? >r
+ header>> "location" peek-at "baz/" tail? r> and
+ nip
+ ] unit-test
+] with-scope
diff --git a/extra/http.good/server/server.factor b/extra/http.good/server/server.factor
new file mode 100755
index 0000000000..e06ae6a95c
--- /dev/null
+++ b/extra/http.good/server/server.factor
@@ -0,0 +1,131 @@
+! Copyright (C) 2003, 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: assocs kernel namespaces io io.timeouts strings splitting
+threads http sequences prettyprint io.server logging calendar
+new-slots html.elements accessors math.parser combinators.lib ;
+IN: http.server
+
+TUPLE: responder path directory ;
+
+: <responder> ( path -- responder )
+ "/" ?tail responder construct-boa ;
+
+GENERIC: do-responder ( request path responder -- quot response )
+
+TUPLE: trivial-responder quot response ;
+
+: <trivial-responder> ( quot response -- responder )
+ trivial-responder construct-boa
+ "" <responder> over set-delegate ;
+
+M: trivial-responder do-responder
+ 2nip dup quot>> swap response>> ;
+
+: trivial-response-body ( code message -- )
+ <html>
+ <body>
+ <h1> swap number>string write bl write </h1>
+ </body>
+ </html> ;
+
+: <trivial-response> ( code message -- quot response )
+ [ [ trivial-response-body ] 2curry ] 2keep <response>
+ "text/html" set-content-type
+ swap >>message
+ swap >>code ;
+
+: <404> ( -- quot response )
+ 404 "Not Found" <trivial-response> ;
+
+: <redirect> ( to code message -- quot response )
+ <trivial-response>
+ rot "location" set-response-header ;
+
+: <permanent-redirect> ( to -- quot response )
+ 301 "Moved Permanently" <redirect> ;
+
+: <temporary-redirect> ( to -- quot response )
+ 307 "Temporary Redirect" <redirect> ;
+
+: <content> ( content-type -- response )
+ <response>
+ 200 >>code
+ swap set-content-type ;
+
+TUPLE: dispatcher responders default ;
+
+: responder-matches? ( path responder -- ? )
+ path>> head? ;
+
+TUPLE: no-/-responder ;
+
+M: no-/-responder do-responder
+ 2drop
+ dup path>> "/" append >>path
+ request-url <permanent-redirect> ;
+
+: <no-/-responder> ( -- responder )
+ "" <responder> no-/-responder construct-delegate ;
+
+<no-/-responder> no-/-responder set-global
+
+: find-responder ( path dispatcher -- path responder )
+ >r "/" ?head drop r>
+ [ responders>> [ dupd responder-matches? ] find nip ] keep
+ default>> or [ path>> ?head drop ] keep ;
+
+: no-trailing-/ ( path responder -- path responder )
+ over empty? over directory>> and
+ [ drop no-/-responder get-global ] when ;
+
+: call-responder ( request path responder -- quot response )
+ no-trailing-/ do-responder ;
+
+SYMBOL: 404-responder
+
+<404> <trivial-responder> 404-responder set-global
+
+M: dispatcher do-responder
+ find-responder call-responder ;
+
+: <dispatcher> ( path -- dispatcher )
+ <responder>
+ dispatcher construct-delegate
+ 404-responder get-global >>default
+ V{ } clone >>responders ;
+
+: add-responder ( dispatcher responder -- dispatcher )
+ over responders>> push ;
+
+SYMBOL: virtual-hosts
+SYMBOL: default-host
+
+virtual-hosts global [ drop H{ } clone ] cache drop
+default-host global [ drop 404-responder ] cache drop
+
+: find-virtual-host ( host -- responder )
+ virtual-hosts get at [ default-host get ] unless* ;
+
+: handle-request ( request -- )
+ [
+ dup path>> over host>> find-virtual-host
+ call-responder
+ write-response
+ ] keep method>> "HEAD" = [ drop ] [ call ] if ;
+
+: default-timeout 1 minutes stdio get set-timeout ;
+
+LOG: httpd-hit NOTICE
+
+: log-request ( request -- )
+ { method>> host>> path>> } map-exec-with httpd-hit ;
+
+: httpd ( port -- )
+ internet-server "http.server" [
+ default-timeout
+ read-request dup log-request handle-request
+ ] with-server ;
+
+: httpd-main ( -- ) 8888 httpd ;
+
+MAIN: httpd-main
diff --git a/extra/http.good/server/summary.txt b/extra/http.good/server/summary.txt
new file mode 100644
index 0000000000..e6d2ca62e9
--- /dev/null
+++ b/extra/http.good/server/summary.txt
@@ -0,0 +1 @@
+HTTP server
diff --git a/extra/http.good/server/tags.txt b/extra/http.good/server/tags.txt
new file mode 100644
index 0000000000..b0881a9ec0
--- /dev/null
+++ b/extra/http.good/server/tags.txt
@@ -0,0 +1,3 @@
+enterprise
+network
+web
diff --git a/extra/http.good/server/templating/authors.txt b/extra/http.good/server/templating/authors.txt
new file mode 100644
index 0000000000..b47eafb62a
--- /dev/null
+++ b/extra/http.good/server/templating/authors.txt
@@ -0,0 +1,2 @@
+Slava Pestov
+Matthew Willis
diff --git a/extra/http.good/server/templating/templating-tests.factor b/extra/http.good/server/templating/templating-tests.factor
new file mode 100644
index 0000000000..d889cd848a
--- /dev/null
+++ b/extra/http.good/server/templating/templating-tests.factor
@@ -0,0 +1,17 @@
+USING: io io.files io.streams.string http.server.templating kernel tools.test
+ sequences ;
+IN: temporary
+
+: test-template ( path -- ? )
+ "extra/http/server/templating/test/" swap append
+ [
+ ".fhtml" append resource-path
+ [ run-template-file ] with-string-writer
+ ] keep
+ ".html" append resource-path file-contents = ;
+
+[ t ] [ "example" test-template ] unit-test
+[ t ] [ "bug" test-template ] unit-test
+[ t ] [ "stack" test-template ] unit-test
+
+[ ] [ "<%\n%>" parse-template drop ] unit-test
diff --git a/extra/http.good/server/templating/templating.factor b/extra/http.good/server/templating/templating.factor
new file mode 100755
index 0000000000..f364b86524
--- /dev/null
+++ b/extra/http.good/server/templating/templating.factor
@@ -0,0 +1,96 @@
+! Copyright (C) 2005 Alex Chapman
+! Copyright (C) 2006, 2007 Slava Pestov
+! See http://factorcode.org/license.txt for BSD license.
+USING: continuations sequences kernel parser namespaces io
+io.files io.streams.lines io.streams.string html html.elements
+source-files debugger combinators math quotations generic
+strings splitting ;
+
+IN: http.server.templating
+
+: templating-vocab ( -- vocab-name ) "http.server.templating" ;
+
+! See apps/http-server/test/ or libs/furnace/ for template usage
+! examples
+
+! We use a custom lexer so that %> ends a token even if not
+! followed by whitespace
+TUPLE: template-lexer ;
+
+: <template-lexer> ( lines -- lexer )
+ <lexer> template-lexer construct-delegate ;
+
+M: template-lexer skip-word
+ [
+ {
+ { [ 2dup nth CHAR: " = ] [ drop 1+ ] }
+ { [ 2dup swap tail-slice "%>" head? ] [ drop 2 + ] }
+ { [ t ] [ f skip ] }
+ } cond
+ ] change-column ;
+
+DEFER: <% delimiter
+
+: check-<% ( lexer -- col )
+ "<%" over lexer-line-text rot lexer-column start* ;
+
+: found-<% ( accum lexer col -- accum )
+ [
+ over lexer-line-text
+ >r >r lexer-column r> r> subseq parsed
+ \ write-html parsed
+ ] 2keep 2 + swap set-lexer-column ;
+
+: still-looking ( accum lexer -- accum )
+ [
+ dup lexer-line-text swap lexer-column tail
+ parsed \ print-html parsed
+ ] keep next-line ;
+
+: parse-%> ( accum lexer -- accum )
+ dup still-parsing? [
+ dup check-<%
+ [ found-<% ] [ [ still-looking ] keep parse-%> ] if*
+ ] [
+ drop
+ ] if ;
+
+: %> lexer get parse-%> ; parsing
+
+: parse-template-lines ( lines -- quot )
+ <template-lexer> [
+ V{ } clone lexer get parse-%> f (parse-until)
+ ] with-parser ;
+
+: parse-template ( string -- quot )
+ [
+ use [ clone ] change
+ templating-vocab use+
+ string-lines parse-template-lines
+ ] with-scope ;
+
+: eval-template ( string -- ) parse-template call ;
+
+: html-error. ( error -- )
+ <pre> error. </pre> ;
+
+: run-template-file ( filename -- )
+ [
+ [
+ "quiet" on
+ parser-notes off
+ templating-vocab use+
+ dup source-file file set ! so that reload works properly
+ [
+ ?resource-path file-contents
+ [ eval-template ] [ html-error. drop ] recover
+ ] keep
+ ] with-file-vocabs
+ ] assert-depth drop ;
+
+: run-relative-template-file ( filename -- )
+ file get source-file-path parent-directory
+ swap path+ run-template-file ;
+
+: template-convert ( infile outfile -- )
+ [ run-template-file ] with-file-writer ;
diff --git a/extra/http.good/server/templating/test/bug.fhtml b/extra/http.good/server/templating/test/bug.fhtml
new file mode 100644
index 0000000000..cb66599079
--- /dev/null
+++ b/extra/http.good/server/templating/test/bug.fhtml
@@ -0,0 +1,5 @@
+<%
+ USING: prettyprint ;
+ ! Hello world
+ 5 pprint
+%>
diff --git a/extra/http.good/server/templating/test/bug.html b/extra/http.good/server/templating/test/bug.html
new file mode 100644
index 0000000000..51d7b8d169
--- /dev/null
+++ b/extra/http.good/server/templating/test/bug.html
@@ -0,0 +1,2 @@
+5
+
diff --git a/extra/http.good/server/templating/test/example.fhtml b/extra/http.good/server/templating/test/example.fhtml
new file mode 100644
index 0000000000..211f44af9a
--- /dev/null
+++ b/extra/http.good/server/templating/test/example.fhtml
@@ -0,0 +1,8 @@
+<% USING: math ; %>
+
+<html>
+ <head><title>Simple Embedded Factor Example</title></head>
+ <body>
+ <% 5 [ %><p>I like repetition</p><% ] times %>
+ </body>
+</html>
diff --git a/extra/http.good/server/templating/test/example.html b/extra/http.good/server/templating/test/example.html
new file mode 100644
index 0000000000..9bf4a08209
--- /dev/null
+++ b/extra/http.good/server/templating/test/example.html
@@ -0,0 +1,9 @@
+
+
+<html>
+ <head><title>Simple Embedded Factor Example</title></head>
+ <body>
+ <p>I like repetition</p><p>I like repetition</p><p>I like repetition</p><p>I like repetition</p><p>I like repetition</p>
+ </body>
+</html>
+
diff --git a/extra/http.good/server/templating/test/stack.fhtml b/extra/http.good/server/templating/test/stack.fhtml
new file mode 100644
index 0000000000..399711a209
--- /dev/null
+++ b/extra/http.good/server/templating/test/stack.fhtml
@@ -0,0 +1 @@
+The stack: <% USING: prettyprint ; .s %>
diff --git a/extra/http.good/server/templating/test/stack.html b/extra/http.good/server/templating/test/stack.html
new file mode 100644
index 0000000000..ee923a6421
--- /dev/null
+++ b/extra/http.good/server/templating/test/stack.html
@@ -0,0 +1,2 @@
+The stack:
+
diff --git a/extra/http.good/summary.txt b/extra/http.good/summary.txt
new file mode 100644
index 0000000000..8791a6f1c4
--- /dev/null
+++ b/extra/http.good/summary.txt
@@ -0,0 +1 @@
+Common code shared by HTTP client and server
diff --git a/extra/http.good/tags.txt b/extra/http.good/tags.txt
new file mode 100644
index 0000000000..93e65ae758
--- /dev/null
+++ b/extra/http.good/tags.txt
@@ -0,0 +1,2 @@
+web
+network
diff --git a/extra/io/monitors/monitors.factor b/extra/io/monitors/monitors.factor
index 34065203f8..1678c2de41 100755
--- a/extra/io/monitors/monitors.factor
+++ b/extra/io/monitors/monitors.factor
@@ -49,7 +49,7 @@ M: simple-monitor set-timeout set-simple-monitor-timeout ;
>r <simple-monitor> r> construct-delegate ; inline
: notify-callback ( simple-monitor -- )
- simple-monitor-callback ?box [ resume ] [ drop ] if ;
+ simple-monitor-callback [ resume ] if-box? ;
M: simple-monitor timed-out
notify-callback ;
diff --git a/extra/ui/windows/windows.factor b/extra/ui/windows/windows.factor
index b5ab63c4c8..9d6e95c07a 100755
--- a/extra/ui/windows/windows.factor
+++ b/extra/ui/windows/windows.factor
@@ -358,7 +358,6 @@ M: windows-ui-backend (close-window)
{ [ t ] [
dup TranslateMessage drop
dup DispatchMessage drop
- yield
event-loop
] }
} cond ;
@@ -454,12 +453,11 @@ M: windows-ui-backend raise-window* ( world -- )
win-hWnd SetFocus drop
] when* ;
-M: windows-ui-backend set-title ( string world -- )
- world-handle [ nip win-hWnd WM_SETTEXT 0 ] 2keep
+M: windows-ui-backend set-title ( string handle -- )
dup win-title [ free ] when*
- >r malloc-u16-string dup r>
- set-win-title alien-address
- SendMessage drop ;
+ >r malloc-u16-string r>
+ 2dup set-win-title
+ win-hWnd WM_SETTEXT 0 roll alien-address SendMessage drop ;
M: windows-ui-backend ui
[
diff --git a/extra/vocabs/monitor/monitor.factor b/extra/vocabs/monitor/monitor.factor
index 32a104687e..78e2339764 100755
--- a/extra/vocabs/monitor/monitor.factor
+++ b/extra/vocabs/monitor/monitor.factor
@@ -1,7 +1,7 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: threads io.files io.monitors init kernel
-tools.browser namespaces continuations ;
+tools.browser namespaces continuations vocabs.loader ;
IN: vocabs.monitor
! Use file system change monitoring to flush the tags/authors
@@ -9,7 +9,9 @@ IN: vocabs.monitor
SYMBOL: vocab-monitor
: monitor-thread ( -- )
- vocab-monitor get-global next-change 2drop reset-cache ;
+ vocab-monitor get-global
+ next-change 2drop
+ t sources-changed? set-global reset-cache ;
: start-monitor-thread
#! Silently ignore errors during monitor creation since
From 85ab4c3b5d7aaa4927d6a9961da61e168886a114 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Fri, 29 Feb 2008 19:11:26 -0600
Subject: [PATCH 18/55] Oops
---
extra/http.good/authors.txt | 1 -
.../basic-authentication/authors.txt | 1 -
.../basic-authentication-docs.factor | 69 -----
.../basic-authentication-tests.factor | 66 -----
.../basic-authentication.factor | 65 ----
.../basic-authentication/summary.txt | 1 -
extra/http.good/basic-authentication/tags.txt | 1 -
extra/http.good/client/authors.txt | 1 -
extra/http.good/client/client-tests.factor | 26 --
extra/http.good/client/client.factor | 96 ------
extra/http.good/client/summary.txt | 1 -
extra/http.good/client/tags.txt | 2 -
extra/http.good/http-tests.factor | 115 --------
extra/http.good/http.factor | 277 ------------------
extra/http.good/mime/authors.txt | 1 -
extra/http.good/mime/mime.factor | 34 ---
extra/http.good/server/authors.txt | 1 -
extra/http.good/server/server-tests.factor | 45 ---
extra/http.good/server/server.factor | 131 ---------
extra/http.good/server/summary.txt | 1 -
extra/http.good/server/tags.txt | 3 -
extra/http.good/server/templating/authors.txt | 2 -
.../server/templating/templating-tests.factor | 17 --
.../server/templating/templating.factor | 96 ------
.../server/templating/test/bug.fhtml | 5 -
.../http.good/server/templating/test/bug.html | 2 -
.../server/templating/test/example.fhtml | 8 -
.../server/templating/test/example.html | 9 -
.../server/templating/test/stack.fhtml | 1 -
.../server/templating/test/stack.html | 2 -
extra/http.good/summary.txt | 1 -
extra/http.good/tags.txt | 2 -
32 files changed, 1083 deletions(-)
delete mode 100644 extra/http.good/authors.txt
delete mode 100644 extra/http.good/basic-authentication/authors.txt
delete mode 100644 extra/http.good/basic-authentication/basic-authentication-docs.factor
delete mode 100644 extra/http.good/basic-authentication/basic-authentication-tests.factor
delete mode 100644 extra/http.good/basic-authentication/basic-authentication.factor
delete mode 100644 extra/http.good/basic-authentication/summary.txt
delete mode 100644 extra/http.good/basic-authentication/tags.txt
delete mode 100644 extra/http.good/client/authors.txt
delete mode 100755 extra/http.good/client/client-tests.factor
delete mode 100755 extra/http.good/client/client.factor
delete mode 100644 extra/http.good/client/summary.txt
delete mode 100644 extra/http.good/client/tags.txt
delete mode 100755 extra/http.good/http-tests.factor
delete mode 100755 extra/http.good/http.factor
delete mode 100755 extra/http.good/mime/authors.txt
delete mode 100644 extra/http.good/mime/mime.factor
delete mode 100755 extra/http.good/server/authors.txt
delete mode 100755 extra/http.good/server/server-tests.factor
delete mode 100755 extra/http.good/server/server.factor
delete mode 100644 extra/http.good/server/summary.txt
delete mode 100644 extra/http.good/server/tags.txt
delete mode 100644 extra/http.good/server/templating/authors.txt
delete mode 100644 extra/http.good/server/templating/templating-tests.factor
delete mode 100755 extra/http.good/server/templating/templating.factor
delete mode 100644 extra/http.good/server/templating/test/bug.fhtml
delete mode 100644 extra/http.good/server/templating/test/bug.html
delete mode 100644 extra/http.good/server/templating/test/example.fhtml
delete mode 100644 extra/http.good/server/templating/test/example.html
delete mode 100644 extra/http.good/server/templating/test/stack.fhtml
delete mode 100644 extra/http.good/server/templating/test/stack.html
delete mode 100644 extra/http.good/summary.txt
delete mode 100644 extra/http.good/tags.txt
diff --git a/extra/http.good/authors.txt b/extra/http.good/authors.txt
deleted file mode 100644
index 1901f27a24..0000000000
--- a/extra/http.good/authors.txt
+++ /dev/null
@@ -1 +0,0 @@
-Slava Pestov
diff --git a/extra/http.good/basic-authentication/authors.txt b/extra/http.good/basic-authentication/authors.txt
deleted file mode 100644
index 44b06f94bc..0000000000
--- a/extra/http.good/basic-authentication/authors.txt
+++ /dev/null
@@ -1 +0,0 @@
-Chris Double
diff --git a/extra/http.good/basic-authentication/basic-authentication-docs.factor b/extra/http.good/basic-authentication/basic-authentication-docs.factor
deleted file mode 100644
index 68d6e6bf1d..0000000000
--- a/extra/http.good/basic-authentication/basic-authentication-docs.factor
+++ /dev/null
@@ -1,69 +0,0 @@
-! Copyright (C) 2007 Chris Double.
-! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax crypto.sha2 ;
-IN: http.basic-authentication
-
-HELP: realms
-{ $description
- "A hashtable mapping a basic authentication realm (a string) "
- "to either a quotation or a hashtable. The quotation has "
- "stack effect ( username sha-256-string -- bool ). It "
- "is expected to perform the user authentication when called." $nl
- "If the realm maps to a hashtable then the hashtable should be a "
- "mapping of usernames to sha-256 hashed passwords." $nl
- "If the 'realms' variable does not exist in the current scope then "
- "authentication will always fail." }
-{ $see-also add-realm with-basic-authentication } ;
-
-HELP: add-realm
-{ $values
- { "data" "a quotation or a hashtable" } { "name" "a string" } }
-{ $description
- "Adds the authentication data to the " { $link realms } ". 'data' can be "
- "a quotation with stack effect ( username sha-256-string -- bool ) or "
- "a hashtable mapping username strings to sha-256-string passwords." }
-{ $examples
- { $code "H{ { \"admin\" \"...\" } { \"user\" \"...\" } } \"my-realm\" add-realm" }
- { $code "[ \"...\" = swap \"admin\" = and ] \"my-realm\" add-realm" }
-}
-{ $see-also with-basic-authentication realms } ;
-
-HELP: with-basic-authentication
-{ $values
- { "realm" "a string" } { "quot" "a quotation with stack effect ( -- )" } }
-{ $description
- "Checks if the HTTP request has the correct authorisation headers "
- "for basic authentication within the named realm. If the headers "
- "are not present then a '401' HTTP response results from the "
- "request, otherwise the quotation is called." }
-{ $examples
-{ $code "\"my-realm\" [\n serving-html \"<html><body>Success!</body></html>\" write\n] with-basic-authentication" } }
-{ $see-also add-realm realms }
- ;
-
-ARTICLE: { "http-authentication" "basic-authentication" } "Basic Authentication"
-"The Basic Authentication system provides a simple browser based "
-"authentication method to web applications. When the browser requests "
-"a resource protected with basic authentication the server responds with "
-"a '401' response code which means the user is unauthorized."
-$nl
-"When the browser receives this it prompts the user for a username and "
-"password. This is sent back to the server in a special HTTP header. The "
-"server then checks this against its authentication information and either "
-"accepts or rejects the users request."
-$nl
-"Authentication is split up into " { $link realms } ". Each realm can have "
-"a different database of username and password information. A responder can "
-"require basic authentication by using the " { $link with-basic-authentication } " word."
-$nl
-"Username and password information can be maintained using " { $link realms } " and " { $link add-realm } "."
-$nl
-"All passwords on the server should be stored as sha-256 strings generated with the " { $link string>sha-256-string } " word."
-$nl
-"Note that Basic Authentication itself is insecure in that it "
-"sends the username and password as clear text (although it is "
-"base64 encoded this is not much help). To prevent eavesdropping "
-"it is best to use Basic Authentication with SSL." ;
-
-IN: http.basic-authentication
-ABOUT: { "http-authentication" "basic-authentication" }
diff --git a/extra/http.good/basic-authentication/basic-authentication-tests.factor b/extra/http.good/basic-authentication/basic-authentication-tests.factor
deleted file mode 100644
index 318123b0b4..0000000000
--- a/extra/http.good/basic-authentication/basic-authentication-tests.factor
+++ /dev/null
@@ -1,66 +0,0 @@
-! Copyright (c) 2007 Chris Double.
-! See http://factorcode.org/license.txt for BSD license.
-USING: kernel crypto.sha2 http.basic-authentication tools.test
- namespaces base64 sequences ;
-
-{ t } [
- [
- H{ } clone realms set
- H{ { "admin" "5e884898da28047151d0e56f8dc6292773603d0d6aabbdd62a11ef721d1542d8" } } "test-realm" add-realm
- "test-realm" "Basic " "admin:password" >base64 append authorization-ok?
- ] with-scope
-] unit-test
-
-{ f } [
- [
- H{ } clone realms set
- H{ { "admin" "5e884898da28047151d0e56f8dc6292773603d0d6aabbdd62a11ef721d1542d8" } } "test-realm" add-realm
- "test-realm" "Basic " "admin:passwordx" >base64 append authorization-ok?
- ] with-scope
-] unit-test
-
-{ f } [
- [
- H{ } clone realms set
- H{ { "admin" "5e884898da28047151d0e56f8dc6292773603d0d6aabbdd62a11ef721d1542d8" } } "test-realm" add-realm
- "test-realm" "Basic " "xadmin:password" >base64 append authorization-ok?
- ] with-scope
-] unit-test
-
-{ t } [
- [
- H{ } clone realms set
- [ "5e884898da28047151d0e56f8dc6292773603d0d6aabbdd62a11ef721d1542d8" = swap "admin" = and ] "test-realm" add-realm
- "test-realm" "Basic " "admin:password" >base64 append authorization-ok?
- ] with-scope
-] unit-test
-
-{ f } [
- [
- H{ } clone realms set
- [ "5e884898da28047151d0e56f8dc6292773603d0d6aabbdd62a11ef721d1542d8" = swap "admin" = and ] "test-realm" add-realm
- "test-realm" "Basic " "xadmin:password" >base64 append authorization-ok?
- ] with-scope
-] unit-test
-
-{ f } [
- [
- H{ } clone realms set
- [ "5e884898da28047151d0e56f8dc6292773603d0d6aabbdd62a11ef721d1542d8" = swap "admin" = and ] "test-realm" add-realm
- "test-realm" "Basic " "admin:xpassword" >base64 append authorization-ok?
- ] with-scope
-] unit-test
-
-{ f } [
- [
- f realms set
- "test-realm" "Basic " "admin:password" >base64 append authorization-ok?
- ] with-scope
-] unit-test
-
-{ f } [
- [
- H{ } clone realms set
- "test-realm" "Basic " "admin:password" >base64 append authorization-ok?
- ] with-scope
-] unit-test
diff --git a/extra/http.good/basic-authentication/basic-authentication.factor b/extra/http.good/basic-authentication/basic-authentication.factor
deleted file mode 100644
index e15ba9db16..0000000000
--- a/extra/http.good/basic-authentication/basic-authentication.factor
+++ /dev/null
@@ -1,65 +0,0 @@
-! Copyright (c) 2007 Chris Double.
-! See http://factorcode.org/license.txt for BSD license.
-USING: kernel base64 http.server crypto.sha2 namespaces assocs
- quotations hashtables combinators splitting sequences
- http.server.responders io html.elements ;
-IN: http.basic-authentication
-
-! 'realms' is a hashtable mapping a realm (a string) to
-! either a quotation or a hashtable. The quotation
-! has stack effect ( username sha-256-string -- bool ).
-! It should perform the user authentication. 'sha-256-string'
-! is the plain text password provided by the user passed through
-! 'string>sha-256-string'. If 'realms' maps to a hashtable then
-! it is a mapping of usernames to sha-256 hashed passwords.
-!
-! 'realms' can be set on a per vhost basis in the vhosts
-! table.
-!
-! If there are no realms then authentication fails.
-SYMBOL: realms
-
-: add-realm ( data name -- )
- #! Add the named realm to the realms table.
- #! 'data' should be a hashtable or a quotation.
- realms get [ H{ } clone dup realms set ] unless*
- set-at ;
-
-: user-authorized? ( username password realm -- bool )
- realms get dup [
- at {
- { [ dup quotation? ] [ call ] }
- { [ dup hashtable? ] [ swapd at = ] }
- { [ t ] [ 3drop f ] }
- } cond
- ] [
- 3drop drop f
- ] if ;
-
-: authorization-ok? ( realm header -- bool )
- #! Given the realm and the 'Authorization' header,
- #! authenticate the user.
- dup [
- " " split dup first "Basic" = [
- second base64> ":" split first2 string>sha-256-string rot
- user-authorized?
- ] [
- 2drop f
- ] if
- ] [
- 2drop f
- ] if ;
-
-: authentication-error ( realm -- )
- "401 Unauthorized" response
- "Basic realm=\"" swap "\"" 3append "WWW-Authenticate" associate print-header
- <html> <body>
- "Username or Password is invalid" write
- </body> </html> ;
-
-: with-basic-authentication ( realm quot -- )
- #! Check if the user is authenticated in the given realm
- #! to run the specified quotation. If not, use Basic
- #! Authentication to ask for authorization details.
- over "Authorization" header-param authorization-ok?
- [ nip call ] [ drop authentication-error ] if ;
diff --git a/extra/http.good/basic-authentication/summary.txt b/extra/http.good/basic-authentication/summary.txt
deleted file mode 100644
index 60cef7e630..0000000000
--- a/extra/http.good/basic-authentication/summary.txt
+++ /dev/null
@@ -1 +0,0 @@
-HTTP Basic Authentication implementation
diff --git a/extra/http.good/basic-authentication/tags.txt b/extra/http.good/basic-authentication/tags.txt
deleted file mode 100644
index c0772185a0..0000000000
--- a/extra/http.good/basic-authentication/tags.txt
+++ /dev/null
@@ -1 +0,0 @@
-web
diff --git a/extra/http.good/client/authors.txt b/extra/http.good/client/authors.txt
deleted file mode 100644
index 1901f27a24..0000000000
--- a/extra/http.good/client/authors.txt
+++ /dev/null
@@ -1 +0,0 @@
-Slava Pestov
diff --git a/extra/http.good/client/client-tests.factor b/extra/http.good/client/client-tests.factor
deleted file mode 100755
index 5e407657a8..0000000000
--- a/extra/http.good/client/client-tests.factor
+++ /dev/null
@@ -1,26 +0,0 @@
-USING: http.client http.client.private http tools.test
-tuple-syntax namespaces ;
-[ "localhost" 80 ] [ "localhost" parse-host ] unit-test
-[ "localhost" 8888 ] [ "localhost:8888" parse-host ] unit-test
-[ "/foo" "localhost" 8888 ] [ "http://localhost:8888/foo" parse-url ] unit-test
-[ "/" "localhost" 8888 ] [ "http://localhost:8888" parse-url ] unit-test
-
-[ "foo.txt" ] [ "http://www.paulgraham.com/foo.txt" download-name ] unit-test
-[ "foo.txt" ] [ "http://www.arcsucks.com/foo.txt?xxx" download-name ] unit-test
-[ "foo.txt" ] [ "http://www.arcsucks.com/foo.txt/" download-name ] unit-test
-[ "www.arcsucks.com" ] [ "http://www.arcsucks.com////" download-name ] unit-test
-
-[
- TUPLE{ request
- method: "GET"
- host: "www.apple.com"
- path: "/index.html"
- port: 80
- }
-] [
- [
- "http://www.apple.com/index.html"
- <get-request>
- request-with-url
- ] with-scope
-] unit-test
diff --git a/extra/http.good/client/client.factor b/extra/http.good/client/client.factor
deleted file mode 100755
index 8b74b6dc72..0000000000
--- a/extra/http.good/client/client.factor
+++ /dev/null
@@ -1,96 +0,0 @@
-! Copyright (C) 2005, 2008 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: assocs http kernel math math.parser namespaces sequences
-io io.sockets io.streams.string io.files io.timeouts strings
-splitting continuations assocs.lib calendar vectors hashtables
-accessors ;
-IN: http.client
-
-: parse-url ( url -- resource host port )
- "http://" ?head [ "Only http:// supported" throw ] unless
- "/" split1 [ "/" swap append ] [ "/" ] if*
- swap parse-host ;
-
-<PRIVATE
-
-: store-path ( request path -- request )
- "?" split1 >r >>path r> dup [ query>assoc ] when >>query ;
-
-! This is all pretty complex because it needs to handle
-! HTTP redirects, which might be absolute or relative
-: request-with-url ( url request -- request )
- clone dup "request" set
- swap parse-url >r >r store-path r> >>host r> >>port ;
-
-DEFER: (http-request)
-
-: absolute-redirect ( url -- request )
- "request" get request-with-url ;
-
-: relative-redirect ( path -- request )
- "request" get swap store-path ;
-
-: do-redirect ( response -- response stream )
- dup response-code 300 399 between? [
- header>> "location" peek-at
- dup "http://" head? [
- absolute-redirect
- ] [
- relative-redirect
- ] if "GET" >>method (http-request)
- ] [
- stdio get
- ] if ;
-
-: (http-request) ( request -- response stream )
- dup host>> over port>> <inet> <client> stdio set
- write-request flush read-response
- do-redirect ;
-
-PRIVATE>
-
-: http-request ( url request -- response stream )
- [
- request-with-url
- [
- (http-request)
- 1 minutes over set-timeout
- ] [ ] [ stdio get dispose ] cleanup
- ] with-scope ;
-
-: <get-request> ( -- request )
- request construct-empty
- "GET" >>method ;
-
-: http-get-stream ( url -- response stream )
- <get-request> http-request ;
-
-: success? ( code -- ? ) 200 = ;
-
-: check-response ( response stream -- stream )
- swap code>> success?
- [ dispose "HTTP download failed" throw ] unless ;
-
-: http-get ( url -- string )
- http-get-stream check-response contents ;
-
-: download-name ( url -- name )
- file-name "?" split1 drop "/" ?tail drop ;
-
-: download-to ( url file -- )
- #! Downloads the contents of a URL to a file.
- swap http-get-stream check-response
- [ swap <file-writer> stream-copy ] with-disposal ;
-
-: download ( url -- )
- dup download-name download-to ;
-
-: <post-request> ( content-type content -- request )
- request construct-empty
- "POST" >>method
- swap >>post-data
- swap >>post-data-type ;
-
-: http-post ( content-type content url -- response string )
- #! The content is URL encoded for you.
- -rot url-encode <post-request> http-request contents ;
diff --git a/extra/http.good/client/summary.txt b/extra/http.good/client/summary.txt
deleted file mode 100644
index 5609c916c4..0000000000
--- a/extra/http.good/client/summary.txt
+++ /dev/null
@@ -1 +0,0 @@
-HTTP client
diff --git a/extra/http.good/client/tags.txt b/extra/http.good/client/tags.txt
deleted file mode 100644
index 93e65ae758..0000000000
--- a/extra/http.good/client/tags.txt
+++ /dev/null
@@ -1,2 +0,0 @@
-web
-network
diff --git a/extra/http.good/http-tests.factor b/extra/http.good/http-tests.factor
deleted file mode 100755
index 9fa593053c..0000000000
--- a/extra/http.good/http-tests.factor
+++ /dev/null
@@ -1,115 +0,0 @@
-USING: http tools.test multiline tuple-syntax
-io.streams.string kernel arrays splitting sequences ;
-IN: temporary
-
-[ "hello%20world" ] [ "hello world" url-encode ] unit-test
-[ "hello world" ] [ "hello%20world" url-decode ] unit-test
-[ "~hello world" ] [ "%7ehello+world" url-decode ] unit-test
-[ "" ] [ "%XX%XX%XX" url-decode ] unit-test
-[ "" ] [ "%XX%XX%X" url-decode ] unit-test
-
-[ "hello world" ] [ "hello+world" url-decode ] unit-test
-[ "hello world" ] [ "hello%20world" url-decode ] unit-test
-[ " ! " ] [ "%20%21%20" url-decode ] unit-test
-[ "hello world" ] [ "hello world%" url-decode ] unit-test
-[ "hello world" ] [ "hello world%x" url-decode ] unit-test
-[ "hello%20world" ] [ "hello world" url-encode ] unit-test
-[ "%20%21%20" ] [ " ! " url-encode ] unit-test
-
-[ "\u001234hi\u002045" ] [ "\u001234hi\u002045" url-encode url-decode ] unit-test
-
-STRING: read-request-test-1
-GET http://foo/bar HTTP/1.1
-Some-Header: 1
-Some-Header: 2
-Content-Length: 4
-
-blah
-;
-
-[
- TUPLE{ request
- method: "GET"
- path: "bar"
- query: f
- version: "1.1"
- header: H{ { "some-header" V{ "1" "2" } } { "content-length" V{ "4" } } }
- post-data: "blah"
- }
-] [
- read-request-test-1 [
- read-request
- ] with-string-reader
-] unit-test
-
-STRING: read-request-test-1'
-GET bar HTTP/1.1
-content-length: 4
-some-header: 1
-some-header: 2
-
-blah
-;
-
-read-request-test-1' 1array [
- read-request-test-1
- [ read-request ] with-string-reader
- [ write-request ] with-string-writer
- ! normalize crlf
- string-lines "\n" join
-] unit-test
-
-STRING: read-request-test-2
-HEAD http://foo/bar HTTP/1.0
-Host: www.sex.com
-;
-
-[
- TUPLE{ request
- method: "HEAD"
- path: "bar"
- query: f
- version: "1.0"
- header: H{ { "host" V{ "www.sex.com" } } }
- host: "www.sex.com"
- }
-] [
- read-request-test-2 [
- read-request
- ] with-string-reader
-] unit-test
-
-STRING: read-response-test-1
-HTTP/1.0 404 not found
-Content-Type: text/html
-
-blah
-;
-
-[
- TUPLE{ response
- version: "1.0"
- code: 404
- message: "not found"
- header: H{ { "content-type" V{ "text/html" } } }
- }
-] [
- read-response-test-1
- [ read-response ] with-string-reader
-] unit-test
-
-
-STRING: read-response-test-1'
-HTTP/1.0 404 not found
-content-type: text/html
-
-
-;
-
-read-response-test-1' 1array [
- read-response-test-1
- [ read-response ] with-string-reader
- [ write-response ] with-string-writer
- ! normalize crlf
- string-lines "\n" join
-] unit-test
diff --git a/extra/http.good/http.factor b/extra/http.good/http.factor
deleted file mode 100755
index 4c2834b7ca..0000000000
--- a/extra/http.good/http.factor
+++ /dev/null
@@ -1,277 +0,0 @@
-! Copyright (C) 2003, 2008 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: hashtables io io.streams.string kernel math namespaces
-math.parser assocs sequences strings splitting ascii
-io.encodings.utf8 assocs.lib namespaces unicode.case combinators
-vectors sorting new-slots accessors calendar ;
-IN: http
-
-: http-port 80 ; inline
-
-: crlf "\r\n" write ;
-
-: header-line ( line -- )
- ": " split1 dup [ swap >lower insert ] [ 2drop ] if ;
-
-: read-header-line ( -- )
- readln dup
- empty? [ drop ] [ header-line read-header-line ] if ;
-
-: read-header ( -- multi-assoc )
- [ read-header-line ] H{ } make-assoc ;
-
-: write-header ( multi-assoc -- )
- >alist sort-keys
- [
- swap write ": " write {
- { [ dup number? ] [ number>string ] }
- { [ dup timestamp? ] [ timestamp>http-string ] }
- { [ dup string? ] [ ] }
- } cond write crlf
- ] multi-assoc-each crlf ;
-
-: url-quotable? ( ch -- ? )
- #! In a URL, can this character be used without
- #! URL-encoding?
- dup letter?
- over LETTER? or
- over digit? or
- swap "/_-." member? or ; foldable
-
-: push-utf8 ( ch -- )
- 1string encode-utf8 [ CHAR: % , >hex 2 CHAR: 0 pad-left % ] each ;
-
-: url-encode ( str -- str )
- [ [
- dup url-quotable? [ , ] [ push-utf8 ] if
- ] each ] "" make ;
-
-: url-decode-hex ( index str -- )
- 2dup length 2 - >= [
- 2drop
- ] [
- >r 1+ dup 2 + r> subseq hex> [ , ] when*
- ] if ;
-
-: url-decode-% ( index str -- index str )
- 2dup url-decode-hex >r 3 + r> ;
-
-: url-decode-+-or-other ( index str ch -- index str )
- dup CHAR: + = [ drop CHAR: \s ] when , >r 1+ r> ;
-
-: url-decode-iter ( index str -- )
- 2dup length >= [
- 2drop
- ] [
- 2dup nth dup CHAR: % = [
- drop url-decode-%
- ] [
- url-decode-+-or-other
- ] if url-decode-iter
- ] if ;
-
-: url-decode ( str -- str )
- [ 0 swap url-decode-iter ] "" make decode-utf8 ;
-
-: query>assoc ( query -- assoc )
- dup [
- "&" split [
- "=" split1 [ dup [ url-decode ] when ] 2apply
- ] H{ } map>assoc
- ] when ;
-
-: assoc>query ( hash -- str )
- [ [ url-encode ] 2apply "=" swap 3append ] { } assoc>map
- "&" join ;
-
-TUPLE: request
-host
-port
-method
-path
-query
-version
-header
-post-data
-post-data-type ;
-
-: <request>
- request construct-empty
- "1.0" >>version
- http-port >>port ;
-
-: url>path ( url -- path )
- url-decode "http://" ?head
- [ "/" split1 "" or nip ] [ "/" ?head drop ] if ;
-
-: read-method ( request -- request )
- " " read-until [ "Bad request: method" throw ] unless
- >>method ;
-
-: read-query ( request -- request )
- " " read-until
- [ "Bad request: query params" throw ] unless
- query>assoc >>query ;
-
-: read-url ( request -- request )
- " ?" read-until {
- { CHAR: \s [ dup empty? [ drop read-url ] [ url>path >>path ] if ] }
- { CHAR: ? [ url>path >>path read-query ] }
- [ "Bad request: URL" throw ]
- } case ;
-
-: parse-version ( string -- version )
- "HTTP/" ?head [ "Bad version" throw ] unless
- dup { "1.0" "1.1" } member? [ "Bad version" throw ] unless ;
-
-: read-request-version ( request -- request )
- readln [ CHAR: \s = ] left-trim
- parse-version
- >>version ;
-
-: read-request-header ( request -- request )
- read-header >>header ;
-
-SYMBOL: max-post-request
-
-1024 256 * max-post-request set-global
-
-: content-length ( header -- n )
- "content-length" peek-at string>number dup [
- dup max-post-request get > [
- "content-length > max-post-request" throw
- ] when
- ] when ;
-
-: read-post-data ( request -- request )
- dup header>> content-length [ read >>post-data ] when* ;
-
-: parse-host ( string -- host port )
- "." ?tail drop ":" split1
- [ string>number ] [ http-port ] if* ;
-
-: extract-host ( request -- request )
- dup header>> "host" peek-at parse-host >r >>host r> >>port ;
-
-: extract-post-data-type ( request -- request )
- dup header>> "content-type" peek-at >>post-data-type ;
-
-: read-request ( -- request )
- <request>
- read-method
- read-url
- read-request-version
- read-request-header
- read-post-data
- extract-host
- extract-post-data-type ;
-
-: write-method ( request -- request )
- dup method>> write bl ;
-
-: write-url ( request -- request )
- dup path>> url-encode write
- dup query>> dup assoc-empty? [ drop ] [
- "?" write
- assoc>query write
- ] if ;
-
-: write-request-url ( request -- request )
- write-url bl ;
-
-: write-version ( request -- request )
- "HTTP/" write dup request-version write crlf ;
-
-: write-request-header ( request -- request )
- dup header>> >hashtable
- over host>> [ "host" replace-at ] when*
- over post-data>> [ length "content-length" replace-at ] when*
- over post-data-type>> [ "content-type" replace-at ] when*
- write-header ;
-
-: write-post-data ( request -- request )
- dup post-data>> [ write ] when* ;
-
-: write-request ( request -- )
- write-method
- write-url
- write-version
- write-request-header
- write-post-data
- flush
- drop ;
-
-: request-url ( request -- url )
- [
- dup host>> [
- "http://" write
- dup host>> url-encode write
- ":" write
- dup port>> number>string write
- ] when
- "/" write
- write-url
- drop
- ] with-string-writer ;
-
-TUPLE: response
-version
-code
-message
-header ;
-
-: <response>
- response construct-empty
- "1.0" >>version
- H{ } clone >>header ;
-
-: read-response-version
- " " read-until
- [ "Bad response: version" throw ] unless
- parse-version
- >>version ;
-
-: read-response-code
- " " read-until [ "Bad response: code" throw ] unless
- string>number [ "Bad response: code" throw ] unless*
- >>code ;
-
-: read-response-message
- readln >>message ;
-
-: read-response-header
- read-header >>header ;
-
-: read-response ( -- response )
- <response>
- read-response-version
- read-response-code
- read-response-message
- read-response-header ;
-
-: write-response-version ( response -- response )
- "HTTP/" write
- dup version>> write bl ;
-
-: write-response-code ( response -- response )
- dup code>> number>string write bl ;
-
-: write-response-message ( response -- response )
- dup message>> write crlf ;
-
-: write-response-header ( response -- response )
- dup header>> write-header ;
-
-: write-response ( respose -- )
- write-response-version
- write-response-code
- write-response-message
- write-response-header
- flush
- drop ;
-
-: set-response-header ( response value key -- response )
- pick header>> -rot replace-at drop ;
-
-: set-content-type ( response content-type -- response )
- "content-type" set-response-header ;
diff --git a/extra/http.good/mime/authors.txt b/extra/http.good/mime/authors.txt
deleted file mode 100755
index 1901f27a24..0000000000
--- a/extra/http.good/mime/authors.txt
+++ /dev/null
@@ -1 +0,0 @@
-Slava Pestov
diff --git a/extra/http.good/mime/mime.factor b/extra/http.good/mime/mime.factor
deleted file mode 100644
index 3365127d87..0000000000
--- a/extra/http.good/mime/mime.factor
+++ /dev/null
@@ -1,34 +0,0 @@
-! Copyright (C) 2004, 2005 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: io assocs kernel sequences math namespaces splitting ;
-
-IN: http.mime
-
-: file-extension ( filename -- extension )
- "." split dup length 1 <= [ drop f ] [ peek ] if ;
-
-: mime-type ( filename -- mime-type )
- file-extension "mime-types" get at "application/octet-stream" or ;
-
-H{
- { "html" "text/html" }
- { "txt" "text/plain" }
- { "xml" "text/xml" }
- { "css" "text/css" }
-
- { "gif" "image/gif" }
- { "png" "image/png" }
- { "jpg" "image/jpeg" }
- { "jpeg" "image/jpeg" }
-
- { "jar" "application/octet-stream" }
- { "zip" "application/octet-stream" }
- { "tgz" "application/octet-stream" }
- { "tar.gz" "application/octet-stream" }
- { "gz" "application/octet-stream" }
-
- { "pdf" "application/pdf" }
-
- { "factor" "text/plain" }
- { "fhtml" "application/x-factor-server-page" }
-} "mime-types" set-global
diff --git a/extra/http.good/server/authors.txt b/extra/http.good/server/authors.txt
deleted file mode 100755
index 1901f27a24..0000000000
--- a/extra/http.good/server/authors.txt
+++ /dev/null
@@ -1 +0,0 @@
-Slava Pestov
diff --git a/extra/http.good/server/server-tests.factor b/extra/http.good/server/server-tests.factor
deleted file mode 100755
index a67d21a640..0000000000
--- a/extra/http.good/server/server-tests.factor
+++ /dev/null
@@ -1,45 +0,0 @@
-USING: http.server tools.test kernel namespaces accessors
-new-slots assocs.lib io http math sequences ;
-IN: temporary
-
-TUPLE: mock-responder ;
-
-: <mock-responder> ( path -- responder )
- <responder> mock-responder construct-delegate ;
-
-M: mock-responder do-responder
- 2nip
- path>> on
- [ "Hello world" print ]
- "text/plain" <content> ;
-
-: check-dispatch ( tag path -- ? )
- over off
- <request> swap default-host get call-responder
- write-response call get ;
-
-[
- "" <dispatcher>
- "foo" <mock-responder> add-responder
- "bar" <mock-responder> add-responder
- "baz/" <dispatcher>
- "123" <mock-responder> add-responder
- "default" <mock-responder> >>default
- add-responder
- default-host set
-
- [ t ] [ "foo" "foo" check-dispatch ] unit-test
- [ f ] [ "foo" "bar" check-dispatch ] unit-test
- [ t ] [ "bar" "bar" check-dispatch ] unit-test
- [ t ] [ "default" "baz/xxx" check-dispatch ] unit-test
- [ t ] [ "123" "baz/123" check-dispatch ] unit-test
-
- [ t ] [
- <request>
- "baz" >>path
- "baz" default-host get call-responder
- dup code>> 300 399 between? >r
- header>> "location" peek-at "baz/" tail? r> and
- nip
- ] unit-test
-] with-scope
diff --git a/extra/http.good/server/server.factor b/extra/http.good/server/server.factor
deleted file mode 100755
index e06ae6a95c..0000000000
--- a/extra/http.good/server/server.factor
+++ /dev/null
@@ -1,131 +0,0 @@
-! Copyright (C) 2003, 2008 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: assocs kernel namespaces io io.timeouts strings splitting
-threads http sequences prettyprint io.server logging calendar
-new-slots html.elements accessors math.parser combinators.lib ;
-IN: http.server
-
-TUPLE: responder path directory ;
-
-: <responder> ( path -- responder )
- "/" ?tail responder construct-boa ;
-
-GENERIC: do-responder ( request path responder -- quot response )
-
-TUPLE: trivial-responder quot response ;
-
-: <trivial-responder> ( quot response -- responder )
- trivial-responder construct-boa
- "" <responder> over set-delegate ;
-
-M: trivial-responder do-responder
- 2nip dup quot>> swap response>> ;
-
-: trivial-response-body ( code message -- )
- <html>
- <body>
- <h1> swap number>string write bl write </h1>
- </body>
- </html> ;
-
-: <trivial-response> ( code message -- quot response )
- [ [ trivial-response-body ] 2curry ] 2keep <response>
- "text/html" set-content-type
- swap >>message
- swap >>code ;
-
-: <404> ( -- quot response )
- 404 "Not Found" <trivial-response> ;
-
-: <redirect> ( to code message -- quot response )
- <trivial-response>
- rot "location" set-response-header ;
-
-: <permanent-redirect> ( to -- quot response )
- 301 "Moved Permanently" <redirect> ;
-
-: <temporary-redirect> ( to -- quot response )
- 307 "Temporary Redirect" <redirect> ;
-
-: <content> ( content-type -- response )
- <response>
- 200 >>code
- swap set-content-type ;
-
-TUPLE: dispatcher responders default ;
-
-: responder-matches? ( path responder -- ? )
- path>> head? ;
-
-TUPLE: no-/-responder ;
-
-M: no-/-responder do-responder
- 2drop
- dup path>> "/" append >>path
- request-url <permanent-redirect> ;
-
-: <no-/-responder> ( -- responder )
- "" <responder> no-/-responder construct-delegate ;
-
-<no-/-responder> no-/-responder set-global
-
-: find-responder ( path dispatcher -- path responder )
- >r "/" ?head drop r>
- [ responders>> [ dupd responder-matches? ] find nip ] keep
- default>> or [ path>> ?head drop ] keep ;
-
-: no-trailing-/ ( path responder -- path responder )
- over empty? over directory>> and
- [ drop no-/-responder get-global ] when ;
-
-: call-responder ( request path responder -- quot response )
- no-trailing-/ do-responder ;
-
-SYMBOL: 404-responder
-
-<404> <trivial-responder> 404-responder set-global
-
-M: dispatcher do-responder
- find-responder call-responder ;
-
-: <dispatcher> ( path -- dispatcher )
- <responder>
- dispatcher construct-delegate
- 404-responder get-global >>default
- V{ } clone >>responders ;
-
-: add-responder ( dispatcher responder -- dispatcher )
- over responders>> push ;
-
-SYMBOL: virtual-hosts
-SYMBOL: default-host
-
-virtual-hosts global [ drop H{ } clone ] cache drop
-default-host global [ drop 404-responder ] cache drop
-
-: find-virtual-host ( host -- responder )
- virtual-hosts get at [ default-host get ] unless* ;
-
-: handle-request ( request -- )
- [
- dup path>> over host>> find-virtual-host
- call-responder
- write-response
- ] keep method>> "HEAD" = [ drop ] [ call ] if ;
-
-: default-timeout 1 minutes stdio get set-timeout ;
-
-LOG: httpd-hit NOTICE
-
-: log-request ( request -- )
- { method>> host>> path>> } map-exec-with httpd-hit ;
-
-: httpd ( port -- )
- internet-server "http.server" [
- default-timeout
- read-request dup log-request handle-request
- ] with-server ;
-
-: httpd-main ( -- ) 8888 httpd ;
-
-MAIN: httpd-main
diff --git a/extra/http.good/server/summary.txt b/extra/http.good/server/summary.txt
deleted file mode 100644
index e6d2ca62e9..0000000000
--- a/extra/http.good/server/summary.txt
+++ /dev/null
@@ -1 +0,0 @@
-HTTP server
diff --git a/extra/http.good/server/tags.txt b/extra/http.good/server/tags.txt
deleted file mode 100644
index b0881a9ec0..0000000000
--- a/extra/http.good/server/tags.txt
+++ /dev/null
@@ -1,3 +0,0 @@
-enterprise
-network
-web
diff --git a/extra/http.good/server/templating/authors.txt b/extra/http.good/server/templating/authors.txt
deleted file mode 100644
index b47eafb62a..0000000000
--- a/extra/http.good/server/templating/authors.txt
+++ /dev/null
@@ -1,2 +0,0 @@
-Slava Pestov
-Matthew Willis
diff --git a/extra/http.good/server/templating/templating-tests.factor b/extra/http.good/server/templating/templating-tests.factor
deleted file mode 100644
index d889cd848a..0000000000
--- a/extra/http.good/server/templating/templating-tests.factor
+++ /dev/null
@@ -1,17 +0,0 @@
-USING: io io.files io.streams.string http.server.templating kernel tools.test
- sequences ;
-IN: temporary
-
-: test-template ( path -- ? )
- "extra/http/server/templating/test/" swap append
- [
- ".fhtml" append resource-path
- [ run-template-file ] with-string-writer
- ] keep
- ".html" append resource-path file-contents = ;
-
-[ t ] [ "example" test-template ] unit-test
-[ t ] [ "bug" test-template ] unit-test
-[ t ] [ "stack" test-template ] unit-test
-
-[ ] [ "<%\n%>" parse-template drop ] unit-test
diff --git a/extra/http.good/server/templating/templating.factor b/extra/http.good/server/templating/templating.factor
deleted file mode 100755
index f364b86524..0000000000
--- a/extra/http.good/server/templating/templating.factor
+++ /dev/null
@@ -1,96 +0,0 @@
-! Copyright (C) 2005 Alex Chapman
-! Copyright (C) 2006, 2007 Slava Pestov
-! See http://factorcode.org/license.txt for BSD license.
-USING: continuations sequences kernel parser namespaces io
-io.files io.streams.lines io.streams.string html html.elements
-source-files debugger combinators math quotations generic
-strings splitting ;
-
-IN: http.server.templating
-
-: templating-vocab ( -- vocab-name ) "http.server.templating" ;
-
-! See apps/http-server/test/ or libs/furnace/ for template usage
-! examples
-
-! We use a custom lexer so that %> ends a token even if not
-! followed by whitespace
-TUPLE: template-lexer ;
-
-: <template-lexer> ( lines -- lexer )
- <lexer> template-lexer construct-delegate ;
-
-M: template-lexer skip-word
- [
- {
- { [ 2dup nth CHAR: " = ] [ drop 1+ ] }
- { [ 2dup swap tail-slice "%>" head? ] [ drop 2 + ] }
- { [ t ] [ f skip ] }
- } cond
- ] change-column ;
-
-DEFER: <% delimiter
-
-: check-<% ( lexer -- col )
- "<%" over lexer-line-text rot lexer-column start* ;
-
-: found-<% ( accum lexer col -- accum )
- [
- over lexer-line-text
- >r >r lexer-column r> r> subseq parsed
- \ write-html parsed
- ] 2keep 2 + swap set-lexer-column ;
-
-: still-looking ( accum lexer -- accum )
- [
- dup lexer-line-text swap lexer-column tail
- parsed \ print-html parsed
- ] keep next-line ;
-
-: parse-%> ( accum lexer -- accum )
- dup still-parsing? [
- dup check-<%
- [ found-<% ] [ [ still-looking ] keep parse-%> ] if*
- ] [
- drop
- ] if ;
-
-: %> lexer get parse-%> ; parsing
-
-: parse-template-lines ( lines -- quot )
- <template-lexer> [
- V{ } clone lexer get parse-%> f (parse-until)
- ] with-parser ;
-
-: parse-template ( string -- quot )
- [
- use [ clone ] change
- templating-vocab use+
- string-lines parse-template-lines
- ] with-scope ;
-
-: eval-template ( string -- ) parse-template call ;
-
-: html-error. ( error -- )
- <pre> error. </pre> ;
-
-: run-template-file ( filename -- )
- [
- [
- "quiet" on
- parser-notes off
- templating-vocab use+
- dup source-file file set ! so that reload works properly
- [
- ?resource-path file-contents
- [ eval-template ] [ html-error. drop ] recover
- ] keep
- ] with-file-vocabs
- ] assert-depth drop ;
-
-: run-relative-template-file ( filename -- )
- file get source-file-path parent-directory
- swap path+ run-template-file ;
-
-: template-convert ( infile outfile -- )
- [ run-template-file ] with-file-writer ;
diff --git a/extra/http.good/server/templating/test/bug.fhtml b/extra/http.good/server/templating/test/bug.fhtml
deleted file mode 100644
index cb66599079..0000000000
--- a/extra/http.good/server/templating/test/bug.fhtml
+++ /dev/null
@@ -1,5 +0,0 @@
-<%
- USING: prettyprint ;
- ! Hello world
- 5 pprint
-%>
diff --git a/extra/http.good/server/templating/test/bug.html b/extra/http.good/server/templating/test/bug.html
deleted file mode 100644
index 51d7b8d169..0000000000
--- a/extra/http.good/server/templating/test/bug.html
+++ /dev/null
@@ -1,2 +0,0 @@
-5
-
diff --git a/extra/http.good/server/templating/test/example.fhtml b/extra/http.good/server/templating/test/example.fhtml
deleted file mode 100644
index 211f44af9a..0000000000
--- a/extra/http.good/server/templating/test/example.fhtml
+++ /dev/null
@@ -1,8 +0,0 @@
-<% USING: math ; %>
-
-<html>
- <head><title>Simple Embedded Factor Example</title></head>
- <body>
- <% 5 [ %><p>I like repetition</p><% ] times %>
- </body>
-</html>
diff --git a/extra/http.good/server/templating/test/example.html b/extra/http.good/server/templating/test/example.html
deleted file mode 100644
index 9bf4a08209..0000000000
--- a/extra/http.good/server/templating/test/example.html
+++ /dev/null
@@ -1,9 +0,0 @@
-
-
-<html>
- <head><title>Simple Embedded Factor Example</title></head>
- <body>
- <p>I like repetition</p><p>I like repetition</p><p>I like repetition</p><p>I like repetition</p><p>I like repetition</p>
- </body>
-</html>
-
diff --git a/extra/http.good/server/templating/test/stack.fhtml b/extra/http.good/server/templating/test/stack.fhtml
deleted file mode 100644
index 399711a209..0000000000
--- a/extra/http.good/server/templating/test/stack.fhtml
+++ /dev/null
@@ -1 +0,0 @@
-The stack: <% USING: prettyprint ; .s %>
diff --git a/extra/http.good/server/templating/test/stack.html b/extra/http.good/server/templating/test/stack.html
deleted file mode 100644
index ee923a6421..0000000000
--- a/extra/http.good/server/templating/test/stack.html
+++ /dev/null
@@ -1,2 +0,0 @@
-The stack:
-
diff --git a/extra/http.good/summary.txt b/extra/http.good/summary.txt
deleted file mode 100644
index 8791a6f1c4..0000000000
--- a/extra/http.good/summary.txt
+++ /dev/null
@@ -1 +0,0 @@
-Common code shared by HTTP client and server
diff --git a/extra/http.good/tags.txt b/extra/http.good/tags.txt
deleted file mode 100644
index 93e65ae758..0000000000
--- a/extra/http.good/tags.txt
+++ /dev/null
@@ -1,2 +0,0 @@
-web
-network
From 4994a0e435849b268cea80863a62fbed14b3b602 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 29 Feb 2008 23:17:15 -0600
Subject: [PATCH 19/55] fix with-directory. i thought i did this already..
---
core/io/files/files-tests.factor | 2 ++
core/io/files/files.factor | 4 ++--
2 files changed, 4 insertions(+), 2 deletions(-)
diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor
index 92e148a854..850a30380b 100755
--- a/core/io/files/files-tests.factor
+++ b/core/io/files/files-tests.factor
@@ -121,3 +121,5 @@ USING: tools.test io.files io threads kernel continuations ;
[ ] [ "copy-destination" temp-file delete-tree ] unit-test
[ ] [ "copy-tree-test" temp-file delete-tree ] unit-test
+
+[ t ] [ cwd "misc" resource-path [ ] with-directory cwd = ] unit-test
diff --git a/core/io/files/files.factor b/core/io/files/files.factor
index e20437fa85..28f23b0de5 100755
--- a/core/io/files/files.factor
+++ b/core/io/files/files.factor
@@ -84,7 +84,7 @@ HOOK: cd io-backend ( path -- )
HOOK: cwd io-backend ( -- path )
: with-directory ( path quot -- )
- swap cd cwd [ cd ] curry [ ] cleanup ; inline
+ cwd [ cd ] curry rot cd [ ] cleanup ; inline
! Creating directories
HOOK: make-directory io-backend ( path -- )
@@ -223,4 +223,4 @@ HOOK: <file-appender> io-backend ( path -- stream )
{ [ winnt? ] [ "USERPROFILE" os-env ] }
{ [ wince? ] [ "" resource-path ] }
{ [ unix? ] [ "HOME" os-env ] }
- } cond ;
\ No newline at end of file
+ } cond ;
From 59872525fd2aa828bd9519d7a04686bbc5d92619 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Sat, 1 Mar 2008 01:19:00 -0600
Subject: [PATCH 20/55] Fix 'box empty' error
---
extra/ui/windows/windows.factor | 137 +++++++++++++++++++++-----------
1 file changed, 89 insertions(+), 48 deletions(-)
diff --git a/extra/ui/windows/windows.factor b/extra/ui/windows/windows.factor
index 9d6e95c07a..6cba5cfdf8 100755
--- a/extra/ui/windows/windows.factor
+++ b/extra/ui/windows/windows.factor
@@ -235,6 +235,35 @@ M: windows-ui-backend (close-window)
: handle-wm-kill-focus ( hWnd uMsg wParam lParam -- )
3drop window [ unfocus-world ] when* ;
+: message>button ( uMsg -- button down? )
+ {
+ { [ dup WM_LBUTTONDOWN = ] [ drop 1 t ] }
+ { [ dup WM_LBUTTONUP = ] [ drop 1 f ] }
+ { [ dup WM_MBUTTONDOWN = ] [ drop 2 t ] }
+ { [ dup WM_MBUTTONUP = ] [ drop 2 f ] }
+ { [ dup WM_RBUTTONDOWN = ] [ drop 3 t ] }
+ { [ dup WM_RBUTTONUP = ] [ drop 3 f ] }
+
+ { [ dup WM_NCLBUTTONDOWN = ] [ drop 1 t ] }
+ { [ dup WM_NCLBUTTONUP = ] [ drop 1 f ] }
+ { [ dup WM_NCMBUTTONDOWN = ] [ drop 2 t ] }
+ { [ dup WM_NCMBUTTONUP = ] [ drop 2 f ] }
+ { [ dup WM_NCRBUTTONDOWN = ] [ drop 3 t ] }
+ { [ dup WM_NCRBUTTONUP = ] [ drop 3 f ] }
+ } cond ;
+
+! If the user clicks in the window border ("non-client area")
+! Windows sends us an NC[LMR]BUTTONDOWN message; but if the
+! mouse is subsequently released outside the NC area, we receive
+! a [LMR]BUTTONUP message and Factor can get confused. So we
+! ignore BUTTONUP's that are a result of an NC*BUTTONDOWN.
+SYMBOL: nc-buttons
+
+: handle-wm-ncbutton ( hWnd uMsg wParam lParam -- )
+ 2drop nip
+ message>button nc-buttons get
+ swap [ push ] [ delete ] if ;
+
: >lo-hi ( WORD -- array ) [ lo-word ] keep hi-word 2array ;
: mouse-wheel ( lParam -- array ) >lo-hi [ sgn neg ] map ;
@@ -244,16 +273,8 @@ M: windows-ui-backend (close-window)
get-RECT-top-left 2array v- ;
: mouse-event>gesture ( uMsg -- button )
- key-modifiers swap
- {
- { [ dup WM_LBUTTONDOWN = ] [ drop 1 <button-down> ] }
- { [ dup WM_LBUTTONUP = ] [ drop 1 <button-up> ] }
- { [ dup WM_MBUTTONDOWN = ] [ drop 2 <button-down> ] }
- { [ dup WM_MBUTTONUP = ] [ drop 2 <button-up> ] }
- { [ dup WM_RBUTTONDOWN = ] [ drop 3 <button-down> ] }
- { [ dup WM_RBUTTONUP = ] [ drop 3 <button-up> ] }
- { [ t ] [ "bad button" throw ] }
- } cond ;
+ key-modifiers swap message>button
+ [ <button-down> ] [ <button-up> ] if ;
: mouse-buttons ( -- seq ) WM_LBUTTONDOWN WM_RBUTTONDOWN 2array ;
@@ -276,12 +297,16 @@ M: windows-ui-backend (close-window)
mouse-captured off ;
: handle-wm-buttondown ( hWnd uMsg wParam lParam -- )
- >r over capture-mouse? [ pick set-capture ] when r>
+ >r >r dup capture-mouse? [ over set-capture ] when r> r>
prepare-mouse send-button-down ;
: handle-wm-buttonup ( hWnd uMsg wParam lParam -- )
mouse-captured get [ release-capture ] when
- prepare-mouse send-button-up ;
+ pick message>button drop dup nc-buttons get member? [
+ nc-buttons get delete 4drop
+ ] [
+ drop prepare-mouse send-button-up
+ ] if ;
: make-TRACKMOUSEEVENT ( hWnd -- alien )
"TRACKMOUSEEVENT" <c-object> [ set-TRACKMOUSEEVENT-hwndTrack ] keep
@@ -307,44 +332,58 @@ M: windows-ui-backend (close-window)
#! message sent if mouse leaves main application
4drop forget-rollover ;
+SYMBOL: wm-handlers
+
+H{ } clone wm-handlers set-global
+
+: add-wm-handler ( quot wm -- )
+ dup array?
+ [ [ execute add-wm-handler ] with each ]
+ [ wm-handlers get-global set-at ] if ;
+
+[ handle-wm-close 0 ] WM_CLOSE add-wm-handler
+[ 4dup handle-wm-paint DefWindowProc ] WM_PAINT add-wm-handler
+
+[ handle-wm-size 0 ] WM_SIZE add-wm-handler
+[ handle-wm-move 0 ] WM_MOVE add-wm-handler
+
+[ 4dup handle-wm-keydown DefWindowProc ] { WM_KEYDOWN WM_SYSKEYDOWN } add-wm-handler
+[ 4dup handle-wm-char DefWindowProc ] { WM_CHAR WM_SYSCHAR } add-wm-handler
+[ 4dup handle-wm-keyup DefWindowProc ] { WM_KEYUP WM_SYSKEYUP } add-wm-handler
+
+[ handle-wm-syscommand ] WM_SYSCOMMAND add-wm-handler
+[ handle-wm-set-focus 0 ] WM_SETFOCUS add-wm-handler
+[ handle-wm-kill-focus 0 ] WM_KILLFOCUS add-wm-handler
+
+[ handle-wm-buttondown 0 ] WM_LBUTTONDOWN add-wm-handler
+[ handle-wm-buttondown 0 ] WM_MBUTTONDOWN add-wm-handler
+[ handle-wm-buttondown 0 ] WM_RBUTTONDOWN add-wm-handler
+[ handle-wm-buttonup 0 ] WM_LBUTTONUP add-wm-handler
+[ handle-wm-buttonup 0 ] WM_MBUTTONUP add-wm-handler
+[ handle-wm-buttonup 0 ] WM_RBUTTONUP add-wm-handler
+
+[ 4dup handle-wm-ncbutton DefWindowProc ]
+{ WM_NCLBUTTONDOWN WM_NCMBUTTONDOWN WM_NCRBUTTONDOWN
+WM_NCLBUTTONUP WM_NCMBUTTONUP WM_NCRBUTTONUP }
+add-wm-handler
+
+[ nc-buttons get-global delete-all DefWindowProc ]
+{ WM_EXITSIZEMOVE WM_EXITMENULOOP } add-wm-handler
+
+[ handle-wm-mousemove 0 ] WM_MOUSEMOVE add-wm-handler
+[ handle-wm-mousewheel 0 ] WM_MOUSEWHEEL add-wm-handler
+[ handle-wm-cancelmode 0 ] WM_CANCELMODE add-wm-handler
+[ handle-wm-mouseleave 0 ] WM_MOUSELEAVE add-wm-handler
+
+SYMBOL: trace-messages?
+
! return 0 if you handle the message, else just let DefWindowProc return its val
: ui-wndproc ( -- object )
"uint" { "void*" "uint" "long" "long" } "stdcall" [
[
- pick ! global [ dup windows-message-name . ] bind
- {
- { [ dup WM_CLOSE = ] [ drop handle-wm-close 0 ] }
- { [ dup WM_PAINT = ]
- [ drop 4dup handle-wm-paint DefWindowProc ] }
- { [ dup WM_SIZE = ] [ drop handle-wm-size 0 ] }
- { [ dup WM_MOVE = ] [ drop handle-wm-move 0 ] }
-
- ! Keyboard events
- { [ dup WM_KEYDOWN = over WM_SYSKEYDOWN = or ]
- [ drop 4dup handle-wm-keydown DefWindowProc ] }
- { [ dup WM_CHAR = over WM_SYSCHAR = or ]
- [ drop 4dup handle-wm-char DefWindowProc ] }
- { [ dup WM_KEYUP = over WM_SYSKEYUP = or ]
- [ drop 4dup handle-wm-keyup DefWindowProc ] }
-
- { [ dup WM_SYSCOMMAND = ] [ drop handle-wm-syscommand ] }
- { [ dup WM_SETFOCUS = ] [ drop handle-wm-set-focus 0 ] }
- { [ dup WM_KILLFOCUS = ] [ drop handle-wm-kill-focus 0 ] }
-
- ! Mouse events
- { [ dup WM_LBUTTONDOWN = ] [ drop handle-wm-buttondown 0 ] }
- { [ dup WM_MBUTTONDOWN = ] [ drop handle-wm-buttondown 0 ] }
- { [ dup WM_RBUTTONDOWN = ] [ drop handle-wm-buttondown 0 ] }
- { [ dup WM_LBUTTONUP = ] [ drop handle-wm-buttonup 0 ] }
- { [ dup WM_MBUTTONUP = ] [ drop handle-wm-buttonup 0 ] }
- { [ dup WM_RBUTTONUP = ] [ drop handle-wm-buttonup 0 ] }
- { [ dup WM_MOUSEMOVE = ] [ drop handle-wm-mousemove 0 ] }
- { [ dup WM_MOUSEWHEEL = ] [ drop handle-wm-mousewheel 0 ] }
- { [ dup WM_CANCELMODE = ] [ drop handle-wm-cancelmode 0 ] }
- { [ dup WM_MOUSELEAVE = ] [ drop handle-wm-mouseleave 0 ] }
-
- { [ t ] [ drop DefWindowProc ] }
- } cond
+ pick
+ trace-messages? get-global [ dup windows-message-name . ] when
+ wm-handlers get-global at* [ call ] [ drop DefWindowProc ] if
] ui-try
] alien-callback ;
@@ -409,7 +448,8 @@ M: windows-ui-backend (close-window)
SetFocus drop ;
: init-win32-ui ( -- )
- "MSG" <c-object> msg-obj set
+ V{ } clone nc-buttons set-global
+ "MSG" <c-object> msg-obj set-global
"Factor-window" malloc-u16-string class-name-ptr set-global
register-wndclassex drop
GetDoubleClickTime double-click-timeout set-global ;
@@ -453,7 +493,8 @@ M: windows-ui-backend raise-window* ( world -- )
win-hWnd SetFocus drop
] when* ;
-M: windows-ui-backend set-title ( string handle -- )
+M: windows-ui-backend set-title ( string world -- )
+ world-handle
dup win-title [ free ] when*
>r malloc-u16-string r>
2dup set-win-title
From 5352ea14ff8402eab23d498562f100b4fc39b6c5 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Sat, 1 Mar 2008 01:46:01 -0600
Subject: [PATCH 21/55] Fix another race...
---
extra/ui/cocoa/tools/tools.factor | 0
extra/ui/tools/listener/listener.factor | 22 ++++++++++++----------
extra/ui/tools/tools-docs.factor | 2 +-
extra/ui/tools/tools.factor | 2 +-
extra/ui/tools/workspace/workspace.factor | 11 +++++++----
5 files changed, 21 insertions(+), 16 deletions(-)
mode change 100644 => 100755 extra/ui/cocoa/tools/tools.factor
diff --git a/extra/ui/cocoa/tools/tools.factor b/extra/ui/cocoa/tools/tools.factor
old mode 100644
new mode 100755
diff --git a/extra/ui/tools/listener/listener.factor b/extra/ui/tools/listener/listener.factor
index c4c366bb7d..75401b3861 100755
--- a/extra/ui/tools/listener/listener.factor
+++ b/extra/ui/tools/listener/listener.factor
@@ -45,21 +45,20 @@ M: listener-gadget tool-scroller
listener-gadget-input interactor-flag wait-for-flag ;
: workspace-busy? ( workspace -- ? )
- workspace-listener
- dup wait-for-listener
- listener-gadget-input interactor-busy? ;
-
-: get-listener ( -- listener )
- [ workspace-busy? not ] get-workspace* workspace-listener ;
+ workspace-listener listener-gadget-input interactor-busy? ;
: listener-input ( string -- )
- get-listener listener-gadget-input set-editor-string ;
+ get-workspace
+ workspace-listener
+ listener-gadget-input set-editor-string ;
: (call-listener) ( quot listener -- )
listener-gadget-input interactor-call ;
: call-listener ( quot -- )
- get-listener (call-listener) ;
+ [ workspace-busy? not ] get-workspace* workspace-listener
+ [ dup wait-for-listener (call-listener) ] 2curry
+ "Listener call" spawn drop ;
M: listener-command invoke-command ( target command -- )
command-quot call-listener ;
@@ -68,7 +67,8 @@ M: listener-operation invoke-command ( target command -- )
[ operation-hook call ] keep operation-quot call-listener ;
: eval-listener ( string -- )
- get-listener
+ get-workspace
+ workspace-listener
listener-gadget-input [ set-editor-string ] keep
evaluate-input ;
@@ -96,7 +96,9 @@ M: listener-operation invoke-command ( target command -- )
[ drop ] [ [ "USE: " % % " " % % ] "" make ] if ;
: insert-word ( word -- )
- get-listener [ word-completion-string ] keep
+ get-workspace
+ workspace-listener
+ [ word-completion-string ] keep
listener-gadget-input user-input ;
: quot-action ( interactor -- lines )
diff --git a/extra/ui/tools/tools-docs.factor b/extra/ui/tools/tools-docs.factor
index 0d68be1730..57ad16bf70 100755
--- a/extra/ui/tools/tools-docs.factor
+++ b/extra/ui/tools/tools-docs.factor
@@ -111,7 +111,7 @@ ARTICLE: "ui-workspace-keys" "UI keyboard shortcuts"
{ $command-map workspace "scrolling" }
{ $command-map workspace "workflow" }
{ $heading "Implementation" }
-"Workspaces are instances of " { $link workspace-window } "." ;
+"Workspaces are instances of " { $link workspace } "." ;
ARTICLE: "ui-tools" "UI development tools"
"The Factor development environment can seem rather different from what you are used to, because it is very simple and powerful.."
diff --git a/extra/ui/tools/tools.factor b/extra/ui/tools/tools.factor
index b3b24cf749..062bcf9416 100755
--- a/extra/ui/tools/tools.factor
+++ b/extra/ui/tools/tools.factor
@@ -82,7 +82,7 @@ workspace "workflow" f {
} define-command-map
[
- <workspace> "Factor workspace" open-status-window
+ <workspace> dup "Factor workspace" open-status-window
] workspace-window-hook set-global
: inspect-continuation ( traceback -- )
diff --git a/extra/ui/tools/workspace/workspace.factor b/extra/ui/tools/workspace/workspace.factor
index de21bf3187..d79fa92f54 100755
--- a/extra/ui/tools/workspace/workspace.factor
+++ b/extra/ui/tools/workspace/workspace.factor
@@ -14,9 +14,12 @@ TUPLE: workspace book listener popup ;
SYMBOL: workspace-window-hook
-: workspace-window ( -- workspace )
+: workspace-window* ( -- workspace )
workspace-window-hook get call ;
+: workspace-window ( -- )
+ workspace-window* drop ;
+
GENERIC: call-tool* ( arg tool -- )
GENERIC: tool-scroller ( tool -- scroller )
@@ -33,9 +36,9 @@ M: gadget tool-scroller drop f ;
: select-tool ( workspace class -- ) swap show-tool drop ;
: get-workspace* ( quot -- workspace )
- [ dup workspace? [ over call ] [ drop f ] if ] find-window
- [ nip dup raise-window gadget-child ]
- [ workspace-window get-workspace* ] if* ; inline
+ [ >r dup workspace? r> [ drop f ] if ] curry find-window
+ [ dup raise-window gadget-child ]
+ [ workspace-window* ] if* ; inline
: get-workspace ( -- workspace ) [ drop t ] get-workspace* ;
From fea927b343291554eacdcaff3bb8a96620bc3560 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Sat, 1 Mar 2008 01:57:34 -0600
Subject: [PATCH 22/55] Fix R/W locks
---
extra/concurrency/locks/locks-docs.factor | 2 +-
extra/concurrency/locks/locks-tests.factor | 35 ++++++++++++++++++++++
extra/concurrency/locks/locks.factor | 35 ++++++++++++++++------
3 files changed, 62 insertions(+), 10 deletions(-)
diff --git a/extra/concurrency/locks/locks-docs.factor b/extra/concurrency/locks/locks-docs.factor
index 86db5914c9..3a89af5ba0 100755
--- a/extra/concurrency/locks/locks-docs.factor
+++ b/extra/concurrency/locks/locks-docs.factor
@@ -46,7 +46,7 @@ $nl
$nl
"Read/write locks allow any number of threads to hold the read lock simulateneously, however attempting to acquire a write lock blocks until all other threads release read locks and write locks."
$nl
-"Read/write locks are reentrant. A thread holding a read lock may acquire a write lock recursively, and a thread holding a write lock may acquire a write lock or a read lock recursively, however a thread holding a read lock may not acquire a write lock recursively since that could break invariants assumed by the code executing with the read lock held."
+"Read/write locks are reentrant. A thread holding a write lock may acquire a read lock or a write lock without blocking. However a thread holding a read lock may not acquire a write lock recursively since that could break invariants assumed by the code executing with the read lock held."
{ $subsection rw-lock }
{ $subsection <rw-lock> }
{ $subsection with-read-lock }
diff --git a/extra/concurrency/locks/locks-tests.factor b/extra/concurrency/locks/locks-tests.factor
index 92f1a9f103..806fad6c32 100755
--- a/extra/concurrency/locks/locks-tests.factor
+++ b/extra/concurrency/locks/locks-tests.factor
@@ -176,3 +176,38 @@ threads sequences calendar ;
[ lock-timeout-test ] [
linked-error-thread thread-name "Lock timeout-er" =
] must-fail-with
+
+:: read/write-test ( -- )
+ [let | l [ <lock> ] |
+ [
+ l [ 1 seconds sleep ] with-lock
+ ] "Lock holder" spawn drop
+
+ [
+ l 1/10 seconds [ ] with-lock-timeout
+ ] "Lock timeout-er" spawn-linked drop
+
+ receive
+ ] ;
+
+[
+ <rw-lock> dup [
+ 1 seconds [ ] with-write-lock-timeout
+ ] with-read-lock
+] must-fail
+
+[
+ <rw-lock> dup [
+ dup [
+ 1 seconds [ ] with-write-lock-timeout
+ ] with-read-lock
+ ] with-write-lock
+] must-fail
+
+[ ] [
+ <rw-lock> dup [
+ dup [
+ 1 seconds [ ] with-read-lock-timeout
+ ] with-read-lock
+ ] with-write-lock
+] unit-test
diff --git a/extra/concurrency/locks/locks.factor b/extra/concurrency/locks/locks.factor
index ea442612b1..43f22c00da 100755
--- a/extra/concurrency/locks/locks.factor
+++ b/extra/concurrency/locks/locks.factor
@@ -55,17 +55,23 @@ TUPLE: rw-lock readers writers reader# writer ;
<PRIVATE
+: add-reader ( lock -- )
+ dup rw-lock-reader# 1+ swap set-rw-lock-reader# ;
+
: acquire-read-lock ( lock timeout -- )
over rw-lock-writer
[ 2dup >r rw-lock-readers r> "read lock" wait ] when drop
- dup rw-lock-reader# 1+ swap set-rw-lock-reader# ;
+ add-reader ;
: notify-writer ( lock -- )
rw-lock-writers notify-1 ;
+: remove-reader ( lock -- )
+ dup rw-lock-reader# 1- swap set-rw-lock-reader# ;
+
: release-read-lock ( lock -- )
- dup rw-lock-reader# 1- dup pick set-rw-lock-reader#
- zero? [ notify-writer ] [ drop ] if ;
+ dup remove-reader
+ dup rw-lock-reader# zero? [ notify-writer ] [ drop ] if ;
: acquire-write-lock ( lock timeout -- )
over rw-lock-writer pick rw-lock-reader# 0 > or
@@ -77,23 +83,34 @@ TUPLE: rw-lock readers writers reader# writer ;
dup rw-lock-readers dlist-empty?
[ notify-writer ] [ rw-lock-readers notify-all ] if ;
-: do-reentrant-rw-lock ( lock timeout quot quot' -- )
- >r pick rw-lock-writer self eq? [ 2nip call ] r> if ; inline
+: reentrant-read-lock-ok? ( lock -- ? )
+ #! If we already have a write lock, then we can grab a read
+ #! lock too.
+ rw-lock-writer self eq? ;
+
+: reentrant-write-lock-ok? ( lock -- ? )
+ #! The only case where we have a writer and > 1 reader is
+ #! write -> read re-entrancy, and in this case we prohibit
+ #! a further write -> read -> write re-entrancy.
+ dup rw-lock-writer self eq?
+ swap rw-lock-reader# zero? and ;
PRIVATE>
: with-read-lock-timeout ( lock timeout quot -- )
- [
+ pick reentrant-read-lock-ok? [
+ [ drop add-reader ] [ remove-reader ] do-lock
+ ] [
[ acquire-read-lock ] [ release-read-lock ] do-lock
- ] do-reentrant-rw-lock ; inline
+ ] if ; inline
: with-read-lock ( lock quot -- )
f swap with-read-lock-timeout ; inline
: with-write-lock-timeout ( lock timeout quot -- )
- [
+ pick reentrant-write-lock-ok? [ 2nip call ] [
[ acquire-write-lock ] [ release-write-lock ] do-lock
- ] do-reentrant-rw-lock ; inline
+ ] if ; inline
: with-write-lock ( lock quot -- )
f swap with-write-lock-timeout ; inline
From c5f5e0a61a9a33d5bbd8a0191d7c8c4405073dfb Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Sat, 1 Mar 2008 02:58:29 -0600
Subject: [PATCH 23/55] io.files: rename the *-to words to *-into
---
core/io/files/files-docs.factor | 28 ++++++++++++++--------------
core/io/files/files.factor | 22 +++++++++++-----------
2 files changed, 25 insertions(+), 25 deletions(-)
diff --git a/core/io/files/files-docs.factor b/core/io/files/files-docs.factor
index b8cf747106..9dc178ee57 100755
--- a/core/io/files/files-docs.factor
+++ b/core/io/files/files-docs.factor
@@ -57,8 +57,8 @@ ARTICLE: "delete-move-copy" "Deleting, moving, copying files"
"The operations for moving and copying files come in three flavors:"
{ $list
{ "A word named " { $snippet { $emphasis "operation" } } " which takes a source and destination path." }
- { "A word named " { $snippet { $emphasis "operation" } "-to" } " which takes a source path and destination directory. The destination file will be stored in the destination directory and will have the same file name as the source path." }
- { "A word named " { $snippet { $emphasis "operation" } "s-to" } " which takes a sequence of source paths and destination directory." }
+ { "A word named " { $snippet { $emphasis "operation" } "-into" } " which takes a source path and destination directory. The destination file will be stored in the destination directory and will have the same file name as the source path." }
+ { "A word named " { $snippet { $emphasis "operation" } "s-into" } " which takes a sequence of source paths and destination directory." }
}
"Since both of the above lists apply to copying files, that this means that there are a total of six variations on copying a file."
$nl
@@ -68,16 +68,16 @@ $nl
{ $subsection delete-tree }
"Moving files:"
{ $subsection move-file }
-{ $subsection move-file-to }
-{ $subsection move-files-to }
+{ $subsection move-file-into }
+{ $subsection move-files-into }
"Copying files:"
{ $subsection copy-file }
-{ $subsection copy-file-to }
-{ $subsection copy-files-to }
+{ $subsection copy-file-into }
+{ $subsection copy-files-into }
"Copying directory trees recursively:"
{ $subsection copy-tree }
-{ $subsection copy-tree-to }
-{ $subsection copy-trees-to }
+{ $subsection copy-tree-into }
+{ $subsection copy-trees-into }
"On most operating systems, files can only be moved within the same file system. To move files between file systems, use " { $link copy-file } " followed by " { $link delete-file } " on the old name." ;
ARTICLE: "io.files" "Basic file operations"
@@ -267,12 +267,12 @@ HELP: move-file
{ $description "Moves or renames a file." }
{ $errors "Throws an error if the file does not exist or if the move operation fails." } ;
-HELP: move-file-to
+HELP: move-file-into
{ $values { "from" "a pathname string" } { "to" "a directory pathname string" } }
{ $description "Moves a file to another directory without renaming it." }
{ $errors "Throws an error if the file does not exist or if the move operation fails." } ;
-HELP: move-files-to
+HELP: move-files-into
{ $values { "files" "a sequence of pathname strings" } { "to" "a directory pathname string" } }
{ $description "Moves a set of files to another directory." }
{ $errors "Throws an error if the file does not exist or if the move operation fails." } ;
@@ -283,12 +283,12 @@ HELP: copy-file
{ $notes "This operation attempts to preserve the original file's attributes, however not all attributes may be preserved." }
{ $errors "Throws an error if the file does not exist or if the copy operation fails." } ;
-HELP: copy-file-to
+HELP: copy-file-into
{ $values { "from" "a pathname string" } { "to" "a directory pathname string" } }
{ $description "Copies a file to another directory." }
{ $errors "Throws an error if the file does not exist or if the copy operation fails." } ;
-HELP: copy-files-to
+HELP: copy-files-into
{ $values { "files" "a sequence of pathname strings" } { "to" "a directory pathname string" } }
{ $description "Copies a set of files to another directory." }
{ $errors "Throws an error if the file does not exist or if the copy operation fails." } ;
@@ -299,12 +299,12 @@ HELP: copy-tree
{ $notes "This operation attempts to preserve original file attributes, however not all attributes may be preserved." }
{ $errors "Throws an error if the copy operation fails." } ;
-HELP: copy-tree-to
+HELP: copy-tree-into
{ $values { "from" "a pathname string" } { "to" "a directory pathname string" } }
{ $description "Copies a directory tree to another directory, recursively." }
{ $errors "Throws an error if the copy operation fails." } ;
-HELP: copy-trees-to
+HELP: copy-trees-into
{ $values { "files" "a sequence of pathname strings" } { "to" "a directory pathname string" } }
{ $description "Copies a set of directory trees to another directory, recursively." }
{ $errors "Throws an error if the copy operation fails." } ;
diff --git a/core/io/files/files.factor b/core/io/files/files.factor
index 28f23b0de5..b51d767069 100755
--- a/core/io/files/files.factor
+++ b/core/io/files/files.factor
@@ -137,37 +137,37 @@ HOOK: delete-directory io-backend ( path -- )
! Moving and renaming files
HOOK: move-file io-backend ( from to -- )
-: move-file-to ( from to -- )
+: move-file-into ( from to -- )
to-directory move-file ;
-: move-files-to ( files to -- )
- [ move-file-to ] curry each ;
+: move-files-into ( files to -- )
+ [ move-file-into ] curry each ;
! Copying files
HOOK: copy-file io-backend ( from to -- )
-: copy-file-to ( from to -- )
+: copy-file-into ( from to -- )
to-directory copy-file ;
-: copy-files-to ( files to -- )
- [ copy-file-to ] curry each ;
+: copy-files-into ( files to -- )
+ [ copy-file-into ] curry each ;
-DEFER: copy-tree-to
+DEFER: copy-tree-into
: copy-tree ( from to -- )
over directory? [
>r dup directory swap r> [
- >r swap first path+ r> copy-tree-to
+ >r swap first path+ r> copy-tree-into
] 2curry each
] [
copy-file
] if ;
-: copy-tree-to ( from to -- )
+: copy-tree-into ( from to -- )
to-directory copy-tree ;
-: copy-trees-to ( files to -- )
- [ copy-tree-to ] curry each ;
+: copy-trees-into ( files to -- )
+ [ copy-tree-into ] curry each ;
! Special paths
: resource-path ( path -- newpath )
From b1a9ba88068f68434d0a210f8872618c05fbe341 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Sat, 1 Mar 2008 03:01:51 -0600
Subject: [PATCH 24/55] builder.release: refactor and cleanup
---
extra/builder/release/release.factor | 95 +++++++++++-----------------
1 file changed, 37 insertions(+), 58 deletions(-)
diff --git a/extra/builder/release/release.factor b/extra/builder/release/release.factor
index c65241d922..849d1a54a3 100644
--- a/extra/builder/release/release.factor
+++ b/extra/builder/release/release.factor
@@ -1,12 +1,17 @@
-USING: kernel namespaces sequences combinators io.files io.launcher
+USING: kernel system namespaces sequences splitting combinators
+ io.files io.launcher
bake combinators.cleave builder.common builder.util ;
IN: builder.release
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-: releases ( -- path ) builds "/releases" append dup make-directory ;
+: releases ( -- path )
+ builds "releases" path+
+ dup exists? not
+ [ dup make-directory ]
+ when ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -34,8 +39,6 @@ IN: builder.release
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-USING: system sequences splitting ;
-
: cpu- ( -- cpu ) cpu "." split "-" join ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -57,70 +60,46 @@ USING: system sequences splitting ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-: move-file ( source destination -- )
- swap { "mv" , , } bake run-process drop ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: linux-release ( -- )
-
- "factor" cd
-
- { "rm" "-rf" "Factor.app" } run-process drop
-
- { "rm" "-rf" common-files } to-strings run-process drop
-
- ".." cd
-
- { "tar" "-cvzf" archive-name "factor" } to-strings run-process drop
-
- archive-name releases move-file ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: windows-release ( -- )
-
- "factor" cd
-
- { "rm" "-rf" "Factor.app" } run-process drop
-
- { "rm" "-rf" common-files } to-strings run-process drop
-
- ".." cd
-
- { "zip" "-r" archive-name "factor" } to-strings run-process drop
-
- archive-name releases move-file ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: macosx-release ( -- )
-
- "factor" cd
-
- { "rm" "-rf" common-files } to-strings run-process drop
-
- ".." cd
+: windows-archive-cmd ( -- cmd ) { "zip" "-r" archive-name "factor" } ;
+: macosx-archive-cmd ( -- cmd )
{ "hdiutil" "create"
"-srcfolder" "factor"
"-fs" "HFS+"
"-volname" "factor"
- archive-name }
- to-strings run-process drop
+ archive-name } ;
- archive-name releases move-file ;
+: unix-archive-cmd ( -- cmd ) { "tar" "-cvzf" archive-name "factor" } ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+: archive-cmd ( -- cmd )
+ {
+ { [ windows? ] [ windows-archive-cmd ] }
+ { [ macosx? ] [ macosx-archive-cmd ] }
+ { [ unix? ] [ unix-archive-cmd ] }
+ }
+ cond ;
+
+: make-archive ( -- ) archive-cmd to-strings try-process ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: remove-common-files ( -- )
+ { "rm" "-rf" common-files } to-strings try-process ;
+
+: remove-factor-app ( -- )
+ macosx? not [ { "rm" "-rf" "Factor.app" } try-process ] when ;
+
: release ( -- )
- os
- {
- { "linux" [ linux-release ] }
- { "winnt" [ windows-release ] }
- { "macosx" [ macosx-release ] }
- }
- case ;
+ "factor"
+ [
+ remove-factor-app
+ remove-common-files
+ ]
+ with-directory
+ make-archive
+ archive-name releases move-file-into ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
From c3fd171547dfc70edde49072d811f7a61ba53037 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Sat, 1 Mar 2008 04:14:37 -0600
Subject: [PATCH 25/55] bootstrap.image.upload: destination is configurable
fix cwd dependency
---
extra/bootstrap/image/upload/upload.factor | 11 +++++++++--
1 file changed, 9 insertions(+), 2 deletions(-)
diff --git a/extra/bootstrap/image/upload/upload.factor b/extra/bootstrap/image/upload/upload.factor
index 1fa8ee4f41..110547d963 100755
--- a/extra/bootstrap/image/upload/upload.factor
+++ b/extra/bootstrap/image/upload/upload.factor
@@ -4,7 +4,12 @@ IN: bootstrap.image.upload
USING: http.client crypto.md5 splitting assocs kernel io.files
bootstrap.image sequences io namespaces io.launcher math ;
-: destination "slava@factorcode.org:www/images/latest/" ;
+SYMBOL: upload-images-destination
+
+: destination ( -- dest )
+ upload-images-destination get
+ "slava@/var/www/factorcode.org/w/images/latest/"
+ or ;
: checksums "checksums.txt" temp-file ;
@@ -23,6 +28,8 @@ bootstrap.image sequences io namespaces io.launcher math ;
] { } make try-process ;
: new-images ( -- )
- make-images compute-checksums upload-images ;
+ "" resource-path
+ [ make-images compute-checksums upload-images ]
+ with-directory ;
MAIN: new-images
From 29ef99663939d7b661ce04f48d2fcc22a9f67019 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Sat, 1 Mar 2008 07:11:44 -0600
Subject: [PATCH 26/55] Move time related items from unix to unix.time
---
extra/calendar/unix/unix.factor | 4 +++-
extra/io/unix/files/files.factor | 4 ++--
extra/unix/time/time.factor | 32 ++++++++++++++++++++++++++++++++
extra/unix/unix.factor | 26 --------------------------
4 files changed, 37 insertions(+), 29 deletions(-)
create mode 100644 extra/unix/time/time.factor
diff --git a/extra/calendar/unix/unix.factor b/extra/calendar/unix/unix.factor
index 4e1833af06..30e22c487b 100644
--- a/extra/calendar/unix/unix.factor
+++ b/extra/calendar/unix/unix.factor
@@ -1,5 +1,7 @@
+
USING: alien alien.c-types arrays calendar.backend
-kernel structs math unix namespaces ;
+ kernel structs math unix.time namespaces ;
+
IN: calendar.unix
TUPLE: unix-calendar ;
diff --git a/extra/io/unix/files/files.factor b/extra/io/unix/files/files.factor
index a5a4e64c03..db3cf674c7 100755
--- a/extra/io/unix/files/files.factor
+++ b/extra/io/unix/files/files.factor
@@ -1,8 +1,8 @@
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: io.backend io.nonblocking io.unix.backend io.files io
- unix unix.stat kernel math continuations math.bitfields byte-arrays
- alien combinators combinators.cleave calendar ;
+ unix unix.stat unix.time kernel math continuations math.bitfields
+ byte-arrays alien combinators combinators.cleave calendar ;
IN: io.unix.files
diff --git a/extra/unix/time/time.factor b/extra/unix/time/time.factor
new file mode 100644
index 0000000000..460631d9ea
--- /dev/null
+++ b/extra/unix/time/time.factor
@@ -0,0 +1,32 @@
+
+USING: kernel alien.syntax alien.c-types math ;
+
+IN: unix.time
+
+TYPEDEF: uint time_t
+
+C-STRUCT: tm
+ { "int" "sec" } ! Seconds: 0-59 (K&R says 0-61?)
+ { "int" "min" } ! Minutes: 0-59
+ { "int" "hour" } ! Hours since midnight: 0-23
+ { "int" "mday" } ! Day of the month: 1-31
+ { "int" "mon" } ! Months *since* january: 0-11
+ { "int" "year" } ! Years since 1900
+ { "int" "wday" } ! Days since Sunday (0-6)
+ { "int" "yday" } ! Days since Jan. 1: 0-365
+ { "int" "isdst" } ! +1 Daylight Savings Time, 0 No DST,
+ { "long" "gmtoff" } ! Seconds: 0-59 (K&R says 0-61?)
+ { "char*" "zone" } ;
+
+C-STRUCT: timespec
+ { "time_t" "sec" }
+ { "long" "nsec" } ;
+
+: make-timespec ( ms -- timespec )
+ 1000 /mod 1000000 *
+ "timespec" <c-object>
+ [ set-timespec-nsec ] keep
+ [ set-timespec-sec ] keep ;
+
+FUNCTION: time_t time ( time_t* t ) ;
+FUNCTION: tm* localtime ( time_t* clock ) ;
\ No newline at end of file
diff --git a/extra/unix/unix.factor b/extra/unix/unix.factor
index f83120a96f..9cc8552f98 100755
--- a/extra/unix/unix.factor
+++ b/extra/unix/unix.factor
@@ -8,32 +8,8 @@ IN: unix
TYPEDEF: uint in_addr_t
TYPEDEF: uint socklen_t
-TYPEDEF: uint time_t
TYPEDEF: ulong size_t
-C-STRUCT: tm
- { "int" "sec" } ! Seconds: 0-59 (K&R says 0-61?)
- { "int" "min" } ! Minutes: 0-59
- { "int" "hour" } ! Hours since midnight: 0-23
- { "int" "mday" } ! Day of the month: 1-31
- { "int" "mon" } ! Months *since* january: 0-11
- { "int" "year" } ! Years since 1900
- { "int" "wday" } ! Days since Sunday (0-6)
- { "int" "yday" } ! Days since Jan. 1: 0-365
- { "int" "isdst" } ! +1 Daylight Savings Time, 0 No DST,
- { "long" "gmtoff" } ! Seconds: 0-59 (K&R says 0-61?)
- { "char*" "zone" } ;
-
-C-STRUCT: timespec
- { "time_t" "sec" }
- { "long" "nsec" } ;
-
-: make-timespec ( ms -- timespec )
- 1000 /mod 1000000 *
- "timespec" <c-object>
- [ set-timespec-nsec ] keep
- [ set-timespec-sec ] keep ;
-
: PROT_NONE 0 ; inline
: PROT_READ 1 ; inline
: PROT_WRITE 2 ; inline
@@ -89,7 +65,6 @@ FUNCTION: ushort htons ( ushort n ) ;
FUNCTION: int ioctl ( int fd, ulong request, char* argp ) ;
FUNCTION: int lchown ( char* path, uid_t owner, gid_t group ) ;
FUNCTION: int listen ( int s, int backlog ) ;
-FUNCTION: tm* localtime ( time_t* clock ) ;
FUNCTION: off_t lseek ( int fildes, off_t offset, int whence ) ;
FUNCTION: void* mmap ( void* addr, size_t len, int prot, int flags, int fd, off_t offset ) ;
FUNCTION: int munmap ( void* addr, size_t len ) ;
@@ -117,7 +92,6 @@ FUNCTION: int setuid ( uid_t uid ) ;
FUNCTION: int socket ( int domain, int type, int protocol ) ;
FUNCTION: char* strerror ( int errno ) ;
FUNCTION: int system ( char* command ) ;
-FUNCTION: time_t time ( time_t* t ) ;
FUNCTION: int unlink ( char* path ) ;
FUNCTION: int utimes ( char* path, timeval[2] times ) ;
From e5c567c7395599d00ecb7bf63886823fbc81cf74 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Sat, 1 Mar 2008 07:13:22 -0600
Subject: [PATCH 27/55] builder: refactoring
---
extra/builder/builder.factor | 94 ++++++++++++++++++------------------
1 file changed, 46 insertions(+), 48 deletions(-)
diff --git a/extra/builder/builder.factor b/extra/builder/builder.factor
index 2b51f8603e..0d5f4292b7 100644
--- a/extra/builder/builder.factor
+++ b/extra/builder/builder.factor
@@ -39,29 +39,27 @@ IN: builder
: record-git-id ( -- ) git-id "../git-id" [ . ] with-file-writer ;
-: make-clean ( -- desc ) { "make" "clean" } ;
+: do-make-clean ( -- desc ) { "make" "clean" } try-process ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-: target ( -- target ) { os [ cpu "." split ] } to-strings "-" join ;
+! : target ( -- target ) { os [ cpu "." split ] } to-strings "-" join ;
: make-vm ( -- desc )
<process*>
- { "make" target } to-strings >>arguments
- "../compile-log" >>stdout
- +stdout+ >>stderr
+ { "make" } >>arguments
+ "../compile-log" >>stdout
+ +stdout+ >>stderr
>desc ;
+: do-make-vm ( -- )
+ make-vm [ "vm compile error" print "../compile-log" cat ] run-or-bail ;
+
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: copy-image ( -- )
- "../../factor/" my-boot-image-name append
- "../" my-boot-image-name append
- copy-file
-
- "../../factor/" my-boot-image-name append
- my-boot-image-name
- copy-file ;
+ builds "factor" path+ my-boot-image-name path+ ".." copy-file-into
+ builds "factor" path+ my-boot-image-name path+ "." copy-file-into ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -77,6 +75,9 @@ IN: builder
20 minutes >>timeout
>desc ;
+: do-bootstrap ( -- )
+ bootstrap [ "Bootstrap error" print "../boot-log" cat ] run-or-bail ;
+
: builder-test-cmd ( -- cmd )
{ "./factor" "-run=builder.test" } to-strings ;
@@ -89,6 +90,9 @@ IN: builder
45 minutes >>timeout
>desc ;
+: do-builder-test ( -- )
+ builder-test [ "Test error" print "../test-log" 100 cat-n ] run-or-bail ;
+
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SYMBOL: build-status
@@ -101,52 +105,46 @@ SYMBOL: build-status
enter-build-dir
- "report" [
+ "report"
+ [
+ "Build machine: " write host-name print
+ "CPU: " write cpu print
+ "OS: " write os print
+ "Build directory: " write cwd print nl
- "Build machine: " write host-name print
- "CPU: " write cpu print
- "OS: " write os print
- "Build directory: " write cwd print nl
+ git-clone [ "git clone failed" print ] run-or-bail
- git-clone [ "git clone failed" print ] run-or-bail
+ "factor"
+ [
+ record-git-id
+ do-make-clean
+ do-make-vm
+ copy-image
+ do-bootstrap
+ do-builder-test
+ ]
+ with-directory
- "factor" cd
+ "test-log" delete-file
- record-git-id
+ "Boot time: " write "boot-time" eval-file milli-seconds>time print
+ "Load time: " write "load-time" eval-file milli-seconds>time print
+ "Test time: " write "test-time" eval-file milli-seconds>time print nl
- make-clean run-process drop
+ "Did not pass load-everything: " print "load-everything-vocabs" cat
+ "Did not pass test-all: " print "test-all-vocabs" cat
- make-vm [ "vm compile error" print "../compile-log" cat ] run-or-bail
+ "Benchmarks: " print "benchmarks" eval-file benchmarks.
- copy-image
+ nl
- bootstrap [ "Bootstrap error" print "../boot-log" cat ] run-or-bail
+ show-benchmark-deltas
- builder-test [ "Test error" print "../test-log" 100 cat-n ] run-or-bail
+ "benchmarks" ".." copy-file-into
- "../test-log" delete-file
-
- "Boot time: " write "../boot-time" eval-file milli-seconds>time print
- "Load time: " write "../load-time" eval-file milli-seconds>time print
- "Test time: " write "../test-time" eval-file milli-seconds>time print nl
-
- "Did not pass load-everything: " print "../load-everything-vocabs" cat
- "Did not pass test-all: " print "../test-all-vocabs" cat
-
- "Benchmarks: " print
- "../benchmarks" [ stdio get contents eval ] with-file-reader benchmarks.
-
- nl
-
- show-benchmark-deltas
-
- "../benchmarks" "../../benchmarks" copy-file
-
- ".." cd
-
- maybe-release
-
- ] with-file-writer
+ maybe-release
+ ]
+ with-file-writer
build-status on ;
From 7b8a3a7bf54c60b7e0e879b74a6a455dda7a490b Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Sat, 1 Mar 2008 14:23:41 -0600
Subject: [PATCH 28/55] Change socket benchmark
---
extra/benchmark/fib6/fib6.factor | 14 ++++++++
extra/benchmark/sockets/sockets.factor | 50 ++++++++++++++++++--------
2 files changed, 50 insertions(+), 14 deletions(-)
create mode 100755 extra/benchmark/fib6/fib6.factor
diff --git a/extra/benchmark/fib6/fib6.factor b/extra/benchmark/fib6/fib6.factor
new file mode 100755
index 0000000000..cc42028df6
--- /dev/null
+++ b/extra/benchmark/fib6/fib6.factor
@@ -0,0 +1,14 @@
+IN: benchmark.fib6
+USING: math kernel alien ;
+
+: fib
+ "int" { "int" } "cdecl" [
+ dup 1 <= [ drop 1 ] [
+ 1- dup fib swap 1- fib +
+ ] if
+ ] alien-callback
+ "int" { "int" } "cdecl" alien-indirect ;
+
+: fib-main 25 fib drop ;
+
+MAIN: fib-main
diff --git a/extra/benchmark/sockets/sockets.factor b/extra/benchmark/sockets/sockets.factor
index 6b1908afb1..c739bb787c 100755
--- a/extra/benchmark/sockets/sockets.factor
+++ b/extra/benchmark/sockets/sockets.factor
@@ -1,32 +1,54 @@
-USING: io.sockets io.server io kernel math threads
-debugger tools.time prettyprint concurrency.combinators ;
+USING: io.sockets io kernel math threads
+debugger tools.time prettyprint concurrency.count-downs
+namespaces arrays continuations ;
IN: benchmark.sockets
+SYMBOL: counter
+
+: number-of-requests 1 ;
+
+: server-addr "127.0.0.1" 7777 <inet4> ;
+
+: server-loop ( server -- )
+ dup accept [
+ [
+ read1 CHAR: x = [
+ "server" get dispose
+ ] [
+ number-of-requests
+ [ read1 write1 flush ] times
+ counter get count-down
+ ] if
+ ] with-stream
+ ] curry "Client handler" spawn drop server-loop ;
+
: simple-server ( -- )
- 7777 local-server "benchmark.sockets" [
- read1 CHAR: x = [
- stop-server
- ] [
- 20 [ read1 write1 flush ] times
- ] if
- ] with-server ;
+ [
+ server-addr <server> dup "server" set [
+ server-loop
+ ] with-disposal
+ ] ignore-errors ;
: simple-client ( -- )
- "localhost" 7777 <inet> <client> [
+ server-addr <client> [
CHAR: b write1 flush
- 20 [ CHAR: a dup write1 flush read1 assert= ] times
+ number-of-requests
+ [ CHAR: a dup write1 flush read1 assert= ] times
+ counter get count-down
] with-stream ;
: stop-server ( -- )
- "localhost" 7777 <inet> <client> [
+ server-addr <client> [
CHAR: x write1
] with-stream ;
: clients ( n -- )
dup pprint " clients: " write [
- [ simple-server ] in-thread
+ dup 2 * <count-down> counter set
+ [ simple-server ] "Simple server" spawn drop
yield yield
- [ drop simple-client ] parallel-each
+ [ [ simple-client ] "Simple client" spawn drop ] times
+ counter get await
stop-server
yield yield
] time ;
From 52d52fa314d955781046810b5f03310d494cbb45 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Sat, 1 Mar 2008 15:19:51 -0600
Subject: [PATCH 29/55] io.unix.kqueue: fix using
---
extra/io/unix/kqueue/kqueue.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/extra/io/unix/kqueue/kqueue.factor b/extra/io/unix/kqueue/kqueue.factor
index 7b67a9d468..60e3754ec6 100755
--- a/extra/io/unix/kqueue/kqueue.factor
+++ b/extra/io/unix/kqueue/kqueue.factor
@@ -1,7 +1,7 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types kernel io.nonblocking io.unix.backend
-sequences assocs unix unix.kqueue unix.process math namespaces
+sequences assocs unix unix.time unix.kqueue unix.process math namespaces
combinators threads vectors io.launcher
io.unix.launcher ;
IN: io.unix.kqueue
From bec4691d6be394c588c75d90990f84bee9351fbc Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Sat, 1 Mar 2008 15:52:34 -0600
Subject: [PATCH 30/55] Fix for word renamings
---
core/io/files/files-tests.factor | 4 ++--
extra/tools/deploy/windows/windows.factor | 4 ++--
2 files changed, 4 insertions(+), 4 deletions(-)
diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor
index 850a30380b..92cc548d89 100755
--- a/core/io/files/files-tests.factor
+++ b/core/io/files/files-tests.factor
@@ -101,7 +101,7 @@ USING: tools.test io.files io threads kernel continuations ;
[ ] [
"copy-tree-test" temp-file
- "copy-destination" temp-file copy-tree-to
+ "copy-destination" temp-file copy-tree-into
] unit-test
[ "Foobar" ] [
@@ -109,7 +109,7 @@ USING: tools.test io.files io threads kernel continuations ;
] unit-test
[ ] [
- "copy-destination/copy-tree-test/a/b/c/d" temp-file "" temp-file copy-file-to
+ "copy-destination/copy-tree-test/a/b/c/d" temp-file "" temp-file copy-file-into
] unit-test
[ "Foobar" ] [
diff --git a/extra/tools/deploy/windows/windows.factor b/extra/tools/deploy/windows/windows.factor
index fb9e0f815a..6a2ce448af 100755
--- a/extra/tools/deploy/windows/windows.factor
+++ b/extra/tools/deploy/windows/windows.factor
@@ -10,12 +10,12 @@ IN: tools.deploy.windows
vm over copy-file ;
: copy-fonts ( bundle-name -- )
- "fonts/" resource-path swap copy-tree-to ;
+ "fonts/" resource-path swap copy-tree-into ;
: copy-dlls ( bundle-name -- )
{ "freetype6.dll" "zlib1.dll" "factor.dll" }
[ resource-path ] map
- swap copy-files-to ;
+ swap copy-files-into ;
: create-exe-dir ( vocab bundle-name -- vm )
dup copy-dlls
From e98cd1fd593a4628eb0cd17a2a7838fd0274fee6 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Sat, 1 Mar 2008 17:00:45 -0500
Subject: [PATCH 31/55] New convention for unit tests
---
core/alien/alien-tests.factor | 2 +-
core/alien/c-types/c-types-tests.factor | 2 +-
core/alien/compiler/compiler-tests.factor | 2 +-
core/alien/structs/structs-tests.factor | 2 +-
core/arrays/arrays-tests.factor | 2 +-
core/assocs/assocs-tests.factor | 2 +-
core/bit-arrays/bit-arrays-tests.factor | 2 +-
core/bit-vectors/bit-vectors-tests.factor | 2 +-
core/bootstrap/image/image-tests.factor | 2 +-
core/boxes/boxes-tests.factor | 2 +-
core/byte-arrays/byte-arrays-tests.factor | 2 +-
core/byte-vectors/byte-vectors-tests.factor | 2 +-
core/classes/classes-tests.factor | 16 +--
core/combinators/combinators-tests.factor | 2 +-
core/command-line/command-line-tests.factor | 2 +-
core/compiler/tests/curry.factor | 2 +-
core/compiler/tests/float.factor | 2 +-
core/compiler/tests/intrinsics.factor | 2 +-
core/compiler/tests/simple.factor | 2 +-
core/compiler/tests/stack-trace.factor | 2 +-
core/compiler/tests/templates-early.factor | 2 +-
core/compiler/tests/templates.factor | 2 +-
core/compiler/tests/tuples.factor | 2 +-
core/continuations/continuations-tests.factor | 2 +-
core/cpu/arm/assembler/assembler-tests.factor | 2 +-
core/cpu/x86/assembler/assembler-tests.factor | 2 +-
core/debugger/debugger-tests.factor | 2 +-
core/definitions/definitions-tests.factor | 2 +-
core/dlists/dlists-tests.factor | 2 +-
core/effects/effects-tests.factor | 2 +-
core/float-arrays/float-arrays-tests.factor | 2 +-
core/float-vectors/float-vectors-tests.factor | 2 +-
core/generic/generic-tests.factor | 12 +-
core/growable/growable-tests.factor | 2 +-
core/hashtables/hashtables-tests.factor | 2 +-
core/heaps/heaps-tests.factor | 2 +-
core/inference/class/class-tests.factor | 2 +-
core/inference/inference-tests.factor | 2 +-
core/inference/state/state-tests.factor | 2 +-
.../transforms/transforms-tests.factor | 2 +-
core/init/init-tests.factor | 2 +-
core/inspector/inspector-tests.factor | 2 +-
core/io/backend/backend-tests.factor | 2 +-
core/io/binary/binary-tests.factor | 2 +-
core/io/files/files-tests.factor | 2 +-
core/io/io-tests.factor | 4 +-
core/io/streams/c/c-tests.factor | 2 +-
core/io/streams/duplex/duplex-tests.factor | 2 +-
core/io/streams/lines/lines-tests.factor | 2 +-
core/io/streams/nested/nested-tests.factor | 2 +-
core/io/streams/string/string-tests.factor | 2 +-
core/io/test/no-trailing-eol.factor | 2 +-
core/kernel/kernel-tests.factor | 2 +-
core/listener/listener-tests.factor | 4 +-
core/math/bitfields/bitfields-tests.factor | 2 +-
core/math/floats/floats-tests.factor | 2 +-
core/math/integers/integers-tests.factor | 2 +-
core/math/intervals/intervals-tests.factor | 2 +-
core/math/math-tests.factor | 2 +-
core/math/parser/parser-tests.factor | 2 +-
core/memory/memory-tests.factor | 2 +-
core/mirrors/mirrors-tests.factor | 2 +-
core/namespaces/namespaces-tests.factor | 2 +-
core/optimizer/control/control-tests.factor | 2 +-
core/optimizer/def-use/def-use-tests.factor | 2 +-
core/optimizer/optimizer-tests.factor | 2 +-
core/parser/parser-tests.factor | 112 +++++++++---------
core/prettyprint/prettyprint-tests.factor | 34 +++---
core/quotations/quotations-tests.factor | 2 +-
core/sbufs/sbufs-tests.factor | 2 +-
core/sequences/sequences-tests.factor | 2 +-
core/sorting/sorting-tests.factor | 2 +-
core/splitting/splitting-tests.factor | 2 +-
core/strings/strings-tests.factor | 2 +-
core/system/system-tests.factor | 2 +-
core/threads/threads-tests.factor | 2 +-
core/tuples/tuples-tests.factor | 22 ++--
core/vectors/vectors-tests.factor | 2 +-
core/vocabs/loader/loader-tests.factor | 4 +-
core/vocabs/vocabs-tests.factor | 2 +-
core/words/words-tests.factor | 52 ++++----
extra/ascii/ascii-tests.factor | 2 +-
.../reverse-complement-tests.factor | 2 +-
extra/calendar/format/format-tests.factor | 2 +-
extra/channels/channels-tests.factor | 2 +-
extra/channels/remote/remote-tests.factor | 2 +-
extra/cocoa/cocoa-tests.factor | 2 +-
extra/combinators/lib/lib-tests.factor | 2 +-
.../combinators/combinators-tests.factor | 2 +-
.../count-downs/count-downs-tests.factor | 2 +-
.../exchangers/exchangers-tests.factor | 2 +-
extra/concurrency/flags/flags-tests.factor | 2 +-
.../concurrency/futures/futures-tests.factor | 2 +-
extra/concurrency/locks/locks-tests.factor | 2 +-
.../mailboxes/mailboxes-tests.factor | 2 +-
.../messaging/messaging-tests.factor | 2 +-
.../promises/promises-tests.factor | 2 +-
extra/coroutines/coroutines-tests.factor | 2 +-
extra/crypto/hmac/hmac-tests.factor | 2 +-
extra/crypto/timing/timing-tests.factor | 2 +-
extra/crypto/xor/xor-tests.factor | 2 +-
extra/db/postgresql/postgresql-tests.factor | 4 +-
extra/db/sqlite/sqlite-tests.factor | 2 +-
extra/db/tuples/tuples-tests.factor | 2 +-
extra/delegate/delegate-tests.factor | 2 +-
extra/destructors/destructors-tests.factor | 2 +-
extra/documents/documents-tests.factor | 2 +-
extra/farkup/farkup-tests.factor | 2 +-
extra/fjsc/fjsc-tests.factor | 2 +-
extra/fry/fry-tests.factor | 2 +-
extra/furnace/furnace-tests.factor | 2 +-
.../furnace/validator/validator-tests.factor | 2 +-
extra/globs/globs-tests.factor | 2 +-
extra/help/crossref/crossref-tests.factor | 12 +-
.../help/definitions/definitions-tests.factor | 16 +--
extra/help/markup/markup-tests.factor | 2 +-
extra/help/syntax/syntax-tests.factor | 14 +--
extra/help/topics/topics-tests.factor | 2 +-
extra/hexdump/hexdump-tests.factor | 2 +-
extra/html/elements/elements-tests.factor | 2 +-
extra/html/html-tests.factor | 2 +-
extra/html/parser/parser-tests.factor | 2 +-
extra/html/parser/utils/utils-tests.factor | 2 +-
extra/http/http-tests.factor | 2 +-
extra/http/server/server-tests.factor | 2 +-
.../server/templating/templating-tests.factor | 2 +-
extra/io/buffers/buffers-tests.factor | 2 +-
extra/io/launcher/launcher-tests.factor | 2 +-
extra/io/mmap/mmap-tests.factor | 2 +-
extra/io/server/server-tests.factor | 2 +-
extra/io/sockets/impl/impl-tests.factor | 2 +-
extra/io/unix/files/files-tests.factor | 2 +-
extra/io/unix/launcher/launcher-tests.factor | 2 +-
extra/io/unix/unix-tests.factor | 2 +-
extra/io/windows/nt/nt-tests.factor | 2 +-
extra/jamshred/tunnel/tunnel-tests.factor | 2 +-
extra/koszul/koszul-tests.factor | 2 +-
.../lazy-lists/examples/examples-tests.factor | 2 +-
extra/lazy-lists/lazy-lists-tests.factor | 2 +-
extra/levenshtein/levenshtein-tests.factor | 2 +-
extra/lint/lint-tests.factor | 2 +-
extra/locals/locals-tests.factor | 2 +-
extra/macros/macros-tests.factor | 2 +-
extra/match/match-tests.factor | 2 +-
extra/math/analysis/analysis-tests.factor | 2 +-
.../combinatorics/combinatorics-tests.factor | 2 +-
extra/math/complex/complex-tests.factor | 2 +-
extra/math/erato/erato-tests.factor | 2 +-
extra/math/functions/functions-tests.factor | 2 +-
.../elimination/elimination-tests.factor | 2 +-
extra/math/matrices/matrices-tests.factor | 2 +-
.../miller-rabin/miller-rabin-tests.factor | 2 +-
.../numerical-integration-tests.factor | 2 +-
.../math/polynomials/polynomials-tests.factor | 2 +-
.../math/quaternions/quaternions-tests.factor | 2 +-
extra/math/ranges/ranges-tests.factor | 2 +-
extra/math/ratios/ratios-tests.factor | 2 +-
extra/math/statistics/statistics-tests.factor | 2 +-
extra/math/text/english/english-tests.factor | 2 +-
extra/math/vectors/vectors-tests.factor | 2 +-
extra/models/models-tests.factor | 2 +-
extra/money/money-tests.factor | 2 +-
.../multi-methods/multi-methods-tests.factor | 2 +-
.../parser-combinators-tests.factor | 2 +-
.../partial-continuations-tests.factor | 2 +-
extra/peg/ebnf/ebnf-tests.factor | 2 +-
extra/peg/peg-tests.factor | 2 +-
extra/peg/pl0/pl0-tests.factor | 2 +-
extra/peg/search/search-tests.factor | 2 +-
.../porter-stemmer-tests.factor | 2 +-
extra/random/random-tests.factor | 2 +-
extra/sequences/lib/lib-tests.factor | 2 +-
extra/serialize/serialize-tests.factor | 2 +-
extra/smtp/smtp-tests.factor | 2 +-
extra/taxes/taxes-tests.factor | 2 +-
.../annotations/annotations-tests.factor | 4 +-
extra/tools/browser/browser-tests.factor | 2 +-
extra/tools/crossref/crossref-tests.factor | 2 +-
extra/tools/deploy/deploy-tests.factor | 2 +-
extra/tools/memory/memory-tests.factor | 2 +-
extra/tools/profiler/profiler-tests.factor | 2 +-
extra/tools/test/test-docs.factor | 2 +-
extra/tools/test/test.factor | 9 +-
extra/tools/test/tools.factor | 2 +-
extra/tools/walker/walker-tests.factor | 2 +-
extra/trees/avl/avl-tests.factor | 2 +-
extra/trees/splay/splay-tests.factor | 2 +-
extra/trees/trees-tests.factor | 2 +-
extra/tuple-syntax/tuple-syntax-tests.factor | 2 +-
extra/tuples/lib/lib-tests.factor | 2 +-
extra/ui/commands/commands-tests.factor | 2 +-
extra/ui/gadgets/books/books-tests.factor | 2 +-
extra/ui/gadgets/buttons/buttons-tests.factor | 2 +-
extra/ui/gadgets/frames/frames-tests.factor | 2 +-
extra/ui/gadgets/gadgets-tests.factor | 2 +-
extra/ui/gadgets/grids/grids-tests.factor | 2 +-
.../ui/gadgets/labelled/labelled-tests.factor | 2 +-
extra/ui/gadgets/lists/lists-tests.factor | 2 +-
extra/ui/gadgets/packs/packs-tests.factor | 2 +-
extra/ui/gadgets/panes/panes-tests.factor | 2 +-
.../presentations/presentations-tests.factor | 2 +-
.../gadgets/scrollers/scrollers-tests.factor | 2 +-
extra/ui/gadgets/slots/slots-tests.factor | 2 +-
extra/ui/gadgets/tracks/tracks-tests.factor | 2 +-
extra/ui/gadgets/worlds/worlds-tests.factor | 2 +-
extra/ui/operations/operations-tests.factor | 2 +-
extra/ui/tools/browser/browser-tests.factor | 2 +-
.../tools/interactor/interactor-tests.factor | 2 +-
extra/ui/tools/listener/listener-tests.factor | 2 +-
extra/ui/tools/search/search-tests.factor | 2 +-
extra/ui/tools/tools-tests.factor | 2 +-
extra/ui/tools/walker/walker-tests.factor | 2 +-
.../ui/tools/workspace/workspace-tests.factor | 2 +-
extra/ui/traverse/traverse-tests.factor | 2 +-
extra/units/imperial/imperial-tests.factor | 2 +-
extra/units/si/si-tests.factor | 2 +-
extra/units/units-tests.factor | 2 +-
extra/xml/tests/arithmetic.factor | 2 +-
extra/xml/tests/soap.factor | 2 +-
extra/xml/tests/templating.factor | 1 +
extra/xml/tests/test.factor | 2 +-
extra/xmode/catalog/catalog-tests.factor | 2 +-
.../keyword-map/keyword-map-tests.factor | 2 +-
extra/xmode/marker/marker-tests.factor | 2 +-
extra/xmode/rules/rules-tests.factor | 2 +-
extra/xmode/utilities/utilities-tests.factor | 2 +-
226 files changed, 367 insertions(+), 373 deletions(-)
diff --git a/core/alien/alien-tests.factor b/core/alien/alien-tests.factor
index 74c94c8edf..72feca27cd 100755
--- a/core/alien/alien-tests.factor
+++ b/core/alien/alien-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: alien.tests
USING: alien alien.accessors byte-arrays arrays kernel
kernel.private namespaces tools.test sequences libc math system
prettyprint ;
diff --git a/core/alien/c-types/c-types-tests.factor b/core/alien/c-types/c-types-tests.factor
index 719068e031..843b0a826b 100755
--- a/core/alien/c-types/c-types-tests.factor
+++ b/core/alien/c-types/c-types-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: alien.c-types.tests
USING: alien alien.syntax alien.c-types kernel tools.test
sequences system libc ;
diff --git a/core/alien/compiler/compiler-tests.factor b/core/alien/compiler/compiler-tests.factor
index 876310cc5d..7e2e23726b 100755
--- a/core/alien/compiler/compiler-tests.factor
+++ b/core/alien/compiler/compiler-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: alien.compiler.tests
USING: alien alien.c-types alien.syntax compiler kernel
namespaces namespaces tools.test sequences inference words
arrays parser quotations continuations inference.backend effects
diff --git a/core/alien/structs/structs-tests.factor b/core/alien/structs/structs-tests.factor
index b934cd56a3..a33a86d4b5 100644
--- a/core/alien/structs/structs-tests.factor
+++ b/core/alien/structs/structs-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: alien.structs.tests
USING: alien alien.syntax alien.c-types kernel tools.test
sequences system libc words vocabs namespaces ;
diff --git a/core/arrays/arrays-tests.factor b/core/arrays/arrays-tests.factor
index e07f192197..a7801c7d74 100755
--- a/core/arrays/arrays-tests.factor
+++ b/core/arrays/arrays-tests.factor
@@ -1,6 +1,6 @@
USING: arrays kernel sequences sequences.private growable
tools.test vectors layouts system math vectors.private ;
-IN: temporary
+IN: arrays.tests
[ -2 { "a" "b" "c" } nth ] must-fail
[ 10 { "a" "b" "c" } nth ] must-fail
diff --git a/core/assocs/assocs-tests.factor b/core/assocs/assocs-tests.factor
index 8fabee06ef..a0a60e875a 100644
--- a/core/assocs/assocs-tests.factor
+++ b/core/assocs/assocs-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: assocs.tests
USING: kernel math namespaces tools.test vectors sequences
sequences.private hashtables io prettyprint assocs
continuations ;
diff --git a/core/bit-arrays/bit-arrays-tests.factor b/core/bit-arrays/bit-arrays-tests.factor
index 5f89b90608..5774b86e45 100755
--- a/core/bit-arrays/bit-arrays-tests.factor
+++ b/core/bit-arrays/bit-arrays-tests.factor
@@ -1,6 +1,6 @@
USING: sequences arrays bit-arrays kernel tools.test math
random ;
-IN: temporary
+IN: bit-arrays.tests
[ 100 ] [ 100 <bit-array> length ] unit-test
diff --git a/core/bit-vectors/bit-vectors-tests.factor b/core/bit-vectors/bit-vectors-tests.factor
index 5838c1eb8d..dff9a8db37 100755
--- a/core/bit-vectors/bit-vectors-tests.factor
+++ b/core/bit-vectors/bit-vectors-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: bit-vectors.tests
USING: tools.test bit-vectors vectors sequences kernel math ;
[ 0 ] [ 123 <bit-vector> length ] unit-test
diff --git a/core/bootstrap/image/image-tests.factor b/core/bootstrap/image/image-tests.factor
index 8c618a8f30..ae5c66a45c 100755
--- a/core/bootstrap/image/image-tests.factor
+++ b/core/bootstrap/image/image-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: bootstrap.image.tests
USING: bootstrap.image bootstrap.image.private tools.test ;
\ ' must-infer
diff --git a/core/boxes/boxes-tests.factor b/core/boxes/boxes-tests.factor
index 66ee5247ec..76a6cfd8b1 100755
--- a/core/boxes/boxes-tests.factor
+++ b/core/boxes/boxes-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: boxes.tests
USING: boxes namespaces tools.test ;
[ ] [ <box> "b" set ] unit-test
diff --git a/core/byte-arrays/byte-arrays-tests.factor b/core/byte-arrays/byte-arrays-tests.factor
index b5b01c201b..07b82f6111 100755
--- a/core/byte-arrays/byte-arrays-tests.factor
+++ b/core/byte-arrays/byte-arrays-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: byte-arrays.tests
USING: tools.test byte-arrays ;
[ B{ 1 2 3 0 0 0 } ] [ 6 B{ 1 2 3 } resize-byte-array ] unit-test
diff --git a/core/byte-vectors/byte-vectors-tests.factor b/core/byte-vectors/byte-vectors-tests.factor
index 2d9ca1f205..d457d6805e 100755
--- a/core/byte-vectors/byte-vectors-tests.factor
+++ b/core/byte-vectors/byte-vectors-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: byte-vectors.tests
USING: tools.test byte-vectors vectors sequences kernel ;
[ 0 ] [ 123 <byte-vector> length ] unit-test
diff --git a/core/classes/classes-tests.factor b/core/classes/classes-tests.factor
index 103c4eed09..38ca796384 100755
--- a/core/classes/classes-tests.factor
+++ b/core/classes/classes-tests.factor
@@ -3,7 +3,7 @@ kernel math namespaces parser prettyprint sequences strings
tools.test vectors words quotations classes io.streams.string
classes.private classes.union classes.mixin classes.predicate
vectors definitions source-files compiler.units ;
-IN: temporary
+IN: classes.tests
H{ } "s" set
@@ -62,7 +62,7 @@ UNION: bah fixnum alien ;
[ bah ] [ \ bah? "predicating" word-prop ] unit-test
! Test generic see and parsing
-[ "USING: alien math ;\nIN: temporary\nUNION: bah fixnum alien ;\n" ]
+[ "USING: alien math ;\nIN: classes.tests\nUNION: bah fixnum alien ;\n" ]
[ [ \ bah see ] with-string-writer ] unit-test
! Test redefinition of classes
@@ -78,7 +78,7 @@ M: union-1 generic-update-test drop "union-1" ;
[ union-1 ] [ fixnum float class-or ] unit-test
-"IN: temporary USE: math USE: arrays UNION: union-1 rational array ;" eval
+"IN: classes.tests USE: math USE: arrays UNION: union-1 rational array ;" eval
[ t ] [ bignum union-1 class< ] unit-test
[ f ] [ union-1 number class< ] unit-test
@@ -86,7 +86,7 @@ M: union-1 generic-update-test drop "union-1" ;
[ object ] [ fixnum float class-or ] unit-test
-"IN: temporary USE: math PREDICATE: integer union-1 even? ;" eval
+"IN: classes.tests USE: math PREDICATE: integer union-1 even? ;" eval
[ f ] [ union-1 union-class? ] unit-test
[ t ] [ union-1 predicate-class? ] unit-test
@@ -126,7 +126,7 @@ INSTANCE: integer mx1
[ t ] [ mx1 integer class< ] unit-test
[ t ] [ mx1 number class< ] unit-test
-"IN: temporary USE: arrays INSTANCE: array mx1" eval
+"IN: classes.tests USE: arrays INSTANCE: array mx1" eval
[ t ] [ array mx1 class< ] unit-test
[ f ] [ mx1 number class< ] unit-test
@@ -157,7 +157,7 @@ UNION: redefine-bug-2 redefine-bug-1 quotation ;
[ t ] [ quotation redefine-bug-2 class< ] unit-test
[ redefine-bug-2 ] [ fixnum quotation class-or ] unit-test
-[ ] [ "IN: temporary USE: math UNION: redefine-bug-1 bignum ;" eval ] unit-test
+[ ] [ "IN: classes.tests USE: math UNION: redefine-bug-1 bignum ;" eval ] unit-test
[ t ] [ bignum redefine-bug-1 class< ] unit-test
[ f ] [ fixnum redefine-bug-2 class< ] unit-test
@@ -185,7 +185,7 @@ DEFER: mixin-forget-test-g
[ ] [
{
"USING: sequences ;"
- "IN: temporary"
+ "IN: classes.tests"
"MIXIN: mixin-forget-test"
"INSTANCE: sequence mixin-forget-test"
"GENERIC: mixin-forget-test-g ( x -- y )"
@@ -200,7 +200,7 @@ DEFER: mixin-forget-test-g
[ ] [
{
"USING: hashtables ;"
- "IN: temporary"
+ "IN: classes.tests"
"MIXIN: mixin-forget-test"
"INSTANCE: hashtable mixin-forget-test"
"GENERIC: mixin-forget-test-g ( x -- y )"
diff --git a/core/combinators/combinators-tests.factor b/core/combinators/combinators-tests.factor
index ce8e180867..8abc53e43f 100755
--- a/core/combinators/combinators-tests.factor
+++ b/core/combinators/combinators-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: combinators.tests
USING: alien strings kernel math tools.test io prettyprint
namespaces combinators words ;
diff --git a/core/command-line/command-line-tests.factor b/core/command-line/command-line-tests.factor
index c4221b0d06..226765bafe 100644
--- a/core/command-line/command-line-tests.factor
+++ b/core/command-line/command-line-tests.factor
@@ -1,5 +1,5 @@
USING: namespaces tools.test kernel command-line ;
-IN: temporary
+IN: command-line.tests
[
[ f ] [ "-no-user-init" cli-arg ] unit-test
diff --git a/core/compiler/tests/curry.factor b/core/compiler/tests/curry.factor
index 982b3cfb75..d2e7115f8f 100755
--- a/core/compiler/tests/curry.factor
+++ b/core/compiler/tests/curry.factor
@@ -1,6 +1,6 @@
USING: tools.test quotations math kernel sequences
assocs namespaces compiler.units ;
-IN: temporary
+IN: compiler.tests
[ 3 ] [ 5 [ [ 2 - ] curry call ] compile-call ] unit-test
[ 3 ] [ [ 5 [ 2 - ] curry call ] compile-call ] unit-test
diff --git a/core/compiler/tests/float.factor b/core/compiler/tests/float.factor
index 11470f7102..0d457a8310 100755
--- a/core/compiler/tests/float.factor
+++ b/core/compiler/tests/float.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: compiler.tests
USING: compiler.units kernel kernel.private memory math
math.private tools.test math.floats.private ;
diff --git a/core/compiler/tests/intrinsics.factor b/core/compiler/tests/intrinsics.factor
index d1e6f7abf4..dd9a453cfc 100755
--- a/core/compiler/tests/intrinsics.factor
+++ b/core/compiler/tests/intrinsics.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: compiler.tests
USING: arrays compiler.units kernel kernel.private math
math.constants math.private sequences strings tools.test words
continuations sequences.private hashtables.private byte-arrays
diff --git a/core/compiler/tests/simple.factor b/core/compiler/tests/simple.factor
index 7f23e28bec..13b7de6987 100755
--- a/core/compiler/tests/simple.factor
+++ b/core/compiler/tests/simple.factor
@@ -1,7 +1,7 @@
USING: compiler.units tools.test kernel kernel.private
sequences.private math.private math combinators strings
alien arrays memory ;
-IN: temporary
+IN: compiler.tests
! Test empty word
[ ] [ [ ] compile-call ] unit-test
diff --git a/core/compiler/tests/stack-trace.factor b/core/compiler/tests/stack-trace.factor
index 137d86b489..f54ac62204 100755
--- a/core/compiler/tests/stack-trace.factor
+++ b/core/compiler/tests/stack-trace.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: compiler.tests
USING: compiler tools.test namespaces sequences
kernel.private kernel math continuations continuations.private
words splitting sorting ;
diff --git a/core/compiler/tests/templates-early.factor b/core/compiler/tests/templates-early.factor
index 13d834a489..bdbc985078 100755
--- a/core/compiler/tests/templates-early.factor
+++ b/core/compiler/tests/templates-early.factor
@@ -1,5 +1,5 @@
! Testing templates machinery without compiling anything
-IN: temporary
+IN: compiler.tests
USING: compiler generator generator.registers
generator.registers.private tools.test namespaces sequences
words kernel math effects definitions compiler.units ;
diff --git a/core/compiler/tests/templates.factor b/core/compiler/tests/templates.factor
index 4be700f221..1c19730ec0 100755
--- a/core/compiler/tests/templates.factor
+++ b/core/compiler/tests/templates.factor
@@ -4,7 +4,7 @@ hashtables.private math.private namespaces sequences
sequences.private tools.test namespaces.private slots.private
sequences.private byte-arrays alien alien.accessors layouts
words definitions compiler.units io combinators ;
-IN: temporary
+IN: compiler.tests
! Oops!
[ 5000 ] [ [ 5000 ] compile-call ] unit-test
diff --git a/core/compiler/tests/tuples.factor b/core/compiler/tests/tuples.factor
index 7acd599cb8..5843575eeb 100755
--- a/core/compiler/tests/tuples.factor
+++ b/core/compiler/tests/tuples.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: compiler.tests
USING: kernel tools.test compiler.units ;
TUPLE: color red green blue ;
diff --git a/core/continuations/continuations-tests.factor b/core/continuations/continuations-tests.factor
index b7d580afe5..d5ede60086 100755
--- a/core/continuations/continuations-tests.factor
+++ b/core/continuations/continuations-tests.factor
@@ -1,7 +1,7 @@
USING: kernel math namespaces io tools.test sequences vectors
continuations debugger parser memory arrays words
kernel.private ;
-IN: temporary
+IN: continuations.tests
: (callcc1-test)
swap 1- tuck swap ?push
diff --git a/core/cpu/arm/assembler/assembler-tests.factor b/core/cpu/arm/assembler/assembler-tests.factor
index 219015fae9..a30ab9f797 100644
--- a/core/cpu/arm/assembler/assembler-tests.factor
+++ b/core/cpu/arm/assembler/assembler-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: cpu.arm.assembler.tests
USING: assembler-arm math test namespaces sequences kernel
quotations ;
diff --git a/core/cpu/x86/assembler/assembler-tests.factor b/core/cpu/x86/assembler/assembler-tests.factor
index 256bc57578..caa00bd618 100644
--- a/core/cpu/x86/assembler/assembler-tests.factor
+++ b/core/cpu/x86/assembler/assembler-tests.factor
@@ -1,5 +1,5 @@
USING: cpu.x86.assembler kernel tools.test namespaces ;
-IN: temporary
+IN: cpu.x86.assembler.tests
[ { HEX: 49 HEX: 89 HEX: 04 HEX: 24 } ] [ [ R12 [] RAX MOV ] { } make ] unit-test
[ { HEX: 49 HEX: 8b HEX: 06 } ] [ [ RAX R14 [] MOV ] { } make ] unit-test
diff --git a/core/debugger/debugger-tests.factor b/core/debugger/debugger-tests.factor
index 31c3e8a762..afa4aa1c28 100755
--- a/core/debugger/debugger-tests.factor
+++ b/core/debugger/debugger-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: debugger.tests
USING: debugger kernel continuations tools.test ;
[ ] [ [ drop ] [ error. ] recover ] unit-test
diff --git a/core/definitions/definitions-tests.factor b/core/definitions/definitions-tests.factor
index f0b0888052..4e8fb255dd 100755
--- a/core/definitions/definitions-tests.factor
+++ b/core/definitions/definitions-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: definitions.tests
USING: tools.test generic kernel definitions sequences
compiler.units ;
diff --git a/core/dlists/dlists-tests.factor b/core/dlists/dlists-tests.factor
index 203c975bb2..cd651bff2f 100755
--- a/core/dlists/dlists-tests.factor
+++ b/core/dlists/dlists-tests.factor
@@ -1,7 +1,7 @@
USING: dlists dlists.private kernel tools.test random assocs
hashtables sequences namespaces sorting debugger io prettyprint
math ;
-IN: temporary
+IN: dlists.tests
[ t ] [ <dlist> dlist-empty? ] unit-test
diff --git a/core/effects/effects-tests.factor b/core/effects/effects-tests.factor
index 46037ba0d4..234f567f25 100644
--- a/core/effects/effects-tests.factor
+++ b/core/effects/effects-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: effects.tests
USING: effects tools.test ;
[ t ] [ 1 1 <effect> 2 2 <effect> effect<= ] unit-test
diff --git a/core/float-arrays/float-arrays-tests.factor b/core/float-arrays/float-arrays-tests.factor
index 0e0ab3feb6..0918eecd84 100755
--- a/core/float-arrays/float-arrays-tests.factor
+++ b/core/float-arrays/float-arrays-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: float-arrays.tests
USING: float-arrays tools.test ;
[ F{ 1.0 1.0 1.0 } ] [ 3 1.0 <float-array> ] unit-test
diff --git a/core/float-vectors/float-vectors-tests.factor b/core/float-vectors/float-vectors-tests.factor
index 68b8195eb7..383dd4bcf2 100755
--- a/core/float-vectors/float-vectors-tests.factor
+++ b/core/float-vectors/float-vectors-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: float-vectors.tests
USING: tools.test float-vectors vectors sequences kernel ;
[ 0 ] [ 123 <float-vector> length ] unit-test
diff --git a/core/generic/generic-tests.factor b/core/generic/generic-tests.factor
index e3fdbc7b46..2dc699f87b 100755
--- a/core/generic/generic-tests.factor
+++ b/core/generic/generic-tests.factor
@@ -3,7 +3,7 @@ generic.math assocs hashtables io kernel math namespaces parser
prettyprint sequences strings tools.test vectors words
quotations classes continuations layouts classes.union sorting
compiler.units ;
-IN: temporary
+IN: generic.tests
GENERIC: foobar ( x -- y )
M: object foobar drop "Hello world" ;
@@ -87,11 +87,11 @@ M: number union-containment drop 2 ;
[ 2 ] [ 1.0 union-containment ] unit-test
! Testing recovery from bad method definitions
-"IN: temporary GENERIC: unhappy ( x -- x )" eval
+"IN: generic.tests GENERIC: unhappy ( x -- x )" eval
[
- "IN: temporary M: dictionary unhappy ;" eval
+ "IN: generic.tests M: dictionary unhappy ;" eval
] must-fail
-[ ] [ "IN: temporary GENERIC: unhappy ( x -- x )" eval ] unit-test
+[ ] [ "IN: generic.tests GENERIC: unhappy ( x -- x )" eval ] unit-test
GENERIC# complex-combination 1 ( a b -- c )
M: string complex-combination drop ;
@@ -192,12 +192,12 @@ SYMBOL: redefinition-test-generic
TUPLE: redefinition-test-tuple ;
-"IN: temporary M: redefinition-test-tuple redefinition-test-generic ;" eval
+"IN: generic.tests M: redefinition-test-tuple redefinition-test-generic ;" eval
[ t ] [
[
redefinition-test-generic ,
- "IN: temporary TUPLE: redefinition-test-tuple ;" eval
+ "IN: generic.tests TUPLE: redefinition-test-tuple ;" eval
redefinition-test-generic ,
] { } make all-equal?
] unit-test
diff --git a/core/growable/growable-tests.factor b/core/growable/growable-tests.factor
index a220ccc45e..7ba67fe97b 100755
--- a/core/growable/growable-tests.factor
+++ b/core/growable/growable-tests.factor
@@ -1,6 +1,6 @@
USING: math sequences classes growable tools.test kernel
layouts ;
-IN: temporary
+IN: growable.tests
! erg found this one
[ fixnum ] [
diff --git a/core/hashtables/hashtables-tests.factor b/core/hashtables/hashtables-tests.factor
index 31486372f2..a62b306378 100755
--- a/core/hashtables/hashtables-tests.factor
+++ b/core/hashtables/hashtables-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: hashtables.tests
USING: kernel math namespaces tools.test vectors sequences
sequences.private hashtables io prettyprint assocs
continuations ;
diff --git a/core/heaps/heaps-tests.factor b/core/heaps/heaps-tests.factor
index f199ba8837..61e09d894e 100755
--- a/core/heaps/heaps-tests.factor
+++ b/core/heaps/heaps-tests.factor
@@ -3,7 +3,7 @@
USING: arrays kernel math namespaces tools.test
heaps heaps.private math.parser random assocs sequences sorting ;
-IN: temporary
+IN: heaps.tests
[ <min-heap> heap-pop ] must-fail
[ <max-heap> heap-pop ] must-fail
diff --git a/core/inference/class/class-tests.factor b/core/inference/class/class-tests.factor
index 10eae1eb99..df90ac2291 100755
--- a/core/inference/class/class-tests.factor
+++ b/core/inference/class/class-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: inference.class.tests
USING: arrays math.private kernel math compiler inference
inference.dataflow optimizer tools.test kernel.private generic
sequences words inference.class quotations alien
diff --git a/core/inference/inference-tests.factor b/core/inference/inference-tests.factor
index 1fe4b7ae1e..3c12e388c4 100755
--- a/core/inference/inference-tests.factor
+++ b/core/inference/inference-tests.factor
@@ -6,7 +6,7 @@ continuations generic.standard sorting assocs definitions
prettyprint io inspector tuples classes.union classes.predicate
debugger threads.private io.streams.string io.timeouts
io.thread sequences.private ;
-IN: temporary
+IN: inference.tests
{ 0 2 } [ 2 "Hello" ] must-infer-as
{ 1 2 } [ dup ] must-infer-as
diff --git a/core/inference/state/state-tests.factor b/core/inference/state/state-tests.factor
index 02a3c4fde0..84d72bdd9b 100644
--- a/core/inference/state/state-tests.factor
+++ b/core/inference/state/state-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: inference.state.tests
USING: tools.test inference.state words ;
SYMBOL: a
diff --git a/core/inference/transforms/transforms-tests.factor b/core/inference/transforms/transforms-tests.factor
index 0e5c3e231e..88aac780c1 100755
--- a/core/inference/transforms/transforms-tests.factor
+++ b/core/inference/transforms/transforms-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: inference.transforms.tests
USING: sequences inference.transforms tools.test math kernel
quotations inference ;
diff --git a/core/init/init-tests.factor b/core/init/init-tests.factor
index aa7cd0ea58..ce68a1d7ab 100644
--- a/core/init/init-tests.factor
+++ b/core/init/init-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: init.tests
USING: init namespaces sequences math tools.test kernel ;
[ t ] [
diff --git a/core/inspector/inspector-tests.factor b/core/inspector/inspector-tests.factor
index fce0cc0c86..72c1a9a6bf 100644
--- a/core/inspector/inspector-tests.factor
+++ b/core/inspector/inspector-tests.factor
@@ -1,6 +1,6 @@
USING: kernel tools.test math namespaces prettyprint
sequences inspector io.streams.string ;
-IN: temporary
+IN: inspector.tests
[ 1 2 3 ] describe
f describe
diff --git a/core/io/backend/backend-tests.factor b/core/io/backend/backend-tests.factor
index e295cc34dc..04f34068eb 100644
--- a/core/io/backend/backend-tests.factor
+++ b/core/io/backend/backend-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: io.backend.tests
USING: tools.test io.backend kernel ;
[ ] [ "a" normalize-pathname drop ] unit-test
diff --git a/core/io/binary/binary-tests.factor b/core/io/binary/binary-tests.factor
index 69e733b55a..f6d103b0d1 100755
--- a/core/io/binary/binary-tests.factor
+++ b/core/io/binary/binary-tests.factor
@@ -1,5 +1,5 @@
USING: io.binary tools.test ;
-IN: temporary
+IN: io.binary.tests
[ "\0\0\u000004\u0000d2" ] [ 1234 4 >be ] unit-test
[ "\u0000d2\u000004\0\0" ] [ 1234 4 >le ] unit-test
diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor
index 850a30380b..4903f86e4b 100755
--- a/core/io/files/files-tests.factor
+++ b/core/io/files/files-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: io.files.tests
USING: tools.test io.files io threads kernel continuations ;
[ "passwd" ] [ "/etc/passwd" file-name ] unit-test
diff --git a/core/io/io-tests.factor b/core/io/io-tests.factor
index 23686abab5..e3c249ec5d 100644
--- a/core/io/io-tests.factor
+++ b/core/io/io-tests.factor
@@ -1,10 +1,10 @@
USING: arrays io io.files kernel math parser strings system
tools.test words namespaces ;
-IN: temporary
+IN: io.tests
[ f ] [
"resource:/core/io/test/no-trailing-eol.factor" run-file
- "foo" "temporary" lookup
+ "foo" "io.tests" lookup
] unit-test
: <resource-reader> ( resource -- stream )
diff --git a/core/io/streams/c/c-tests.factor b/core/io/streams/c/c-tests.factor
index 16b78c2192..3da9f27646 100755
--- a/core/io/streams/c/c-tests.factor
+++ b/core/io/streams/c/c-tests.factor
@@ -1,5 +1,5 @@
USING: tools.test io.files io io.streams.c ;
-IN: temporary
+IN: io.streams.c.tests
[ "hello world" ] [
"test.txt" temp-file [
diff --git a/core/io/streams/duplex/duplex-tests.factor b/core/io/streams/duplex/duplex-tests.factor
index 44542e05ce..65bad3de41 100755
--- a/core/io/streams/duplex/duplex-tests.factor
+++ b/core/io/streams/duplex/duplex-tests.factor
@@ -1,5 +1,5 @@
USING: io.streams.duplex io kernel continuations tools.test ;
-IN: temporary
+IN: io.streams.duplex.tests
! Test duplex stream close behavior
TUPLE: closing-stream closed? ;
diff --git a/core/io/streams/lines/lines-tests.factor b/core/io/streams/lines/lines-tests.factor
index 64dc7bff3b..e8ecc65526 100755
--- a/core/io/streams/lines/lines-tests.factor
+++ b/core/io/streams/lines/lines-tests.factor
@@ -1,6 +1,6 @@
USING: io.streams.lines io.files io.streams.string io
tools.test kernel ;
-IN: temporary
+IN: io.streams.lines.tests
: <resource-reader> ( resource -- stream )
resource-path <file-reader> ;
diff --git a/core/io/streams/nested/nested-tests.factor b/core/io/streams/nested/nested-tests.factor
index 7b26beb9c6..402cb19c3b 100644
--- a/core/io/streams/nested/nested-tests.factor
+++ b/core/io/streams/nested/nested-tests.factor
@@ -1,3 +1,3 @@
USING: io io.streams.string io.streams.nested kernel math
namespaces io.styles tools.test ;
-IN: temporary
+IN: io.streams.nested.tests
diff --git a/core/io/streams/string/string-tests.factor b/core/io/streams/string/string-tests.factor
index 4bd31fe7d8..ca117534da 100644
--- a/core/io/streams/string/string-tests.factor
+++ b/core/io/streams/string/string-tests.factor
@@ -1,5 +1,5 @@
USING: io.streams.string io kernel arrays namespaces tools.test ;
-IN: temporary
+IN: io.streams.string.tests
[ "line 1" CHAR: l ]
[
diff --git a/core/io/test/no-trailing-eol.factor b/core/io/test/no-trailing-eol.factor
index aa4d8b82d1..959f145bf5 100644
--- a/core/io/test/no-trailing-eol.factor
+++ b/core/io/test/no-trailing-eol.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: io.tests
USE: math
: foo 2 2 + ;
FORGET: foo
\ No newline at end of file
diff --git a/core/kernel/kernel-tests.factor b/core/kernel/kernel-tests.factor
index 2972cb2d5d..3c40984d7a 100755
--- a/core/kernel/kernel-tests.factor
+++ b/core/kernel/kernel-tests.factor
@@ -1,7 +1,7 @@
USING: arrays byte-arrays kernel kernel.private math memory
namespaces sequences tools.test math.private quotations
continuations prettyprint io.streams.string debugger assocs ;
-IN: temporary
+IN: kernel.tests
[ 0 ] [ f size ] unit-test
[ t ] [ [ \ = \ = ] all-equal? ] unit-test
diff --git a/core/listener/listener-tests.factor b/core/listener/listener-tests.factor
index 4570b1162a..71ea6e66c6 100755
--- a/core/listener/listener-tests.factor
+++ b/core/listener/listener-tests.factor
@@ -1,7 +1,7 @@
USING: io io.streams.string io.streams.duplex listener
tools.test parser math namespaces continuations vocabs kernel
compiler.units ;
-IN: temporary
+IN: listener.tests
: hello "Hi" print ; parsing
@@ -45,6 +45,6 @@ IN: temporary
] unit-test
[ ] [
- "IN: temporary : hello\n\"world\" ;" parse-interactive
+ "IN: listener.tests : hello\n\"world\" ;" parse-interactive
drop
] unit-test
diff --git a/core/math/bitfields/bitfields-tests.factor b/core/math/bitfields/bitfields-tests.factor
index a10c0566f8..6dfc51f440 100755
--- a/core/math/bitfields/bitfields-tests.factor
+++ b/core/math/bitfields/bitfields-tests.factor
@@ -1,5 +1,5 @@
USING: math math.bitfields tools.test kernel words ;
-IN: temporary
+IN: math.bitfields.tests
[ 0 ] [ { } bitfield ] unit-test
[ 256 ] [ 1 { 8 } bitfield ] unit-test
diff --git a/core/math/floats/floats-tests.factor b/core/math/floats/floats-tests.factor
index 54a90ef233..095392ed81 100755
--- a/core/math/floats/floats-tests.factor
+++ b/core/math/floats/floats-tests.factor
@@ -1,5 +1,5 @@
USING: kernel math math.constants tools.test sequences ;
-IN: temporary
+IN: math.floats.tests
[ t ] [ 0.0 float? ] unit-test
[ t ] [ 3.1415 number? ] unit-test
diff --git a/core/math/integers/integers-tests.factor b/core/math/integers/integers-tests.factor
index 194edb8f7e..eebc45511a 100755
--- a/core/math/integers/integers-tests.factor
+++ b/core/math/integers/integers-tests.factor
@@ -1,6 +1,6 @@
USING: kernel math namespaces prettyprint
math.private continuations tools.test sequences ;
-IN: temporary
+IN: math.integers.tests
[ "-8" ] [ -8 unparse ] unit-test
diff --git a/core/math/intervals/intervals-tests.factor b/core/math/intervals/intervals-tests.factor
index 2c6ac2ecb0..8e2f47f72b 100755
--- a/core/math/intervals/intervals-tests.factor
+++ b/core/math/intervals/intervals-tests.factor
@@ -1,6 +1,6 @@
USING: math.intervals kernel sequences words math arrays
prettyprint tools.test random vocabs ;
-IN: temporary
+IN: math.intervals.tests
[ T{ interval f { 1 t } { 2 t } } ] [ 1 2 [a,b] ] unit-test
diff --git a/core/math/math-tests.factor b/core/math/math-tests.factor
index c650f7384c..fcd3b929ea 100644
--- a/core/math/math-tests.factor
+++ b/core/math/math-tests.factor
@@ -1,5 +1,5 @@
USING: kernel math namespaces tools.test ;
-IN: temporary
+IN: math.tests
[ ] [ 5 [ ] times ] unit-test
[ ] [ 0 [ ] times ] unit-test
diff --git a/core/math/parser/parser-tests.factor b/core/math/parser/parser-tests.factor
index 226e47090a..baa6634a9f 100755
--- a/core/math/parser/parser-tests.factor
+++ b/core/math/parser/parser-tests.factor
@@ -1,5 +1,5 @@
USING: kernel math math.parser sequences tools.test ;
-IN: temporary
+IN: math.parser.tests
[ f ]
[ f string>number ]
diff --git a/core/memory/memory-tests.factor b/core/memory/memory-tests.factor
index d0dfd2c0be..8808b30c59 100755
--- a/core/memory/memory-tests.factor
+++ b/core/memory/memory-tests.factor
@@ -1,6 +1,6 @@
USING: generic kernel kernel.private math memory prettyprint
sequences tools.test words namespaces layouts classes ;
-IN: temporary
+IN: memory.tests
TUPLE: testing x y z ;
diff --git a/core/mirrors/mirrors-tests.factor b/core/mirrors/mirrors-tests.factor
index 994bb8ef84..863c4baa42 100644
--- a/core/mirrors/mirrors-tests.factor
+++ b/core/mirrors/mirrors-tests.factor
@@ -1,5 +1,5 @@
USING: mirrors tools.test assocs kernel arrays ;
-IN: temporary
+IN: mirrors.tests
TUPLE: foo bar baz ;
diff --git a/core/namespaces/namespaces-tests.factor b/core/namespaces/namespaces-tests.factor
index 07e9d80c9e..8dc065c04a 100644
--- a/core/namespaces/namespaces-tests.factor
+++ b/core/namespaces/namespaces-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: namespaces.tests
USING: kernel namespaces tools.test words ;
H{ } clone "test-namespace" set
diff --git a/core/optimizer/control/control-tests.factor b/core/optimizer/control/control-tests.factor
index b5b52e0e0e..d7638fa66d 100755
--- a/core/optimizer/control/control-tests.factor
+++ b/core/optimizer/control/control-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: optimizer.control.tests
USING: tools.test optimizer.control combinators kernel
sequences inference.dataflow math inference classes strings
optimizer ;
diff --git a/core/optimizer/def-use/def-use-tests.factor b/core/optimizer/def-use/def-use-tests.factor
index 815c564109..d5e8e2d75d 100755
--- a/core/optimizer/def-use/def-use-tests.factor
+++ b/core/optimizer/def-use/def-use-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: optimizer.def-use.tests
USING: inference inference.dataflow optimizer optimizer.def-use
namespaces assocs kernel sequences math tools.test words ;
diff --git a/core/optimizer/optimizer-tests.factor b/core/optimizer/optimizer-tests.factor
index c63787ad52..5116d66715 100755
--- a/core/optimizer/optimizer-tests.factor
+++ b/core/optimizer/optimizer-tests.factor
@@ -3,7 +3,7 @@ kernel.private math optimizer prettyprint sequences sbufs
strings tools.test vectors words sequences.private quotations
optimizer.backend classes inference.dataflow tuples.private
continuations growable optimizer.inlining namespaces hints ;
-IN: temporary
+IN: optimizer.tests
[ H{ { 1 5 } { 3 4 } { 2 5 } } ] [
H{ { 1 2 } { 3 4 } } H{ { 2 5 } } union*
diff --git a/core/parser/parser-tests.factor b/core/parser/parser-tests.factor
index d95e8258be..bfea532242 100755
--- a/core/parser/parser-tests.factor
+++ b/core/parser/parser-tests.factor
@@ -2,7 +2,7 @@ USING: arrays math parser tools.test kernel generic words
io.streams.string namespaces classes effects source-files
assocs sequences strings io.files definitions continuations
sorting tuples compiler.units debugger ;
-IN: temporary
+IN: parser.tests
[
[ 1 [ 2 [ 3 ] 4 ] 5 ]
@@ -23,7 +23,7 @@ IN: temporary
[ "hello world" ]
[
- "IN: temporary : hello \"hello world\" ;"
+ "IN: parser.tests : hello \"hello world\" ;"
eval "USE: temporary hello" eval
] unit-test
@@ -51,7 +51,7 @@ IN: temporary
: effect-parsing-test ( a b -- c ) + ;
[ t ] [
- "effect-parsing-test" "temporary" lookup
+ "effect-parsing-test" "parser.tests" lookup
\ effect-parsing-test eq?
] unit-test
@@ -64,24 +64,24 @@ IN: temporary
[ \ baz "declared-effect" word-prop effect-terminated? ]
unit-test
- [ ] [ "IN: temporary USE: math : effect-parsing-test ( a b -- d ) - ;" eval ] unit-test
+ [ ] [ "IN: parser.tests USE: math : effect-parsing-test ( a b -- d ) - ;" eval ] unit-test
[ t ] [
- "effect-parsing-test" "temporary" lookup
+ "effect-parsing-test" "parser.tests" lookup
\ effect-parsing-test eq?
] unit-test
[ T{ effect f { "a" "b" } { "d" } f } ]
[ \ effect-parsing-test "declared-effect" word-prop ] unit-test
- [ ] [ "IN: temporary : effect-parsing-test ;" eval ] unit-test
+ [ ] [ "IN: parser.tests : effect-parsing-test ;" eval ] unit-test
[ f ] [ \ effect-parsing-test "declared-effect" word-prop ] unit-test
! Funny bug
- [ 2 ] [ "IN: temporary : \0. 2 ; \0." eval ] unit-test
+ [ 2 ] [ "IN: parser.tests : \0. 2 ; \0." eval ] unit-test
- [ "IN: temporary : missing-- ( a b ) ;" eval ] must-fail
+ [ "IN: parser.tests : missing-- ( a b ) ;" eval ] must-fail
! These should throw errors
[ "HEX: zzz" eval ] must-fail
@@ -102,71 +102,71 @@ IN: temporary
] unit-test
DEFER: foo
- "IN: temporary USING: math prettyprint ; : foo 2 2 + . ; parsing" eval
+ "IN: parser.tests USING: math prettyprint ; : foo 2 2 + . ; parsing" eval
[ ] [ "USE: temporary foo" eval ] unit-test
- "IN: temporary USING: math prettyprint ; : foo 2 2 + . ;" eval
+ "IN: parser.tests USING: math prettyprint ; : foo 2 2 + . ;" eval
[ t ] [
"USE: temporary \\ foo" eval
- "foo" "temporary" lookup eq?
+ "foo" "parser.tests" lookup eq?
] unit-test
! Test smudging
[ 1 ] [
- "IN: temporary : smudge-me ;" <string-reader> "foo"
+ "IN: parser.tests : smudge-me ;" <string-reader> "foo"
parse-stream drop
"foo" source-file source-file-definitions first assoc-size
] unit-test
- [ t ] [ "smudge-me" "temporary" lookup >boolean ] unit-test
+ [ t ] [ "smudge-me" "parser.tests" lookup >boolean ] unit-test
[ ] [
- "IN: temporary : smudge-me-more ;" <string-reader> "foo"
+ "IN: parser.tests : smudge-me-more ;" <string-reader> "foo"
parse-stream drop
] unit-test
- [ t ] [ "smudge-me-more" "temporary" lookup >boolean ] unit-test
- [ f ] [ "smudge-me" "temporary" lookup >boolean ] unit-test
+ [ t ] [ "smudge-me-more" "parser.tests" lookup >boolean ] unit-test
+ [ f ] [ "smudge-me" "parser.tests" lookup >boolean ] unit-test
[ 3 ] [
- "IN: temporary USING: math strings ; GENERIC: smudge-me M: integer smudge-me ; M: string smudge-me ;" <string-reader> "foo"
+ "IN: parser.tests USING: math strings ; GENERIC: smudge-me M: integer smudge-me ; M: string smudge-me ;" <string-reader> "foo"
parse-stream drop
"foo" source-file source-file-definitions first assoc-size
] unit-test
[ 1 ] [
- "IN: temporary USING: arrays ; M: array smudge-me ;" <string-reader> "bar"
+ "IN: parser.tests USING: arrays ; M: array smudge-me ;" <string-reader> "bar"
parse-stream drop
"bar" source-file source-file-definitions first assoc-size
] unit-test
[ 2 ] [
- "IN: temporary USING: math strings ; GENERIC: smudge-me M: integer smudge-me ;" <string-reader> "foo"
+ "IN: parser.tests USING: math strings ; GENERIC: smudge-me M: integer smudge-me ;" <string-reader> "foo"
parse-stream drop
"foo" source-file source-file-definitions first assoc-size
] unit-test
[ t ] [
- array "smudge-me" "temporary" lookup order memq?
+ array "smudge-me" "parser.tests" lookup order memq?
] unit-test
[ t ] [
- integer "smudge-me" "temporary" lookup order memq?
+ integer "smudge-me" "parser.tests" lookup order memq?
] unit-test
[ f ] [
- string "smudge-me" "temporary" lookup order memq?
+ string "smudge-me" "parser.tests" lookup order memq?
] unit-test
[ ] [
- "IN: temporary USE: math 2 2 +" <string-reader> "a"
+ "IN: parser.tests USE: math 2 2 +" <string-reader> "a"
parse-stream drop
] unit-test
@@ -175,7 +175,7 @@ IN: temporary
] unit-test
[ ] [
- "IN: temporary USE: math 2 2 -" <string-reader> "a"
+ "IN: parser.tests USE: math 2 2 -" <string-reader> "a"
parse-stream drop
] unit-test
@@ -186,7 +186,7 @@ IN: temporary
[ ] [
"a" source-files get delete-at
2 [
- "IN: temporary DEFER: x : y x ; : x y ;"
+ "IN: parser.tests DEFER: x : y x ; : x y ;"
<string-reader> "a" parse-stream drop
] times
] unit-test
@@ -194,19 +194,19 @@ IN: temporary
"a" source-files get delete-at
[
- "IN: temporary : x ; : y 3 throw ; this is an error"
+ "IN: parser.tests : x ; : y 3 throw ; this is an error"
<string-reader> "a" parse-stream
] [ parse-error? ] must-fail-with
[ t ] [
- "y" "temporary" lookup >boolean
+ "y" "parser.tests" lookup >boolean
] unit-test
[ f ] [
- "IN: temporary : x ;"
+ "IN: parser.tests : x ;"
<string-reader> "a" parse-stream drop
- "y" "temporary" lookup
+ "y" "parser.tests" lookup
] unit-test
! Test new forward definition logic
@@ -269,81 +269,81 @@ IN: temporary
] unit-test
[ ] [
- "IN: temporary : <bogus-error> ; : bogus <bogus-error> ;"
+ "IN: parser.tests : <bogus-error> ; : bogus <bogus-error> ;"
<string-reader> "bogus-error" parse-stream drop
] unit-test
[ ] [
- "IN: temporary TUPLE: bogus-error ; C: <bogus-error> bogus-error : bogus <bogus-error> ;"
+ "IN: parser.tests TUPLE: bogus-error ; C: <bogus-error> bogus-error : bogus <bogus-error> ;"
<string-reader> "bogus-error" parse-stream drop
] unit-test
! Problems with class predicates -vs- ordinary words
[ ] [
- "IN: temporary TUPLE: killer ;"
+ "IN: parser.tests TUPLE: killer ;"
<string-reader> "removing-the-predicate" parse-stream drop
] unit-test
[ ] [
- "IN: temporary GENERIC: killer? ( a -- b )"
+ "IN: parser.tests GENERIC: killer? ( a -- b )"
<string-reader> "removing-the-predicate" parse-stream drop
] unit-test
[ t ] [
- "killer?" "temporary" lookup >boolean
+ "killer?" "parser.tests" lookup >boolean
] unit-test
[
- "IN: temporary TUPLE: another-pred-test ; GENERIC: another-pred-test?"
+ "IN: parser.tests TUPLE: another-pred-test ; GENERIC: another-pred-test?"
<string-reader> "removing-the-predicate" parse-stream
] [ [ redefine-error? ] is? ] must-fail-with
[
- "IN: temporary TUPLE: class-redef-test ; TUPLE: class-redef-test ;"
+ "IN: parser.tests TUPLE: class-redef-test ; TUPLE: class-redef-test ;"
<string-reader> "redefining-a-class-1" parse-stream
] [ [ redefine-error? ] is? ] must-fail-with
[ ] [
- "IN: temporary TUPLE: class-redef-test ; SYMBOL: class-redef-test"
+ "IN: parser.tests TUPLE: class-redef-test ; SYMBOL: class-redef-test"
<string-reader> "redefining-a-class-2" parse-stream drop
] unit-test
[
- "IN: temporary TUPLE: class-redef-test ; SYMBOL: class-redef-test : class-redef-test ;"
+ "IN: parser.tests TUPLE: class-redef-test ; SYMBOL: class-redef-test : class-redef-test ;"
<string-reader> "redefining-a-class-3" parse-stream drop
] [ [ redefine-error? ] is? ] must-fail-with
[ ] [
- "IN: temporary TUPLE: class-fwd-test ;"
+ "IN: parser.tests TUPLE: class-fwd-test ;"
<string-reader> "redefining-a-class-3" parse-stream drop
] unit-test
[
- "IN: temporary \\ class-fwd-test"
+ "IN: parser.tests \\ class-fwd-test"
<string-reader> "redefining-a-class-3" parse-stream drop
] [ [ no-word? ] is? ] must-fail-with
[ ] [
- "IN: temporary TUPLE: class-fwd-test ; SYMBOL: class-fwd-test"
+ "IN: parser.tests TUPLE: class-fwd-test ; SYMBOL: class-fwd-test"
<string-reader> "redefining-a-class-3" parse-stream drop
] unit-test
[
- "IN: temporary \\ class-fwd-test"
+ "IN: parser.tests \\ class-fwd-test"
<string-reader> "redefining-a-class-3" parse-stream drop
] [ [ no-word? ] is? ] must-fail-with
[
- "IN: temporary : foo ; TUPLE: foo ;"
+ "IN: parser.tests : foo ; TUPLE: foo ;"
<string-reader> "redefining-a-class-4" parse-stream drop
] [ [ redefine-error? ] is? ] must-fail-with
[ ] [
- "IN: temporary : foo ( x y -- z ) 1 2 ; : bar ( a -- b ) ;" eval
+ "IN: parser.tests : foo ( x y -- z ) 1 2 ; : bar ( a -- b ) ;" eval
] unit-test
[
- "IN: temporary : foo ( x y -- z) 1 2 ; : bar ( a -- b ) ;" eval
+ "IN: parser.tests : foo ( x y -- z) 1 2 ; : bar ( a -- b ) ;" eval
] must-fail
] with-file-vocabs
@@ -354,7 +354,7 @@ IN: temporary
DEFER: ~b
- "IN: temporary : ~b ~a ;" <string-reader>
+ "IN: parser.tests : ~b ~a ;" <string-reader>
"smudgy" parse-stream drop
: ~c ;
@@ -389,43 +389,43 @@ IN: temporary
] with-scope
[ ] [
- "IN: temporary USE: kernel PREDICATE: object foo ( x -- y ) ;" eval
+ "IN: parser.tests USE: kernel PREDICATE: object foo ( x -- y ) ;" eval
] unit-test
[ t ] [
- "foo?" "temporary" lookup word eq?
+ "foo?" "parser.tests" lookup word eq?
] unit-test
[ ] [
- "IN: temporary TUPLE: foo ; GENERIC: foo"
+ "IN: parser.tests TUPLE: foo ; GENERIC: foo"
<string-reader> "redefining-a-class-5" parse-stream drop
] unit-test
[ ] [
- "IN: temporary M: f foo ;"
+ "IN: parser.tests M: f foo ;"
<string-reader> "redefining-a-class-6" parse-stream drop
] unit-test
-[ f ] [ f "foo" "temporary" lookup execute ] unit-test
+[ f ] [ f "foo" "parser.tests" lookup execute ] unit-test
[ ] [
- "IN: temporary TUPLE: foo ; GENERIC: foo"
+ "IN: parser.tests TUPLE: foo ; GENERIC: foo"
<string-reader> "redefining-a-class-5" parse-stream drop
] unit-test
-[ f ] [ f "foo" "temporary" lookup execute ] unit-test
+[ f ] [ f "foo" "parser.tests" lookup execute ] unit-test
[ ] [
- "IN: temporary TUPLE: foo ; GENERIC: foo"
+ "IN: parser.tests TUPLE: foo ; GENERIC: foo"
<string-reader> "redefining-a-class-7" parse-stream drop
] unit-test
[ ] [
- "IN: temporary TUPLE: foo ;"
+ "IN: parser.tests TUPLE: foo ;"
<string-reader> "redefining-a-class-7" parse-stream drop
] unit-test
-[ t ] [ "foo" "temporary" lookup symbol? ] unit-test
+[ t ] [ "foo" "parser.tests" lookup symbol? ] unit-test
[ "resource:core/parser/test/assert-depth.factor" run-file ]
[ relative-overflow-stack { 1 2 3 } sequence= ]
diff --git a/core/prettyprint/prettyprint-tests.factor b/core/prettyprint/prettyprint-tests.factor
index 32629724bd..6226ddca38 100755
--- a/core/prettyprint/prettyprint-tests.factor
+++ b/core/prettyprint/prettyprint-tests.factor
@@ -3,7 +3,7 @@ kernel math namespaces parser prettyprint prettyprint.config
prettyprint.sections sequences tools.test vectors words
effects splitting generic.standard prettyprint.private
continuations generic compiler.units tools.walker ;
-IN: temporary
+IN: prettyprint.tests
[ "4" ] [ 4 unparse ] unit-test
[ "1.0" ] [ 1.0 unparse ] unit-test
@@ -73,12 +73,12 @@ unit-test
: foo ( a -- b ) dup * ; inline
-[ "USING: kernel math ;\nIN: temporary\n: foo ( a -- b ) dup * ; inline\n" ]
+[ "USING: kernel math ;\nIN: prettyprint.tests\n: foo ( a -- b ) dup * ; inline\n" ]
[ [ \ foo see ] with-string-writer ] unit-test
: bar ( x -- y ) 2 + ;
-[ "USING: math ;\nIN: temporary\n: bar ( x -- y ) 2 + ;\n" ]
+[ "USING: math ;\nIN: prettyprint.tests\n: bar ( x -- y ) 2 + ;\n" ]
[ [ \ bar see ] with-string-writer ] unit-test
: blah
@@ -115,14 +115,14 @@ unit-test
[
[ parse-fresh drop ] with-compilation-unit
[
- "temporary" lookup see
+ "prettyprint.tests" lookup see
] with-string-writer "\n" split 1 head*
] keep =
] with-scope ;
: method-test
{
- "IN: temporary"
+ "IN: prettyprint.tests"
"GENERIC: method-layout"
""
"USING: math temporary ;"
@@ -147,7 +147,7 @@ unit-test
: retain-stack-test
{
"USING: io kernel sequences words ;"
- "IN: temporary"
+ "IN: prettyprint.tests"
": retain-stack-layout ( x -- )"
" dup stream-readln stream-readln"
" >r [ define ] map r>"
@@ -161,7 +161,7 @@ unit-test
: soft-break-test
{
"USING: kernel math sequences strings ;"
- "IN: temporary"
+ "IN: prettyprint.tests"
": soft-break-layout ( x y -- ? )"
" over string? ["
" over hashcode over hashcode number="
@@ -176,7 +176,7 @@ unit-test
: another-retain-layout-test
{
"USING: kernel sequences ;"
- "IN: temporary"
+ "IN: prettyprint.tests"
": another-retain-layout ( seq1 seq2 quot -- newseq )"
" -rot 2dup dupd min-length [ each drop roll ] map"
" >r 3drop r> ; inline"
@@ -189,7 +189,7 @@ unit-test
: another-soft-break-test
{
"USING: namespaces parser sequences ;"
- "IN: temporary"
+ "IN: prettyprint.tests"
": another-soft-break-layout ( node -- quot )"
" parse-error-file"
" [ <reversed> \"hello world foo\" add ] [ ] make ;"
@@ -203,7 +203,7 @@ unit-test
: string-layout
{
"USING: io kernel parser ;"
- "IN: temporary"
+ "IN: prettyprint.tests"
": string-layout-test ( error -- )"
" \"Expected \" write dup unexpected-want expected>string write"
" \" but got \" write unexpected-got expected>string print ;"
@@ -224,7 +224,7 @@ unit-test
: final-soft-break-test
{
"USING: kernel sequences ;"
- "IN: temporary"
+ "IN: prettyprint.tests"
": final-soft-break-layout ( class dim -- view )"
" >r \"alloc\" send 0 0 r>"
" first2 <NSRect>"
@@ -240,7 +240,7 @@ unit-test
: narrow-test
{
"USING: arrays combinators continuations kernel sequences ;"
- "IN: temporary"
+ "IN: prettyprint.tests"
": narrow-layout ( obj -- )"
" {"
" { [ dup continuation? ] [ append ] }"
@@ -255,7 +255,7 @@ unit-test
: another-narrow-test
{
- "IN: temporary"
+ "IN: prettyprint.tests"
": another-narrow-layout ( -- obj )"
" H{"
" { 1 2 }"
@@ -274,10 +274,10 @@ unit-test
: class-see-test
{
- "IN: temporary"
+ "IN: prettyprint.tests"
"TUPLE: class-see-layout ;"
""
- "IN: temporary"
+ "IN: prettyprint.tests"
"GENERIC: class-see-layout ( x -- y )"
""
"USING: temporary ;"
@@ -292,9 +292,9 @@ unit-test
! Regression
[ t ] [
- "IN: temporary\nGENERIC: generic-decl-test ( a -- b ) flushable\n"
+ "IN: prettyprint.tests\nGENERIC: generic-decl-test ( a -- b ) flushable\n"
dup eval
- "generic-decl-test" "temporary" lookup
+ "generic-decl-test" "prettyprint.tests" lookup
[ see ] with-string-writer =
] unit-test
diff --git a/core/quotations/quotations-tests.factor b/core/quotations/quotations-tests.factor
index 90ba150a41..a4c9a619b5 100755
--- a/core/quotations/quotations-tests.factor
+++ b/core/quotations/quotations-tests.factor
@@ -1,5 +1,5 @@
USING: math kernel quotations tools.test sequences ;
-IN: temporary
+IN: quotations.tests
[ [ 3 ] ] [ 3 [ ] curry ] unit-test
[ [ \ + ] ] [ \ + [ ] curry ] unit-test
diff --git a/core/sbufs/sbufs-tests.factor b/core/sbufs/sbufs-tests.factor
index b8d5b3e3fc..b30812b06f 100644
--- a/core/sbufs/sbufs-tests.factor
+++ b/core/sbufs/sbufs-tests.factor
@@ -1,6 +1,6 @@
USING: kernel math namespaces sequences sbufs strings
tools.test classes ;
-IN: temporary
+IN: sbufs.tests
[ 5 ] [ "Hello" >sbuf length ] unit-test
diff --git a/core/sequences/sequences-tests.factor b/core/sequences/sequences-tests.factor
index 40b2fef85e..c545a9baee 100755
--- a/core/sequences/sequences-tests.factor
+++ b/core/sequences/sequences-tests.factor
@@ -1,7 +1,7 @@
USING: arrays kernel math namespaces sequences kernel.private
sequences.private strings sbufs tools.test vectors bit-arrays
generic ;
-IN: temporary
+IN: sequences.tests
[ V{ 1 2 3 4 } ] [ 1 5 dup <slice> >vector ] unit-test
[ 3 ] [ 1 4 dup <slice> length ] unit-test
diff --git a/core/sorting/sorting-tests.factor b/core/sorting/sorting-tests.factor
index d9227b2d95..732aeb045d 100755
--- a/core/sorting/sorting-tests.factor
+++ b/core/sorting/sorting-tests.factor
@@ -1,6 +1,6 @@
USING: sorting sequences kernel math random tools.test
vectors ;
-IN: temporary
+IN: sorting.tests
[ [ ] ] [ [ ] natural-sort ] unit-test
diff --git a/core/splitting/splitting-tests.factor b/core/splitting/splitting-tests.factor
index 2b6107e08b..d60403362c 100644
--- a/core/splitting/splitting-tests.factor
+++ b/core/splitting/splitting-tests.factor
@@ -1,5 +1,5 @@
USING: splitting tools.test ;
-IN: temporary
+IN: splitting.tests
[ { 1 2 3 } 0 group ] must-fail
diff --git a/core/strings/strings-tests.factor b/core/strings/strings-tests.factor
index 1df4e1c477..c971287ef6 100755
--- a/core/strings/strings-tests.factor
+++ b/core/strings/strings-tests.factor
@@ -1,6 +1,6 @@
USING: continuations kernel math namespaces strings sbufs
tools.test sequences vectors arrays ;
-IN: temporary
+IN: strings.tests
[ CHAR: b ] [ 1 >bignum "abc" nth ] unit-test
diff --git a/core/system/system-tests.factor b/core/system/system-tests.factor
index c542e68981..296f542418 100755
--- a/core/system/system-tests.factor
+++ b/core/system/system-tests.factor
@@ -1,5 +1,5 @@
USING: math tools.test system prettyprint ;
-IN: temporary
+IN: system.tests
[ t ] [ cell integer? ] unit-test
[ t ] [ bootstrap-cell integer? ] unit-test
diff --git a/core/threads/threads-tests.factor b/core/threads/threads-tests.factor
index 00306da062..c2e627e7bf 100755
--- a/core/threads/threads-tests.factor
+++ b/core/threads/threads-tests.factor
@@ -1,5 +1,5 @@
USING: namespaces io tools.test threads kernel ;
-IN: temporary
+IN: threads.tests
3 "x" set
namespace [ [ yield 2 "x" set ] bind ] curry "Test" spawn drop
diff --git a/core/tuples/tuples-tests.factor b/core/tuples/tuples-tests.factor
index 8680a3ce61..63bb233654 100755
--- a/core/tuples/tuples-tests.factor
+++ b/core/tuples/tuples-tests.factor
@@ -3,7 +3,7 @@ math.constants parser sequences tools.test words assocs
namespaces quotations sequences.private classes continuations
generic.standard effects tuples tuples.private arrays vectors
strings compiler.units ;
-IN: temporary
+IN: tuples.tests
[ t ] [ \ tuple-class \ class class< ] unit-test
[ f ] [ \ class \ tuple-class class< ] unit-test
@@ -45,19 +45,19 @@ C: <point> point
100 200 <point> "p" set
! Use eval to sequence parsing explicitly
-"IN: temporary TUPLE: point x y z ;" eval
+"IN: tuples.tests TUPLE: point x y z ;" eval
[ 100 ] [ "p" get point-x ] unit-test
[ 200 ] [ "p" get point-y ] unit-test
-[ f ] [ "p" get "point-z" "temporary" lookup execute ] unit-test
+[ f ] [ "p" get "point-z" "tuples.tests" lookup execute ] unit-test
-300 "p" get "set-point-z" "temporary" lookup execute
+300 "p" get "set-point-z" "tuples.tests" lookup execute
-"IN: temporary TUPLE: point z y ;" eval
+"IN: tuples.tests TUPLE: point z y ;" eval
[ "p" get point-x ] must-fail
[ 200 ] [ "p" get point-y ] unit-test
-[ 300 ] [ "p" get "point-z" "temporary" lookup execute ] unit-test
+[ 300 ] [ "p" get "point-z" "tuples.tests" lookup execute ] unit-test
TUPLE: predicate-test ;
@@ -113,7 +113,7 @@ GENERIC: <yo-momma>
TUPLE: yo-momma ;
-"IN: temporary C: <yo-momma> yo-momma" eval
+"IN: tuples.tests C: <yo-momma> yo-momma" eval
[ f ] [ \ <yo-momma> generic? ] unit-test
@@ -202,12 +202,12 @@ M: vector silly "z" ;
SYMBOL: not-a-tuple-class
[
- "IN: temporary C: <not-a-tuple-class> not-a-tuple-class"
+ "IN: tuples.tests C: <not-a-tuple-class> not-a-tuple-class"
eval
] must-fail
[ t ] [
- "not-a-tuple-class" "temporary" lookup symbol?
+ "not-a-tuple-class" "tuples.tests" lookup symbol?
] unit-test
! Missing check
@@ -226,7 +226,7 @@ C: <erg's-reshape-problem> erg's-reshape-problem
{ set-erg's-reshape-problem-a }
\ erg's-reshape-problem construct ;
-"IN: temporary TUPLE: erg's-reshape-problem a b c d e f ;" eval
+"IN: tuples.tests TUPLE: erg's-reshape-problem a b c d e f ;" eval
[ ] [ 1 2 3 4 5 6 cons-test-2 "a" set ] unit-test
@@ -235,7 +235,7 @@ C: <erg's-reshape-problem> erg's-reshape-problem
[ t ] [ 1 cons-test-3 array-capacity "a" get array-capacity = ] unit-test
[
- "IN: temporary SYMBOL: not-a-class C: <not-a-class> not-a-class" eval
+ "IN: tuples.tests SYMBOL: not-a-class C: <not-a-class> not-a-class" eval
] [ [ check-tuple? ] is? ] must-fail-with
! Hardcore unit tests
diff --git a/core/vectors/vectors-tests.factor b/core/vectors/vectors-tests.factor
index b56cee1b34..d990f5f31c 100755
--- a/core/vectors/vectors-tests.factor
+++ b/core/vectors/vectors-tests.factor
@@ -1,7 +1,7 @@
USING: arrays kernel kernel.private math namespaces
sequences sequences.private strings tools.test vectors
continuations random growable classes ;
-IN: temporary
+IN: vectors.tests
[ ] [ 10 [ [ -1000000 <vector> ] ignore-errors ] times ] unit-test
diff --git a/core/vocabs/loader/loader-tests.factor b/core/vocabs/loader/loader-tests.factor
index 3a8fc37583..f99bf94aa4 100755
--- a/core/vocabs/loader/loader-tests.factor
+++ b/core/vocabs/loader/loader-tests.factor
@@ -1,5 +1,5 @@
! Unit tests for vocabs.loader vocabulary
-IN: temporary
+IN: vocabs.loader.tests
USING: vocabs.loader tools.test continuations vocabs math
kernel arrays sequences namespaces io.streams.string
parser source-files words assocs tuples definitions
@@ -31,7 +31,7 @@ IN: vocabs.loader.test.2
MAIN: hello
-IN: temporary
+IN: vocabs.loader.tests
[ { 3 3 3 } ] [
"vocabs.loader.test.2" run
diff --git a/core/vocabs/vocabs-tests.factor b/core/vocabs/vocabs-tests.factor
index 9b05660d9d..21c3668148 100644
--- a/core/vocabs/vocabs-tests.factor
+++ b/core/vocabs/vocabs-tests.factor
@@ -1,5 +1,5 @@
! Unit tests for vocabs vocabulary
USING: vocabs tools.test ;
-IN: temporary
+IN: vocabs.tests
[ f ] [ "kernel" vocab-main ] unit-test
diff --git a/core/words/words-tests.factor b/core/words/words-tests.factor
index 63e30178f5..97ce86d38a 100755
--- a/core/words/words-tests.factor
+++ b/core/words/words-tests.factor
@@ -1,13 +1,13 @@
USING: arrays generic assocs kernel math namespaces
sequences tools.test words definitions parser quotations
vocabs continuations tuples compiler.units io.streams.string ;
-IN: temporary
+IN: words.tests
[ 4 ] [
[
- "poo" "temporary" create [ 2 2 + ] define
+ "poo" "words.tests" create [ 2 2 + ] define
] with-compilation-unit
- "poo" "temporary" lookup execute
+ "poo" "words.tests" lookup execute
] unit-test
[ t ] [ t vocabs [ words [ word? and ] each ] each ] unit-test
@@ -50,7 +50,7 @@ SYMBOL: a-symbol
! See if redefining a generic as a colon def clears some
! word props.
GENERIC: testing
-"IN: temporary : testing ;" eval
+"IN: words.tests : testing ;" eval
[ f ] [ \ testing generic? ] unit-test
@@ -112,13 +112,13 @@ M: array freakish ;
DEFER: x
[ x ] [ undefined? ] must-fail-with
-[ ] [ "no-loc" "temporary" create drop ] unit-test
-[ f ] [ "no-loc" "temporary" lookup where ] unit-test
+[ ] [ "no-loc" "words.tests" create drop ] unit-test
+[ f ] [ "no-loc" "words.tests" lookup where ] unit-test
-[ ] [ "IN: temporary : no-loc-2 ;" eval ] unit-test
-[ f ] [ "no-loc-2" "temporary" lookup where ] unit-test
+[ ] [ "IN: words.tests : no-loc-2 ;" eval ] unit-test
+[ f ] [ "no-loc-2" "words.tests" lookup where ] unit-test
-[ ] [ "IN: temporary : test-last ( -- ) ;" eval ] unit-test
+[ ] [ "IN: words.tests : test-last ( -- ) ;" eval ] unit-test
[ "test-last" ] [ word word-name ] unit-test
! regression
@@ -141,40 +141,40 @@ SYMBOL: quot-uses-b
[ { + } ] [ \ quot-uses-b uses ] unit-test
-[ "IN: temporary : undef-test ; << undef-test >>" eval ]
+[ "IN: words.tests : undef-test ; << undef-test >>" eval ]
[ [ undefined? ] is? ] must-fail-with
[ ] [
- "IN: temporary GENERIC: symbol-generic" eval
+ "IN: words.tests GENERIC: symbol-generic" eval
] unit-test
[ ] [
- "IN: temporary SYMBOL: symbol-generic" eval
+ "IN: words.tests SYMBOL: symbol-generic" eval
] unit-test
-[ t ] [ "symbol-generic" "temporary" lookup symbol? ] unit-test
-[ f ] [ "symbol-generic" "temporary" lookup generic? ] unit-test
+[ t ] [ "symbol-generic" "words.tests" lookup symbol? ] unit-test
+[ f ] [ "symbol-generic" "words.tests" lookup generic? ] unit-test
[ ] [
- "IN: temporary GENERIC: symbol-generic" <string-reader>
+ "IN: words.tests GENERIC: symbol-generic" <string-reader>
"symbol-generic-test" parse-stream drop
] unit-test
[ ] [
- "IN: temporary TUPLE: symbol-generic ;" <string-reader>
+ "IN: words.tests TUPLE: symbol-generic ;" <string-reader>
"symbol-generic-test" parse-stream drop
] unit-test
-[ t ] [ "symbol-generic" "temporary" lookup symbol? ] unit-test
-[ f ] [ "symbol-generic" "temporary" lookup generic? ] unit-test
+[ t ] [ "symbol-generic" "words.tests" lookup symbol? ] unit-test
+[ f ] [ "symbol-generic" "words.tests" lookup generic? ] unit-test
! Regressions
-[ ] [ "IN: temporary : decl-forget-test ; foldable" eval ] unit-test
-[ t ] [ "decl-forget-test" "temporary" lookup "foldable" word-prop ] unit-test
-[ ] [ "IN: temporary : decl-forget-test ;" eval ] unit-test
-[ f ] [ "decl-forget-test" "temporary" lookup "foldable" word-prop ] unit-test
+[ ] [ "IN: words.tests : decl-forget-test ; foldable" eval ] unit-test
+[ t ] [ "decl-forget-test" "words.tests" lookup "foldable" word-prop ] unit-test
+[ ] [ "IN: words.tests : decl-forget-test ;" eval ] unit-test
+[ f ] [ "decl-forget-test" "words.tests" lookup "foldable" word-prop ] unit-test
-[ ] [ "IN: temporary : decl-forget-test ; flushable" eval ] unit-test
-[ t ] [ "decl-forget-test" "temporary" lookup "flushable" word-prop ] unit-test
-[ ] [ "IN: temporary : decl-forget-test ;" eval ] unit-test
-[ f ] [ "decl-forget-test" "temporary" lookup "flushable" word-prop ] unit-test
+[ ] [ "IN: words.tests : decl-forget-test ; flushable" eval ] unit-test
+[ t ] [ "decl-forget-test" "words.tests" lookup "flushable" word-prop ] unit-test
+[ ] [ "IN: words.tests : decl-forget-test ;" eval ] unit-test
+[ f ] [ "decl-forget-test" "words.tests" lookup "flushable" word-prop ] unit-test
diff --git a/extra/ascii/ascii-tests.factor b/extra/ascii/ascii-tests.factor
index ec76d89d7c..b2b13b1d78 100644
--- a/extra/ascii/ascii-tests.factor
+++ b/extra/ascii/ascii-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: ascii.tests
USING: ascii tools.test sequences kernel math ;
[ t ] [ CHAR: a letter? ] unit-test
diff --git a/extra/benchmark/reverse-complement/reverse-complement-tests.factor b/extra/benchmark/reverse-complement/reverse-complement-tests.factor
index c8da5f2c9f..c8d4714802 100755
--- a/extra/benchmark/reverse-complement/reverse-complement-tests.factor
+++ b/extra/benchmark/reverse-complement/reverse-complement-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: benchmark.reverse-complement.tests
USING: tools.test benchmark.reverse-complement crypto.md5
io.files kernel ;
diff --git a/extra/calendar/format/format-tests.factor b/extra/calendar/format/format-tests.factor
index 1f23d4f841..eb32ce5b43 100755
--- a/extra/calendar/format/format-tests.factor
+++ b/extra/calendar/format/format-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: calendar.format.tests
USING: calendar.format tools.test io.streams.string ;
[ 0 ] [
diff --git a/extra/channels/channels-tests.factor b/extra/channels/channels-tests.factor
index 1f2436cf5d..df72572c67 100755
--- a/extra/channels/channels-tests.factor
+++ b/extra/channels/channels-tests.factor
@@ -3,7 +3,7 @@
!
USING: kernel tools.test math channels channels.private
sequences threads sorting ;
-IN: temporary
+IN: channels.tests
{ V{ 10 } } [
V{ } clone <channel>
diff --git a/extra/channels/remote/remote-tests.factor b/extra/channels/remote/remote-tests.factor
index 58a70fbf62..03967c954e 100644
--- a/extra/channels/remote/remote-tests.factor
+++ b/extra/channels/remote/remote-tests.factor
@@ -3,7 +3,7 @@
!
USING: kernel tools.test math assocs channels channels.remote
channels.remote.private ;
-IN: temporary
+IN: channels.remote.tests
{ t } [
remote-channels assoc?
diff --git a/extra/cocoa/cocoa-tests.factor b/extra/cocoa/cocoa-tests.factor
index 44f0b50996..20b7e2a02d 100644
--- a/extra/cocoa/cocoa-tests.factor
+++ b/extra/cocoa/cocoa-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: cocoa.tests
USING: cocoa cocoa.messages cocoa.subclassing cocoa.types
compiler kernel namespaces cocoa.classes tools.test memory
compiler.units ;
diff --git a/extra/combinators/lib/lib-tests.factor b/extra/combinators/lib/lib-tests.factor
index 32fca44eaf..0a08948346 100755
--- a/extra/combinators/lib/lib-tests.factor
+++ b/extra/combinators/lib/lib-tests.factor
@@ -1,6 +1,6 @@
USING: combinators.lib kernel math random sequences tools.test continuations
arrays vectors ;
-IN: temporary
+IN: combinators.lib.tests
[ 5 ] [ [ 10 random ] [ 5 = ] generate ] unit-test
[ t ] [ [ 10 random ] [ even? ] generate even? ] unit-test
diff --git a/extra/concurrency/combinators/combinators-tests.factor b/extra/concurrency/combinators/combinators-tests.factor
index e06b97489b..0f18fcf431 100755
--- a/extra/concurrency/combinators/combinators-tests.factor
+++ b/extra/concurrency/combinators/combinators-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: concurrency.combinators.tests
USING: concurrency.combinators tools.test random kernel math
concurrency.mailboxes threads sequences ;
diff --git a/extra/concurrency/count-downs/count-downs-tests.factor b/extra/concurrency/count-downs/count-downs-tests.factor
index f6bd64234f..649802cd95 100755
--- a/extra/concurrency/count-downs/count-downs-tests.factor
+++ b/extra/concurrency/count-downs/count-downs-tests.factor
@@ -1,5 +1,5 @@
USING: concurrency.count-downs threads kernel tools.test ;
-IN: temporary`
+IN: concurrency.count-downs.tests`
[ ] [ 0 <count-down> await ] unit-test
diff --git a/extra/concurrency/exchangers/exchangers-tests.factor b/extra/concurrency/exchangers/exchangers-tests.factor
index 91338389d1..569b1a72c2 100755
--- a/extra/concurrency/exchangers/exchangers-tests.factor
+++ b/extra/concurrency/exchangers/exchangers-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: concurrency.exchangers.tests
USING: sequences tools.test concurrency.exchangers
concurrency.count-downs concurrency.promises locals kernel
threads ;
diff --git a/extra/concurrency/flags/flags-tests.factor b/extra/concurrency/flags/flags-tests.factor
index 44934b59c4..f23ea95167 100755
--- a/extra/concurrency/flags/flags-tests.factor
+++ b/extra/concurrency/flags/flags-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: concurrency.flags.tests
USING: tools.test concurrency.flags kernel threads locals ;
:: flag-test-1 ( -- )
diff --git a/extra/concurrency/futures/futures-tests.factor b/extra/concurrency/futures/futures-tests.factor
index 39299f9cf7..208a72f820 100755
--- a/extra/concurrency/futures/futures-tests.factor
+++ b/extra/concurrency/futures/futures-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: concurrency.futures.tests
USING: concurrency.futures kernel tools.test threads ;
[ 50 ] [
diff --git a/extra/concurrency/locks/locks-tests.factor b/extra/concurrency/locks/locks-tests.factor
index 806fad6c32..659bd2714e 100755
--- a/extra/concurrency/locks/locks-tests.factor
+++ b/extra/concurrency/locks/locks-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: concurrency.locks.tests
USING: tools.test concurrency.locks concurrency.count-downs
concurrency.messaging concurrency.mailboxes locals kernel
threads sequences calendar ;
diff --git a/extra/concurrency/mailboxes/mailboxes-tests.factor b/extra/concurrency/mailboxes/mailboxes-tests.factor
index 4541d06a5a..24d83b2961 100755
--- a/extra/concurrency/mailboxes/mailboxes-tests.factor
+++ b/extra/concurrency/mailboxes/mailboxes-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: concurrency.mailboxes.tests
USING: concurrency.mailboxes vectors sequences threads
tools.test math kernel strings ;
diff --git a/extra/concurrency/messaging/messaging-tests.factor b/extra/concurrency/messaging/messaging-tests.factor
index 3f6e4e3ed8..6de381b166 100755
--- a/extra/concurrency/messaging/messaging-tests.factor
+++ b/extra/concurrency/messaging/messaging-tests.factor
@@ -4,7 +4,7 @@
USING: kernel threads vectors arrays sequences
namespaces tools.test continuations dlists strings math words
match quotations concurrency.messaging concurrency.mailboxes ;
-IN: temporary
+IN: concurrency.messaging.tests
[ ] [ my-mailbox mailbox-data dlist-delete-all ] unit-test
diff --git a/extra/concurrency/promises/promises-tests.factor b/extra/concurrency/promises/promises-tests.factor
index fa749438d2..36fe4ef907 100755
--- a/extra/concurrency/promises/promises-tests.factor
+++ b/extra/concurrency/promises/promises-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: concurrency.promises.tests
USING: vectors concurrency.promises kernel threads sequences
tools.test ;
diff --git a/extra/coroutines/coroutines-tests.factor b/extra/coroutines/coroutines-tests.factor
index 52b1123265..6710452b22 100644
--- a/extra/coroutines/coroutines-tests.factor
+++ b/extra/coroutines/coroutines-tests.factor
@@ -1,6 +1,6 @@
! Copyright (C) 2005 Chris Double, 2007 Clemens Hofreither.
! See http://factorcode.org/license.txt for BSD license.
-IN: temporary
+IN: coroutines.tests
USING: coroutines kernel sequences prettyprint tools.test math ;
: test1 ( -- co )
diff --git a/extra/crypto/hmac/hmac-tests.factor b/extra/crypto/hmac/hmac-tests.factor
index 64efb96f90..35c99258db 100755
--- a/extra/crypto/hmac/hmac-tests.factor
+++ b/extra/crypto/hmac/hmac-tests.factor
@@ -1,5 +1,5 @@
USING: kernel io strings sequences namespaces math parser crypto.hmac tools.test ;
-IN: temporary
+IN: crypto.hmac.tests
[ "\u000092\u000094rz68\u0000bb\u00001c\u000013\u0000f4\u00008e\u0000f8\u000015\u00008b\u0000fc\u00009d" ] [ 16 11 <string> "Hi There" string>md5-hmac >string ] unit-test
[ "u\u00000cx>j\u0000b0\u0000b5\u000003\u0000ea\u0000a8n1\n]\u0000b78" ] [ "Jefe" "what do ya want for nothing?" string>md5-hmac >string ] unit-test
diff --git a/extra/crypto/timing/timing-tests.factor b/extra/crypto/timing/timing-tests.factor
index 1337ccca8a..9afb913724 100644
--- a/extra/crypto/timing/timing-tests.factor
+++ b/extra/crypto/timing/timing-tests.factor
@@ -1,4 +1,4 @@
USING: crypto.timing kernel tools.test system math ;
-IN: temporary
+IN: crypto.timing.tests
[ t ] [ millis [ ] 1000 with-timing millis swap - 1000 >= ] unit-test
diff --git a/extra/crypto/xor/xor-tests.factor b/extra/crypto/xor/xor-tests.factor
index 2a6fd525e0..ef781b9f25 100644
--- a/extra/crypto/xor/xor-tests.factor
+++ b/extra/crypto/xor/xor-tests.factor
@@ -1,5 +1,5 @@
USING: continuations crypto.xor kernel strings tools.test ;
-IN: temporary
+IN: crypto.xor.tests
! No key
[ "" dup xor-crypt ] [ T{ no-xor-key f } = ] must-fail-with
diff --git a/extra/db/postgresql/postgresql-tests.factor b/extra/db/postgresql/postgresql-tests.factor
index 7ea2bb629a..250f98f73e 100755
--- a/extra/db/postgresql/postgresql-tests.factor
+++ b/extra/db/postgresql/postgresql-tests.factor
@@ -4,12 +4,10 @@
USING: kernel db.postgresql alien continuations io classes
prettyprint sequences namespaces tools.test db
db.tuples db.types unicode.case ;
-IN: temporary
+IN: db.postgresql.tests
-IN: scratchpad
: test-db ( -- postgresql-db )
{ "localhost" "postgres" "" "factor-test" } postgresql-db ;
-IN: temporary
[ ] [ test-db [ ] with-db ] unit-test
diff --git a/extra/db/sqlite/sqlite-tests.factor b/extra/db/sqlite/sqlite-tests.factor
index 6c4b65ff9f..974fdb8782 100755
--- a/extra/db/sqlite/sqlite-tests.factor
+++ b/extra/db/sqlite/sqlite-tests.factor
@@ -1,7 +1,7 @@
USING: io io.files io.launcher kernel namespaces
prettyprint tools.test db.sqlite db sequences
continuations db.types db.tuples unicode.case ;
-IN: temporary
+IN: db.sqlite.tests
: test.db "extra/db/sqlite/test.db" resource-path ;
diff --git a/extra/db/tuples/tuples-tests.factor b/extra/db/tuples/tuples-tests.factor
index c9e6d302e0..aa94bbfbb6 100755
--- a/extra/db/tuples/tuples-tests.factor
+++ b/extra/db/tuples/tuples-tests.factor
@@ -3,7 +3,7 @@
USING: io.files kernel tools.test db db.tuples
db.types continuations namespaces db.postgresql math
prettyprint tools.walker db.sqlite ;
-IN: temporary
+IN: db.tuples.tests
TUPLE: person the-id the-name the-number the-real ;
: <person> ( name age real -- person )
diff --git a/extra/delegate/delegate-tests.factor b/extra/delegate/delegate-tests.factor
index dd9a77aa21..d66357daa5 100644
--- a/extra/delegate/delegate-tests.factor
+++ b/extra/delegate/delegate-tests.factor
@@ -1,5 +1,5 @@
USING: delegate kernel arrays tools.test ;
-IN: temporary
+IN: delegate.tests
TUPLE: hello this that ;
C: <hello> hello
diff --git a/extra/destructors/destructors-tests.factor b/extra/destructors/destructors-tests.factor
index db4f023dad..09b4ccc357 100755
--- a/extra/destructors/destructors-tests.factor
+++ b/extra/destructors/destructors-tests.factor
@@ -1,5 +1,5 @@
USING: destructors kernel tools.test continuations ;
-IN: temporary
+IN: destructors.tests
TUPLE: dummy-obj destroyed? ;
diff --git a/extra/documents/documents-tests.factor b/extra/documents/documents-tests.factor
index dfa24c6cea..e09afebfc2 100644
--- a/extra/documents/documents-tests.factor
+++ b/extra/documents/documents-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: documents.tests
USING: documents namespaces tools.test ;
! Tests
diff --git a/extra/farkup/farkup-tests.factor b/extra/farkup/farkup-tests.factor
index db11833cf1..8ac2686718 100644
--- a/extra/farkup/farkup-tests.factor
+++ b/extra/farkup/farkup-tests.factor
@@ -1,5 +1,5 @@
USING: farkup kernel tools.test ;
-IN: temporary
+IN: farkup.tests
[ "<ul><li>foo</li></ul>" ] [ "-foo" parse-farkup ] unit-test
[ "<ul><li>foo</li></ul>\n" ] [ "-foo\n" parse-farkup ] unit-test
diff --git a/extra/fjsc/fjsc-tests.factor b/extra/fjsc/fjsc-tests.factor
index ccb004581a..ce968128be 100755
--- a/extra/fjsc/fjsc-tests.factor
+++ b/extra/fjsc/fjsc-tests.factor
@@ -1,7 +1,7 @@
! Copyright (C) 2006 Chris Double. All Rights Reserved.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel tools.test peg fjsc ;
-IN: temporary
+IN: fjsc.tests
{ T{ ast-expression f V{ T{ ast-number f 55 } T{ ast-identifier f "2abc1" } T{ ast-number f 100 } } } } [
"55 2abc1 100" 'expression' parse parse-result-ast
diff --git a/extra/fry/fry-tests.factor b/extra/fry/fry-tests.factor
index fd21a4a4cd..e1ef40b44d 100755
--- a/extra/fry/fry-tests.factor
+++ b/extra/fry/fry-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: fry.tests
USING: fry tools.test math prettyprint kernel io arrays
sequences ;
diff --git a/extra/furnace/furnace-tests.factor b/extra/furnace/furnace-tests.factor
index 4afbd653bd..84ec798df2 100644
--- a/extra/furnace/furnace-tests.factor
+++ b/extra/furnace/furnace-tests.factor
@@ -1,5 +1,5 @@
USING: kernel sequences namespaces math tools.test furnace furnace.validator ;
-IN: temporary
+IN: furnace.tests
TUPLE: test-tuple m n ;
diff --git a/extra/furnace/validator/validator-tests.factor b/extra/furnace/validator/validator-tests.factor
index 06d8ac815d..e84e57be6a 100644
--- a/extra/furnace/validator/validator-tests.factor
+++ b/extra/furnace/validator/validator-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: furnace.validator.tests
USING: kernel sequences tools.test furnace.validator furnace ;
[
diff --git a/extra/globs/globs-tests.factor b/extra/globs/globs-tests.factor
index 8021128810..446f1ee0a9 100644
--- a/extra/globs/globs-tests.factor
+++ b/extra/globs/globs-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: globs.tests
USING: tools.test globs ;
[ f ] [ "abd" "fdf" glob-matches? ] unit-test
diff --git a/extra/help/crossref/crossref-tests.factor b/extra/help/crossref/crossref-tests.factor
index eb30965f6a..1d569d8a8f 100755
--- a/extra/help/crossref/crossref-tests.factor
+++ b/extra/help/crossref/crossref-tests.factor
@@ -1,10 +1,10 @@
-IN: temporary
+IN: help.crossref.tests
USING: help.crossref help.topics help.markup tools.test words
definitions assocs sequences kernel namespaces parser arrays
io.streams.string continuations debugger compiler.units ;
[ ] [
- "IN: temporary USING: help.syntax help.markup ; : foo ; HELP: foo \"foo is great\" ; ARTICLE: \"foo\" \"Foo\" { $subsection foo } ;" eval
+ "IN: help.crossref.tests USING: help.syntax help.markup ; : foo ; HELP: foo \"foo is great\" ; ARTICLE: \"foo\" \"Foo\" { $subsection foo } ;" eval
] unit-test
[ $subsection ] [
@@ -13,17 +13,17 @@ io.streams.string continuations debugger compiler.units ;
[ t ] [
"foo" article-children
- "foo" "temporary" lookup 1array sequence=
+ "foo" "help.crossref.tests" lookup 1array sequence=
] unit-test
-[ "foo" ] [ "foo" "temporary" lookup article-parent ] unit-test
+[ "foo" ] [ "foo" "help.crossref.tests" lookup article-parent ] unit-test
[ ] [
- [ "foo" "temporary" lookup forget ] with-compilation-unit
+ [ "foo" "help.crossref.tests" lookup forget ] with-compilation-unit
] unit-test
[ ] [
- "IN: temporary USING: help.syntax help.markup ; : bar ; HELP: bar \"bar is great\" ; ARTICLE: \"bar\" \"Bar\" { $subsection bar } ;" eval
+ "IN: help.crossref.tests USING: help.syntax help.markup ; : bar ; HELP: bar \"bar is great\" ; ARTICLE: \"bar\" \"Bar\" { $subsection bar } ;" eval
] unit-test
[ ] [
diff --git a/extra/help/definitions/definitions-tests.factor b/extra/help/definitions/definitions-tests.factor
index 836f82a306..921d8e1c69 100755
--- a/extra/help/definitions/definitions-tests.factor
+++ b/extra/help/definitions/definitions-tests.factor
@@ -1,13 +1,13 @@
USING: math definitions help.topics help tools.test
prettyprint parser io.streams.string kernel source-files
assocs namespaces words io sequences ;
-IN: temporary
+IN: help.definitions.tests
[ ] [ \ + >link see ] unit-test
[
[ 4 ] [
- "IN: temporary USING: help.syntax ; : hello ; HELP: hello \"test\" ; ARTICLE: \"hello\" \"world\" ; ARTICLE: \"hello2\" \"world\" ;" <string-reader> "foo"
+ "IN: help.definitions.tests USING: help.syntax ; : hello ; HELP: hello \"test\" ; ARTICLE: \"hello\" \"world\" ; ARTICLE: \"hello2\" \"world\" ;" <string-reader> "foo"
parse-stream drop
"foo" source-file source-file-definitions first assoc-size
@@ -16,11 +16,11 @@ IN: temporary
[ t ] [ "hello" articles get key? ] unit-test
[ t ] [ "hello2" articles get key? ] unit-test
[ t ] [
- "hello" "temporary" lookup "help" word-prop >boolean
+ "hello" "help.definitions" lookup "help" word-prop >boolean
] unit-test
[ 2 ] [
- "IN: temporary USING: help.syntax ; : hello ; ARTICLE: \"hello\" \"world\" ;" <string-reader> "foo"
+ "IN: help.definitions.tests USING: help.syntax ; : hello ; ARTICLE: \"hello\" \"world\" ;" <string-reader> "foo"
parse-stream drop
"foo" source-file source-file-definitions first assoc-size
@@ -29,12 +29,12 @@ IN: temporary
[ t ] [ "hello" articles get key? ] unit-test
[ f ] [ "hello2" articles get key? ] unit-test
[ f ] [
- "hello" "temporary" lookup "help" word-prop
+ "hello" "help.definitions" lookup "help" word-prop
] unit-test
- [ ] [ "IN: temporary USING: help.syntax ; : xxx ; HELP: xxx ;" eval ] unit-test
+ [ ] [ "IN: help.definitions.tests USING: help.syntax ; : xxx ; HELP: xxx ;" eval ] unit-test
- [ ] [ "xxx" "temporary" lookup help ] unit-test
+ [ ] [ "xxx" "help.definitions" lookup help ] unit-test
- [ ] [ "xxx" "temporary" lookup >link synopsis print ] unit-test
+ [ ] [ "xxx" "help.definitions" lookup >link synopsis print ] unit-test
] with-file-vocabs
diff --git a/extra/help/markup/markup-tests.factor b/extra/help/markup/markup-tests.factor
index 71a9b54760..0b4b69bf59 100644
--- a/extra/help/markup/markup-tests.factor
+++ b/extra/help/markup/markup-tests.factor
@@ -1,6 +1,6 @@
USING: definitions help help.markup kernel sequences tools.test
words parser namespaces assocs generic io.streams.string ;
-IN: temporary
+IN: help.markup.tests
TUPLE: blahblah quux ;
diff --git a/extra/help/syntax/syntax-tests.factor b/extra/help/syntax/syntax-tests.factor
index 136313c2ef..038d7fa490 100755
--- a/extra/help/syntax/syntax-tests.factor
+++ b/extra/help/syntax/syntax-tests.factor
@@ -1,21 +1,21 @@
-IN: temporary
+IN: help.syntax.tests
USING: tools.test parser vocabs help.syntax namespaces ;
[
[ "foobar" ] [
- "IN: temporary USE: help.syntax ABOUT: \"foobar\"" eval
- "temporary" vocab vocab-help
+ "IN: help.syntax.tests USE: help.syntax ABOUT: \"foobar\"" eval
+ "help.syntax" vocab vocab-help
] unit-test
[ { "foobar" } ] [
- "IN: temporary USE: help.syntax ABOUT: { \"foobar\" }" eval
- "temporary" vocab vocab-help
+ "IN: help.syntax.tests USE: help.syntax ABOUT: { \"foobar\" }" eval
+ "help.syntax" vocab vocab-help
] unit-test
SYMBOL: xyz
[ xyz ] [
- "IN: temporary USE: help.syntax ABOUT: xyz" eval
- "temporary" vocab vocab-help
+ "IN: help.syntax.tests USE: help.syntax ABOUT: xyz" eval
+ "help.syntax" vocab vocab-help
] unit-test
] with-file-vocabs
diff --git a/extra/help/topics/topics-tests.factor b/extra/help/topics/topics-tests.factor
index c4c22b551f..1099f747bc 100644
--- a/extra/help/topics/topics-tests.factor
+++ b/extra/help/topics/topics-tests.factor
@@ -1,7 +1,7 @@
USING: definitions help help.topics help.crossref help.markup
help.syntax kernel sequences tools.test words parser namespaces
assocs source-files ;
-IN: temporary
+IN: help.topics.tests
! Test help cross-referencing
diff --git a/extra/hexdump/hexdump-tests.factor b/extra/hexdump/hexdump-tests.factor
index 3ddfe721a6..7fb26e10c5 100644
--- a/extra/hexdump/hexdump-tests.factor
+++ b/extra/hexdump/hexdump-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: hexdump.tests
USING: hexdump kernel sequences tools.test ;
[ t ] [ "" hexdump "Length: 0, 0h\n" = ] unit-test
diff --git a/extra/html/elements/elements-tests.factor b/extra/html/elements/elements-tests.factor
index aab00e0ca3..aa6a017540 100644
--- a/extra/html/elements/elements-tests.factor
+++ b/extra/html/elements/elements-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: html.elements.tests
USING: tools.test html html.elements io.streams.string ;
: make-html-string
diff --git a/extra/html/html-tests.factor b/extra/html/html-tests.factor
index 4e3344855f..2994e2d792 100644
--- a/extra/html/html-tests.factor
+++ b/extra/html/html-tests.factor
@@ -1,6 +1,6 @@
USING: html http io io.streams.string io.styles kernel
namespaces tools.test xml.writer sbufs sequences html.private ;
-IN: temporary
+IN: html.tests
: make-html-string
[ with-html-stream ] with-string-writer ;
diff --git a/extra/html/parser/parser-tests.factor b/extra/html/parser/parser-tests.factor
index c490b737d9..0e98c1b998 100644
--- a/extra/html/parser/parser-tests.factor
+++ b/extra/html/parser/parser-tests.factor
@@ -1,5 +1,5 @@
USING: html.parser kernel tools.test ;
-IN: temporary
+IN: html.parser.tests
[
V{ T{ tag f "html" H{ } f f f } }
diff --git a/extra/html/parser/utils/utils-tests.factor b/extra/html/parser/utils/utils-tests.factor
index fcac31a6aa..4b25db16fd 100644
--- a/extra/html/parser/utils/utils-tests.factor
+++ b/extra/html/parser/utils/utils-tests.factor
@@ -3,7 +3,7 @@ hashtables.private io kernel math
namespaces prettyprint quotations sequences splitting
state-parser strings tools.test ;
USING: html.parser.utils ;
-IN: temporary
+IN: html.parser.utils.tests
[ "'Rome'" ] [ "Rome" single-quote ] unit-test
[ "\"Roma\"" ] [ "Roma" double-quote ] unit-test
diff --git a/extra/http/http-tests.factor b/extra/http/http-tests.factor
index 5146502644..0a4941aaa0 100644
--- a/extra/http/http-tests.factor
+++ b/extra/http/http-tests.factor
@@ -1,5 +1,5 @@
USING: http tools.test ;
-IN: temporary
+IN: http.tests
[ "hello%20world" ] [ "hello world" url-encode ] unit-test
[ "hello world" ] [ "hello%20world" url-decode ] unit-test
diff --git a/extra/http/server/server-tests.factor b/extra/http/server/server-tests.factor
index 18edd94f12..627d7d889d 100755
--- a/extra/http/server/server-tests.factor
+++ b/extra/http/server/server-tests.factor
@@ -1,7 +1,7 @@
USING: webapps.file http.server.responders http
http.server namespaces io tools.test strings io.server
logging ;
-IN: temporary
+IN: http.server.tests
[ ] [ f [ "404 not found" httpd-error ] with-logging ] unit-test
diff --git a/extra/http/server/templating/templating-tests.factor b/extra/http/server/templating/templating-tests.factor
index d889cd848a..ceb2ed95be 100644
--- a/extra/http/server/templating/templating-tests.factor
+++ b/extra/http/server/templating/templating-tests.factor
@@ -1,6 +1,6 @@
USING: io io.files io.streams.string http.server.templating kernel tools.test
sequences ;
-IN: temporary
+IN: http.server.templating.tests
: test-template ( path -- ? )
"extra/http/server/templating/test/" swap append
diff --git a/extra/io/buffers/buffers-tests.factor b/extra/io/buffers/buffers-tests.factor
index c9203d9ef8..2260bf5882 100755
--- a/extra/io/buffers/buffers-tests.factor
+++ b/extra/io/buffers/buffers-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: io.buffers.tests
USING: alien alien.c-types io.buffers kernel kernel.private libc
sequences tools.test namespaces ;
diff --git a/extra/io/launcher/launcher-tests.factor b/extra/io/launcher/launcher-tests.factor
index 6705caa33c..bacb8eb5a9 100755
--- a/extra/io/launcher/launcher-tests.factor
+++ b/extra/io/launcher/launcher-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: io.launcher.tests
USING: tools.test io.launcher ;
\ <process-stream> must-infer
diff --git a/extra/io/mmap/mmap-tests.factor b/extra/io/mmap/mmap-tests.factor
index 25caae036d..832b88b248 100644
--- a/extra/io/mmap/mmap-tests.factor
+++ b/extra/io/mmap/mmap-tests.factor
@@ -1,5 +1,5 @@
USING: io io.mmap io.files kernel tools.test continuations sequences ;
-IN: temporary
+IN: io.mmap.tests
[ "mmap-test-file.txt" resource-path delete-file ] ignore-errors
[ ] [ "mmap-test-file.txt" resource-path [ "12345" write ] with-file-writer ] unit-test
diff --git a/extra/io/server/server-tests.factor b/extra/io/server/server-tests.factor
index 24b4c231d1..8e56169bb3 100755
--- a/extra/io/server/server-tests.factor
+++ b/extra/io/server/server-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: io.server.tests
USING: tools.test io.server io.server.private ;
{ 1 0 } [ [ ] server-loop ] must-infer-as
diff --git a/extra/io/sockets/impl/impl-tests.factor b/extra/io/sockets/impl/impl-tests.factor
index 51305db45c..6b930a994e 100644
--- a/extra/io/sockets/impl/impl-tests.factor
+++ b/extra/io/sockets/impl/impl-tests.factor
@@ -1,5 +1,5 @@
USING: io.sockets.impl io.sockets kernel tools.test ;
-IN: temporary
+IN: io.sockets.impl.tests
[ B{ 1 2 3 4 } ]
[ "1.2.3.4" T{ inet4 } inet-pton ] unit-test
diff --git a/extra/io/unix/files/files-tests.factor b/extra/io/unix/files/files-tests.factor
index 103c2789c6..f5366d32ae 100755
--- a/extra/io/unix/files/files-tests.factor
+++ b/extra/io/unix/files/files-tests.factor
@@ -1,5 +1,5 @@
USING: tools.test io.files ;
-IN: temporary
+IN: io.unix.files.tests
[ "/usr/libexec/" ] [ "/usr/libexec/awk/" parent-directory ] unit-test
[ "/etc/" ] [ "/etc/passwd" parent-directory ] unit-test
diff --git a/extra/io/unix/launcher/launcher-tests.factor b/extra/io/unix/launcher/launcher-tests.factor
index eb3038e1b5..7b2a7848fc 100755
--- a/extra/io/unix/launcher/launcher-tests.factor
+++ b/extra/io/unix/launcher/launcher-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: io.unix.launcher.tests
USING: io.unix.launcher tools.test ;
[ "" tokenize-command ] must-fail
diff --git a/extra/io/unix/unix-tests.factor b/extra/io/unix/unix-tests.factor
index af7417854e..680cb0b3e5 100755
--- a/extra/io/unix/unix-tests.factor
+++ b/extra/io/unix/unix-tests.factor
@@ -1,7 +1,7 @@
USING: io.files io.sockets io kernel threads
namespaces tools.test continuations strings byte-arrays
sequences prettyprint system ;
-IN: temporary
+IN: io.unix.tests
! Unix domain stream sockets
: socket-server "unix-domain-socket-test" temp-file ;
diff --git a/extra/io/windows/nt/nt-tests.factor b/extra/io/windows/nt/nt-tests.factor
index e4ebe3dd37..c4ac99fe4a 100755
--- a/extra/io/windows/nt/nt-tests.factor
+++ b/extra/io/windows/nt/nt-tests.factor
@@ -1,6 +1,6 @@
USING: io.files kernel tools.test io.backend
io.windows.nt.files splitting ;
-IN: temporary
+IN: io.windows.nt.tests
[ "c:\\foo\\" ] [ "c:\\foo\\bar" parent-directory ] unit-test
[ "c:\\" ] [ "c:\\foo\\" parent-directory ] unit-test
diff --git a/extra/jamshred/tunnel/tunnel-tests.factor b/extra/jamshred/tunnel/tunnel-tests.factor
index 2ea8a64bd9..3cc230126c 100644
--- a/extra/jamshred/tunnel/tunnel-tests.factor
+++ b/extra/jamshred/tunnel/tunnel-tests.factor
@@ -1,5 +1,5 @@
USING: jamshred.oint jamshred.tunnel kernel sequences tools.test ;
-IN: temporary
+IN: jamshred.tunnel.tests
[ 0 ] [ T{ segment T{ oint f { 0 0 0 } } 0 }
T{ segment T{ oint f { 1 1 1 } } 1 }
diff --git a/extra/koszul/koszul-tests.factor b/extra/koszul/koszul-tests.factor
index d72314fc4d..13dc341350 100644
--- a/extra/koszul/koszul-tests.factor
+++ b/extra/koszul/koszul-tests.factor
@@ -1,5 +1,5 @@
USING: koszul tools.test kernel sequences assocs namespaces ;
-IN: temporary
+IN: koszul.tests
[
{ V{ { } } V{ { 1 } } V{ { 2 3 } { 7 8 } } V{ { 4 5 6 } } }
diff --git a/extra/lazy-lists/examples/examples-tests.factor b/extra/lazy-lists/examples/examples-tests.factor
index 14798de18a..d4e3ed79b8 100644
--- a/extra/lazy-lists/examples/examples-tests.factor
+++ b/extra/lazy-lists/examples/examples-tests.factor
@@ -1,5 +1,5 @@
USING: lazy-lists.examples lazy-lists tools.test ;
-IN: temporary
+IN: lazy-lists.examples.tests
[ { 1 3 5 7 } ] [ 4 odds ltake list>array ] unit-test
[ { 0 1 4 9 16 } ] [ first-five-squares ] unit-test
diff --git a/extra/lazy-lists/lazy-lists-tests.factor b/extra/lazy-lists/lazy-lists-tests.factor
index 9b7f0effd2..0424a5d069 100644
--- a/extra/lazy-lists/lazy-lists-tests.factor
+++ b/extra/lazy-lists/lazy-lists-tests.factor
@@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
!
USING: lazy-lists tools.test kernel math io sequences ;
-IN: temporary
+IN: lazy-lists.tests
[ { 1 2 3 4 } ] [
{ 1 2 3 4 } >list list>array
diff --git a/extra/levenshtein/levenshtein-tests.factor b/extra/levenshtein/levenshtein-tests.factor
index 40e055686a..722ccb86ca 100644
--- a/extra/levenshtein/levenshtein-tests.factor
+++ b/extra/levenshtein/levenshtein-tests.factor
@@ -1,6 +1,6 @@
! Copyright (C) 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-IN: temporary
+IN: levenshtein.tests
USING: tools.test levenshtein ;
[ 3 ] [ "sitting" "kitten" levenshtein ] unit-test
diff --git a/extra/lint/lint-tests.factor b/extra/lint/lint-tests.factor
index 707d34b274..9a39980c9f 100644
--- a/extra/lint/lint-tests.factor
+++ b/extra/lint/lint-tests.factor
@@ -1,5 +1,5 @@
USING: io lint kernel math tools.test ;
-IN: temporary
+IN: lint.tests
! Don't write code like this
: lint1
diff --git a/extra/locals/locals-tests.factor b/extra/locals/locals-tests.factor
index b290c25159..e48f9f4061 100644
--- a/extra/locals/locals-tests.factor
+++ b/extra/locals/locals-tests.factor
@@ -1,6 +1,6 @@
USING: locals math sequences tools.test hashtables words kernel
namespaces arrays strings prettyprint ;
-IN: temporary
+IN: locals.tests
:: foo ( a b -- a a ) a a ;
diff --git a/extra/macros/macros-tests.factor b/extra/macros/macros-tests.factor
index d41003797c..59a53afb70 100644
--- a/extra/macros/macros-tests.factor
+++ b/extra/macros/macros-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: macros.tests
USING: tools.test macros math kernel arrays
vectors ;
diff --git a/extra/match/match-tests.factor b/extra/match/match-tests.factor
index d9162ae286..044b80fe9d 100755
--- a/extra/match/match-tests.factor
+++ b/extra/match/match-tests.factor
@@ -1,7 +1,7 @@
! Copyright (C) 2006 Chris Double.
! See http://factorcode.org/license.txt for BSD license.
USING: tools.test match namespaces arrays ;
-IN: temporary
+IN: match.tests
MATCH-VARS: ?a ?b ;
diff --git a/extra/math/analysis/analysis-tests.factor b/extra/math/analysis/analysis-tests.factor
index 0ed66a569c..5b537c2621 100644
--- a/extra/math/analysis/analysis-tests.factor
+++ b/extra/math/analysis/analysis-tests.factor
@@ -1,6 +1,6 @@
USING: kernel math math.functions tools.test math.analysis
math.constants ;
-IN: temporary
+IN: math.analysis.tests
: eps
.00000001 ;
diff --git a/extra/math/combinatorics/combinatorics-tests.factor b/extra/math/combinatorics/combinatorics-tests.factor
index 440630e38f..e6a2824433 100644
--- a/extra/math/combinatorics/combinatorics-tests.factor
+++ b/extra/math/combinatorics/combinatorics-tests.factor
@@ -1,5 +1,5 @@
USING: math.combinatorics math.combinatorics.private tools.test ;
-IN: temporary
+IN: math.combinatorics.tests
[ { } ] [ 0 factoradic ] unit-test
[ { 1 0 } ] [ 1 factoradic ] unit-test
diff --git a/extra/math/complex/complex-tests.factor b/extra/math/complex/complex-tests.factor
index e8535d0637..9174ac9988 100755
--- a/extra/math/complex/complex-tests.factor
+++ b/extra/math/complex/complex-tests.factor
@@ -1,6 +1,6 @@
USING: kernel math math.constants math.functions tools.test
prettyprint ;
-IN: temporary
+IN: math.complex.tests
[ 1 C{ 0 1 } rect> ] must-fail
[ C{ 0 1 } 1 rect> ] must-fail
diff --git a/extra/math/erato/erato-tests.factor b/extra/math/erato/erato-tests.factor
index 6e961b979c..9244fa62e2 100644
--- a/extra/math/erato/erato-tests.factor
+++ b/extra/math/erato/erato-tests.factor
@@ -1,6 +1,6 @@
! Copyright (c) 2007 Samuel Tardieu.
! See http://factorcode.org/license.txt for BSD license.
USING: lazy-lists math.erato tools.test ;
-IN: temporary
+IN: math.erato.tests
[ { 2 3 5 7 11 13 17 19 } ] [ 20 lerato list>array ] unit-test
diff --git a/extra/math/functions/functions-tests.factor b/extra/math/functions/functions-tests.factor
index 6f4dc42593..6773678dab 100755
--- a/extra/math/functions/functions-tests.factor
+++ b/extra/math/functions/functions-tests.factor
@@ -1,6 +1,6 @@
USING: kernel math math.constants math.functions math.private
math.libm tools.test ;
-IN: temporary
+IN: math.functions.tests
[ t ] [ 4 4 .00000001 ~ ] unit-test
[ t ] [ 4.0000001 4.0000001 .000001 ~ ] unit-test
diff --git a/extra/math/matrices/elimination/elimination-tests.factor b/extra/math/matrices/elimination/elimination-tests.factor
index d6fb2957e1..7c833391d8 100644
--- a/extra/math/matrices/elimination/elimination-tests.factor
+++ b/extra/math/matrices/elimination/elimination-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: math.matrices.elimination.tests
USING: kernel math.matrices math.matrices.elimination
tools.test sequences ;
diff --git a/extra/math/matrices/matrices-tests.factor b/extra/math/matrices/matrices-tests.factor
index 9670ab80b8..ee2516e9a6 100644
--- a/extra/math/matrices/matrices-tests.factor
+++ b/extra/math/matrices/matrices-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: math.matrices.tests
USING: math.matrices math.vectors tools.test math ;
[
diff --git a/extra/math/miller-rabin/miller-rabin-tests.factor b/extra/math/miller-rabin/miller-rabin-tests.factor
index f8bc9d4970..9ca85ea72c 100644
--- a/extra/math/miller-rabin/miller-rabin-tests.factor
+++ b/extra/math/miller-rabin/miller-rabin-tests.factor
@@ -1,5 +1,5 @@
USING: math.miller-rabin tools.test ;
-IN: temporary
+IN: math.miller-rabin.tests
[ f ] [ 473155932665450549999756893736999469773678960651272093993257221235459777950185377130233556540099119926369437865330559863 miller-rabin ] unit-test
[ t ] [ 2 miller-rabin ] unit-test
diff --git a/extra/math/numerical-integration/numerical-integration-tests.factor b/extra/math/numerical-integration/numerical-integration-tests.factor
index 33b6e78571..c5b92c73de 100644
--- a/extra/math/numerical-integration/numerical-integration-tests.factor
+++ b/extra/math/numerical-integration/numerical-integration-tests.factor
@@ -1,6 +1,6 @@
USING: kernel math.numerical-integration tools.test math
math.constants math.functions ;
-IN: temporary
+IN: math.numerical-integration.tests
[ 50 ] [ 0 10 [ ] integrate-simpson ] unit-test
[ 1000/3 ] [ 0 10 [ sq ] integrate-simpson ] unit-test
diff --git a/extra/math/polynomials/polynomials-tests.factor b/extra/math/polynomials/polynomials-tests.factor
index 4d0cdf8c8b..73215f9167 100644
--- a/extra/math/polynomials/polynomials-tests.factor
+++ b/extra/math/polynomials/polynomials-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: math.polynomials.tests
USING: kernel math math.polynomials tools.test ;
! Tests
diff --git a/extra/math/quaternions/quaternions-tests.factor b/extra/math/quaternions/quaternions-tests.factor
index 4f59798df0..b30a1bc271 100644
--- a/extra/math/quaternions/quaternions-tests.factor
+++ b/extra/math/quaternions/quaternions-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: math.quaternions.tests
USING: tools.test math.quaternions kernel math.vectors
math.constants ;
diff --git a/extra/math/ranges/ranges-tests.factor b/extra/math/ranges/ranges-tests.factor
index 09416814bd..825c68d1b9 100644
--- a/extra/math/ranges/ranges-tests.factor
+++ b/extra/math/ranges/ranges-tests.factor
@@ -1,5 +1,5 @@
USING: math.ranges sequences tools.test arrays ;
-IN: temporary
+IN: math.ranges.tests
[ { } ] [ 1 1 (a,b) >array ] unit-test
[ { } ] [ 1 1 (a,b] >array ] unit-test
diff --git a/extra/math/ratios/ratios-tests.factor b/extra/math/ratios/ratios-tests.factor
index 4dba49b908..75572d8415 100755
--- a/extra/math/ratios/ratios-tests.factor
+++ b/extra/math/ratios/ratios-tests.factor
@@ -1,6 +1,6 @@
USING: kernel math math.parser math.ratios math.functions
tools.test ;
-IN: temporary
+IN: math.ratios.tests
[ 1 2 ] [ 1/2 >fraction ] unit-test
diff --git a/extra/math/statistics/statistics-tests.factor b/extra/math/statistics/statistics-tests.factor
index 4d3b21bbbe..0884e1aed2 100644
--- a/extra/math/statistics/statistics-tests.factor
+++ b/extra/math/statistics/statistics-tests.factor
@@ -1,5 +1,5 @@
USING: kernel math math.functions math.statistics tools.test ;
-IN: temporary
+IN: math.statistics.tests
[ 1 ] [ { 1 } mean ] unit-test
[ 3/2 ] [ { 1 2 } mean ] unit-test
diff --git a/extra/math/text/english/english-tests.factor b/extra/math/text/english/english-tests.factor
index 00fccde1d3..8f8932c97d 100644
--- a/extra/math/text/english/english-tests.factor
+++ b/extra/math/text/english/english-tests.factor
@@ -1,5 +1,5 @@
USING: math.functions math.text.english tools.test ;
-IN: temporary
+IN: math.text.english.tests
[ "Zero" ] [ 0 number>text ] unit-test
[ "Twenty-One" ] [ 21 number>text ] unit-test
diff --git a/extra/math/vectors/vectors-tests.factor b/extra/math/vectors/vectors-tests.factor
index 924dc16c44..5c71e2374f 100644
--- a/extra/math/vectors/vectors-tests.factor
+++ b/extra/math/vectors/vectors-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: math.vectors.tests
USING: math.vectors tools.test ;
[ { 1 2 3 } ] [ 1/2 { 2 4 6 } n*v ] unit-test
diff --git a/extra/models/models-tests.factor b/extra/models/models-tests.factor
index ea615d2f9a..bd02c2f708 100755
--- a/extra/models/models-tests.factor
+++ b/extra/models/models-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: models.tests
USING: arrays generic kernel math models namespaces sequences assocs
tools.test ;
diff --git a/extra/money/money-tests.factor b/extra/money/money-tests.factor
index 19d6b6c2aa..b2ccdf93b7 100644
--- a/extra/money/money-tests.factor
+++ b/extra/money/money-tests.factor
@@ -1,5 +1,5 @@
USING: money parser tools.test ;
-IN: temporary
+IN: money.tests
[ -1/10 ] [ DECIMAL: -.1 ] unit-test
[ -1/10 ] [ DECIMAL: -0.1 ] unit-test
diff --git a/extra/multi-methods/multi-methods-tests.factor b/extra/multi-methods/multi-methods-tests.factor
index 1c68cbe540..8910e64092 100755
--- a/extra/multi-methods/multi-methods-tests.factor
+++ b/extra/multi-methods/multi-methods-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: multi-methods.tests
USING: multi-methods tools.test kernel math arrays sequences
prettyprint strings classes hashtables assocs namespaces
debugger continuations ;
diff --git a/extra/parser-combinators/parser-combinators-tests.factor b/extra/parser-combinators/parser-combinators-tests.factor
index 6f921497b2..2dd3fd911c 100755
--- a/extra/parser-combinators/parser-combinators-tests.factor
+++ b/extra/parser-combinators/parser-combinators-tests.factor
@@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: kernel lazy-lists tools.test strings math
sequences parser-combinators arrays math.parser unicode.categories ;
-IN: temporary
+IN: parser-combinators.tests
! Testing <&>
{ { T{ parse-result f { "a" "b" } T{ slice f 2 4 "abcd" } } } } [
diff --git a/extra/partial-continuations/partial-continuations-tests.factor b/extra/partial-continuations/partial-continuations-tests.factor
index 56dc6bcd87..7e876b0934 100644
--- a/extra/partial-continuations/partial-continuations-tests.factor
+++ b/extra/partial-continuations/partial-continuations-tests.factor
@@ -1,6 +1,6 @@
USING: namespaces math partial-continuations tools.test
kernel sequences ;
-IN: temporary
+IN: partial-continuations.tests
SYMBOL: sum
diff --git a/extra/peg/ebnf/ebnf-tests.factor b/extra/peg/ebnf/ebnf-tests.factor
index a308b9af52..452da8df05 100644
--- a/extra/peg/ebnf/ebnf-tests.factor
+++ b/extra/peg/ebnf/ebnf-tests.factor
@@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
!
USING: kernel tools.test peg peg.ebnf ;
-IN: temporary
+IN: peg.ebnf.tests
{ T{ ebnf-non-terminal f "abc" } } [
"abc" 'non-terminal' parse parse-result-ast
diff --git a/extra/peg/peg-tests.factor b/extra/peg/peg-tests.factor
index 6a8d7429f3..7a1ce99883 100644
--- a/extra/peg/peg-tests.factor
+++ b/extra/peg/peg-tests.factor
@@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
!
USING: kernel tools.test strings namespaces arrays sequences peg peg.private ;
-IN: temporary
+IN: peg.tests
{ 0 1 2 } [
0 next-id set-global get-next-id get-next-id get-next-id
diff --git a/extra/peg/pl0/pl0-tests.factor b/extra/peg/pl0/pl0-tests.factor
index cec7b24cd0..fa8ac89f57 100644
--- a/extra/peg/pl0/pl0-tests.factor
+++ b/extra/peg/pl0/pl0-tests.factor
@@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
!
USING: kernel tools.test peg peg.pl0 ;
-IN: temporary
+IN: peg.pl0.tests
{ "abc" } [
"abc" ident parse parse-result-ast
diff --git a/extra/peg/search/search-tests.factor b/extra/peg/search/search-tests.factor
index b33161dfff..c65001be09 100755
--- a/extra/peg/search/search-tests.factor
+++ b/extra/peg/search/search-tests.factor
@@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
!
USING: kernel math math.parser arrays tools.test peg peg.search ;
-IN: temporary
+IN: peg.search.tests
{ V{ 123 456 } } [
"abc 123 def 456" 'integer' search
diff --git a/extra/porter-stemmer/porter-stemmer-tests.factor b/extra/porter-stemmer/porter-stemmer-tests.factor
index d3e031fdc6..7294ac0e8f 100644
--- a/extra/porter-stemmer/porter-stemmer-tests.factor
+++ b/extra/porter-stemmer/porter-stemmer-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: porter-stemmer.tests
USING: arrays io kernel porter-stemmer sequences tools.test
io.files ;
diff --git a/extra/random/random-tests.factor b/extra/random/random-tests.factor
index 7d506b85f3..d431e57d01 100644
--- a/extra/random/random-tests.factor
+++ b/extra/random/random-tests.factor
@@ -1,5 +1,5 @@
USING: kernel math random namespaces sequences tools.test ;
-IN: temporary
+IN: random.tests
: check-random ( max -- ? )
dup >r random 0 r> between? ;
diff --git a/extra/sequences/lib/lib-tests.factor b/extra/sequences/lib/lib-tests.factor
index d4af66b72f..b19c2f39c9 100755
--- a/extra/sequences/lib/lib-tests.factor
+++ b/extra/sequences/lib/lib-tests.factor
@@ -1,6 +1,6 @@
USING: arrays kernel sequences sequences.lib math math.functions math.ranges
tools.test strings ;
-IN: temporary
+IN: sequences.lib.tests
[ 50 ] [ 100 [1,b] [ even? ] count ] unit-test
[ 50 ] [ 100 [1,b] [ odd? ] count ] unit-test
diff --git a/extra/serialize/serialize-tests.factor b/extra/serialize/serialize-tests.factor
index 6c80c8de7d..766103e4b0 100755
--- a/extra/serialize/serialize-tests.factor
+++ b/extra/serialize/serialize-tests.factor
@@ -4,7 +4,7 @@
USING: tools.test kernel serialize io io.streams.string math
alien arrays byte-arrays sequences math prettyprint parser
classes math.constants ;
-IN: temporary
+IN: serialize.tests
TUPLE: serialize-test a b ;
diff --git a/extra/smtp/smtp-tests.factor b/extra/smtp/smtp-tests.factor
index 784f446b7e..c1afeced3d 100755
--- a/extra/smtp/smtp-tests.factor
+++ b/extra/smtp/smtp-tests.factor
@@ -1,6 +1,6 @@
USING: smtp tools.test io.streams.string threads
smtp.server kernel sequences namespaces logging ;
-IN: temporary
+IN: smtp.tests
{ 0 0 } [ [ ] with-smtp-connection ] must-infer-as
diff --git a/extra/taxes/taxes-tests.factor b/extra/taxes/taxes-tests.factor
index 4091156558..6aeb5aa098 100644
--- a/extra/taxes/taxes-tests.factor
+++ b/extra/taxes/taxes-tests.factor
@@ -1,5 +1,5 @@
USING: kernel money taxes tools.test ;
-IN: temporary
+IN: taxes.tests
[
426 23
diff --git a/extra/tools/annotations/annotations-tests.factor b/extra/tools/annotations/annotations-tests.factor
index 90d9d26f51..ec8f48a161 100755
--- a/extra/tools/annotations/annotations-tests.factor
+++ b/extra/tools/annotations/annotations-tests.factor
@@ -1,5 +1,5 @@
USING: tools.test tools.annotations math parser ;
-IN: temporary
+IN: tools.annotations.tests
: foo ;
\ foo watch
@@ -17,7 +17,7 @@ M: integer some-generic 1+ ;
[ 4 ] [ 3 some-generic ] unit-test
-[ ] [ "IN: temporary USE: math M: integer some-generic 1- ;" eval ] unit-test
+[ ] [ "IN: tools.annotations.tests USE: math M: integer some-generic 1- ;" eval ] unit-test
[ 2 ] [ 3 some-generic ] unit-test
diff --git a/extra/tools/browser/browser-tests.factor b/extra/tools/browser/browser-tests.factor
index fc7960e475..38d9ae65e2 100755
--- a/extra/tools/browser/browser-tests.factor
+++ b/extra/tools/browser/browser-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: tools.browser.tests
USING: tools.browser tools.test help.markup ;
[ ] [ { $describe-vocab "scratchpad" } print-content ] unit-test
diff --git a/extra/tools/crossref/crossref-tests.factor b/extra/tools/crossref/crossref-tests.factor
index b616766597..8616be141e 100755
--- a/extra/tools/crossref/crossref-tests.factor
+++ b/extra/tools/crossref/crossref-tests.factor
@@ -1,6 +1,6 @@
USING: math kernel sequences io.files tools.crossref tools.test
parser namespaces source-files generic definitions ;
-IN: temporary
+IN: tools.crossref.tests
GENERIC: foo
diff --git a/extra/tools/deploy/deploy-tests.factor b/extra/tools/deploy/deploy-tests.factor
index 2f79669497..d473d8f640 100755
--- a/extra/tools/deploy/deploy-tests.factor
+++ b/extra/tools/deploy/deploy-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: tools.deploy.tests
USING: tools.test system io.files kernel tools.deploy.config
tools.deploy.backend math ;
diff --git a/extra/tools/memory/memory-tests.factor b/extra/tools/memory/memory-tests.factor
index 36bcc73b74..9efbf63f7f 100644
--- a/extra/tools/memory/memory-tests.factor
+++ b/extra/tools/memory/memory-tests.factor
@@ -1,4 +1,4 @@
USING: tools.test tools.memory ;
-IN: temporary
+IN: tools.memory.tests
[ ] [ heap-stats. ] unit-test
diff --git a/extra/tools/profiler/profiler-tests.factor b/extra/tools/profiler/profiler-tests.factor
index c346d9763c..e33201e22c 100755
--- a/extra/tools/profiler/profiler-tests.factor
+++ b/extra/tools/profiler/profiler-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: tools.profiler.tests
USING: tools.profiler tools.test kernel memory math threads
alien tools.profiler.private sequences ;
diff --git a/extra/tools/test/test-docs.factor b/extra/tools/test/test-docs.factor
index a8c7239922..743822e7f9 100755
--- a/extra/tools/test/test-docs.factor
+++ b/extra/tools/test/test-docs.factor
@@ -43,7 +43,7 @@ $nl
}
"The latter is used for vocabularies with more extensive test suites."
$nl
-"If the test harness needs to define words, they should be placed in the " { $snippet "temporary" } " vocabulary so that they can be forgotten after the tests have been run."
+"If the test harness needs to define words, they should be placed in a vocabulary named " { $snippet { $emphasis "vocab" } ".tests" } " where " { $emphasis "vocab" } " is the vocab being tested."
{ $subsection "tools.test.write" }
{ $subsection "tools.test.run" }
{ $subsection "tools.test.failure" } ;
diff --git a/extra/tools/test/test.factor b/extra/tools/test/test.factor
index 0ab68f502e..259b91c3af 100755
--- a/extra/tools/test/test.factor
+++ b/extra/tools/test/test.factor
@@ -50,13 +50,8 @@ SYMBOL: this-test
: (run-test) ( vocab -- )
dup vocab-source-loaded? [
- vocab-tests
- [
- "temporary" forget-vocab
- dup [ forget-source ] each
- ] with-compilation-unit
- dup [ run-file ] each
- ] when drop ;
+ vocab-tests [ run-file ] each
+ ] [ drop ] if ;
: run-test ( vocab -- failures )
V{ } clone [
diff --git a/extra/tools/test/tools.factor b/extra/tools/test/tools.factor
index 7699d61062..bf74c1ae98 100644
--- a/extra/tools/test/tools.factor
+++ b/extra/tools/test/tools.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: tools.test.tests
USING: completion words sequences test ;
[ ] [ "swp" apropos ] unit-test
diff --git a/extra/tools/walker/walker-tests.factor b/extra/tools/walker/walker-tests.factor
index 1302ebe3d8..2d4a6c3396 100755
--- a/extra/tools/walker/walker-tests.factor
+++ b/extra/tools/walker/walker-tests.factor
@@ -1,7 +1,7 @@
USING: tools.walker io io.streams.string kernel math
math.private namespaces prettyprint sequences tools.test
continuations math.parser threads arrays tools.walker.debug ;
-IN: temporary
+IN: tools.walker.tests
[ { } ] [
[ ] test-walker
diff --git a/extra/trees/avl/avl-tests.factor b/extra/trees/avl/avl-tests.factor
index 0964ea7e56..570125cb45 100644
--- a/extra/trees/avl/avl-tests.factor
+++ b/extra/trees/avl/avl-tests.factor
@@ -1,5 +1,5 @@
USING: kernel tools.test trees trees.avl math random sequences assocs ;
-IN: temporary
+IN: trees.avl.tests
[ "key1" 0 "key2" 0 ] [
T{ avl-node T{ node f "key1" f f T{ avl-node T{ node f "key2" } 1 } } 2 }
diff --git a/extra/trees/splay/splay-tests.factor b/extra/trees/splay/splay-tests.factor
index 5075163802..29ea2eee2d 100644
--- a/extra/trees/splay/splay-tests.factor
+++ b/extra/trees/splay/splay-tests.factor
@@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: kernel tools.test trees.splay math namespaces assocs
sequences random ;
-IN: temporary
+IN: trees.splay.tests
: randomize-numeric-splay-tree ( splay-tree -- )
100 [ drop 100 random swap at drop ] with each ;
diff --git a/extra/trees/trees-tests.factor b/extra/trees/trees-tests.factor
index 2795b0d5da..fd26b37c70 100644
--- a/extra/trees/trees-tests.factor
+++ b/extra/trees/trees-tests.factor
@@ -1,5 +1,5 @@
USING: trees assocs tools.test kernel sequences ;
-IN: temporary
+IN: trees.tests
: test-tree ( -- tree )
TREE{
diff --git a/extra/tuple-syntax/tuple-syntax-tests.factor b/extra/tuple-syntax/tuple-syntax-tests.factor
index 0a9711c446..2eb9d8bb12 100755
--- a/extra/tuple-syntax/tuple-syntax-tests.factor
+++ b/extra/tuple-syntax/tuple-syntax-tests.factor
@@ -1,5 +1,5 @@
USING: tools.test tuple-syntax ;
-IN: temporary
+IN: tuple-syntax.tests
TUPLE: foo bar baz ;
diff --git a/extra/tuples/lib/lib-tests.factor b/extra/tuples/lib/lib-tests.factor
index 88c09d81c4..5d90f25bd7 100644
--- a/extra/tuples/lib/lib-tests.factor
+++ b/extra/tuples/lib/lib-tests.factor
@@ -1,5 +1,5 @@
USING: kernel tools.test tuples.lib ;
-IN: temporary
+IN: tuples.lib.tests
TUPLE: foo a b* c d* e f* ;
diff --git a/extra/ui/commands/commands-tests.factor b/extra/ui/commands/commands-tests.factor
index de9534ab74..8001ff9761 100644
--- a/extra/ui/commands/commands-tests.factor
+++ b/extra/ui/commands/commands-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: ui.commands.tests
USING: ui.commands ui.gestures tools.test help.markup io
io.streams.string ;
diff --git a/extra/ui/gadgets/books/books-tests.factor b/extra/ui/gadgets/books/books-tests.factor
index 9e1b0aa985..dab9ef5acf 100755
--- a/extra/ui/gadgets/books/books-tests.factor
+++ b/extra/ui/gadgets/books/books-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: ui.gadgets.books.tests
USING: tools.test ui.gadgets.books ;
\ <book> must-infer
diff --git a/extra/ui/gadgets/buttons/buttons-tests.factor b/extra/ui/gadgets/buttons/buttons-tests.factor
index 224ef9e1ce..6c5d757dd4 100755
--- a/extra/ui/gadgets/buttons/buttons-tests.factor
+++ b/extra/ui/gadgets/buttons/buttons-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: ui.gadgets.buttons.tests
USING: ui.commands ui.gadgets.buttons ui.gadgets.labels
ui.gadgets tools.test namespaces sequences kernel models ;
diff --git a/extra/ui/gadgets/frames/frames-tests.factor b/extra/ui/gadgets/frames/frames-tests.factor
index 80cf70b960..e38e97c76c 100644
--- a/extra/ui/gadgets/frames/frames-tests.factor
+++ b/extra/ui/gadgets/frames/frames-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: ui.gadgets.frames.tests
USING: ui.gadgets.frames ui.gadgets tools.test ;
[ ] [ <frame> layout ] unit-test
diff --git a/extra/ui/gadgets/gadgets-tests.factor b/extra/ui/gadgets/gadgets-tests.factor
index 54bae31f79..0a44e5e267 100755
--- a/extra/ui/gadgets/gadgets-tests.factor
+++ b/extra/ui/gadgets/gadgets-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: ui.gadgets.tests
USING: ui.gadgets ui.gadgets.packs ui.gadgets.worlds tools.test
namespaces models kernel dlists math
math.parser ui sequences hashtables assocs io arrays
diff --git a/extra/ui/gadgets/grids/grids-tests.factor b/extra/ui/gadgets/grids/grids-tests.factor
index 6f08009da3..0792d55135 100644
--- a/extra/ui/gadgets/grids/grids-tests.factor
+++ b/extra/ui/gadgets/grids/grids-tests.factor
@@ -1,6 +1,6 @@
USING: ui.gadgets ui.gadgets.grids tools.test kernel arrays
namespaces ;
-IN: temporary
+IN: ui.gadgets.grids.tests
[ { 0 0 } ] [ { } <grid> pref-dim ] unit-test
diff --git a/extra/ui/gadgets/labelled/labelled-tests.factor b/extra/ui/gadgets/labelled/labelled-tests.factor
index 87b2a45678..377f3ab787 100644
--- a/extra/ui/gadgets/labelled/labelled-tests.factor
+++ b/extra/ui/gadgets/labelled/labelled-tests.factor
@@ -1,7 +1,7 @@
USING: ui.gadgets ui.gadgets.labels ui.gadgets.labelled
ui.gadgets.packs ui.gadgets.frames ui.gadgets.grids namespaces
kernel tools.test ui.gadgets.buttons sequences ;
-IN: temporary
+IN: ui.gadgets.labelled.tests
TUPLE: testing ;
diff --git a/extra/ui/gadgets/lists/lists-tests.factor b/extra/ui/gadgets/lists/lists-tests.factor
index 44a89a7e60..bf2ad72d0e 100644
--- a/extra/ui/gadgets/lists/lists-tests.factor
+++ b/extra/ui/gadgets/lists/lists-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: ui.gadgets.lists.tests
USING: ui.gadgets.lists models prettyprint math tools.test
kernel ;
diff --git a/extra/ui/gadgets/packs/packs-tests.factor b/extra/ui/gadgets/packs/packs-tests.factor
index ce6df74769..28a656e2ad 100644
--- a/extra/ui/gadgets/packs/packs-tests.factor
+++ b/extra/ui/gadgets/packs/packs-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: ui.gadgets.packs.tests
USING: ui.gadgets.packs ui.gadgets.labels ui.gadgets ui.render
kernel namespaces tools.test math.parser sequences ;
diff --git a/extra/ui/gadgets/panes/panes-tests.factor b/extra/ui/gadgets/panes/panes-tests.factor
index 848f7919d3..e3f6e36050 100755
--- a/extra/ui/gadgets/panes/panes-tests.factor
+++ b/extra/ui/gadgets/panes/panes-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: ui.gadgets.panes.tests
USING: alien ui.gadgets.panes ui.gadgets namespaces
kernel sequences io io.streams.string tools.test prettyprint
definitions help help.syntax help.markup splitting
diff --git a/extra/ui/gadgets/presentations/presentations-tests.factor b/extra/ui/gadgets/presentations/presentations-tests.factor
index c4f693c939..46f274d53a 100644
--- a/extra/ui/gadgets/presentations/presentations-tests.factor
+++ b/extra/ui/gadgets/presentations/presentations-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: ui.gadgets.presentations.tests
USING: math ui.gadgets.presentations ui.gadgets tools.test
prettyprint ui.gadgets.buttons io io.streams.string kernel
tuples ;
diff --git a/extra/ui/gadgets/scrollers/scrollers-tests.factor b/extra/ui/gadgets/scrollers/scrollers-tests.factor
index dd667fdfec..5ccd6c7cd8 100755
--- a/extra/ui/gadgets/scrollers/scrollers-tests.factor
+++ b/extra/ui/gadgets/scrollers/scrollers-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: ui.gadgets.scrollers.tests
USING: ui.gadgets ui.gadgets.scrollers
namespaces tools.test kernel models ui.gadgets.viewports
ui.gadgets.labels ui.gadgets.grids ui.gadgets.frames
diff --git a/extra/ui/gadgets/slots/slots-tests.factor b/extra/ui/gadgets/slots/slots-tests.factor
index 5388794624..b955a2604d 100644
--- a/extra/ui/gadgets/slots/slots-tests.factor
+++ b/extra/ui/gadgets/slots/slots-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: ui.gadgets.slots.tests
USING: assocs ui.gadgets.slots tools.test refs ;
[ t ] [ { 1 2 3 } 2 <value-ref> <slot-editor> slot-editor? ] unit-test
diff --git a/extra/ui/gadgets/tracks/tracks-tests.factor b/extra/ui/gadgets/tracks/tracks-tests.factor
index 77c69bc8a8..e2db914089 100644
--- a/extra/ui/gadgets/tracks/tracks-tests.factor
+++ b/extra/ui/gadgets/tracks/tracks-tests.factor
@@ -1,5 +1,5 @@
USING: kernel ui.gadgets ui.gadgets.tracks tools.test ;
-IN: temporary
+IN: ui.gadgets.tracks.tests
[ { 100 100 } ] [
[
diff --git a/extra/ui/gadgets/worlds/worlds-tests.factor b/extra/ui/gadgets/worlds/worlds-tests.factor
index 949ad49460..2e186d875d 100644
--- a/extra/ui/gadgets/worlds/worlds-tests.factor
+++ b/extra/ui/gadgets/worlds/worlds-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: ui.gadgets.worlds.tests
USING: ui.gadgets ui.gadgets.packs ui.gadgets.worlds tools.test
namespaces models kernel ;
diff --git a/extra/ui/operations/operations-tests.factor b/extra/ui/operations/operations-tests.factor
index b7b2224cfa..1e3d08f164 100755
--- a/extra/ui/operations/operations-tests.factor
+++ b/extra/ui/operations/operations-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: ui.operations.tests
USING: ui.operations ui.commands prettyprint kernel namespaces
tools.test ui.gadgets ui.gadgets.editors parser io
io.streams.string math help help.markup ;
diff --git a/extra/ui/tools/browser/browser-tests.factor b/extra/ui/tools/browser/browser-tests.factor
index 7262c72756..f56f5bcc4e 100755
--- a/extra/ui/tools/browser/browser-tests.factor
+++ b/extra/ui/tools/browser/browser-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: ui.tools.browser.tests
USING: tools.test tools.test.ui ui.tools.browser ;
\ <browser-gadget> must-infer
diff --git a/extra/ui/tools/interactor/interactor-tests.factor b/extra/ui/tools/interactor/interactor-tests.factor
index 0422c4170a..fe0a654217 100755
--- a/extra/ui/tools/interactor/interactor-tests.factor
+++ b/extra/ui/tools/interactor/interactor-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: ui.tools.interactor.tests
USING: ui.tools.interactor tools.test ;
\ <interactor> must-infer
diff --git a/extra/ui/tools/listener/listener-tests.factor b/extra/ui/tools/listener/listener-tests.factor
index 0024fa725f..13ce834df3 100755
--- a/extra/ui/tools/listener/listener-tests.factor
+++ b/extra/ui/tools/listener/listener-tests.factor
@@ -3,7 +3,7 @@ ui.tools.listener hashtables kernel namespaces parser sequences
tools.test ui.commands ui.gadgets ui.gadgets.editors
ui.gadgets.panes vocabs words tools.test.ui slots.private
threads ;
-IN: temporary
+IN: ui.tools.listener.tests
[ f ] [ "word" source-editor command-map empty? ] unit-test
diff --git a/extra/ui/tools/search/search-tests.factor b/extra/ui/tools/search/search-tests.factor
index 49bd1a3837..4a75ebfc96 100755
--- a/extra/ui/tools/search/search-tests.factor
+++ b/extra/ui/tools/search/search-tests.factor
@@ -2,7 +2,7 @@ USING: assocs ui.tools.search help.topics io.files io.styles
kernel namespaces sequences source-files threads
tools.test ui.gadgets ui.gestures vocabs
vocabs.loader words tools.test.ui debugger ;
-IN: temporary
+IN: ui.tools.search.tests
[ f ] [
"no such word with this name exists, certainly"
diff --git a/extra/ui/tools/tools-tests.factor b/extra/ui/tools/tools-tests.factor
index ff2444e43b..279737466f 100755
--- a/extra/ui/tools/tools-tests.factor
+++ b/extra/ui/tools/tools-tests.factor
@@ -3,7 +3,7 @@ ui.tools.search ui.tools.workspace kernel models namespaces
sequences tools.test ui.gadgets ui.gadgets.buttons
ui.gadgets.labelled ui.gadgets.presentations
ui.gadgets.scrollers vocabs tools.test.ui ui ;
-IN: temporary
+IN: ui.tools.tests
[
[ f ] [
diff --git a/extra/ui/tools/walker/walker-tests.factor b/extra/ui/tools/walker/walker-tests.factor
index 36b2abb7dd..fefb188239 100755
--- a/extra/ui/tools/walker/walker-tests.factor
+++ b/extra/ui/tools/walker/walker-tests.factor
@@ -1,4 +1,4 @@
USING: ui.tools.walker tools.test ;
-IN: temporary
+IN: ui.tools.walker.tests
\ <walker-gadget> must-infer
diff --git a/extra/ui/tools/workspace/workspace-tests.factor b/extra/ui/tools/workspace/workspace-tests.factor
index 5e3695fed3..49b14cda77 100755
--- a/extra/ui/tools/workspace/workspace-tests.factor
+++ b/extra/ui/tools/workspace/workspace-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: ui.tools.workspace.tests
USING: tools.test ui.tools ;
\ <workspace> must-infer
diff --git a/extra/ui/traverse/traverse-tests.factor b/extra/ui/traverse/traverse-tests.factor
index 37b3f25321..5e6ac4125b 100755
--- a/extra/ui/traverse/traverse-tests.factor
+++ b/extra/ui/traverse/traverse-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: ui.traverse.tests
USING: ui.gadgets ui.gadgets.labels namespaces sequences kernel
math arrays tools.test io ui.gadgets.panes ui.traverse
definitions compiler.units ;
diff --git a/extra/units/imperial/imperial-tests.factor b/extra/units/imperial/imperial-tests.factor
index def13bd784..793fe5679d 100644
--- a/extra/units/imperial/imperial-tests.factor
+++ b/extra/units/imperial/imperial-tests.factor
@@ -1,5 +1,5 @@
USING: kernel math tools.test units.imperial inverse ;
-IN: temporary
+IN: units.imperial.tests
[ 1 ] [ 12 inches [ feet ] undo ] unit-test
[ 12 ] [ 1 feet [ inches ] undo ] unit-test
diff --git a/extra/units/si/si-tests.factor b/extra/units/si/si-tests.factor
index 85d2bd3317..9fb702f050 100644
--- a/extra/units/si/si-tests.factor
+++ b/extra/units/si/si-tests.factor
@@ -1,6 +1,6 @@
USING: kernel tools.test units.si inverse math.constants
math.functions units.imperial ;
-IN: temporary
+IN: units.si.tests
[ t ] [ 1 m 100 cm = ] unit-test
diff --git a/extra/units/units-tests.factor b/extra/units/units-tests.factor
index 28ab9ab7c4..81f3163a77 100644
--- a/extra/units/units-tests.factor
+++ b/extra/units/units-tests.factor
@@ -1,6 +1,6 @@
USING: arrays kernel math sequences tools.test units.si
units.imperial units inverse math.functions ;
-IN: temporary
+IN: units.tests
[ T{ dimensioned f 3 { m } { } } ] [ 3 m ] unit-test
[ T{ dimensioned f 3 { m } { s } } ] [ 3 m/s ] unit-test
diff --git a/extra/xml/tests/arithmetic.factor b/extra/xml/tests/arithmetic.factor
index 371bf2d605..577ef5718c 100644
--- a/extra/xml/tests/arithmetic.factor
+++ b/extra/xml/tests/arithmetic.factor
@@ -1,6 +1,6 @@
! Copyright (C) 2005, 2006 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
-IN: xml-arith
+IN: xml.tests
USING: xml io kernel math sequences strings xml.utilities tools.test math.parser ;
PROCESS: calculate ( tag -- n )
diff --git a/extra/xml/tests/soap.factor b/extra/xml/tests/soap.factor
index 8b7d17553b..775930025f 100755
--- a/extra/xml/tests/soap.factor
+++ b/extra/xml/tests/soap.factor
@@ -1,5 +1,5 @@
USING: sequences xml kernel arrays xml.utilities io.files tools.test ;
-IN: temporary
+IN: xml.tests
: assemble-data ( tag -- 3array )
{ "URL" "snippet" "title" }
diff --git a/extra/xml/tests/templating.factor b/extra/xml/tests/templating.factor
index 2dd69ca99b..6db98ec848 100644
--- a/extra/xml/tests/templating.factor
+++ b/extra/xml/tests/templating.factor
@@ -1,5 +1,6 @@
USING: kernel xml sequences assocs tools.test io arrays namespaces
xml.data xml.utilities xml.writer generic sequences.deep ;
+IN: xml.tests
: sub-tag
T{ name f f "sub" "http://littledan.onigirihouse.com/namespaces/replace" } ;
diff --git a/extra/xml/tests/test.factor b/extra/xml/tests/test.factor
index 871425559b..02c7aecb13 100644
--- a/extra/xml/tests/test.factor
+++ b/extra/xml/tests/test.factor
@@ -1,6 +1,6 @@
! Copyright (C) 2005, 2006 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
-IN: temporary
+IN: xml.tests
USING: kernel xml tools.test io namespaces sequences xml.errors xml.entities
parser strings xml.data io.files xml.writer xml.utilities state-parser
continuations assocs sequences.deep ;
diff --git a/extra/xmode/catalog/catalog-tests.factor b/extra/xmode/catalog/catalog-tests.factor
index d5420ed2e3..75e377bc97 100644
--- a/extra/xmode/catalog/catalog-tests.factor
+++ b/extra/xmode/catalog/catalog-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: xmode.catalog.tests
USING: xmode.catalog tools.test hashtables assocs
kernel sequences io ;
diff --git a/extra/xmode/keyword-map/keyword-map-tests.factor b/extra/xmode/keyword-map/keyword-map-tests.factor
index 9fbe9110e8..b14bbd0f70 100644
--- a/extra/xmode/keyword-map/keyword-map-tests.factor
+++ b/extra/xmode/keyword-map/keyword-map-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: xmode.keyword-map.tests
USING: xmode.keyword-map xmode.tokens
tools.test namespaces assocs kernel strings ;
diff --git a/extra/xmode/marker/marker-tests.factor b/extra/xmode/marker/marker-tests.factor
index 6bcba91c84..1d059852e2 100755
--- a/extra/xmode/marker/marker-tests.factor
+++ b/extra/xmode/marker/marker-tests.factor
@@ -1,6 +1,6 @@
USING: xmode.tokens xmode.catalog
xmode.marker tools.test kernel ;
-IN: temporary
+IN: xmode.marker.tests
[
{
diff --git a/extra/xmode/rules/rules-tests.factor b/extra/xmode/rules/rules-tests.factor
index 404dbb89fb..5fc62f39e9 100644
--- a/extra/xmode/rules/rules-tests.factor
+++ b/extra/xmode/rules/rules-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: xmode.rules.tests
USING: xmode.rules tools.test ;
[ { 1 2 3 } ] [ f { 1 2 3 } ?push-all ] unit-test
diff --git a/extra/xmode/utilities/utilities-tests.factor b/extra/xmode/utilities/utilities-tests.factor
index 713700bf7a..bbb19a7555 100755
--- a/extra/xmode/utilities/utilities-tests.factor
+++ b/extra/xmode/utilities/utilities-tests.factor
@@ -1,4 +1,4 @@
-IN: temporary
+IN: xmode.utilities.tests
USING: xmode.utilities tools.test xml xml.data kernel strings
vectors sequences io.files prettyprint assocs unicode.case ;
From 12d254f62973cab4ac8bcb57825d8245dc79ede2 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Sun, 2 Mar 2008 00:33:37 -0600
Subject: [PATCH 32/55] io.files tests: minor fix
---
core/io/files/files-tests.factor | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor
index 850a30380b..92cc548d89 100755
--- a/core/io/files/files-tests.factor
+++ b/core/io/files/files-tests.factor
@@ -101,7 +101,7 @@ USING: tools.test io.files io threads kernel continuations ;
[ ] [
"copy-tree-test" temp-file
- "copy-destination" temp-file copy-tree-to
+ "copy-destination" temp-file copy-tree-into
] unit-test
[ "Foobar" ] [
@@ -109,7 +109,7 @@ USING: tools.test io.files io threads kernel continuations ;
] unit-test
[ ] [
- "copy-destination/copy-tree-test/a/b/c/d" temp-file "" temp-file copy-file-to
+ "copy-destination/copy-tree-test/a/b/c/d" temp-file "" temp-file copy-file-into
] unit-test
[ "Foobar" ] [
From 67eade4a296a617d2ad7e82d010fb3ff5a5d8186 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Sun, 2 Mar 2008 18:49:04 -0500
Subject: [PATCH 33/55] Fix refresh-all
---
core/vocabs/loader/loader.factor | 3 +--
1 file changed, 1 insertion(+), 2 deletions(-)
diff --git a/core/vocabs/loader/loader.factor b/core/vocabs/loader/loader.factor
index 57743ce9e1..acc6c783a5 100755
--- a/core/vocabs/loader/loader.factor
+++ b/core/vocabs/loader/loader.factor
@@ -180,8 +180,7 @@ SYMBOL: sources-changed?
[ t sources-changed? set-global ] "vocabs.loader" add-init-hook
: refresh-all ( -- )
- sources-changed? get-global
- [ "" refresh f sources-changed? set-global ] when ;
+ "" refresh f sources-changed? set-global ;
GENERIC: (load-vocab) ( name -- vocab )
From 151c62d609d1b5437e0bb824e7be5a36a23ff53b Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Sun, 2 Mar 2008 18:51:35 -0500
Subject: [PATCH 34/55] Fix bootstrap.image.upload
---
extra/bootstrap/image/upload/upload.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/extra/bootstrap/image/upload/upload.factor b/extra/bootstrap/image/upload/upload.factor
index 110547d963..084f30a103 100755
--- a/extra/bootstrap/image/upload/upload.factor
+++ b/extra/bootstrap/image/upload/upload.factor
@@ -8,7 +8,7 @@ SYMBOL: upload-images-destination
: destination ( -- dest )
upload-images-destination get
- "slava@/var/www/factorcode.org/w/images/latest/"
+ "slava@/var/www/factorcode.org/newsite/images/latest/"
or ;
: checksums "checksums.txt" temp-file ;
From e555c00287126c92193fddeb5cfec72a688c4967 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Mon, 3 Mar 2008 02:22:27 -0600
Subject: [PATCH 35/55] Fix alarms bug
---
extra/alarms/alarms-tests.factor | 17 +++++++++++++++++
extra/alarms/alarms.factor | 5 ++---
2 files changed, 19 insertions(+), 3 deletions(-)
create mode 100755 extra/alarms/alarms-tests.factor
diff --git a/extra/alarms/alarms-tests.factor b/extra/alarms/alarms-tests.factor
new file mode 100755
index 0000000000..1af851c9c6
--- /dev/null
+++ b/extra/alarms/alarms-tests.factor
@@ -0,0 +1,17 @@
+IN: alarms.tests
+USING: alarms kernel calendar sequences tools.test threads
+concurrency.count-downs ;
+
+[ ] [
+ 1 <count-down>
+ { f } clone 2dup
+ [ first cancel-alarm count-down ] 2curry 1 seconds later
+ swap set-first
+ await
+] unit-test
+
+[ ] [
+ [
+ [ resume ] curry instant later drop
+ ] "test" suspend drop
+] unit-test
diff --git a/extra/alarms/alarms.factor b/extra/alarms/alarms.factor
index d008b7b462..1ccfdcbd30 100755
--- a/extra/alarms/alarms.factor
+++ b/extra/alarms/alarms.factor
@@ -37,8 +37,8 @@ SYMBOL: alarm-thread
register-alarm ;
: call-alarm ( alarm -- )
- dup alarm-quot try
dup alarm-entry box> drop
+ dup alarm-quot try
dup alarm-interval [ reschedule-alarm ] [ drop ] if ;
: (trigger-alarms) ( alarms now -- )
@@ -46,8 +46,7 @@ SYMBOL: alarm-thread
2drop
] [
over heap-peek drop over alarm-expired? [
- over heap-pop drop call-alarm
- (trigger-alarms)
+ over heap-pop drop call-alarm (trigger-alarms)
] [
2drop
] if
From e95a79b50c8d0c9333f43ba6a5e02358113f31ec Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Mon, 3 Mar 2008 04:52:38 -0600
Subject: [PATCH 36/55] builder: minor cleanup
---
extra/builder/builder.factor | 2 --
1 file changed, 2 deletions(-)
diff --git a/extra/builder/builder.factor b/extra/builder/builder.factor
index 0d5f4292b7..ecce3275cb 100644
--- a/extra/builder/builder.factor
+++ b/extra/builder/builder.factor
@@ -43,8 +43,6 @@ IN: builder
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! : target ( -- target ) { os [ cpu "." split ] } to-strings "-" join ;
-
: make-vm ( -- desc )
<process*>
{ "make" } >>arguments
From 8bce800b4a77537735876040c7dc1a0278eb25b6 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Mon, 3 Mar 2008 04:56:39 -0600
Subject: [PATCH 37/55] builder: show git-id in report
---
extra/builder/builder.factor | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/extra/builder/builder.factor b/extra/builder/builder.factor
index ecce3275cb..fbe4f6149f 100644
--- a/extra/builder/builder.factor
+++ b/extra/builder/builder.factor
@@ -108,7 +108,8 @@ SYMBOL: build-status
"Build machine: " write host-name print
"CPU: " write cpu print
"OS: " write os print
- "Build directory: " write cwd print nl
+ "Build directory: " write cwd print
+ "git id: " write "git-id" eval-file print
git-clone [ "git clone failed" print ] run-or-bail
From e8f72a61dca7a048be801ab00af8465bc4fb8c7d Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Mon, 3 Mar 2008 05:02:59 -0600
Subject: [PATCH 38/55] builder: fix bug
---
extra/builder/builder.factor | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/extra/builder/builder.factor b/extra/builder/builder.factor
index fbe4f6149f..92cd5f5241 100644
--- a/extra/builder/builder.factor
+++ b/extra/builder/builder.factor
@@ -109,7 +109,6 @@ SYMBOL: build-status
"CPU: " write cpu print
"OS: " write os print
"Build directory: " write cwd print
- "git id: " write "git-id" eval-file print
git-clone [ "git clone failed" print ] run-or-bail
@@ -126,6 +125,8 @@ SYMBOL: build-status
"test-log" delete-file
+ "git id: " write "git-id" eval-file print nl
+
"Boot time: " write "boot-time" eval-file milli-seconds>time print
"Load time: " write "load-time" eval-file milli-seconds>time print
"Test time: " write "test-time" eval-file milli-seconds>time print nl
From 15947d68535df0484db54ebd1ed4a7b5aefaa153 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Mon, 3 Mar 2008 08:56:06 -0600
Subject: [PATCH 39/55] start moving db to new-slots redo the tuple tests so
it's a bit easier to work with fix a bug where selecting based on an empty
tuple wouldn't work
---
extra/db/db.factor | 33 +++-----
extra/db/sqlite/sqlite.factor | 14 ++--
extra/db/tuples/tuples-tests.factor | 120 +++++++++++++++-------------
3 files changed, 88 insertions(+), 79 deletions(-)
diff --git a/extra/db/db.factor b/extra/db/db.factor
index a577ff5fc5..e834144d0c 100755
--- a/extra/db/db.factor
+++ b/extra/db/db.factor
@@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: arrays assocs classes continuations kernel math
namespaces sequences sequences.lib tuples words strings
-tools.walker ;
+tools.walker new-slots accessors ;
IN: db
TUPLE: db
@@ -25,10 +25,10 @@ HOOK: db-close db ( handle -- )
: dispose-db ( db -- )
dup db [
- dup db-insert-statements dispose-statements
- dup db-update-statements dispose-statements
- dup db-delete-statements dispose-statements
- db-handle db-close
+ dup insert-statements>> dispose-statements
+ dup update-statements>> dispose-statements
+ dup delete-statements>> dispose-statements
+ handle>> db-close
] with-variable ;
TUPLE: statement handle sql in-params out-params bind-params bound? ;
@@ -36,11 +36,7 @@ TUPLE: simple-statement ;
TUPLE: prepared-statement ;
TUPLE: result-set sql params handle n max ;
: <statement> ( sql in out -- statement )
- {
- set-statement-sql
- set-statement-in-params
- set-statement-out-params
- } statement construct ;
+ { (>>sql) (>>in-params) (>>out-params) } statement construct ;
HOOK: <simple-statement> db ( str in out -- statement )
HOOK: <prepared-statement> db ( str in out -- statement )
@@ -62,21 +58,18 @@ GENERIC: more-rows? ( result-set -- ? )
] if ;
: bind-statement ( obj statement -- )
- [ set-statement-bind-params ] keep
+ swap >>bind-params
[ bind-statement* ] keep
- t swap set-statement-bound? ;
+ t >>bound? drop ;
: init-result-set ( result-set -- )
- dup #rows over set-result-set-max
- 0 swap set-result-set-n ;
+ dup #rows >>max
+ 0 >>n drop ;
: <result-set> ( query handle tuple -- result-set )
- >r >r { statement-sql statement-in-params } get-slots r>
- {
- set-result-set-sql
- set-result-set-params
- set-result-set-handle
- } result-set construct r> construct-delegate ;
+ >r >r { sql>> in-params>> } get-slots r>
+ { (>>sql) (>>params) (>>handle) } result-set
+ construct r> construct-delegate ;
: sql-row ( result-set -- seq )
dup #columns [ row-column ] with map ;
diff --git a/extra/db/sqlite/sqlite.factor b/extra/db/sqlite/sqlite.factor
index c03496530b..cfdcfc7750 100755
--- a/extra/db/sqlite/sqlite.factor
+++ b/extra/db/sqlite/sqlite.factor
@@ -5,7 +5,7 @@ hashtables io.files kernel math math.parser namespaces
prettyprint sequences strings tuples alien.c-types
continuations db.sqlite.lib db.sqlite.ffi db.tuples
words combinators.lib db.types combinators tools.walker
-combinators.cleave ;
+combinators.cleave io ;
IN: db.sqlite
TUPLE: sqlite-db path ;
@@ -173,10 +173,14 @@ M: sqlite-db <select-by-slots-statement> ( tuple class -- statement )
" from " 0% 0%
[ sql-spec-slot-name swap get-slot-named ] with subset
- " where " 0%
- [ ", " 0% ]
- [ dup sql-spec-column-name 0% " = " 0% bind% ] interleave
- ";" 0%
+ dup empty? [
+ drop
+ ] [
+ " where " 0%
+ [ ", " 0% ]
+ [ dup sql-spec-column-name 0% " = " 0% bind% ] interleave
+ ";" 0%
+ ] if
] sqlite-make ;
M: sqlite-db modifier-table ( -- hashtable )
diff --git a/extra/db/tuples/tuples-tests.factor b/extra/db/tuples/tuples-tests.factor
index aa94bbfbb6..517f8bcc36 100755
--- a/extra/db/tuples/tuples-tests.factor
+++ b/extra/db/tuples/tuples-tests.factor
@@ -41,73 +41,73 @@ SYMBOL: the-person2
T{ person f 2 "johnny" 10 3.14 }
}
] [ T{ person f f f f 3.14 } select-tuples ] unit-test
+ [
+ {
+ T{ person f 1 "billy" 200 3.14 }
+ T{ person f 2 "johnny" 10 3.14 }
+ }
+ ] [ T{ person f } select-tuples ] unit-test
+
[ ] [ the-person1 get delete-tuple ] unit-test
[ f ] [ T{ person f 1 } select-tuple ] unit-test
[ ] [ person drop-table ] unit-test ;
-: test-sqlite ( -- )
- "tuples-test.db" resource-path sqlite-db [
- test-tuples
- ] with-db ;
+: make-native-person-table ( -- )
+ [ person drop-table ] [ drop ] recover
+ person create-table
+ T{ person f f "billy" 200 3.14 } insert-tuple
+ T{ person f f "johnny" 10 3.14 } insert-tuple
+ ;
-: test-postgresql ( -- )
- { "localhost" "postgres" "" "factor-test" } postgresql-db [
- test-tuples
- ] with-db ;
+: native-person-schema ( -- )
+ person "PERSON"
+ {
+ { "the-id" "ID" +native-id+ }
+ { "the-name" "NAME" { VARCHAR 256 } +not-null+ }
+ { "the-number" "AGE" INTEGER { +default+ 0 } }
+ { "the-real" "REAL" DOUBLE { +default+ 0.3 } }
+ } define-persistent
+ "billy" 10 3.14 <person> the-person1 set
+ "johnny" 10 3.14 <person> the-person2 set ;
-person "PERSON"
-{
- { "the-id" "ID" +native-id+ }
- { "the-name" "NAME" { VARCHAR 256 } +not-null+ }
- { "the-number" "AGE" INTEGER { +default+ 0 } }
- { "the-real" "REAL" DOUBLE { +default+ 0.3 } }
-} define-persistent
+: assigned-person-schema ( -- )
+ person "PERSON"
+ {
+ { "the-id" "ID" INTEGER +assigned-id+ }
+ { "the-name" "NAME" { VARCHAR 256 } +not-null+ }
+ { "the-number" "AGE" INTEGER { +default+ 0 } }
+ { "the-real" "REAL" DOUBLE { +default+ 0.3 } }
+ } define-persistent
+ 1 "billy" 10 3.14 <assigned-person> the-person1 set
+ 2 "johnny" 10 3.14 <assigned-person> the-person2 set ;
-"billy" 10 3.14 <person> the-person1 set
-"johnny" 10 3.14 <person> the-person2 set
-
-test-sqlite
-! test-postgresql
-
-person "PERSON"
-{
- { "the-id" "ID" INTEGER +assigned-id+ }
- { "the-name" "NAME" { VARCHAR 256 } +not-null+ }
- { "the-number" "AGE" INTEGER { +default+ 0 } }
- { "the-real" "REAL" DOUBLE { +default+ 0.3 } }
-} define-persistent
-
-1 "billy" 10 3.14 <assigned-person> the-person1 set
-2 "johnny" 10 3.14 <assigned-person> the-person2 set
-
-test-sqlite
-! test-postgresql
TUPLE: paste n summary author channel mode contents timestamp annotations ;
TUPLE: annotation n paste-id summary author mode contents ;
-paste "PASTE"
-{
- { "n" "ID" +native-id+ }
- { "summary" "SUMMARY" TEXT }
- { "author" "AUTHOR" TEXT }
- { "channel" "CHANNEL" TEXT }
- { "mode" "MODE" TEXT }
- { "contents" "CONTENTS" TEXT }
- { "date" "DATE" TIMESTAMP }
- { "annotations" { +has-many+ annotation } }
-} define-persistent
+: native-paste-schema ( -- )
+ paste "PASTE"
+ {
+ { "n" "ID" +native-id+ }
+ { "summary" "SUMMARY" TEXT }
+ { "author" "AUTHOR" TEXT }
+ { "channel" "CHANNEL" TEXT }
+ { "mode" "MODE" TEXT }
+ { "contents" "CONTENTS" TEXT }
+ { "date" "DATE" TIMESTAMP }
+ { "annotations" { +has-many+ annotation } }
+ } define-persistent
-annotation "ANNOTATION"
-{
- { "n" "ID" +native-id+ }
- { "paste-id" "PASTE_ID" INTEGER { +foreign-id+ paste "n" } }
- { "summary" "SUMMARY" TEXT }
- { "author" "AUTHOR" TEXT }
- { "mode" "MODE" TEXT }
- { "contents" "CONTENTS" TEXT }
-} define-persistent
+ annotation "ANNOTATION"
+ {
+ { "n" "ID" +native-id+ }
+ { "paste-id" "PASTE_ID" INTEGER { +foreign-id+ paste "n" } }
+ { "summary" "SUMMARY" TEXT }
+ { "author" "AUTHOR" TEXT }
+ { "mode" "MODE" TEXT }
+ { "contents" "CONTENTS" TEXT }
+ } define-persistent ;
! { "localhost" "postgres" "" "factor-test" } postgresql-db [
! [ paste drop-table ] [ drop ] recover
@@ -117,3 +117,15 @@ annotation "ANNOTATION"
! [ ] [ paste create-table ] unit-test
! [ ] [ annotation create-table ] unit-test
! ] with-db
+
+
+: test-sqlite ( quot -- )
+ >r "tuples-test.db" resource-path sqlite-db r> with-db ;
+
+: test-postgresql ( -- )
+ >r { "localhost" "postgres" "" "factor-test" } postgresql-db r> with-db ;
+
+[ native-person-schema test-tuples ] test-sqlite
+[ assigned-person-schema test-tuples ] test-sqlite
+
+! [ make-native-person-table ] test-sqlite
From 762d4ebe48e3598ef49019ef83ea3b034ffe727e Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Mon, 3 Mar 2008 08:59:32 -0600
Subject: [PATCH 40/55] headings were not included in lines. oops
---
extra/farkup/farkup.factor | 3 +--
1 file changed, 1 insertion(+), 2 deletions(-)
diff --git a/extra/farkup/farkup.factor b/extra/farkup/farkup.factor
index 718b8b3e28..9b0602d7b2 100644
--- a/extra/farkup/farkup.factor
+++ b/extra/farkup/farkup.factor
@@ -8,8 +8,6 @@ html.elements sequences.deep ascii ;
USE: tools.walker
IN: farkup
-MEMO: any-char ( -- parser ) [ drop t ] satisfy ;
-
: delimiters ( -- string )
"*_^~%=[-|\\\n" ; inline
@@ -108,6 +106,7 @@ MEMO: code ( -- parser )
MEMO: line ( -- parser )
[
text , strong , emphasis , link ,
+ h1 , h2 , h3 , h4 ,
superscript , subscript , inline-code ,
escaped-char , delimiter ,
] choice* repeat1 ;
From cff39b475d6854d4cfcaedb0d42f62790b80b572 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Mon, 3 Mar 2008 09:16:20 -0600
Subject: [PATCH 41/55] previous fix was wrong, real fix is to remove = from
delimiters when printing them by themselves
---
extra/farkup/farkup-tests.factor | 2 ++
extra/farkup/farkup.factor | 9 ++++-----
2 files changed, 6 insertions(+), 5 deletions(-)
diff --git a/extra/farkup/farkup-tests.factor b/extra/farkup/farkup-tests.factor
index 8ac2686718..32909478bf 100644
--- a/extra/farkup/farkup-tests.factor
+++ b/extra/farkup/farkup-tests.factor
@@ -40,3 +40,5 @@ IN: farkup.tests
[ "<table><tr><td>a</td><td>b</td></tr></table>\n<table><tr><td>c</td><td>d</td></tr></table>\n" ]
[ "a|b\nc|d\n" parse-farkup ] unit-test
+[ "<p><strong>foo</strong>\n</p><h1>aheading</h1>\n<p>adfasd</p>" ]
+[ "*foo*\n=aheading=\nadfasd" parse-farkup ] unit-test
diff --git a/extra/farkup/farkup.factor b/extra/farkup/farkup.factor
index 9b0602d7b2..003f1d57a7 100644
--- a/extra/farkup/farkup.factor
+++ b/extra/farkup/farkup.factor
@@ -9,14 +9,14 @@ USE: tools.walker
IN: farkup
: delimiters ( -- string )
- "*_^~%=[-|\\\n" ; inline
+ "*_^~%[-=|\\\n" ; inline
MEMO: text ( -- parser )
[ delimiters member? not ] satisfy repeat1
[ >string escape-string ] action ;
MEMO: delimiter ( -- parser )
- [ dup delimiters member? swap CHAR: \n = not and ] satisfy
+ [ dup delimiters member? swap "\n=" member? not and ] satisfy
[ 1string ] action ;
: surround-with-foo ( string tag -- seq )
@@ -37,12 +37,12 @@ MEMO: emphasis ( -- parser ) "_" "em" delimited ;
MEMO: superscript ( -- parser ) "^" "sup" delimited ;
MEMO: subscript ( -- parser ) "~" "sub" delimited ;
MEMO: inline-code ( -- parser ) "%" "code" delimited ;
+MEMO: nl ( -- parser ) "\n" token ;
+MEMO: 2nl ( -- parser ) "\n\n" token hide ;
MEMO: h1 ( -- parser ) "=" "h1" delimited ;
MEMO: h2 ( -- parser ) "==" "h2" delimited ;
MEMO: h3 ( -- parser ) "===" "h3" delimited ;
MEMO: h4 ( -- parser ) "====" "h4" delimited ;
-MEMO: nl ( -- parser ) "\n" token ;
-MEMO: 2nl ( -- parser ) "\n\n" token hide ;
: render-code ( string mode -- string' )
>r string-lines r>
@@ -106,7 +106,6 @@ MEMO: code ( -- parser )
MEMO: line ( -- parser )
[
text , strong , emphasis , link ,
- h1 , h2 , h3 , h4 ,
superscript , subscript , inline-code ,
escaped-char , delimiter ,
] choice* repeat1 ;
From 2f48327b475a4ef2687bedae8dac95adf99d9d92 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Mon, 3 Mar 2008 13:28:53 -0600
Subject: [PATCH 42/55] move non-core peg parsers to peg.parsers document and
unit test peg.parsers add just parser
---
extra/peg/parsers/parsers-docs.factor | 149 +++++++++++++++++++++++++
extra/peg/parsers/parsers-tests.factor | 50 +++++++++
extra/peg/parsers/parsers.factor | 67 +++++++++++
extra/peg/peg.factor | 44 ++++----
4 files changed, 287 insertions(+), 23 deletions(-)
create mode 100644 extra/peg/parsers/parsers-docs.factor
create mode 100644 extra/peg/parsers/parsers-tests.factor
create mode 100644 extra/peg/parsers/parsers.factor
diff --git a/extra/peg/parsers/parsers-docs.factor b/extra/peg/parsers/parsers-docs.factor
new file mode 100644
index 0000000000..00d98acb71
--- /dev/null
+++ b/extra/peg/parsers/parsers-docs.factor
@@ -0,0 +1,149 @@
+! Copyright (C) 2007 Chris Double.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax peg peg.parsers.private
+unicode.categories ;
+IN: peg.parsers
+
+HELP: (list-of)
+{ $values
+ { "items" "a sequence" }
+ { "separator" "a parser" }
+ { "repeat1?" "a boolean" }
+ { "parser" "a parser" }
+} { $description
+ "Returns a parser that returns a list of items separated by the separator parser. Does not hide the separators."
+} { $see-also list-of list-of-many } ;
+
+HELP: list-of
+{ $values
+ { "items" "a sequence" }
+ { "separator" "a parser" }
+} { $description
+ "Returns a parser that returns a list of items separated by the separator parser. Hides the separators and matches a list of one or more items."
+} { $notes "Use " { $link list-of-many } " to ensure a list contains two or more items." }
+{ $examples
+ { $example "\"a\" \"a\" token \",\" token list-of parse parse-result-ast ." "V{ \"a\" }" }
+ { $example "\"a,a,a,a\" \"a\" token \",\" token list-of parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
+} { $see-also list-of-many } ;
+
+HELP: list-of-many
+{ $values
+ { "items" "a sequence" }
+ { "separator" "a parser" }
+} { $description
+ "Returns a parser that returns a list of items separated by the separator parser. Hides the separators and matches a list of two or more items."
+} { $notes "Use " { $link list-of } " to return a list of only one item."
+} { $examples
+ { $example "\"a\" \"a\" token \",\" token list-of-many parse ." "f" }
+ { $example "\"a,a,a,a\" \"a\" token \",\" token list-of-many parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
+} { $see-also list-of } ;
+
+HELP: epsilon
+{ $values
+ { "parser" "a parser" }
+} { $description
+ "Returns a parser that matches the empty sequence."
+} ;
+
+HELP: any-char
+{ $values
+ { "parser" "a parser" }
+} { $description
+ "Returns a parser that matches the any single character."
+} ;
+
+HELP: exactly-n
+{ $values
+ { "parser" "a parser" }
+ { "n" "an integer" }
+ { "parser'" "a parser" }
+} { $description
+ "Returns a parser that matches an exact repetition of the input parser."
+} { $examples
+ { $example "\"aaa\" \"a\" token 4 exactly-n parse ." "f" }
+ { $example "\"aaaa\" \"a\" token 4 exactly-n parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
+} { $see-also at-least-n at-most-n from-m-to-n } ;
+
+HELP: at-least-n
+{ $values
+ { "parser" "a parser" }
+ { "n" "an integer" }
+ { "parser'" "a parser" }
+} { $description
+ "Returns a parser that matches n or more repetitions of the input parser."
+} { $examples
+ { $example "\"aaa\" \"a\" token 4 at-least-n parse ." "f" }
+ { $example "\"aaaa\" \"a\" token 4 at-least-n parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
+ { $example "\"aaaaa\" \"a\" token 4 at-least-n parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" \"a\" \"a\" }" }
+} { $see-also exactly-n at-most-n from-m-to-n } ;
+
+HELP: at-most-n
+{ $values
+ { "parser" "a parser" }
+ { "n" "an integer" }
+ { "parser'" "a parser" }
+} { $description
+ "Returns a parser that matches n or fewer repetitions of the input parser."
+} { $examples
+ { $example "\"aaaa\" \"a\" token 4 at-most-n parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
+ { $example "\"aaaaa\" \"a\" token 4 at-most-n parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
+} { $see-also exactly-n at-least-n from-m-to-n } ;
+
+HELP: from-m-to-n
+{ $values
+ { "parser" "a parser" }
+ { "m" "an integer" }
+ { "n" "an integer" }
+ { "parser'" "a parser" }
+} { $description
+ "Returns a parser that matches between and including m to n repetitions of the input parser."
+} { $examples
+ { $example "\"aaa\" \"a\" token 3 4 from-m-to-n parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" }" }
+ { $example "\"aaaa\" \"a\" token 3 4 from-m-to-n parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
+ { $example "\"aaaaa\" \"a\" token 3 4 from-m-to-n parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
+} { $see-also exactly-n at-most-n at-least-n } ;
+
+HELP: pack
+{ $values
+ { "begin" "a parser" }
+ { "body" "a parser" }
+ { "end" "a parser" }
+ { "parser'" "a parser" }
+} { $description
+ "Returns a parser that parses the begin, body, and end parsers in order. The begin and end parsers are hidden."
+} { $examples
+ { $example "\"hi123bye\" \"hi\" token 'integer' \"bye\" token pack parse parse-result-ast ." "V{ 123 }" }
+} { $see-also surrounded-by } ;
+
+HELP: surrounded-by
+{ $values
+ { "parser" "a parser" }
+ { "begin" "a string" }
+ { "end" "a string" }
+ { "parser'" "a parser" }
+} { $description
+ "Calls token on begin and end to make them into string parsers. Returns a parser that parses the begin, body, and end parsers in order. The begin and end parsers are hidden."
+} { $examples
+ { $example "\"hi123bye\" 'integer' \"hi\" \"bye\" surrounded-by parse parse-result-ast ." "V{ 123 }" }
+} { $see-also pack } ;
+
+HELP: 'digit'
+{ $values
+ { "parser" "a parser" }
+} { $description
+ "Returns a parser that matches a single digit as defined by the " { $link digit? } " word."
+} { $see-also 'integer' } ;
+
+HELP: 'integer'
+{ $values
+ { "parser" "a parser" }
+} { $description
+ "Returns a parser that matches an integer composed of digits, as defined by the " { $link 'digit' } " word."
+} { $see-also 'digit' 'string' } ;
+
+HELP: 'string'
+{ $values
+ { "parser" "a parser" }
+} { $description
+ "Returns a parser that matches an string composed of a \", anything that is not \", and another \"."
+} { $see-also 'integer' } ;
diff --git a/extra/peg/parsers/parsers-tests.factor b/extra/peg/parsers/parsers-tests.factor
new file mode 100644
index 0000000000..08bde98419
--- /dev/null
+++ b/extra/peg/parsers/parsers-tests.factor
@@ -0,0 +1,50 @@
+USING: kernel peg peg.parsers tools.test ;
+IN: peg.parsers.tests
+
+[ V{ "a" } ]
+[ "a" "a" token "," token list-of parse parse-result-ast ] unit-test
+
+[ V{ "a" "a" "a" "a" } ]
+[ "a,a,a,a" "a" token "," token list-of parse parse-result-ast ] unit-test
+
+[ f ]
+[ "a" "a" token "," token list-of-many parse ] unit-test
+
+[ V{ "a" "a" "a" "a" } ]
+[ "a,a,a,a" "a" token "," token list-of-many parse parse-result-ast ] unit-test
+
+[ f ]
+[ "aaa" "a" token 4 exactly-n parse ] unit-test
+
+[ V{ "a" "a" "a" "a" } ]
+[ "aaaa" "a" token 4 exactly-n parse parse-result-ast ] unit-test
+
+[ f ]
+[ "aaa" "a" token 4 at-least-n parse ] unit-test
+
+[ V{ "a" "a" "a" "a" } ]
+[ "aaaa" "a" token 4 at-least-n parse parse-result-ast ] unit-test
+
+[ V{ "a" "a" "a" "a" "a" } ]
+[ "aaaaa" "a" token 4 at-least-n parse parse-result-ast ] unit-test
+
+[ V{ "a" "a" "a" "a" } ]
+[ "aaaa" "a" token 4 at-most-n parse parse-result-ast ] unit-test
+
+[ V{ "a" "a" "a" "a" } ]
+[ "aaaaa" "a" token 4 at-most-n parse parse-result-ast ] unit-test
+
+[ V{ "a" "a" "a" } ]
+[ "aaa" "a" token 3 4 from-m-to-n parse parse-result-ast ] unit-test
+
+[ V{ "a" "a" "a" "a" } ]
+[ "aaaa" "a" token 3 4 from-m-to-n parse parse-result-ast ] unit-test
+
+[ V{ "a" "a" "a" "a" } ]
+[ "aaaaa" "a" token 3 4 from-m-to-n parse parse-result-ast ] unit-test
+
+[ 97 ]
+[ "a" any-char parse parse-result-ast ] unit-test
+
+[ V{ } ]
+[ "" epsilon parse parse-result-ast ] unit-test
diff --git a/extra/peg/parsers/parsers.factor b/extra/peg/parsers/parsers.factor
new file mode 100644
index 0000000000..86a301bcbf
--- /dev/null
+++ b/extra/peg/parsers/parsers.factor
@@ -0,0 +1,67 @@
+! Copyright (C) 2007, 2008 Chris Double, Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel sequences strings namespaces math assocs shuffle
+ vectors arrays combinators.lib memoize math.parser match
+ unicode.categories sequences.deep peg ;
+IN: peg.parsers
+
+<PRIVATE
+MEMO: (list-of) ( items separator repeat1? -- parser )
+ >r over 2seq r> [ repeat1 ] [ repeat0 ] if [ concat ] action 2seq
+ [ unclip 1vector swap first append ] action ;
+PRIVATE>
+
+MEMO: list-of ( items separator -- parser )
+ hide f (list-of) ;
+
+MEMO: list-of-many ( items separator -- parser )
+ hide t (list-of) ;
+
+MEMO: epsilon ( -- parser ) V{ } token ;
+
+MEMO: any-char ( -- parser ) [ drop t ] satisfy ;
+
+<PRIVATE
+
+: flatten-vectors ( pair -- vector )
+ first2 over push-all ;
+
+PRIVATE>
+
+MEMO: exactly-n ( parser n -- parser' )
+ swap <repetition> seq ;
+
+MEMO: at-most-n ( parser n -- parser' )
+ dup zero? [
+ 2drop epsilon
+ ] [
+ 2dup exactly-n
+ -rot 1- at-most-n 2choice
+ ] if ;
+
+MEMO: at-least-n ( parser n -- parser' )
+ dupd exactly-n swap repeat0 2seq
+ [ flatten-vectors ] action ;
+
+MEMO: from-m-to-n ( parser m n -- parser' )
+ >r [ exactly-n ] 2keep r> swap - at-most-n 2seq
+ [ flatten-vectors ] action ;
+
+MEMO: pack ( begin body end -- parser )
+ >r >r hide r> r> hide 3seq ;
+
+MEMO: surrounded-by ( parser begin end -- parser' )
+ [ token ] 2apply swapd pack ;
+
+MEMO: 'digit' ( -- parser )
+ [ digit? ] satisfy [ digit> ] action ;
+
+MEMO: 'integer' ( -- parser )
+ 'digit' repeat1 [ 10 digits>integer ] action ;
+
+MEMO: 'string' ( -- parser )
+ [
+ [ CHAR: " = ] satisfy hide ,
+ [ CHAR: " = not ] satisfy repeat0 ,
+ [ CHAR: " = ] satisfy hide ,
+ ] { } make seq [ first >string ] action ;
diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor
index ed7012da45..a843c460a1 100755
--- a/extra/peg/peg.factor
+++ b/extra/peg/peg.factor
@@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences strings namespaces math assocs shuffle
vectors arrays combinators.lib memoize math.parser match
- unicode.categories ;
+ unicode.categories sequences.lib ;
IN: peg
TUPLE: parse-result remaining ast ;
@@ -292,6 +292,18 @@ M: delay-parser compile ( parser -- quot )
delay-parser-quot % \ compile , \ call ,
] [ ] make ;
+TUPLE: just-parser p1 ;
+
+: just-pattern
+ [
+ ?quot call dup
+ [ parse-result-remaining empty? [ drop f ] unless ] [ f ] if*
+ ] ;
+
+
+M: just-parser compile ( parser -- quot )
+ just-parser-p1 compile \ ?quot just-pattern match-replace ;
+
PRIVATE>
MEMO: token ( string -- parser )
@@ -312,6 +324,9 @@ MEMO: range ( min max -- parser )
: 3seq ( parser1 parser2 parser3 -- parser )
3array seq ;
+: 4seq ( parser1 parser2 parser3 parser4 -- parser )
+ 4array seq ;
+
: seq* ( quot -- paser )
{ } make seq ; inline
@@ -324,6 +339,9 @@ MEMO: range ( min max -- parser )
: 3choice ( parser1 parser2 parser3 -- parser )
3array choice ;
+: 4choice ( parser1 parser2 parser3 parser4 -- parser )
+ 4array choice ;
+
: choice* ( quot -- paser )
{ } make choice ; inline
@@ -354,25 +372,5 @@ MEMO: hide ( parser -- parser )
MEMO: delay ( parser -- parser )
delay-parser construct-boa init-parser ;
-MEMO: (list-of) ( items separator repeat1? -- parser )
- >r over 2seq r> [ repeat1 ] [ repeat0 ] if [ concat ] action 2seq
- [ unclip 1vector swap first append ] action ;
-
-MEMO: list-of ( items separator -- parser )
- hide f (list-of) ;
-
-MEMO: list-of* ( items separator -- parser )
- hide t (list-of) ;
-
-MEMO: 'digit' ( -- parser )
- [ digit? ] satisfy [ digit> ] action ;
-
-MEMO: 'integer' ( -- parser )
- 'digit' repeat1 [ 10 digits>integer ] action ;
-
-MEMO: 'string' ( -- parser )
- [
- [ CHAR: " = ] satisfy hide ,
- [ CHAR: " = not ] satisfy repeat0 ,
- [ CHAR: " = ] satisfy hide ,
- ] { } make seq [ first >string ] action ;
+MEMO: just ( parser -- parser )
+ just-parser construct-boa init-parser ;
From a969b9c778abab4646a5a1b66581d85ab953941d Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Mon, 3 Mar 2008 13:29:28 -0600
Subject: [PATCH 43/55] use sequences.deep's flatten
---
extra/parser-combinators/parser-combinators.factor | 7 +------
1 file changed, 1 insertion(+), 6 deletions(-)
diff --git a/extra/parser-combinators/parser-combinators.factor b/extra/parser-combinators/parser-combinators.factor
index cdf89e1f37..bf06708e09 100755
--- a/extra/parser-combinators/parser-combinators.factor
+++ b/extra/parser-combinators/parser-combinators.factor
@@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: lazy-lists promises kernel sequences strings math
arrays splitting quotations combinators namespaces
-unicode.case unicode.categories ;
+unicode.case unicode.categories sequences.deep ;
IN: parser-combinators
! Parser combinator protocol
@@ -329,11 +329,6 @@ LAZY: <(+)> ( parser -- parser )
LAZY: surrounded-by ( parser start end -- parser' )
[ token ] 2apply swapd pack ;
-: flatten* ( obj -- )
- dup array? [ [ flatten* ] each ] [ , ] if ;
-
-: flatten [ flatten* ] { } make ;
-
: exactly-n ( parser n -- parser' )
swap <repetition> <and-parser> [ flatten ] <@ ;
From 64c5dc591c79535b2e56c6a77fac977eec621e26 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Mon, 3 Mar 2008 14:06:16 -0600
Subject: [PATCH 44/55] fix using
---
extra/builder/util/util.factor | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/extra/builder/util/util.factor b/extra/builder/util/util.factor
index 1081d3256d..9682fc1346 100644
--- a/extra/builder/util/util.factor
+++ b/extra/builder/util/util.factor
@@ -3,7 +3,7 @@ USING: kernel words namespaces classes parser continuations
io io.files io.launcher io.sockets
math math.parser
combinators sequences splitting quotations arrays strings tools.time
- parser-combinators new-slots accessors assocs.lib
+ sequences.deep new-slots accessors assocs.lib
combinators.cleave bake calendar calendar.format ;
IN: builder.util
@@ -108,4 +108,4 @@ USE: prettyprint
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-: failsafe ( quot -- ) [ drop ] recover ;
\ No newline at end of file
+: failsafe ( quot -- ) [ drop ] recover ;
From 6378d38d636893882eadaf6528bd84d380977f82 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Mon, 3 Mar 2008 14:32:37 -0600
Subject: [PATCH 45/55] add missing usings
---
extra/peg/ebnf/ebnf.factor | 4 ++--
extra/peg/pl0/pl0.factor | 3 ++-
2 files changed, 4 insertions(+), 3 deletions(-)
diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor
index d134f3316f..5d7d7297ef 100644
--- a/extra/peg/ebnf/ebnf.factor
+++ b/extra/peg/ebnf/ebnf.factor
@@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: kernel parser words arrays strings math.parser sequences
quotations vectors namespaces math assocs continuations peg
- unicode.categories ;
+ peg.parsers unicode.categories ;
IN: peg.ebnf
TUPLE: ebnf-non-terminal symbol ;
@@ -182,4 +182,4 @@ DEFER: 'choice'
f
] if* ;
-: <EBNF "EBNF>" parse-tokens " " join ebnf>quot call ; parsing
\ No newline at end of file
+: <EBNF "EBNF>" parse-tokens " " join ebnf>quot call ; parsing
diff --git a/extra/peg/pl0/pl0.factor b/extra/peg/pl0/pl0.factor
index b6b030f56c..6844eb44dc 100644
--- a/extra/peg/pl0/pl0.factor
+++ b/extra/peg/pl0/pl0.factor
@@ -1,6 +1,7 @@
! Copyright (C) 2007 Chris Double.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel arrays strings math.parser sequences peg peg.ebnf memoize ;
+USING: kernel arrays strings math.parser sequences
+peg peg.ebnf peg.parsers memoize ;
IN: peg.pl0
#! Grammar for PL/0 based on http://en.wikipedia.org/wiki/PL/0
From bd7fea256880887fedea3ec38160c1b46f57f701 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Mon, 3 Mar 2008 14:38:09 -0600
Subject: [PATCH 46/55] add missing using
---
extra/fjsc/fjsc.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/extra/fjsc/fjsc.factor b/extra/fjsc/fjsc.factor
index 5b5900f0bc..3811949c1d 100755
--- a/extra/fjsc/fjsc.factor
+++ b/extra/fjsc/fjsc.factor
@@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: kernel peg strings promises sequences math math.parser
namespaces words quotations arrays hashtables io
- io.streams.string assocs memoize ascii ;
+ io.streams.string assocs memoize ascii peg.parsers ;
IN: fjsc
TUPLE: ast-number value ;
From dd42efaa20457ad8f03ff8c3fd020a41f5cac1e4 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Mon, 3 Mar 2008 14:39:29 -0600
Subject: [PATCH 47/55] fix load
---
extra/farkup/farkup.factor | 5 ++---
1 file changed, 2 insertions(+), 3 deletions(-)
diff --git a/extra/farkup/farkup.factor b/extra/farkup/farkup.factor
index 003f1d57a7..a1636d0356 100644
--- a/extra/farkup/farkup.factor
+++ b/extra/farkup/farkup.factor
@@ -2,9 +2,8 @@
! See http://factorcode.org/license.txt for BSD license.
USING: arrays io kernel memoize namespaces peg
peg.ebnf sequences strings html.elements xml.entities
-xmode.code2html splitting io.streams.string html
-html.elements sequences.deep ascii ;
-! unicode.categories ;
+xmode.code2html splitting io.streams.string html peg.parsers
+html.elements sequences.deep unicode.categories ;
USE: tools.walker
IN: farkup
From c3c315a580720dddc2521e2b6ebe4b091eb7ee46 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Mon, 3 Mar 2008 14:41:22 -0600
Subject: [PATCH 48/55] fix path
---
extra/io/files/temporary/temporary.factor | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/extra/io/files/temporary/temporary.factor b/extra/io/files/temporary/temporary.factor
index 5c5e72e83f..c4b197cf5e 100644
--- a/extra/io/files/temporary/temporary.factor
+++ b/extra/io/files/temporary/temporary.factor
@@ -27,6 +27,6 @@ IN: io.files.temporary
[ with-directory ] 2keep drop delete-tree ;
{
- { [ unix? ] [ "io.unix.files.temporary" ] }
- { [ windows? ] [ "io.windows.files.temporary" ] }
+ { [ unix? ] [ "io.unix.files.unique" ] }
+ { [ windows? ] [ "io.windows.files.unique" ] }
} cond require
From ae6ad23855e7c3b116236551bf005d1c3d54b118 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Mon, 3 Mar 2008 14:42:32 -0600
Subject: [PATCH 49/55] remove io.windows.files.temporary
---
extra/io/windows/files/temporary/temporary.factor | 10 ----------
1 file changed, 10 deletions(-)
delete mode 100644 extra/io/windows/files/temporary/temporary.factor
diff --git a/extra/io/windows/files/temporary/temporary.factor b/extra/io/windows/files/temporary/temporary.factor
deleted file mode 100644
index 426cab367b..0000000000
--- a/extra/io/windows/files/temporary/temporary.factor
+++ /dev/null
@@ -1,10 +0,0 @@
-USING: io.files.temporary.backend io.nonblocking io.windows
-kernel system windows.kernel32 ;
-
-IN: io.windows.files.temporary
-
-M: windows-io (temporary-file) ( path -- stream )
- GENERIC_WRITE CREATE_NEW 0 open-file 0 <win32-file> <writer> ;
-
-M: windows-io temporary-path ( -- path )
- "TEMP" os-env ;
From 58d6e4c97d10e960bb8ee32b98cd83501070b0cb Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Mon, 3 Mar 2008 14:44:48 -0600
Subject: [PATCH 50/55] remove extra files
---
.../io/files/temporary/backend/backend.factor | 5 ---
extra/io/files/temporary/temporary.factor | 32 -------------------
2 files changed, 37 deletions(-)
delete mode 100644 extra/io/files/temporary/backend/backend.factor
delete mode 100644 extra/io/files/temporary/temporary.factor
diff --git a/extra/io/files/temporary/backend/backend.factor b/extra/io/files/temporary/backend/backend.factor
deleted file mode 100644
index 5c6900b3d2..0000000000
--- a/extra/io/files/temporary/backend/backend.factor
+++ /dev/null
@@ -1,5 +0,0 @@
-USING: io.backend ;
-IN: io.files.temporary.backend
-
-HOOK: (temporary-file) io-backend ( path -- stream path )
-HOOK: temporary-path io-backend ( -- path )
diff --git a/extra/io/files/temporary/temporary.factor b/extra/io/files/temporary/temporary.factor
deleted file mode 100644
index c4b197cf5e..0000000000
--- a/extra/io/files/temporary/temporary.factor
+++ /dev/null
@@ -1,32 +0,0 @@
-USING: kernel math math.bitfields combinators.lib math.parser
-random sequences sequences.lib continuations namespaces
-io.files io.backend io.nonblocking io arrays
-io.files.temporary.backend system combinators vocabs.loader ;
-IN: io.files.temporary
-
-: random-letter ( -- ch ) 26 random { CHAR: a CHAR: A } random + ;
-
-: random-ch ( -- ch )
- { t f } random [ 10 random CHAR: 0 + ] [ random-letter ] if ;
-
-: random-name ( n -- string ) [ drop random-ch ] "" map-as ;
-
-: <temporary-file> ( prefix suffix -- path duplex-stream )
- temporary-path -rot
- [ 10 random-name swap 3append path+ dup (temporary-file) ] 3curry
- 10 retry ;
-
-: with-temporary-file ( quot -- path )
- >r f f <temporary-file> r> with-stream ;
-
-: temporary-directory ( -- path )
- [ temporary-path 10 random-name path+ dup make-directory ] 10 retry ;
-
-: with-temporary-directory ( quot -- )
- >r temporary-directory r>
- [ with-directory ] 2keep drop delete-tree ;
-
-{
- { [ unix? ] [ "io.unix.files.unique" ] }
- { [ windows? ] [ "io.windows.files.unique" ] }
-} cond require
From 07f8203d3e4437de81a4a839887939e00db5ce59 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Mon, 3 Mar 2008 15:23:12 -0600
Subject: [PATCH 51/55] list-of* -> list-of-many
---
extra/farkup/farkup.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/extra/farkup/farkup.factor b/extra/farkup/farkup.factor
index a1636d0356..810ab22ce1 100644
--- a/extra/farkup/farkup.factor
+++ b/extra/farkup/farkup.factor
@@ -84,7 +84,7 @@ MEMO: table-column ( -- parser )
MEMO: table-row ( -- parser )
[
- table-column "|" token hide list-of* ,
+ table-column "|" token hide list-of-many ,
] seq* [ "tr" surround-with-foo ] action ;
MEMO: table ( -- parser )
From 2c23357f25570e464ba1e25db15012abec874f0c Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Mon, 3 Mar 2008 16:44:24 -0600
Subject: [PATCH 52/55] Unit test fixes
---
core/listener/listener-tests.factor | 2 +-
core/parser/parser-tests.factor | 6 +-
core/prettyprint/prettyprint-tests.factor | 10 +--
core/source-files/source-files.factor | 5 +-
extra/fry/fry-tests.factor | 88 ++++++++++---------
extra/fry/fry.factor | 83 +++++++++--------
extra/furnace/furnace-tests.factor | 2 +-
.../help/definitions/definitions-tests.factor | 8 +-
extra/help/syntax/syntax-tests.factor | 6 +-
.../http/server/templating/templating.factor | 4 +-
extra/tools/crossref/crossref-tests.factor | 2 +-
extra/tools/{ => crossref}/test/foo.factor | 2 +-
12 files changed, 115 insertions(+), 103 deletions(-)
mode change 100644 => 100755 extra/furnace/furnace-tests.factor
rename extra/tools/{ => crossref}/test/foo.factor (50%)
mode change 100644 => 100755
diff --git a/core/listener/listener-tests.factor b/core/listener/listener-tests.factor
index 71ea6e66c6..d694c62c67 100755
--- a/core/listener/listener-tests.factor
+++ b/core/listener/listener-tests.factor
@@ -9,7 +9,7 @@ IN: listener.tests
<string-reader> stream-read-quot ;
[ [ ] ] [
- "USE: temporary hello" parse-interactive
+ "USE: listener.tests hello" parse-interactive
] unit-test
[
diff --git a/core/parser/parser-tests.factor b/core/parser/parser-tests.factor
index bfea532242..89783d1b3c 100755
--- a/core/parser/parser-tests.factor
+++ b/core/parser/parser-tests.factor
@@ -24,7 +24,7 @@ IN: parser.tests
[ "hello world" ]
[
"IN: parser.tests : hello \"hello world\" ;"
- eval "USE: temporary hello" eval
+ eval "USE: parser.tests hello" eval
] unit-test
[ ]
@@ -104,12 +104,12 @@ IN: parser.tests
"IN: parser.tests USING: math prettyprint ; : foo 2 2 + . ; parsing" eval
- [ ] [ "USE: temporary foo" eval ] unit-test
+ [ ] [ "USE: parser.tests foo" eval ] unit-test
"IN: parser.tests USING: math prettyprint ; : foo 2 2 + . ;" eval
[ t ] [
- "USE: temporary \\ foo" eval
+ "USE: parser.tests \\ foo" eval
"foo" "parser.tests" lookup eq?
] unit-test
diff --git a/core/prettyprint/prettyprint-tests.factor b/core/prettyprint/prettyprint-tests.factor
index 6226ddca38..20130d7f7e 100755
--- a/core/prettyprint/prettyprint-tests.factor
+++ b/core/prettyprint/prettyprint-tests.factor
@@ -125,18 +125,18 @@ unit-test
"IN: prettyprint.tests"
"GENERIC: method-layout"
""
- "USING: math temporary ;"
+ "USING: math prettyprint.tests ;"
"M: complex method-layout"
" \"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\""
" ;"
""
- "USING: math temporary ;"
+ "USING: math prettyprint.tests ;"
"M: fixnum method-layout ;"
""
- "USING: math temporary ;"
+ "USING: math prettyprint.tests ;"
"M: integer method-layout ;"
""
- "USING: kernel temporary ;"
+ "USING: kernel prettyprint.tests ;"
"M: object method-layout ;"
} ;
@@ -280,7 +280,7 @@ unit-test
"IN: prettyprint.tests"
"GENERIC: class-see-layout ( x -- y )"
""
- "USING: temporary ;"
+ "USING: prettyprint.tests ;"
"M: class-see-layout class-see-layout ;"
} ;
diff --git a/core/source-files/source-files.factor b/core/source-files/source-files.factor
index dd5313383e..98c39ae390 100755
--- a/core/source-files/source-files.factor
+++ b/core/source-files/source-files.factor
@@ -68,7 +68,10 @@ uses definitions ;
: reset-checksums ( -- )
source-files get [
swap ?resource-path dup exists?
- [ file-lines swap record-checksum ] [ 2drop ] if
+ [
+ over record-modified
+ file-lines swap record-checksum
+ ] [ 2drop ] if
] assoc-each ;
M: pathname where pathname-string 1 2array ;
diff --git a/extra/fry/fry-tests.factor b/extra/fry/fry-tests.factor
index e1ef40b44d..4d2c9fe1c8 100755
--- a/extra/fry/fry-tests.factor
+++ b/extra/fry/fry-tests.factor
@@ -1,42 +1,46 @@
-IN: fry.tests
-USING: fry tools.test math prettyprint kernel io arrays
-sequences ;
-
-[ [ 3 + ] ] [ 3 '[ , + ] ] unit-test
-
-[ [ 1 3 + ] ] [ 1 3 '[ , , + ] ] unit-test
-
-[ [ 1 + ] ] [ 1 [ + ] '[ , @ ] ] unit-test
-
-[ [ 1 + . ] ] [ 1 [ + ] '[ , @ . ] ] unit-test
-
-[ [ + - ] ] [ [ + ] [ - ] '[ @ @ ] ] unit-test
-
-[ [ "a" write "b" print ] ]
-[ "a" "b" '[ , write , print ] ] unit-test
-
-[ [ 1 2 + 3 4 - ] ]
-[ [ + ] [ - ] '[ 1 2 @ 3 4 @ ] ] unit-test
-
-[ 1/2 ] [
- 1 '[ , _ / ] 2 swap call
-] unit-test
-
-[ { { 1 "a" "A" } { 1 "b" "B" } { 1 "c" "C" } } ] [
- 1 '[ , _ _ 3array ]
- { "a" "b" "c" } { "A" "B" "C" } rot 2map
-] unit-test
-
-[ { { 1 "a" } { 1 "b" } { 1 "c" } } ] [
- '[ 1 _ 2array ]
- { "a" "b" "c" } swap map
-] unit-test
-
-[ { { 1 "a" 2 } { 1 "b" 2 } { 1 "c" 2 } } ] [
- 1 2 '[ , _ , 3array ]
- { "a" "b" "c" } swap map
-] unit-test
-
-: funny-dip '[ @ _ ] call ; inline
-
-[ "hi" 3 ] [ "h" "i" 3 [ append ] funny-dip ] unit-test
+IN: fry.tests
+USING: fry tools.test math prettyprint kernel io arrays
+sequences ;
+
+[ [ 3 + ] ] [ 3 '[ , + ] ] unit-test
+
+[ [ 1 3 + ] ] [ 1 3 '[ , , + ] ] unit-test
+
+[ [ 1 + ] ] [ 1 [ + ] '[ , @ ] ] unit-test
+
+[ [ 1 + . ] ] [ 1 [ + ] '[ , @ . ] ] unit-test
+
+[ [ + - ] ] [ [ + ] [ - ] '[ @ @ ] ] unit-test
+
+[ [ "a" write "b" print ] ]
+[ "a" "b" '[ , write , print ] ] unit-test
+
+[ [ 1 2 + 3 4 - ] ]
+[ [ + ] [ - ] '[ 1 2 @ 3 4 @ ] ] unit-test
+
+[ 1/2 ] [
+ 1 '[ , _ / ] 2 swap call
+] unit-test
+
+[ { { 1 "a" "A" } { 1 "b" "B" } { 1 "c" "C" } } ] [
+ 1 '[ , _ _ 3array ]
+ { "a" "b" "c" } { "A" "B" "C" } rot 2map
+] unit-test
+
+[ { { 1 "a" } { 1 "b" } { 1 "c" } } ] [
+ '[ 1 _ 2array ]
+ { "a" "b" "c" } swap map
+] unit-test
+
+[ 1 2 ] [
+ 1 2 '[ _ , ] call
+] unit-test
+
+[ { { 1 "a" 2 } { 1 "b" 2 } { 1 "c" 2 } } ] [
+ 1 2 '[ , _ , 3array ]
+ { "a" "b" "c" } swap map
+] unit-test
+
+: funny-dip '[ @ _ ] call ; inline
+
+[ "hi" 3 ] [ "h" "i" 3 [ append ] funny-dip ] unit-test
diff --git a/extra/fry/fry.factor b/extra/fry/fry.factor
index 0b0b91f0d0..f8d49af163 100755
--- a/extra/fry/fry.factor
+++ b/extra/fry/fry.factor
@@ -1,39 +1,44 @@
-! Copyright (C) 2008 Slava Pestov, Eduardo Cavazos.
-! See http://factorcode.org/license.txt for BSD license.
-USING: kernel sequences combinators parser splitting
-quotations ;
-IN: fry
-
-: , "Only valid inside a fry" throw ;
-: @ "Only valid inside a fry" throw ;
-: _ "Only valid inside a fry" throw ;
-
-DEFER: (fry)
-
-: ((fry)) ( accum quot adder -- result )
- >r [ ] swap (fry) r>
- append swap dup empty? [ drop ] [
- [ swap compose ] curry append
- ] if ; inline
-
-: (fry) ( accum quot -- result )
- dup empty? [
- drop 1quotation
- ] [
- unclip {
- { , [ [ curry ] ((fry)) ] }
- { @ [ [ compose ] ((fry)) ] }
- [ swap >r add r> (fry) ]
- } case
- ] if ;
-
-: trivial-fry ( quot -- quot' ) [ ] swap (fry) ;
-
-: fry ( quot -- quot' )
- { _ } last-split1 [
- >r fry [ [ dip ] curry ] r> trivial-fry [ compose ] compose 3compose
- ] [
- trivial-fry
- ] if* ;
-
-: '[ \ ] parse-until fry over push-all ; parsing
+! Copyright (C) 2008 Slava Pestov, Eduardo Cavazos.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel sequences combinators parser splitting
+quotations arrays namespaces ;
+IN: fry
+
+: , "Only valid inside a fry" throw ;
+: @ "Only valid inside a fry" throw ;
+: _ "Only valid inside a fry" throw ;
+
+DEFER: (fry)
+
+: ((fry)) ( accum quot adder -- result )
+ >r [ ] swap (fry) r>
+ append swap dup empty? [ drop ] [
+ [ swap compose ] curry append
+ ] if ; inline
+
+: (fry) ( accum quot -- result )
+ dup empty? [
+ drop 1quotation
+ ] [
+ unclip {
+ { , [ [ curry ] ((fry)) ] }
+ { @ [ [ compose ] ((fry)) ] }
+ [ swap >r add r> (fry) ]
+ } case
+ ] if ;
+
+: trivial-fry ( quot -- quot' ) [ ] swap (fry) ;
+
+: fry ( quot -- quot' )
+ { _ } last-split1 [
+ [
+ trivial-fry %
+ [ >r ] %
+ fry %
+ [ [ dip ] curry r> compose ] %
+ ] [ ] make
+ ] [
+ trivial-fry
+ ] if* ;
+
+: '[ \ ] parse-until fry over push-all ; parsing
diff --git a/extra/furnace/furnace-tests.factor b/extra/furnace/furnace-tests.factor
old mode 100644
new mode 100755
index 84ec798df2..d8124d1f2b
--- a/extra/furnace/furnace-tests.factor
+++ b/extra/furnace/furnace-tests.factor
@@ -39,7 +39,7 @@ TUPLE: test-tuple m n ;
] unit-test
[
- "/responder/temporary/foo?foo=3"
+ "/responder/furnace.tests/foo?foo=3"
] [
[
[ "3" foo ] quot-link
diff --git a/extra/help/definitions/definitions-tests.factor b/extra/help/definitions/definitions-tests.factor
index 921d8e1c69..7134c6b0b0 100755
--- a/extra/help/definitions/definitions-tests.factor
+++ b/extra/help/definitions/definitions-tests.factor
@@ -16,7 +16,7 @@ IN: help.definitions.tests
[ t ] [ "hello" articles get key? ] unit-test
[ t ] [ "hello2" articles get key? ] unit-test
[ t ] [
- "hello" "help.definitions" lookup "help" word-prop >boolean
+ "hello" "help.definitions.tests" lookup "help" word-prop >boolean
] unit-test
[ 2 ] [
@@ -29,12 +29,12 @@ IN: help.definitions.tests
[ t ] [ "hello" articles get key? ] unit-test
[ f ] [ "hello2" articles get key? ] unit-test
[ f ] [
- "hello" "help.definitions" lookup "help" word-prop
+ "hello" "help.definitions.tests" lookup "help" word-prop
] unit-test
[ ] [ "IN: help.definitions.tests USING: help.syntax ; : xxx ; HELP: xxx ;" eval ] unit-test
- [ ] [ "xxx" "help.definitions" lookup help ] unit-test
+ [ ] [ "xxx" "help.definitions.tests" lookup help ] unit-test
- [ ] [ "xxx" "help.definitions" lookup >link synopsis print ] unit-test
+ [ ] [ "xxx" "help.definitions.tests" lookup >link synopsis print ] unit-test
] with-file-vocabs
diff --git a/extra/help/syntax/syntax-tests.factor b/extra/help/syntax/syntax-tests.factor
index 038d7fa490..bcf92b77c7 100755
--- a/extra/help/syntax/syntax-tests.factor
+++ b/extra/help/syntax/syntax-tests.factor
@@ -4,18 +4,18 @@ USING: tools.test parser vocabs help.syntax namespaces ;
[
[ "foobar" ] [
"IN: help.syntax.tests USE: help.syntax ABOUT: \"foobar\"" eval
- "help.syntax" vocab vocab-help
+ "help.syntax.tests" vocab vocab-help
] unit-test
[ { "foobar" } ] [
"IN: help.syntax.tests USE: help.syntax ABOUT: { \"foobar\" }" eval
- "help.syntax" vocab vocab-help
+ "help.syntax.tests" vocab vocab-help
] unit-test
SYMBOL: xyz
[ xyz ] [
"IN: help.syntax.tests USE: help.syntax ABOUT: xyz" eval
- "help.syntax" vocab vocab-help
+ "help.syntax.tests" vocab vocab-help
] unit-test
] with-file-vocabs
diff --git a/extra/http/server/templating/templating.factor b/extra/http/server/templating/templating.factor
index 3b0dcb8e5e..4c451f7f6e 100755
--- a/extra/http/server/templating/templating.factor
+++ b/extra/http/server/templating/templating.factor
@@ -82,10 +82,10 @@ DEFER: <% delimiter
templating-vocab use+
! so that reload works properly
dup source-file file set
- dup ?resource-path file-contents
+ ?resource-path file-contents
[ eval-template ] [ html-error. drop ] recover
] with-file-vocabs
- ] assert-depth drop ;
+ ] curry assert-depth ;
: run-relative-template-file ( filename -- )
file get source-file-path parent-directory
diff --git a/extra/tools/crossref/crossref-tests.factor b/extra/tools/crossref/crossref-tests.factor
index 8616be141e..a277a68ed7 100755
--- a/extra/tools/crossref/crossref-tests.factor
+++ b/extra/tools/crossref/crossref-tests.factor
@@ -6,7 +6,7 @@ GENERIC: foo
M: integer foo + ;
-"resource:extra/tools/test/foo.factor" run-file
+"resource:extra/tools/crossref/test/foo.factor" run-file
[ t ] [ integer \ foo method method-word \ + usage member? ] unit-test
[ t ] [ \ foo usage [ pathname? ] contains? ] unit-test
diff --git a/extra/tools/test/foo.factor b/extra/tools/crossref/test/foo.factor
old mode 100644
new mode 100755
similarity index 50%
rename from extra/tools/test/foo.factor
rename to extra/tools/crossref/test/foo.factor
index 944a25cf5e..f7bc321912
--- a/extra/tools/test/foo.factor
+++ b/extra/tools/crossref/test/foo.factor
@@ -1,4 +1,4 @@
-USE: temporary
+USE: tools.crossref.tests
USE: kernel
1 2 foo drop
From 05a02ade7aa6a2f69f7e155c25dfbdf82b41b894 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Mon, 3 Mar 2008 16:45:18 -0600
Subject: [PATCH 53/55] Unix <process-stream> now compiles
---
extra/io/unix/launcher/launcher.factor | 32 +------------
.../unix/launcher/parser/parser-tests.factor | 33 +++++++++++++
extra/io/unix/launcher/parser/parser.factor | 47 +++++++++++++++++++
extra/peg/parsers/parsers-docs.factor | 4 +-
extra/peg/parsers/parsers.factor | 18 ++++++-
extra/peg/peg.factor | 15 ------
6 files changed, 101 insertions(+), 48 deletions(-)
create mode 100755 extra/io/unix/launcher/parser/parser-tests.factor
create mode 100755 extra/io/unix/launcher/parser/parser.factor
mode change 100644 => 100755 extra/peg/parsers/parsers-docs.factor
mode change 100644 => 100755 extra/peg/parsers/parsers.factor
diff --git a/extra/io/unix/launcher/launcher.factor b/extra/io/unix/launcher/launcher.factor
index 0393b13c7f..444a662c32 100755
--- a/extra/io/unix/launcher/launcher.factor
+++ b/extra/io/unix/launcher/launcher.factor
@@ -2,41 +2,13 @@
! See http://factorcode.org/license.txt for BSD license.
USING: io io.backend io.launcher io.unix.backend io.unix.files
io.nonblocking sequences kernel namespaces math system
- alien.c-types debugger continuations arrays assocs
-combinators unix.process parser-combinators memoize
-promises strings threads unix ;
+alien.c-types debugger continuations arrays assocs combinators
+unix.process strings threads unix ;
IN: io.unix.launcher
! Search unix first
USE: unix
-! Our command line parser. Supported syntax:
-! foo bar baz -- simple tokens
-! foo\ bar -- escaping the space
-! 'foo bar' -- quotation
-! "foo bar" -- quotation
-LAZY: 'escaped-char' "\\" token any-char-parser &> ;
-
-LAZY: 'quoted-char' ( delimiter -- parser' )
- 'escaped-char'
- swap [ member? not ] curry satisfy
- <|> ; inline
-
-LAZY: 'quoted' ( delimiter -- parser )
- dup 'quoted-char' <!*> swap dup surrounded-by ;
-
-LAZY: 'unquoted' ( -- parser ) " '\"" 'quoted-char' <!+> ;
-
-LAZY: 'argument' ( -- parser )
- "\"" 'quoted' "'" 'quoted' 'unquoted' <|> <|>
- [ >string ] <@ ;
-
-MEMO: 'arguments' ( -- parser )
- 'argument' " " token <!+> nonempty-list-of ;
-
-: tokenize-command ( command -- arguments )
- 'arguments' just parse-1 ;
-
: get-arguments ( -- seq )
+command+ get [ tokenize-command ] [ +arguments+ get ] if* ;
diff --git a/extra/io/unix/launcher/parser/parser-tests.factor b/extra/io/unix/launcher/parser/parser-tests.factor
new file mode 100755
index 0000000000..63aadcabbe
--- /dev/null
+++ b/extra/io/unix/launcher/parser/parser-tests.factor
@@ -0,0 +1,33 @@
+IN: io.unix.launcher.parser.tests
+USING: io.unix.launcher.parser tools.test ;
+
+[ "" tokenize-command ] must-fail
+[ " " tokenize-command ] must-fail
+[ V{ "a" } ] [ "a" tokenize-command ] unit-test
+[ V{ "abc" } ] [ "abc" tokenize-command ] unit-test
+[ V{ "abc" } ] [ "abc " tokenize-command ] unit-test
+[ V{ "abc" } ] [ " abc" tokenize-command ] unit-test
+[ V{ "abc" "def" } ] [ "abc def" tokenize-command ] unit-test
+[ V{ "abc def" } ] [ "abc\\ def" tokenize-command ] unit-test
+[ V{ "abc\\" "def" } ] [ "abc\\\\ def" tokenize-command ] unit-test
+[ V{ "abc\\ def" } ] [ "'abc\\\\ def'" tokenize-command ] unit-test
+[ V{ "abc\\ def" } ] [ " 'abc\\\\ def'" tokenize-command ] unit-test
+[ V{ "abc\\ def" "hey" } ] [ "'abc\\\\ def' hey" tokenize-command ] unit-test
+[ V{ "abc def" "hey" } ] [ "'abc def' \"hey\"" tokenize-command ] unit-test
+[ "'abc def' \"hey" tokenize-command ] must-fail
+[ "'abc def" tokenize-command ] must-fail
+[ V{ "abc def" "h\"ey" } ] [ "'abc def' \"h\\\"ey\" " tokenize-command ] unit-test
+
+[
+ V{
+ "Hello world.app/Contents/MacOS/hello-ui"
+ "-i=boot.macosx-ppc.image"
+ "-include= math compiler ui"
+ "-deploy-vocab=hello-ui"
+ "-output-image=Hello world.app/Contents/Resources/hello-ui.image"
+ "-no-stack-traces"
+ "-no-user-init"
+ }
+] [
+ "\"Hello world.app/Contents/MacOS/hello-ui\" -i=boot.macosx-ppc.image \"-include= math compiler ui\" -deploy-vocab=hello-ui \"-output-image=Hello world.app/Contents/Resources/hello-ui.image\" -no-stack-traces -no-user-init" tokenize-command
+] unit-test
diff --git a/extra/io/unix/launcher/parser/parser.factor b/extra/io/unix/launcher/parser/parser.factor
new file mode 100755
index 0000000000..9be5a48d1d
--- /dev/null
+++ b/extra/io/unix/launcher/parser/parser.factor
@@ -0,0 +1,47 @@
+! Copyright (C) 2008 Slava Pestov
+! See http://factorcode.org/license.txt for BSD license.
+IN: io.unix.launcher.parser
+USING: peg peg.parsers kernel sequences strings qualified
+words ;
+QUALIFIED: compiler.units
+
+! Our command line parser. Supported syntax:
+! foo bar baz -- simple tokens
+! foo\ bar -- escaping the space
+! 'foo bar' -- quotation
+! "foo bar" -- quotation
+: 'escaped-char'
+ "\\" token [ drop t ] satisfy 2seq [ second ] action ;
+
+: 'quoted-char' ( delimiter -- parser' )
+ 'escaped-char'
+ swap [ member? not ] curry satisfy
+ 2choice ; inline
+
+: 'quoted' ( delimiter -- parser )
+ dup 'quoted-char' repeat0 swap dup surrounded-by ;
+
+: 'unquoted' ( -- parser ) " '\"" 'quoted-char' repeat1 ;
+
+: 'argument' ( -- parser )
+ "\"" 'quoted'
+ "'" 'quoted'
+ 'unquoted' 3choice
+ [ >string ] action ;
+
+: 'arguments' ( -- parser )
+ 'argument' " " token repeat1 list-of
+ " " token repeat0 swap over pack
+ just ;
+
+DEFER: argument-parser
+
+[
+ \ argument-parser
+ 'arguments' compile
+ define
+] compiler.units:with-compilation-unit
+
+: tokenize-command ( command -- arguments )
+ argument-parser
+ dup [ parse-result-ast ] [ "Parse failed" throw ] if ;
diff --git a/extra/peg/parsers/parsers-docs.factor b/extra/peg/parsers/parsers-docs.factor
old mode 100644
new mode 100755
index 00d98acb71..437edc1007
--- a/extra/peg/parsers/parsers-docs.factor
+++ b/extra/peg/parsers/parsers-docs.factor
@@ -112,7 +112,7 @@ HELP: pack
} { $description
"Returns a parser that parses the begin, body, and end parsers in order. The begin and end parsers are hidden."
} { $examples
- { $example "\"hi123bye\" \"hi\" token 'integer' \"bye\" token pack parse parse-result-ast ." "V{ 123 }" }
+ { $example "\"hi123bye\" \"hi\" token 'integer' \"bye\" token pack parse parse-result-ast ." "123" }
} { $see-also surrounded-by } ;
HELP: surrounded-by
@@ -124,7 +124,7 @@ HELP: surrounded-by
} { $description
"Calls token on begin and end to make them into string parsers. Returns a parser that parses the begin, body, and end parsers in order. The begin and end parsers are hidden."
} { $examples
- { $example "\"hi123bye\" 'integer' \"hi\" \"bye\" surrounded-by parse parse-result-ast ." "V{ 123 }" }
+ { $example "\"hi123bye\" 'integer' \"hi\" \"bye\" surrounded-by parse parse-result-ast ." "123" }
} { $see-also pack } ;
HELP: 'digit'
diff --git a/extra/peg/parsers/parsers.factor b/extra/peg/parsers/parsers.factor
old mode 100644
new mode 100755
index 86a301bcbf..60002a450a
--- a/extra/peg/parsers/parsers.factor
+++ b/extra/peg/parsers/parsers.factor
@@ -5,6 +5,22 @@ USING: kernel sequences strings namespaces math assocs shuffle
unicode.categories sequences.deep peg ;
IN: peg.parsers
+TUPLE: just-parser p1 ;
+
+: just-pattern
+ [
+ dup [
+ dup parse-result-remaining empty? [ drop f ] unless
+ ] when
+ ] ;
+
+
+M: just-parser compile ( parser -- quot )
+ just-parser-p1 compile just-pattern swap append ;
+
+MEMO: just ( parser -- parser )
+ just-parser construct-boa init-parser ;
+
<PRIVATE
MEMO: (list-of) ( items separator repeat1? -- parser )
>r over 2seq r> [ repeat1 ] [ repeat0 ] if [ concat ] action 2seq
@@ -48,7 +64,7 @@ MEMO: from-m-to-n ( parser m n -- parser' )
[ flatten-vectors ] action ;
MEMO: pack ( begin body end -- parser )
- >r >r hide r> r> hide 3seq ;
+ >r >r hide r> r> hide 3seq [ first ] action ;
MEMO: surrounded-by ( parser begin end -- parser' )
[ token ] 2apply swapd pack ;
diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor
index a843c460a1..91877d680c 100755
--- a/extra/peg/peg.factor
+++ b/extra/peg/peg.factor
@@ -292,18 +292,6 @@ M: delay-parser compile ( parser -- quot )
delay-parser-quot % \ compile , \ call ,
] [ ] make ;
-TUPLE: just-parser p1 ;
-
-: just-pattern
- [
- ?quot call dup
- [ parse-result-remaining empty? [ drop f ] unless ] [ f ] if*
- ] ;
-
-
-M: just-parser compile ( parser -- quot )
- just-parser-p1 compile \ ?quot just-pattern match-replace ;
-
PRIVATE>
MEMO: token ( string -- parser )
@@ -371,6 +359,3 @@ MEMO: hide ( parser -- parser )
MEMO: delay ( parser -- parser )
delay-parser construct-boa init-parser ;
-
-MEMO: just ( parser -- parser )
- just-parser construct-boa init-parser ;
From b705f18a6b1ac1e6bc52f97fdfda62b17806a7ff Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Mon, 3 Mar 2008 16:45:34 -0600
Subject: [PATCH 54/55] Remove obsolete file
---
extra/io/unix/launcher/launcher-tests.factor | 33 --------------------
1 file changed, 33 deletions(-)
delete mode 100755 extra/io/unix/launcher/launcher-tests.factor
diff --git a/extra/io/unix/launcher/launcher-tests.factor b/extra/io/unix/launcher/launcher-tests.factor
deleted file mode 100755
index 7b2a7848fc..0000000000
--- a/extra/io/unix/launcher/launcher-tests.factor
+++ /dev/null
@@ -1,33 +0,0 @@
-IN: io.unix.launcher.tests
-USING: io.unix.launcher tools.test ;
-
-[ "" tokenize-command ] must-fail
-[ " " tokenize-command ] must-fail
-[ { "a" } ] [ "a" tokenize-command ] unit-test
-[ { "abc" } ] [ "abc" tokenize-command ] unit-test
-[ { "abc" } ] [ "abc " tokenize-command ] unit-test
-[ { "abc" } ] [ " abc" tokenize-command ] unit-test
-[ { "abc" "def" } ] [ "abc def" tokenize-command ] unit-test
-[ { "abc def" } ] [ "abc\\ def" tokenize-command ] unit-test
-[ { "abc\\" "def" } ] [ "abc\\\\ def" tokenize-command ] unit-test
-[ { "abc\\ def" } ] [ "'abc\\\\ def'" tokenize-command ] unit-test
-[ { "abc\\ def" } ] [ " 'abc\\\\ def'" tokenize-command ] unit-test
-[ { "abc\\ def" "hey" } ] [ "'abc\\\\ def' hey" tokenize-command ] unit-test
-[ { "abc def" "hey" } ] [ "'abc def' \"hey\"" tokenize-command ] unit-test
-[ "'abc def' \"hey" tokenize-command ] must-fail
-[ "'abc def" tokenize-command ] must-fail
-[ { "abc def" "h\"ey" } ] [ "'abc def' \"h\\\"ey\" " tokenize-command ] unit-test
-
-[
- {
- "Hello world.app/Contents/MacOS/hello-ui"
- "-i=boot.macosx-ppc.image"
- "-include= math compiler ui"
- "-deploy-vocab=hello-ui"
- "-output-image=Hello world.app/Contents/Resources/hello-ui.image"
- "-no-stack-traces"
- "-no-user-init"
- }
-] [
- "\"Hello world.app/Contents/MacOS/hello-ui\" -i=boot.macosx-ppc.image \"-include= math compiler ui\" -deploy-vocab=hello-ui \"-output-image=Hello world.app/Contents/Resources/hello-ui.image\" -no-stack-traces -no-user-init" tokenize-command
-] unit-test
From 47a96775d87de48b9d300b7b999c9290d60390be Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Mon, 3 Mar 2008 16:57:30 -0600
Subject: [PATCH 55/55] Add PEG: word
---
extra/farkup/farkup-tests.factor | 46 ++++++++++-----------
extra/farkup/farkup.factor | 32 ++++----------
extra/io/unix/launcher/parser/parser.factor | 29 ++++---------
extra/peg/parsers/parsers.factor | 4 +-
extra/peg/peg.factor | 12 +++++-
5 files changed, 52 insertions(+), 71 deletions(-)
mode change 100644 => 100755 extra/farkup/farkup-tests.factor
mode change 100644 => 100755 extra/farkup/farkup.factor
diff --git a/extra/farkup/farkup-tests.factor b/extra/farkup/farkup-tests.factor
old mode 100644
new mode 100755
index 32909478bf..2e0d9832b0
--- a/extra/farkup/farkup-tests.factor
+++ b/extra/farkup/farkup-tests.factor
@@ -1,44 +1,44 @@
USING: farkup kernel tools.test ;
IN: farkup.tests
-[ "<ul><li>foo</li></ul>" ] [ "-foo" parse-farkup ] unit-test
-[ "<ul><li>foo</li></ul>\n" ] [ "-foo\n" parse-farkup ] unit-test
-[ "<ul><li>foo</li><li>bar</li></ul>" ] [ "-foo\n-bar" parse-farkup ] unit-test
-[ "<ul><li>foo</li><li>bar</li></ul>\n" ] [ "-foo\n-bar\n" parse-farkup ] unit-test
+[ "<ul><li>foo</li></ul>" ] [ "-foo" convert-farkup ] unit-test
+[ "<ul><li>foo</li></ul>\n" ] [ "-foo\n" convert-farkup ] unit-test
+[ "<ul><li>foo</li><li>bar</li></ul>" ] [ "-foo\n-bar" convert-farkup ] unit-test
+[ "<ul><li>foo</li><li>bar</li></ul>\n" ] [ "-foo\n-bar\n" convert-farkup ] unit-test
-[ "<ul><li>foo</li></ul>\n<p>bar\n</p>" ] [ "-foo\nbar\n" parse-farkup ] unit-test
-[ "<p>*foo\nbar\n</p>" ] [ "*foo\nbar\n" parse-farkup ] unit-test
-[ "<p><strong>Wow!</strong></p>" ] [ "*Wow!*" parse-farkup ] unit-test
-[ "<p><em>Wow.</em></p>" ] [ "_Wow._" parse-farkup ] unit-test
+[ "<ul><li>foo</li></ul>\n<p>bar\n</p>" ] [ "-foo\nbar\n" convert-farkup ] unit-test
+[ "<p>*foo\nbar\n</p>" ] [ "*foo\nbar\n" convert-farkup ] unit-test
+[ "<p><strong>Wow!</strong></p>" ] [ "*Wow!*" convert-farkup ] unit-test
+[ "<p><em>Wow.</em></p>" ] [ "_Wow._" convert-farkup ] unit-test
-[ "<p>*</p>" ] [ "*" parse-farkup ] unit-test
-[ "<p>*</p>" ] [ "\\*" parse-farkup ] unit-test
-[ "<p>**</p>" ] [ "\\**" parse-farkup ] unit-test
+[ "<p>*</p>" ] [ "*" convert-farkup ] unit-test
+[ "<p>*</p>" ] [ "\\*" convert-farkup ] unit-test
+[ "<p>**</p>" ] [ "\\**" convert-farkup ] unit-test
-[ "" ] [ "\n\n" parse-farkup ] unit-test
-[ "\n" ] [ "\n\n\n" parse-farkup ] unit-test
-[ "<p>foo</p><p>bar</p>" ] [ "foo\n\nbar" parse-farkup ] unit-test
+[ "" ] [ "\n\n" convert-farkup ] unit-test
+[ "\n" ] [ "\n\n\n" convert-farkup ] unit-test
+[ "<p>foo</p><p>bar</p>" ] [ "foo\n\nbar" convert-farkup ] unit-test
-[ "\n<p>bar\n</p>" ] [ "\nbar\n" parse-farkup ] unit-test
+[ "\n<p>bar\n</p>" ] [ "\nbar\n" convert-farkup ] unit-test
-[ "<p>foo</p>\n<p>bar</p>" ] [ "foo\n\n\nbar" parse-farkup ] unit-test
+[ "<p>foo</p>\n<p>bar</p>" ] [ "foo\n\n\nbar" convert-farkup ] unit-test
-[ "" ] [ "" parse-farkup ] unit-test
+[ "" ] [ "" convert-farkup ] unit-test
[ "<p>|a</p>" ]
-[ "|a" parse-farkup ] unit-test
+[ "|a" convert-farkup ] unit-test
[ "<p>|a|</p>" ]
-[ "|a|" parse-farkup ] unit-test
+[ "|a|" convert-farkup ] unit-test
[ "<table><tr><td>a</td><td>b</td></tr></table>" ]
-[ "a|b" parse-farkup ] unit-test
+[ "a|b" convert-farkup ] unit-test
[ "<table><tr><td>a</td><td>b</td></tr></table>\n<table><tr><td>c</td><td>d</td></tr></table>" ]
-[ "a|b\nc|d" parse-farkup ] unit-test
+[ "a|b\nc|d" convert-farkup ] unit-test
[ "<table><tr><td>a</td><td>b</td></tr></table>\n<table><tr><td>c</td><td>d</td></tr></table>\n" ]
-[ "a|b\nc|d\n" parse-farkup ] unit-test
+[ "a|b\nc|d\n" convert-farkup ] unit-test
[ "<p><strong>foo</strong>\n</p><h1>aheading</h1>\n<p>adfasd</p>" ]
-[ "*foo*\n=aheading=\nadfasd" parse-farkup ] unit-test
+[ "*foo*\n=aheading=\nadfasd" convert-farkup ] unit-test
diff --git a/extra/farkup/farkup.factor b/extra/farkup/farkup.factor
old mode 100644
new mode 100755
index 810ab22ce1..dac4359d90
--- a/extra/farkup/farkup.factor
+++ b/extra/farkup/farkup.factor
@@ -1,10 +1,9 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: arrays io kernel memoize namespaces peg
-peg.ebnf sequences strings html.elements xml.entities
-xmode.code2html splitting io.streams.string html peg.parsers
-html.elements sequences.deep unicode.categories ;
-USE: tools.walker
+USING: arrays io kernel memoize namespaces peg sequences strings
+html.elements xml.entities xmode.code2html splitting
+io.streams.string html peg.parsers html.elements sequences.deep
+unicode.categories ;
IN: farkup
: delimiters ( -- string )
@@ -118,28 +117,13 @@ MEMO: paragraph ( -- parser )
[ "<p>" swap "</p>" 3array ] unless
] action ;
-MEMO: farkup ( -- parser )
+PEG: parse-farkup ( -- parser )
[
list , table , h1 , h2 , h3 , h4 , code , paragraph , 2nl , nl ,
] choice* repeat0 "\n" token optional 2seq ;
-: farkup. ( parse-result -- )
- parse-result-ast
+: write-farkup ( parse-result -- )
[ dup string? [ write ] [ drop ] if ] deep-each ;
-: parse-farkup ( string -- string' )
- farkup parse [ farkup. ] with-string-writer ;
-
-! MEMO: table-column ( -- parser )
- ! text [ "td" surround-with-foo ] action ;
-!
-! MEMO: table-row ( -- parser )
- ! [
- ! "|" token hide ,
- ! table-column "|" token hide list-of ,
- ! "|" token "\n" token 2array choice hide ,
- ! ] seq* [ "tr" surround-with-foo ] action ;
-!
-! MEMO: table ( -- parser )
- ! table-row repeat1
- ! [ "table" surround-with-foo ] action ;
+: convert-farkup ( string -- string' )
+ parse-farkup [ write-farkup ] with-string-writer ;
diff --git a/extra/io/unix/launcher/parser/parser.factor b/extra/io/unix/launcher/parser/parser.factor
index 9be5a48d1d..21ce131abd 100755
--- a/extra/io/unix/launcher/parser/parser.factor
+++ b/extra/io/unix/launcher/parser/parser.factor
@@ -1,47 +1,34 @@
! Copyright (C) 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
+USING: peg peg.parsers kernel sequences strings words
+memoize ;
IN: io.unix.launcher.parser
-USING: peg peg.parsers kernel sequences strings qualified
-words ;
-QUALIFIED: compiler.units
! Our command line parser. Supported syntax:
! foo bar baz -- simple tokens
! foo\ bar -- escaping the space
! 'foo bar' -- quotation
! "foo bar" -- quotation
-: 'escaped-char'
+MEMO: 'escaped-char'
"\\" token [ drop t ] satisfy 2seq [ second ] action ;
-: 'quoted-char' ( delimiter -- parser' )
+MEMO: 'quoted-char' ( delimiter -- parser' )
'escaped-char'
swap [ member? not ] curry satisfy
2choice ; inline
-: 'quoted' ( delimiter -- parser )
+MEMO: 'quoted' ( delimiter -- parser )
dup 'quoted-char' repeat0 swap dup surrounded-by ;
-: 'unquoted' ( -- parser ) " '\"" 'quoted-char' repeat1 ;
+MEMO: 'unquoted' ( -- parser ) " '\"" 'quoted-char' repeat1 ;
-: 'argument' ( -- parser )
+MEMO: 'argument' ( -- parser )
"\"" 'quoted'
"'" 'quoted'
'unquoted' 3choice
[ >string ] action ;
-: 'arguments' ( -- parser )
+PEG: tokenize-command ( command -- ast/f )
'argument' " " token repeat1 list-of
" " token repeat0 swap over pack
just ;
-
-DEFER: argument-parser
-
-[
- \ argument-parser
- 'arguments' compile
- define
-] compiler.units:with-compilation-unit
-
-: tokenize-command ( command -- arguments )
- argument-parser
- dup [ parse-result-ast ] [ "Parse failed" throw ] if ;
diff --git a/extra/peg/parsers/parsers.factor b/extra/peg/parsers/parsers.factor
index 60002a450a..5e82756853 100755
--- a/extra/peg/parsers/parsers.factor
+++ b/extra/peg/parsers/parsers.factor
@@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences strings namespaces math assocs shuffle
vectors arrays combinators.lib memoize math.parser match
- unicode.categories sequences.deep peg ;
+ unicode.categories sequences.deep peg peg.private ;
IN: peg.parsers
TUPLE: just-parser p1 ;
@@ -16,7 +16,7 @@ TUPLE: just-parser p1 ;
M: just-parser compile ( parser -- quot )
- just-parser-p1 compile just-pattern swap append ;
+ just-parser-p1 compile just-pattern append ;
MEMO: just ( parser -- parser )
just-parser construct-boa init-parser ;
diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor
index 91877d680c..01decc2c81 100755
--- a/extra/peg/peg.factor
+++ b/extra/peg/peg.factor
@@ -2,7 +2,8 @@
! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences strings namespaces math assocs shuffle
vectors arrays combinators.lib memoize math.parser match
- unicode.categories sequences.lib ;
+ unicode.categories sequences.lib compiler.units parser
+ words ;
IN: peg
TUPLE: parse-result remaining ast ;
@@ -359,3 +360,12 @@ MEMO: hide ( parser -- parser )
MEMO: delay ( parser -- parser )
delay-parser construct-boa init-parser ;
+
+: PEG:
+ (:) [
+ [
+ call compile
+ [ dup [ parse-result-ast ] [ "Parse failed" throw ] if ]
+ append define
+ ] with-compilation-unit
+ ] 2curry over push-all ; parsing