steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' of git://factorcode.org/git/factor into frepublic

db4
Alex Chapman 2008-03-04 09:58:57 +11:00
parent 7af882a5fb 47a96775d8
commit 62e330319d
288 changed files with 1643 additions and 1055 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
core/alien/alien-tests.factor
View File

@ -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 ;

2
core/alien/c-types/c-types-tests.factor
View File

@ -1,4 +1,4 @@
IN: temporary
IN: alien.c-types.tests
USING: alien alien.syntax alien.c-types kernel tools.test
sequences system libc ;

2
core/alien/compiler/compiler-tests.factor
View File

@ -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

2
core/alien/structs/structs-tests.factor
View File

@ -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 ;

2
core/arrays/arrays-tests.factor
View File

@ -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

2
core/assocs/assocs-tests.factor
View File

@ -1,4 +1,4 @@
IN: temporary
IN: assocs.tests
USING: kernel math namespaces tools.test vectors sequences
sequences.private hashtables io prettyprint assocs
continuations ;

2
core/bit-arrays/bit-arrays-tests.factor
View File

@ -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

2
core/bit-vectors/bit-vectors-tests.factor
View File

@ -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

2
core/bootstrap/image/image-tests.factor
View File

@ -1,4 +1,4 @@
IN: temporary
IN: bootstrap.image.tests
USING: bootstrap.image bootstrap.image.private tools.test ;
\ ' must-infer

2
core/boxes/boxes-tests.factor
View File

@ -1,4 +1,4 @@
IN: temporary
IN: boxes.tests
USING: boxes namespaces tools.test ;
[ ] [ <box> "b" set ] unit-test

3
core/boxes/boxes.factor
View File

@ -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

2
core/byte-arrays/byte-arrays-tests.factor
View File

@ -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

2
core/byte-vectors/byte-vectors-tests.factor
View File

@ -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

16
core/classes/classes-tests.factor
View File

@ -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 )"

2
core/combinators/combinators-tests.factor
View File

@ -1,4 +1,4 @@
IN: temporary
IN: combinators.tests
USING: alien strings kernel math tools.test io prettyprint
namespaces combinators words ;

2
core/command-line/command-line-tests.factor
View File

@ -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

2
core/compiler/tests/curry.factor
View File

@ -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

2
core/compiler/tests/float.factor
View File

@ -1,4 +1,4 @@
IN: temporary
IN: compiler.tests
USING: compiler.units kernel kernel.private memory math
math.private tools.test math.floats.private ;

2
core/compiler/tests/intrinsics.factor
View File

@ -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

2
core/compiler/tests/simple.factor
View File

@ -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

2
core/compiler/tests/stack-trace.factor
View File

@ -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 ;

2
core/compiler/tests/templates-early.factor
View File

@ -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 ;

2
core/compiler/tests/templates.factor
View File

@ -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

2
core/compiler/tests/tuples.factor
View File

@ -1,4 +1,4 @@
IN: temporary
IN: compiler.tests
USING: kernel tools.test compiler.units ;
TUPLE: color red green blue ;

2
core/continuations/continuations-tests.factor
View File

@ -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

2
core/cpu/arm/assembler/assembler-tests.factor
View File

@ -1,4 +1,4 @@
IN: temporary
IN: cpu.arm.assembler.tests
USING: assembler-arm math test namespaces sequences kernel
quotations ;

2
core/cpu/x86/assembler/assembler-tests.factor
View File

@ -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

2
core/debugger/debugger-tests.factor
View File

@ -1,4 +1,4 @@
IN: temporary
IN: debugger.tests
USING: debugger kernel continuations tools.test ;
[ ] [ [ drop ] [ error. ] recover ] unit-test

2
core/definitions/definitions-tests.factor
View File

@ -1,4 +1,4 @@
IN: temporary
IN: definitions.tests
USING: tools.test generic kernel definitions sequences
compiler.units ;

2
core/dlists/dlists-tests.factor
View File

@ -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

2
core/effects/effects-tests.factor
View File

@ -1,4 +1,4 @@
IN: temporary
IN: effects.tests
USING: effects tools.test ;
[ t ] [ 1 1 <effect> 2 2 <effect> effect<= ] unit-test

2
core/float-arrays/float-arrays-tests.factor
View File

@ -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

2
core/float-vectors/float-vectors-tests.factor
View File

@ -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

12
core/generic/generic-tests.factor
View File

@ -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

2
core/growable/growable-tests.factor
View File

@ -1,6 +1,6 @@
USING: math sequences classes growable tools.test kernel
layouts ;
IN: temporary
IN: growable.tests
! erg found this one
[ fixnum ] [

2
core/hashtables/hashtables-tests.factor
View File

@ -1,4 +1,4 @@
IN: temporary
IN: hashtables.tests
USING: kernel math namespaces tools.test vectors sequences
sequences.private hashtables io prettyprint assocs
continuations ;

2
core/heaps/heaps-tests.factor
View File

@ -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

2
core/inference/class/class-tests.factor
View File

@ -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

2
core/inference/inference-tests.factor
View File

@ -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

2
core/inference/state/state-tests.factor
View File

@ -1,4 +1,4 @@
IN: temporary
IN: inference.state.tests
USING: tools.test inference.state words ;
SYMBOL: a

2
core/inference/transforms/transforms-tests.factor
View File

@ -1,4 +1,4 @@
IN: temporary
IN: inference.transforms.tests
USING: sequences inference.transforms tools.test math kernel
quotations inference ;

2
core/init/init-tests.factor
View File

@ -1,4 +1,4 @@
IN: temporary
IN: init.tests
USING: init namespaces sequences math tools.test kernel ;
[ t ] [

2
core/inspector/inspector-tests.factor
View File

@ -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

2
core/io/backend/backend-tests.factor
View File

@ -1,4 +1,4 @@
IN: temporary
IN: io.backend.tests
USING: tools.test io.backend kernel ;
[ ] [ "a" normalize-pathname drop ] unit-test

2
core/io/binary/binary-tests.factor
View File

@ -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

29
core/io/files/files-docs.factor
View File

@ -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"
@ -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"
@ -266,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." } ;
@ -282,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." } ;
@ -298,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." } ;

8
core/io/files/files-tests.factor
View File

@ -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
@ -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" ] [
@ -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

42
core/io/files/files.factor
View File

@ -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) ;
@ -70,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 -- )
@ -123,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 )
@ -209,4 +223,4 @@ HOOK: <file-appender> io-backend ( path -- stream )
{ [ winnt? ] [ "USERPROFILE" os-env ] }
{ [ wince? ] [ "" resource-path ] }
{ [ unix? ] [ "HOME" os-env ] }
} cond ;
} cond ;

4
core/io/io-tests.factor
View File

@ -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 )

2
core/io/streams/c/c-tests.factor
View File

@ -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 [

2
core/io/streams/duplex/duplex-tests.factor
View File

@ -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? ;

2
core/io/streams/lines/lines-tests.factor
View File

@ -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> ;

2
core/io/streams/nested/nested-tests.factor
View File

@ -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

2
core/io/streams/string/string-tests.factor
View File

@ -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 ]
[

2
core/io/test/no-trailing-eol.factor
View File

@ -1,4 +1,4 @@
IN: temporary
IN: io.tests
USE: math
: foo 2 2 + ;
FORGET: foo

2
core/kernel/kernel-tests.factor
View File

@ -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

6
core/listener/listener-tests.factor
View File

@ -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
@ -9,7 +9,7 @@ IN: temporary
<string-reader> stream-read-quot ;
[ [ ] ] [
"USE: temporary hello" parse-interactive
"USE: listener.tests hello" parse-interactive
] unit-test
[
@ -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

2
core/math/bitfields/bitfields-tests.factor
View File

@ -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

2
core/math/floats/floats-tests.factor
View File

@ -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

2
core/math/integers/integers-tests.factor
View File

@ -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

2
core/math/intervals/intervals-tests.factor
View File

@ -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

2
core/math/math-tests.factor
View File

@ -1,5 +1,5 @@
USING: kernel math namespaces tools.test ;
IN: temporary
IN: math.tests
[ ] [ 5 [ ] times ] unit-test
[ ] [ 0 [ ] times ] unit-test

2
core/math/parser/parser-tests.factor
View File

@ -1,5 +1,5 @@
USING: kernel math math.parser sequences tools.test ;
IN: temporary
IN: math.parser.tests
[ f ]
[ f string>number ]

2
core/memory/memory-tests.factor
View File

@ -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 ;

2
core/mirrors/mirrors-tests.factor
View File

@ -1,5 +1,5 @@
USING: mirrors tools.test assocs kernel arrays ;
IN: temporary
IN: mirrors.tests
TUPLE: foo bar baz ;

2
core/namespaces/namespaces-tests.factor
View File

@ -1,4 +1,4 @@
IN: temporary
IN: namespaces.tests
USING: kernel namespaces tools.test words ;
H{ } clone "test-namespace" set

2
core/optimizer/control/control-tests.factor
View File

@ -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 ;

2
core/optimizer/def-use/def-use-tests.factor
View File

@ -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 ;

2
core/optimizer/optimizer-tests.factor
View File

@ -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*

118
core/parser/parser-tests.factor
View File

@ -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,8 +23,8 @@ IN: temporary
[ "hello world" ]
[
"IN: temporary : hello \"hello world\" ;"
eval "USE: temporary hello" eval
"IN: parser.tests : hello \"hello world\" ;"
eval "USE: parser.tests 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
[ ] [ "USE: parser.tests 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?
"USE: parser.tests \\ foo" eval
"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= ]

44
core/prettyprint/prettyprint-tests.factor
View File

@ -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,28 +115,28 @@ 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 ;"
"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 ;"
} ;
@ -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,13 +274,13 @@ 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 ;"
"USING: prettyprint.tests ;"
"M: class-see-layout class-see-layout ;"
} ;
@ -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

2
core/quotations/quotations-tests.factor
View File

@ -1,5 +1,5 @@
USING: math kernel quotations tools.test sequences ;
IN: temporary
IN: quotations.tests
[ [ 3 ] ] [ 3 [ ] curry ] unit-test
[ [ \ + ] ] [ \ + [ ] curry ] unit-test

2
core/sbufs/sbufs-tests.factor
View File

@ -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

2
core/sequences/sequences-tests.factor
View File

@ -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

2
core/sorting/sorting-tests.factor
View File

@ -1,6 +1,6 @@
USING: sorting sequences kernel math random tools.test
vectors ;
IN: temporary
IN: sorting.tests
[ [ ] ] [ [ ] natural-sort ] unit-test

5
core/source-files/source-files.factor
View File

@ -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 ;

2
core/splitting/splitting-tests.factor
View File

@ -1,5 +1,5 @@
USING: splitting tools.test ;
IN: temporary
IN: splitting.tests
[ { 1 2 3 } 0 group ] must-fail

2
core/strings/strings-tests.factor
View File

@ -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

2
core/system/system-tests.factor
View File

@ -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

2
core/threads/threads-tests.factor
View File

@ -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

22
core/tuples/tuples-tests.factor
View File

@ -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

2
core/vectors/vectors-tests.factor
View File

@ -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

4
core/vocabs/loader/loader-tests.factor
View File

@ -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

9
core/vocabs/loader/loader.factor
View File

@ -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,12 @@ 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 ( -- )
"" refresh f sources-changed? set-global ;
GENERIC: (load-vocab) ( name -- vocab )

2
core/vocabs/vocabs-tests.factor
View File

@ -1,5 +1,5 @@
! Unit tests for vocabs vocabulary
USING: vocabs tools.test ;
IN: temporary
IN: vocabs.tests
[ f ] [ "kernel" vocab-main ] unit-test

52
core/words/words-tests.factor
View File

@ -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

17
extra/alarms/alarms-tests.factor Executable file
View File

@ -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

8
extra/alarms/alarms.factor
View File

@ -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
@ -87,5 +86,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? ;

2
extra/ascii/ascii-tests.factor
View File

@ -1,4 +1,4 @@
IN: temporary
IN: ascii.tests
USING: ascii tools.test sequences kernel math ;
[ t ] [ CHAR: a letter? ] unit-test

14
extra/benchmark/fib6/fib6.factor Executable file
View File

@ -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

2
extra/benchmark/reverse-complement/reverse-complement-tests.factor
View File

@ -1,4 +1,4 @@
IN: temporary
IN: benchmark.reverse-complement.tests
USING: tools.test benchmark.reverse-complement crypto.md5
io.files kernel ;

50
extra/benchmark/sockets/sockets.factor
View File

@ -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 ;

11
extra/bootstrap/image/upload/upload.factor
View File

@ -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/newsite/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

94
extra/builder/builder.factor
View File

@ -39,29 +39,25 @@ 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 ;
: 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 +73,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 +88,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 +103,48 @@ 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
"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
"git id: " write "git-id" eval-file print nl
make-clean run-process drop
"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-vm [ "vm compile error" print "../compile-log" cat ] run-or-bail
"Did not pass load-everything: " print "load-everything-vocabs" cat
"Did not pass test-all: " print "test-all-vocabs" cat
copy-image
"Benchmarks: " print "benchmarks" eval-file benchmarks.
bootstrap [ "Bootstrap error" print "../boot-log" cat ] run-or-bail
nl
builder-test [ "Test error" print "../test-log" 100 cat-n ] run-or-bail
show-benchmark-deltas
"../test-log" delete-file
"benchmarks" ".." copy-file-into
"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 ;

95
extra/builder/release/release.factor
View File

@ -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 ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

4
extra/builder/util/util.factor
View File

@ -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 ;
: failsafe ( quot -- ) [ drop ] recover ;

2
extra/calendar/format/format-tests.factor
View File

@ -1,4 +1,4 @@
IN: temporary
IN: calendar.format.tests
USING: calendar.format tools.test io.streams.string ;
[ 0 ] [

4
extra/calendar/unix/unix.factor
View File

@ -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 ;

2
extra/channels/channels-tests.factor
View File

@ -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>

2
extra/channels/remote/remote-tests.factor
View File

@ -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?

Some files were not shown because too many files have changed in this diff Show More