B{ 0 0 0 0 0 0 0 0 0 0 3 } be-packed-struct memory>struct
b>>
] unit-test
-
[ ?{ } ] [ 0 integer>bit-array ] unit-test
[ ?{ f t } ] [ 2 integer>bit-array ] unit-test
[ ?{ t t t t t t t t t } ] [ 511 integer>bit-array ] unit-test
-[ ?{
+[ ?{
t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t
t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t
t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t
{ V{ 10 } } [
V{ } clone <channel>
[ from swap push ] in-thread
- 10 swap to
+ 10 swap to
] unit-test
{ 20 } [
<channel>
[ 20 swap to ] in-thread
- from
+ from
] unit-test
{ { 1 2 3 4 } } [
[ from swap push ] in-thread
[ from swap push ] in-thread
[ from swap push ] in-thread
- 4 over to
- 2 over to
- 1 over to
- 3 swap to
+ 4 over to
+ 2 over to
+ 1 over to
+ 3 swap to
natural-sort
] unit-test
[ 2 swap to ] in-thread
[ 1 swap to ] in-thread
[ 9 swap to ] in-thread
- 2dup from swap push
- 2dup from swap push
- 2dup from swap push
- dupd from swap push
+ 2dup from swap push
+ 2dup from swap push
+ 2dup from swap push
+ dupd from swap push
natural-sort
] unit-test
{ t f } [
<channel> publish [
get-channel channel?
- ] keep
+ ] keep
[ unpublish ] keep
get-channel
] unit-test
-
"abcde" { fletcher-16 fletcher-32 fletcher-64 }
[ checksum-bytes ] with map
] unit-test
-
}
sha1 interleaved-checksum
] unit-test
-
} ;
[ B{ 34 13 } ] [ test-data internet checksum-bytes ] unit-test
-
USING: byte-arrays checksums checksums.md5 io.encodings.binary
io.streams.byte-array kernel math namespaces tools.test
sequences ;
-IN: checksums.md5.tests
+IN: checksums.md5.tests
[ "d41d8cd98f00b204e9800998ecf8427e" ] [ "" >byte-array md5 checksum-bytes hex-string ] unit-test
[ "0cc175b9c0f1b6a831c399e269772661" ] [ "a" >byte-array md5 checksum-bytes hex-string ] unit-test
<sha-224-state> "asdf" binary <byte-reader> add-checksum-stream
[ get-checksum ] [ get-checksum ] bi =
] unit-test
-
[ "test" ] [ "test" <circular> >string ] unit-test
[ CHAR: e ] [ "test" <circular> 5 swap nth-unsafe ] unit-test
-
+
[ [ 1 2 3 ] ] [ { 1 2 3 } <circular> [ ] like ] unit-test
[ [ 2 3 1 ] ] [ { 1 2 3 } <circular> [ rotate-circular ] keep [ ] like ] unit-test
[ [ 3 1 2 ] ] [ { 1 2 3 } <circular> [ rotate-circular ] keep [ rotate-circular ] keep [ ] like ] unit-test
[ 1 2 3 t ] [
1 2 3 t struct-test-foo <struct-boa> struct-test-bar <struct-boa>
{
- [ w>> ]
+ [ w>> ]
[ foo>> x>> ]
[ foo>> y>> ]
[ foo>> z>> ]
USING: tools.test colors.constants colors ;
IN: colors.constants.tests
-[ t ] [ COLOR: light-green rgba? ] unit-test
\ No newline at end of file
+[ t ] [ COLOR: light-green rgba? ] unit-test
[ f ] [ row-|| ] unit-test
[ f ] [ \ row-|| def>> call ] unit-test
-
1 + dup 100 fixnum> [ 1 fixnum+ ] when
] \ fixnum+ inlined?
] unit-test
-
+
[ t ] [
[ [ resize-array ] keep length ] \ length inlined?
] unit-test
: loop-test-1 ( a -- )
dup [ 1 + loop-test-1 ] [ drop ] if ; inline recursive
-
+
[ t ] [
[ loop-test-1 ] build-tree analyze-recursive
\ loop-test-1 label-is-loop?
-USING: concurrency.combinators tools.test random kernel math
+USING: concurrency.combinators tools.test random kernel math
concurrency.mailboxes threads sequences accessors arrays
math.parser ;
IN: concurrency.combinators.tests
{ [ os windows? ] [ insecure-addr ] }
} cond ;
-
+
[ ] [ [ "distributed-concurrency-test" temp-file delete-file ] ignore-errors ] unit-test
test-node-server [
] unit-test
[
- [ "this should propogate" throw ] future ?future
+ [ "this should propogate" throw ] future ?future
] must-fail
[ ] [
- [ "this should not propogate" throw ] future drop
+ [ "this should not propogate" throw ] future drop
] unit-test
! Race condition with futures
[ ] [ my-mailbox data>> clear-deque ] unit-test
-[ "received" ] [
+[ "received" ] [
[
receive "received" swap reply-synchronous
] "Synchronous test" spawn
core-foundation ;
IN: core-foundation.attributed-strings.tests
-[ ] [ "Hello world" H{ } <CFAttributedString> CFRelease ] unit-test
\ No newline at end of file
+[ ] [ "Hello world" H{ } <CFAttributedString> CFRelease ] unit-test
CFDictionaryGetValue
dup [ CF>string ] when
] with-destructors
-] unit-test
\ No newline at end of file
+] unit-test
[ "\0" ] [ "\0" <CFString> [ CF>string ] [ CFRelease ] bi ] unit-test
! This shouldn't fail
-[ ] [ { 0x123456 } >string <CFString> CFRelease ] unit-test
\ No newline at end of file
+[ ] [ { 0x123456 } >string <CFString> CFRelease ] unit-test
[ t ] [ { 100 200 } [ drop ] make-bitmap-image image? ] unit-test
-[ ] [ dummy-context drop ] unit-test
\ No newline at end of file
+[ ] [ dummy-context drop ] unit-test
] [
{ [ sql-table-exists? ] [ table>> "ship" = ] } 1&&
] must-fail-with
-
+
[
"create table foo(id) lol;" sql-command
] [
] [
{ [ sql-table-missing? ] [ table>> "foo" = ] } 1&&
] must-fail-with
-
+
[
"create table foo(id);" sql-command
"create table foo(id);" sql-command
{ [ sql-table-exists? ] [ table>> "foo" = ] } 1&&
] must-fail-with
-] with-db
\ No newline at end of file
+] with-db
{ "show" "SHOW" BIG-INTEGER +not-null+ +user-assigned-id+
{ +foreign-id+ show "ID" } }
} define-persistent
-
+
[ T{ user { username "littledan" } { data "foo" } } ] [
test.db [
user create-table
[ ] [ person create-table ] unit-test
[ person create-table ] must-fail
[ ] [ person ensure-table ] unit-test
-
+
[ ] [ person1 get insert-tuple ] unit-test
[ 1 ] [ person1 get the-id>> ] unit-test
{ T{ serialize-me f 1 H{ { 1 2 } } } }
] [ T{ serialize-me f 1 } select-tuples ] unit-test ;
-TUPLE: exam id name score ;
+TUPLE: exam id name score ;
: random-exam ( -- exam )
f
] [
T{ exam f T{ interval f { -1/0. t } { 1/0. f } } } select-tuples
] unit-test
-
+
[
{
T{ exam f 1 "Kyle" 100 }
: test-db-inheritance ( -- )
[ ] [ subbclass ensure-table ] unit-test
[ ] [ fubbclass ensure-table ] unit-test
-
+
[ ] [
subbclass new 5 >>a "hi" >>b dup insert-tuple id>> "id" set
] unit-test
-
+
[ t "hi" 5 ] [
subbclass new "id" get >>id select-tuple
[ subbclass? ] [ b>> ] [ a>> ] tri
] unit-test
-
+
[ ] [ fubbclass new 0 >>a "hi" >>b insert-tuple ] unit-test
-
+
[ t ] [ fubbclass new select-tuples [ fubbclass? ] all? ] unit-test ;
[ test-db-inheritance ] test-sqlite
"\u{copyright-sign}\u{bengali-letter-cha}" >>string
[ insert-tuple ] [ id>> "id" set ] bi
] unit-test
-
+
[ "\u{copyright-sign}\u{bengali-letter-cha}" ] [
string-encoding-test new "id" get >>id select-tuple string>>
] unit-test ;
TUPLE: compound-foo a b c ;
-compound-foo "COMPOUND_FOO"
+compound-foo "COMPOUND_FOO"
{
{ "a" "A" INTEGER +user-assigned-id+ }
{ "b" "B" INTEGER +user-assigned-id+ }
] unit-test
DEFER: seq-delegate
-
+
! See if removing a consultation updates protocol-consult word prop
[ [ ] ] [
"IN: delegate.tests
[ "<hr/>" ] [ "___" convert-farkup ] unit-test
[ "<hr/>" ] [ "___\n" convert-farkup ] unit-test
-[ "<p>before:</p><pre><span class=\"OPERATOR\">{</span> <span class=\"DIGIT\">1</span> <span class=\"DIGIT\">2</span> <span class=\"DIGIT\">3</span> <span class=\"OPERATOR\">}</span> <span class=\"DIGIT\">1</span> tail</pre>" ]
+[ "<p>before:</p><pre><span class=\"OPERATOR\">{</span> <span class=\"DIGIT\">1</span> <span class=\"DIGIT\">2</span> <span class=\"DIGIT\">3</span> <span class=\"OPERATOR\">}</span> <span class=\"DIGIT\">1</span> tail</pre>" ]
[ "before:\n[factor{{ 1 2 3 } 1 tail}]" convert-farkup ] unit-test
-
+
[ "<p><a href=\"Factor\">Factor</a>-rific!</p>" ]
[ "[[Factor]]-rific!" convert-farkup ] unit-test
] unit-test
[
-
+
[
"/" >>path
[
{ name "nemo" }
{ offset 0 }
{ class integer }
- { initial 0 }
+ { initial 0 }
{ type c:longlong }
}
T{ struct-slot-spec
{ name "x" }
{ offset 8 }
{ class object }
- { initial f }
+ { initial f }
{ type { c:char 4 } }
}
T{ struct-slot-spec
{ name "y" }
{ offset 12 }
{ class object }
- { initial f }
+ { initial f }
{ type { c:short 2 } }
}
T{ struct-slot-spec
{ name "z" }
{ offset 16 }
{ class fixnum }
- { initial 5 }
+ { initial 5 }
{ type c:char }
}
T{ struct-slot-spec
{ name "float" }
{ offset 20 }
{ class object }
- { initial f }
+ { initial f }
{ type { c:float 2 } }
}
}
-USING: furnace.actions furnace.auth furnace.auth.providers
+USING: furnace.actions furnace.auth furnace.auth.providers
furnace.auth.providers.assoc furnace.auth.login
tools.test namespaces accessors kernel ;
IN: furnace.auth.providers.assoc.tests
{ "foo" "bar" } path-separator join 1array
[ { "foo" "bar" "ba?" } path-separator join glob-parent-directory ] unit-test
-[ "foo" ]
+[ "foo" ]
[ { "foo" "b?r" "bas" } path-separator join glob-parent-directory ] unit-test
-[ "" ]
+[ "" ]
[ { "f*" "bar" "bas" } path-separator join glob-parent-directory ] unit-test
} "g" set
[ { 2 3 4 5 } ] [
- 2 [ "g" get at ] closure keys natural-sort
+ 2 [ "g" get at ] closure keys natural-sort
] unit-test
H{ } "g" set
] unit-test
[ { "asdf" } ] [ SHS{ "asdf" } members ] unit-test
-
] unit-test
[ { { "asdf" 1000 } } ] [ SH{ { "asdf" 1000 } } >alist ] unit-test
-
"IN: help.syntax.tests USE: help.syntax ABOUT: \"foobar\"" eval( -- )
"help.syntax.tests" lookup-vocab vocab-help
] unit-test
-
+
[ { "foobar" } ] [
"IN: help.syntax.tests USE: help.syntax ABOUT: { \"foobar\" }" eval( -- )
"help.syntax.tests" lookup-vocab vocab-help
] unit-test
-
+
[ ] [ "help.syntax.tests" lookup-vocab f >>help drop ] unit-test
] with-file-vocabs
"xmltest" html render
] with-string-writer
] unit-test
-
>>url
request set
- [ "http://www.apple.com/xxx/bar" ] [
- <url> relative-to-request present
+ [ "http://www.apple.com/xxx/bar" ] [
+ <url> relative-to-request present
] unit-test
[ "http://www.apple.com/xxx/baz" ] [
<url> "baz" >>path relative-to-request present
] unit-test
-
+
[ "http://www.apple.com/xxx/baz?c=d" ] [
<url> "baz" >>path { { "c" "d" } } >>query relative-to-request present
] unit-test
-
+
[ "http://www.apple.com/xxx/bar?c=d" ] [
<url> { { "c" "d" } } >>query relative-to-request present
] unit-test
-
+
[ "http://www.apple.com/flip" ] [
<url> "/flip" >>path relative-to-request present
] unit-test
-
+
[ "http://www.apple.com/flip?c=d" ] [
<url> "/flip" >>path { { "c" "d" } } >>query relative-to-request present
] unit-test
-
+
[ "http://www.jedit.org/" ] [
"http://www.jedit.org" >url relative-to-request present
] unit-test
-
+
[ "http://www.jedit.org/?a=b" ] [
"http://www.jedit.org" >url { { "a" "b" } } >>query relative-to-request present
] unit-test
-
+
[ "http://www.jedit.org:1234/?a=b" ] [
"http://www.jedit.org:1234" >url { { "a" "b" } } >>query relative-to-request present
] unit-test
[ { { } "erg" } ] [
URL" http://erg.blogs.vegan.net" url set
{ } "rewrite" get call-responder
-] unit-test
\ No newline at end of file
+] unit-test
T{ image f { 1 1 } RGB ubyte-components f B{ 0 0 0 } }
INTENSITY reorder-components
] must-fail
-
{ } [
"foo" temp-file [ make-directories ] keep
[ "touch bar" try-output-process ] with-directory
-] unit-test
\ No newline at end of file
+] unit-test
[ t ] [ phrase-johab>unicode phrase-unicode = ] unit-test
[ t ] [ phrase-unicode>johab phrase-johab = ] unit-test
-
[ { CHAR: x } ] [ B{ 0 0 0xfe 0xff 0 0 0 CHAR: x } utf32 decode >array ] unit-test
[ B{ 0xff 0xfe 0 0 120 0 0 0 0x1e 0xd1 1 0 } ] [ { CHAR: x 0x1d11e } >string utf32 encode ] unit-test
-
! Killed processes were exiting with code 0 on FreeBSD
[ f ] [
- [let
+ [let
<promise> :> p
<promise> :> s
"count-down" get count-down
] in-thread
] bi@
-
+
! Give the threads enough time to start blocking on
! read
1 seconds sleep
[ 10 ] [
ascii <threaded-server>
10 >>max-connections
- init-server semaphore>> count>>
+ init-server semaphore>> count>>
] unit-test
[ "Hello world." ] [
[ ] [
[
[
- "127.0.0.1" 0 <inet4> ascii <server> &dispose
+ "127.0.0.1" 0 <inet4> ascii <server> &dispose
dup addr>> port>> "port" get fulfill
accept drop &dispose 1 minutes sleep
] with-destructors
! Until I sort out two-stage handshaking, I can't do much here
[
[ ] [ <promise> "port" set ] unit-test
-
+
[ ] [
[
[
] with-destructors
] "Silly server" spawn drop
] unit-test
-
+
[
1 seconds secure-socket-timeout [
<secure-config> [
] with-secure-context
] with-variable
] [ io-timeout? ] must-fail-with
-
+
! Server socket shutdown timeout
[ ] [ <promise> "port" set ] unit-test
-
+
[ ] [
[
[
] with-destructors
] "Silly client" spawn drop
] unit-test
-
+
[
[
1 seconds secure-socket-timeout [
[ "/System/Library/CoreServices/Finder.app" ]
[ "com.apple.finder" find-native-bundle ] unit-test
-
-
{ "𝄞" } [ "\"\\ud834\\udd1e\"" json> ] unit-test
{ H{ { "a" { } } { "b" 123 } } } [ "{\"a\":[],\"b\":123}" json> ] unit-test
-{ { } } [ "[]" json> ] unit-test
+{ { } } [ "[]" json> ] unit-test
{ { 1 "two" 3.0 } } [ """ [1, "two", 3.0] """ json> ] unit-test
{ H{ } } [ "{}" json> ] unit-test
{ "\"\\ud800\\udc01\"" }
[ t json-escape-unicode? [ "𐀁" >json ] with-variable ] unit-test
-
3 "a" pick set-at
4 "d" pick set-at
[ values ] [ keys ] [ assoc-size ] tri
-] unit-test
+] unit-test
{ f 1 } [
<linked-hash> 1 "c" pick set-at
2 "b" pick set-at
"c" over delete-at
"c" over at swap assoc-size
-] unit-test
+] unit-test
{ { } 0 } [
<linked-hash> 1 "a" pick set-at
"call" "scratchpad" lookup-word
[ "call" search ] with-interactive-vocabs
eq?
- ] unit-test
+ ] unit-test
] with-file-vocabs
[ "call" "scratchpad" lookup-word forget ] with-compilation-unit
"USING: locals fry math ; 1 '[ [let 10 :> A A _ + ] ]"
eval( -- ) call
] [ error>> >r/r>-in-fry-error? ] must-fail-with
-
+
:: (funny-macro-test) ( obj quot -- ? ) obj { [ quot call ] } 1&& ; inline
: funny-macro-test ( n -- ? ) [ odd? ] (funny-macro-test) ;
:: erg's-:>-bug ( n ? -- n ) ? [ n :> n n ] [ n :> b b ] if ;
[ 3 ] [ 3 f erg's-:>-bug ] unit-test
-
+
[ 3 ] [ 3 t erg's-:>-bug ] unit-test
:: erg's-:>-bug-2 ( n ? -- n ) ? n '[ _ :> n n ] [ n :> b b ] if ;
[ 3 ] [ 3 f erg's-:>-bug-2 ] unit-test
-
+
[ 3 ] [ 3 t erg's-:>-bug-2 ] unit-test
! dharmatech found this problem
[ half-array{ 1.0 2.0 3.0 1/0. -1/0. } ]
[ { 1.0 2.0 3.0 1/0. -1/0. } half >c-array ] unit-test
-
{ { 1 }
{ 2 }
{ 3 } }
-
+
m.
] unit-test
{ t } [
{ 4 6 8 9 10 12 } 100 sieve '[ _ marked-prime? not ] all?
] unit-test
-
{ 10 10 }
{ 100 100 }
popup-rect
-] unit-test
\ No newline at end of file
+] unit-test
longlong-2 ushort-8 test-vconvert
]
[ error>> bad-vconvert? ] must-fail-with
-
class random-int-vector :> src
char-16 random-shift-vector :> perm
{ class char-16 } :> decl
-
+
src perm vshuffle
src perm [ decl declare vshuffle ] compile-call
=
[
vector decl test-vector-tests-bool :> ( bool-none bool-any bool-all )
vector decl test-vector-tests-branch :> ( branch-none branch-any branch-all )
-
+
bool-none branch-none ?inconsistent
bool-any branch-any ?inconsistent
bool-all branch-all ?inconsistent
theta cos float-4-with :> cc
theta sin float-4-with :> ss
-
+
axis cc v+ :> diagonal
diagonal cc ss ; inline
! stack was aligned properly by the runtime
: simd-spill-test-1 ( a b c -- v )
- { float-4 float-4 float } declare
+ { float-4 float-4 float } declare
[ v+ ] dip sin v*n ;
[ float-4{ 0 0 0 0 } ]
[ float-4{ 1 2 3 4 } float-4{ 4 5 6 7 } 0.0 simd-spill-test-1 ] unit-test
: simd-spill-test-2 ( a b d c -- v )
- { float float-4 float-4 float } declare
+ { float float-4 float-4 float } declare
[ [ 3.0 + ] 2dip v+ ] dip sin v*n n*v ;
[ float-4{ 0 0 0 0 } ]
[ { 2.5 1.0 } ] [ { 1.0 2.5 } { 2.5 1.0 } 1.0 vnlerp ] unit-test
[ { 1.75 1.75 } ] [ { 1.0 2.5 } { 2.5 1.0 } 0.5 vnlerp ] unit-test
-[ { 1.75 2.125 } ] [ { 1.0 2.5 } { 2.5 1.0 } { 0.5 0.25 } vlerp ] unit-test
+[ { 1.75 2.125 } ] [ { 1.0 2.5 } { 2.5 1.0 } { 0.5 0.25 } vlerp ] unit-test
[ 1.125 ] [ 0.0 1.0 2.0 4.0 { 0.5 0.25 } bilerp ] unit-test
IN: models.arrows.smart.tests
USING: models.arrow.smart tools.test accessors models math kernel ;
-[ 7 ] [ 3 <model> 4 <model> [ + ] <smart-arrow> [ activate-model ] [ value>> ] bi ] unit-test
\ No newline at end of file
+[ 7 ] [ 3 <model> 4 <model> [ + ] <smart-arrow> [ activate-model ] [ value>> ] bi ] unit-test
] unit-test
[ ] [
- H{ { "one" 3 } { "two" 4 } }
+ H{ { "one" 3 } { "two" 4 } }
"m" get set-model
] unit-test
T{ model-tester f f } clone V{ 5 } clone <model> 2dup add-connection
[ pop-model ] [ value>> ] bi
] unit-test
-
{ m1 m2 } <product> :> c
an-observer new :> o1
an-observer new :> o2
-
+
o1 m1 add-connection
o2 m2 add-connection
c activate-model
-
+
"OH HAI" m1 set-model
o1 i>>
o2 i>>
[ 0 ] [ setup-range 30 over move-by -30 over move-by range-value ] unit-test
! should be able to move by a page of 10
-[ 10 ] [
- setup-range 10 over set-range-page-value
- 1 over move-by-page range-value
+[ 10 ] [
+ setup-range 10 over set-range-page-value
+ 1 over move-by-page range-value
] unit-test
] unit-test
[ "xyz \n" ] [ HEREDOC: END
-xyz
+xyz
END
] unit-test
IN: peg.ebnf.tests
{ T{ ebnf-non-terminal f "abc" } } [
- "abc" 'non-terminal' parse
+ "abc" 'non-terminal' parse
] unit-test
{ T{ ebnf-terminal f "55" } } [
- "'55'" 'terminal' parse
+ "'55'" 'terminal' parse
] unit-test
{
- T{ ebnf-rule f
+ T{ ebnf-rule f
"digit"
T{ ebnf-choice f
V{ T{ ebnf-terminal f "1" } T{ ebnf-terminal f "2" } }
}
- }
+ }
} [
"digit = '1' | '2'" 'rule' parse
] unit-test
{
- T{ ebnf-rule f
- "digit"
+ T{ ebnf-rule f
+ "digit"
T{ ebnf-sequence f
V{ T{ ebnf-terminal f "1" } T{ ebnf-terminal f "2" } }
}
- }
+ }
} [
"digit = '1' '2'" 'rule' parse
] unit-test
{
T{ ebnf-choice f
- V{
+ V{
T{ ebnf-sequence f
V{ T{ ebnf-non-terminal f "one" } T{ ebnf-non-terminal f "two" } }
}
T{ ebnf-non-terminal f "three" }
}
- }
+ }
} [
"one two | three" 'choice' parse
] unit-test
{
T{ ebnf-sequence f
- V{
+ V{
T{ ebnf-non-terminal f "one" }
T{ ebnf-whitespace f
T{ ebnf-choice f
}
}
}
- }
+ }
} [
"one {two | three}" 'choice' parse
] unit-test
{
T{ ebnf-sequence f
- V{
+ V{
T{ ebnf-non-terminal f "one" }
T{ ebnf-repeat0 f
T{ ebnf-sequence f
}
}
}
- }
+ }
} [
"one ((two | three) four)*" 'choice' parse
] unit-test
{
T{ ebnf-sequence f
- V{
+ V{
T{ ebnf-non-terminal f "one" }
T{ ebnf-ignore f
T{ ebnf-sequence f
}
}
}
- }
+ }
} [
"one ((two | three) four)~" 'choice' parse
] unit-test
{
T{ ebnf-sequence f
- V{
- T{ ebnf-non-terminal f "one" }
+ V{
+ T{ ebnf-non-terminal f "one" }
T{ ebnf-optional f T{ ebnf-non-terminal f "two" } }
T{ ebnf-non-terminal f "three" }
}
- }
+ }
} [
"one ( two )? three" 'choice' parse
] unit-test
] unit-test
{ V{ "a" "b" } } [
- "ab" [EBNF foo='a' 'b' EBNF]
+ "ab" [EBNF foo='a' 'b' EBNF]
] unit-test
{ V{ 1 "b" } } [
] unit-test
[
- "0" [EBNF foo=[A-Z] EBNF]
+ "0" [EBNF foo=[A-Z] EBNF]
] must-fail
{ CHAR: 0 } [
] unit-test
[
- "A" [EBNF foo=[^A-Z] EBNF]
+ "A" [EBNF foo=[^A-Z] EBNF]
] must-fail
[
- "Z" [EBNF foo=[^A-Z] EBNF]
+ "Z" [EBNF foo=[^A-Z] EBNF]
] must-fail
{ V{ "1" "+" "foo" } } [
] unit-test
[
- { "a" 2 3 4 } [EBNF num=. ?[ number? ]? list=list:x num:y => [[ x y + ]] | num EBNF]
+ { "a" 2 3 4 } [EBNF num=. ?[ number? ]? list=list:x num:y => [[ x y + ]] | num EBNF]
] must-fail
{ 3 } [
] unit-test
[
- "ab" [EBNF -=" " | "\t" | "\n" foo="a" - "b" EBNF]
+ "ab" [EBNF -=" " | "\t" | "\n" foo="a" - "b" EBNF]
] must-fail
{ V{ "a" " " "b" } } [
] unit-test
[
- "axb" [EBNF -=(" " | "\t" | "\n")? => [[ drop ignore ]] foo="a" - "b" EBNF]
+ "axb" [EBNF -=(" " | "\t" | "\n")? => [[ drop ignore ]] foo="a" - "b" EBNF]
] must-fail
-{ V{ V{ 49 } "+" V{ 49 } } } [
+{ V{ V{ 49 } "+" V{ 49 } } } [
#! Test direct left recursion.
#! Using packrat, so first part of expr fails, causing 2nd choice to be used
"1+1" [EBNF num=([0-9])+ expr=expr "+" num | num EBNF]
] unit-test
-{ V{ V{ V{ 49 } "+" V{ 49 } } "+" V{ 49 } } } [
+{ V{ V{ V{ 49 } "+" V{ 49 } } "+" V{ 49 } } } [
#! Test direct left recursion.
#! Using packrat, so first part of expr fails, causing 2nd choice to be used
"1+1+1" [EBNF num=([0-9])+ expr=expr "+" num | num EBNF]
] unit-test
-{ V{ V{ V{ 49 } "+" V{ 49 } } "+" V{ 49 } } } [
+{ V{ V{ V{ 49 } "+" V{ 49 } } "+" V{ 49 } } } [
#! Test indirect left recursion.
#! Using packrat, so first part of expr fails, causing 2nd choice to be used
"1+1+1" [EBNF num=([0-9])+ x=expr expr=x "+" num | num EBNF]
ExpressionName = Identifier
Expression = "i" | "j"
main = Primary
-;EBNF
+;EBNF
{ "this" } [
"this" primary
] unit-test
[
- "a bc" [EBNF a="a" "b" foo=(a "c") EBNF]
+ "a bc" [EBNF a="a" "b" foo=(a "c") EBNF]
] must-fail
[
- "a bc" [EBNF a="a" "b" foo=a "c" EBNF]
+ "a bc" [EBNF a="a" "b" foo=a "c" EBNF]
] must-fail
[
] must-fail
[
- "ab c" [EBNF a="a" "b" foo=a "c" EBNF]
+ "ab c" [EBNF a="a" "b" foo=a "c" EBNF]
] must-fail
{ V{ V{ "a" "b" } "c" } } [
] unit-test
[
- "ab c" [EBNF a="a" "b" foo=(a "c") EBNF]
+ "ab c" [EBNF a="a" "b" foo=(a "c") EBNF]
] must-fail
[
- "a b c" [EBNF a="a" "b" foo=a "c" EBNF]
+ "a b c" [EBNF a="a" "b" foo=a "c" EBNF]
] must-fail
[
- "a b c" [EBNF a="a" "b" foo=(a "c") EBNF]
+ "a b c" [EBNF a="a" "b" foo=(a "c") EBNF]
] must-fail
[
- "a b c" [EBNF a="a" "b" foo={a "c"} EBNF]
+ "a b c" [EBNF a="a" "b" foo={a "c"} EBNF]
] must-fail
{ V{ V{ V{ "a" "b" } "c" } V{ V{ "a" "b" } "c" } } } [
] unit-test
{ } [
- "USING: kernel peg.ebnf ; \"a\\n\" [EBNF foo='a' '\n' => [[ drop \"\n\" ]] EBNF] drop" eval( -- )
+ "USING: kernel peg.ebnf ; \"a\\n\" [EBNF foo='a' '\n' => [[ drop \"\n\" ]] EBNF] drop" eval( -- )
] unit-test
[
;EBNF
{ V{ CHAR: 1 T{ ast-number f 23 } ";" CHAR: x } } [
- "123;x" [EBNF bar = .
- tokenizer = <foreign a-tokenizer Tok> foo=.
- tokenizer=default baz=.
- main = bar foo foo baz
+ "123;x" [EBNF bar = .
+ tokenizer = <foreign a-tokenizer Tok> foo=.
+ tokenizer=default baz=.
+ main = bar foo foo baz
EBNF]
] unit-test
{ V{ CHAR: 5 "+" CHAR: 2 } } [
- "5+2" [EBNF
- space=(" " | "\n")
- number=[0-9]
- operator=("*" | "+")
- spaces=space* => [[ ignore ]]
- tokenizer=spaces (number | operator)
- main= . . .
+ "5+2" [EBNF
+ space=(" " | "\n")
+ number=[0-9]
+ operator=("*" | "+")
+ spaces=space* => [[ ignore ]]
+ tokenizer=spaces (number | operator)
+ main= . . .
EBNF]
] unit-test
{ V{ CHAR: 5 "+" CHAR: 2 } } [
- "5 + 2" [EBNF
- space=(" " | "\n")
- number=[0-9]
- operator=("*" | "+")
- spaces=space* => [[ ignore ]]
- tokenizer=spaces (number | operator)
- main= . . .
+ "5 + 2" [EBNF
+ space=(" " | "\n")
+ number=[0-9]
+ operator=("*" | "+")
+ spaces=space* => [[ ignore ]]
+ tokenizer=spaces (number | operator)
+ main= . . .
EBNF]
] unit-test
{ "a" } [
"a" "a" token just parse
-] unit-test
\ No newline at end of file
+] unit-test
{ "abc 246 def 912" } [
"abc 123 def 456" 'integer' [ 2 * number>string ] action replace
] unit-test
-
{ T{ hash-0-b } "b" }
}
] [ "ph" get >hashtable ] unit-test
-
+
[
H{
{ T{ hash-0-b } "b" }
[ "[ \\ + ]" ] [ [ \ + ] unparse ] unit-test
[ "[ \\ [ ]" ] [ [ \ [ ] unparse ] unit-test
-
+
[ t ] [
100 \ dup <array> unparse-short
"{" head?
[ [ + ] ] [ [ \ + (step-into-execute) ] (remove-breakpoints) ] unit-test
[ [ (step-into-execute) ] ] [ [ (step-into-execute) ] (remove-breakpoints) ] unit-test
-
+
[ [ 2 2 + . ] ] [
[ 2 2 \ + (step-into-execute) . ] (remove-breakpoints)
] unit-test
[ ] [ \ curry see ] unit-test
[ "POSTPONE: [" ] [ \ [ unparse ] unit-test
-
+
TUPLE: started-out-hustlin' ;
GENERIC: ended-up-ballin' ( a -- b )
LAZY: lazy-test ( a -- b ) 1 + ;
{ 1 1 } [ lazy-test ] must-infer-as
-[ 3 ] [ 2 lazy-test force ] unit-test
\ No newline at end of file
+[ 3 ] [ 2 lazy-test force ] unit-test
USING: regexp.dfa tools.test ;
IN: regexp.dfa.tests
-
{ start-state 0 }
{ final-states HS{ 3 } }
}
-] [
+] [
T{ transition-table
{ transitions H{
{ 0 H{ { CHAR: a 1 } { CHAR: b 4 } } }
{ 0 H{ { CHAR: a 1 } { T{ not-class f CHAR: a } -1 } } }
{ 1 H{ { t -1 } } }
{ -1 H{ { t -1 } } }
- } }
+ } }
{ start-state 0 }
{ final-states HS{ 0 -1 } }
}
T{ transition-table
{ transitions H{
{ 0 H{ { CHAR: a 1 } } }
- { 1 H{ } }
+ { 1 H{ } }
} }
{ start-state 0 }
{ final-states HS{ 1 } }
[ 0 ] [ test-array fourth ] unit-test
[ { 1.0 2.0 3.0 0 5.0 6.0 } ] [ test-array >array ] unit-test
-
[ float-array{ 7.0 0.0 3.0 4.0 } ]
[ test-array [ 7.0 0 rot set-nth ] [ seq>> ] bi ]
unit-test
-
] unit-test
[ { "A1a!" "B2b@" "C3c#" "D4d$" } ]
-[
+[
{ "A" "B" "C" "D" }
{ "1" "2" "3" "4" }
{ "a" "b" "c" "d" }
] unit-test
[ [ "A1a!" "B2b@" "C3c#" "D4d$" ] ]
-[
+[
{ "A" "B" "C" "D" }
{ "1" "2" "3" "4" }
{ "a" "b" "c" "d" }
{ "A" "B" "C" "D" }
{ "1" "2" "3" "4" }
{ "a!" "b@" "c#" "d$" }
-] [
+] [
{ "A" "B" "C" "D" }
{ "1" "2" "3" "4" }
{ "a" "b" "c" "d" }
[
{ "A1" "B2" "C3" "D4" }
{ "a!" "b@" "c#" "d$" }
-] [
+] [
{ "A" "B" "C" "D" }
{ "1" "2" "3" "4" }
{ "a" "b" "c" "d" }
[
{ "A1" "B2" "C3" "D4" }
[ "a!" "b@" "c#" "d$" ]
-] [
+] [
{ "A" "B" "C" "D" }
{ "1" "2" "3" "4" }
{ "a" "b" "c" "d" }
] unit-test
[ { "A1a!" "B2b@" "C3c#" "D4d$" } ]
-[
+[
{ "A" "B" "C" "D" }
{ "1" "2" "3" "4" }
{ "a" "b" "c" "d" }
[ "foo " "and bar" ]
[
"foo and bar" [
- [ "and" take-until-sequence ] [ take-rest ] bi
+ [ "and" take-until-sequence ] [ take-rest ] bi
] parse-sequence
] unit-test
[ "yes" ]
[
"yes1234f" <sequence-parser>
- [ take-integer drop ] [ "yes" take-sequence ] bi
+ [ take-integer drop ] [ "yes" take-sequence ] bi
] unit-test
[ f ] [ "" <sequence-parser> 4 take-n ] unit-test
! Copyright (C) 2006 Chris Double.
! See http://factorcode.org/license.txt for BSD license.
-!
+!
USING: tools.test kernel serialize io io.streams.byte-array
alien arrays byte-arrays bit-arrays specialized-arrays
sequences math prettyprint parser classes math.constants
[ 2 3 4 1 ] [ 1 2 3 4 roll ] unit-test
[ 1 2 3 4 ] [ 2 3 4 1 -roll ] unit-test
-
[ 0xAD31 ] [ 0x8258 <test1> at ] unit-test
[ 0x8258 ] [ 0xAD31 <test1> value-at ] unit-test
-
-
[ S{ test-struct f 12 20 } ] [
test-struct-array{
- S{ test-struct f 4 20 }
+ S{ test-struct f 4 20 }
S{ test-struct f 12 20 }
S{ test-struct f 20 20 }
} second
[ struct-resize-test <struct> swap >>x ] map
\ struct-resize-test >c-array
[ x>> ] { } map-as ;
-
+
[ { 10 20 30 } ] [ { 10 20 30 } struct-resize-test-usage ] unit-test
[ ] [ "IN: specialized-arrays.tests USE: classes.struct USE: alien.c-types STRUCT: struct-resize-test { x int } { y int } ;" eval( -- ) ] unit-test
int-array{ 1 2 3 4 5 6 7 8 }
3 6 pick direct-slice [ 55555 1 ] dip set-nth
] unit-test
-
IN: suffix-arrays.tests
! built from [ all-words 10 head [ name>> ] map ]
-[ ] [
+[ ] [
{
"run-tests"
"must-fail-with"
! Make sure annotations work on primitives
\ gc reset
\ gc watch
-
+
[ f ] [ [ [ gc ] with-error>output ] with-string-writer empty? ] unit-test
\ gc reset
[ f ] [
\ = usage [ word? ] filter
[ name>> "sequence=>generic-forget-test-2" = ] any?
-] unit-test
\ No newline at end of file
+] unit-test
{ asset blah }
}
} errors.
-] unit-test
\ No newline at end of file
+] unit-test
: test-maybe ( obj -- obj/f ) ;
-[ ] [ \ test-maybe (help.) ] unit-test
\ No newline at end of file
+[ ] [ \ test-maybe (help.) ] unit-test
] with-variable
notify-error-observers
-
[ { "4\n" } ] [
[ [ 2 2 + number>string print ] with-string-writer ] test-walker
] unit-test
-
+
[ { 1 2 3 } ] [
[ { 1 2 3 } set-datastack ] test-walker
] unit-test
[ T{ foo } ] [ mat get first ] unit-test
[ T{ foo f 2 } ] [ T{ foo f 2 } 0 mat get [ set-nth ] keep first ] unit-test
[ t ] [ { T{ foo f 1 } T{ foo f 2 } } >foo-array dup mat set foo-array? ] unit-test
-[ T{ foo f 3 } t ]
+[ T{ foo f 3 } t ]
[ mat get [ bar>> 2 + <foo> ] map [ first ] keep foo-array? ] unit-test
[ 2 ] [ 2 <foo-array> dup mat set length ] unit-test
eval( -- )
] unit-test
-[ t ] [ tuple-to-struct struct-class? ] unit-test
\ No newline at end of file
+[ t ] [ tuple-to-struct struct-class? ] unit-test
[ 15 40 ] [ 20 10 40 10 combine-metrics ] unit-test
[ 12 3 ] [ 0 12 3 9 combine-metrics ] unit-test
-[ t ] [ \ baseline \ cap-height [ order ] bi@ set= ] unit-test
\ No newline at end of file
+[ t ] [ \ baseline \ cap-height [ order ] bi@ set= ] unit-test
: com-foo. ( -- ) ;
-[ "Foo" ] [ \ com-foo. command-name ] unit-test
\ No newline at end of file
+[ "Foo" ] [ \ com-foo. command-name ] unit-test
dup pref-viewport-dim >>dim
visible-lines
] unit-test
-
{ 65 70 } >>dim
layout
"c" get [ loc>> ] [ dim>> ] bi
-] unit-test
\ No newline at end of file
+] unit-test
[ f ] [ "g" get parent>> parent>> ] unit-test
-[ t ] [ "w" get layers>> empty? ] unit-test
\ No newline at end of file
+[ t ] [ "w" get layers>> empty? ] unit-test
1array 1array <grid> { 1 1 } >>gap
dup prefer
compute-grid-lines
-] unit-test
\ No newline at end of file
+] unit-test
IN: ui.gadgets.labeled.tests
USING: ui.gadgets ui.gadgets.labeled accessors tools.test ;
-[ t ] [ <gadget> "Hey" <labeled-gadget> content>> gadget? ] unit-test
\ No newline at end of file
+[ t ] [ <gadget> "Hey" <labeled-gadget> content>> gadget? ] unit-test
12 9 { 15 15 } <baseline-gadget> add-gadget
"g" set
-[ { 39 24 } ] [ "g" get pref-dim ] unit-test
\ No newline at end of file
+[ { 39 24 } ] [ "g" get pref-dim ] unit-test
<gadget> pane new-pane ;
[ t ] [ <test-pane> dup input>> child? ] unit-test
-[ t ] [ <test-pane> dup last-line>> child? ] unit-test
\ No newline at end of file
+[ t ] [ <test-pane> dup last-line>> child? ] unit-test
[ { 45 5 } ] [ "b" get loc>> ] unit-test
-[ { 0 35 } ] [ "c" get loc>> ] unit-test
\ No newline at end of file
+[ { 0 35 } ] [ "c" get loc>> ] unit-test
[ { 100 100 } ] [
vertical <track>
<gadget> { 100 100 } >>dim 1 track-add
- pref-dim
+ pref-dim
] unit-test
[ { 100 110 } ] [
"track" get [ layout ] [ children>> [ dim>> ] map ] bi
] unit-test
-[ 3 ] [ "track" get sizes>> length ] unit-test
\ No newline at end of file
+[ 3 ] [ "track" get sizes>> length ] unit-test
[ f ] [ "history" get back>> empty? ] unit-test
[ t ] [ "history" get forward>> empty? ] unit-test
-
IN: ui.tools.inspector.tests
USING: tools.test ui.tools.inspector math models ;
-[ ] [ \ + <model> <inspector-gadget> com-edit-slot ] unit-test
\ No newline at end of file
+[ ] [ \ + <model> <inspector-gadget> com-edit-slot ] unit-test
USING: ui.tools.walker tools.test ;
IN: ui.tools.walker.tests
-
USING: tools.test kernel unicode.categories words sequences unicode.data ;
IN: unicode.categories.tests
-[ { f f t t f t t f f t } ] [ CHAR: A {
- blank? letter? LETTER? Letter? digit?
- printable? alpha? control? uncased? character?
+[ { f f t t f t t f f t } ] [ CHAR: A {
+ blank? letter? LETTER? Letter? digit?
+ printable? alpha? control? uncased? character?
} [ execute ] with map ] unit-test
[ "Nd" ] [ CHAR: 3 category ] unit-test
[ "Lo" ] [ 0x3400 category ] unit-test
! Copyright (C) 2009 Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
-
0.5 seconds sleep
sigusr1-count get-global swap -
] unit-test
-
10 group [
[ [ over push-front ] each ]
[ length [ dup pop-back ] replicate ]
- bi
+ bi
] map concat
] keep
=
[ "a" ] [ { { "a" f } } assoc>query ] unit-test
-[ H{ { "a" f } } ] [ "a" query>assoc ] unit-test
\ No newline at end of file
+[ H{ { "a" f } } ] [ "a" query>assoc ] unit-test
[ t ] [ NAMESPACE_OID [ uuid-parse uuid-unparse ] keep = ] unit-test
[ t ] [ NAMESPACE_X500 [ uuid-parse uuid-unparse ] keep = ] unit-test
-[ t ] [ NAMESPACE_URL "ABCD" uuid3
+[ t ] [ NAMESPACE_URL "ABCD" uuid3
"2e10e403-d7fa-3ffb-808f-ab834a46890e" = ] unit-test
-[ t ] [ NAMESPACE_URL "ABCD" uuid5
+[ t ] [ NAMESPACE_URL "ABCD" uuid5
"0aa883d6-7953-57e7-a8f0-66db29ce5a91" = ] unit-test
-
! Copyright (C) 2009 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
USING: tools.test wrap.words sequences ;
-IN: wrap.words.tests
+IN: wrap.words.tests
[
{
T{ word f 5 10 f }
} 35 35 wrap-words [ { } like ] map
] unit-test
-
[ T{ rpc-method f "blah" { 1 H{ { "2" 3 } { "5" t } } } } ]
[ "blah" { 1 H{ { "2" 3 } { "5" t } } }
- <rpc-method> send-rpc receive-rpc ] unit-test
+ <rpc-method> send-rpc receive-rpc ] unit-test
] unit-test
[
-
+
] [
f "font:75%/1.6em \"Lucida Grande\", \"Lucida Sans Unicode\", verdana, geneva, sans-serif;" "css" load-mode tokenize-line 2drop
] unit-test
[ B{ 0 0 0 0 } ] [ "" crc32 checksum-bytes ] unit-test
[ B{ 0xcb 0xf4 0x39 0x26 } ] [ "123456789" crc32 checksum-bytes ] unit-test
-
[ t ] [
20 [ random-boolean-op ] [ ] replicate-as dup .
[ infer in>> length [ random-boolean ] replicate dup . ] keep
-
+
[ [ [ ] each ] dip call ] 2keep
-
+
[ [ boolean>class ] each ] dip [ boolean-op>class-op ] map call object class=
-
+
=
] unit-test
] times
[ t ] [ { xa xb xc xd xe xf xg xh } sort-classes dup sort-classes = ] unit-test
-[ H{ { word word } } ] [
+[ H{ { word word } } ] [
generic-class flatten-class
] unit-test
2 [
[ "mixin-forget-test" forget-source ] with-compilation-unit
-
+
[ ] [
{
"USING: sequences ;"
} "\n" join <string-reader> "mixin-forget-test"
parse-stream drop
] unit-test
-
+
[ { } ] [ { } "mixin-forget-test-g" "classes.mixin.tests" lookup-word execute ] unit-test
[ H{ } "mixin-forget-test-g" "classes.mixin.tests" lookup-word execute ] must-fail
-
+
[ ] [
{
"USING: hashtables ;"
} "\n" join <string-reader> "mixin-forget-test"
parse-stream drop
] unit-test
-
+
[ { } "mixin-forget-test-g" "classes.mixin.tests" lookup-word execute ] must-fail
[ H{ } ] [ H{ } "mixin-forget-test-g" "classes.mixin.tests" lookup-word execute ] unit-test
] times
! ! See how well callstack overflow is handled
! [ clear drop ] must-fail
-!
+!
! : callstack-overflow callstack-overflow f ;
! [ callstack-overflow ] must-fail
[ t ] [
\ + \ nth effective-method nip dup \ nth "default-method" word-prop eq? and
] unit-test
-
"""IN: generic.standard.tests
FORGET: boii""" eval( -- )
-
+
"""IN: generic.standard.tests
TUPLE: boii ;
M: boii jeah ;""" eval( -- )
M: dumb-writer stream-write1 vector>> push ; inline
{ BV{ 11 22 33 } } [
- <dumb-writer>
+ <dumb-writer>
[ B{ 11 22 33 } swap stream-write ]
[ vector>> ] bi
] unit-test
{ BV{ 11 22 33 10 } } [
- <dumb-writer>
+ <dumb-writer>
[ B{ 11 22 33 } swap stream-write ]
[ stream-nl ]
[ vector>> ] tri
USING: io.pathnames io.files.temp io.directories
continuations math io.files.private kernel
-namespaces sequences system tools.test
+namespaces sequences system tools.test
io.backend io.pathnames.private ;
IN: io.pathnames.tests
[ "" ] [ "/funny.directory/file-with-no-extension." file-extension ] unit-test
! Testing ~ special pathname
-[ t ] [ os windows? "~\\" "~/" ? absolute-path home = ] unit-test
-[ t ] [ "~/" home [ normalize-path ] same? ] unit-test
+[ t ] [ os windows? "~\\" "~/" ? absolute-path home = ] unit-test
+[ t ] [ "~/" home [ normalize-path ] same? ] unit-test
[ t ] [ "~" absolute-path home = ] unit-test
-[ t ] [ "~" home [ normalize-path ] same? ] unit-test
+[ t ] [ "~" home [ normalize-path ] same? ] unit-test
[ t ] [ "~" home [ "foo" append-path ] bi@ [ normalize-path ] same? ] unit-test
[ t ] [ os windows? "~\\~/" "~/~/" ? "~" "~" append-path [ path-components ] same? ] unit-test
-
-
[ f ]
[ "." string>number ]
unit-test
-
+
[ f ]
[ ".e" string>number ]
unit-test
USING: lexer namespaces parser.notes source-files tools.test ;
IN: parser.notes.tests
-[ ] [ f lexer set f file set "Hello world" note. ] unit-test
\ No newline at end of file
+[ ] [ f lexer set f file set "Hello world" note. ] unit-test
[ t ]
[ [ "hello" "world" ] [ second ] keep member-eq? ] unit-test
-[ 4 ] [ CHAR: x "tuvwxyz" >vector index ] unit-test
+[ 4 ] [ CHAR: x "tuvwxyz" >vector index ] unit-test
-[ f ] [ CHAR: x 5 "tuvwxyz" >vector index-from ] unit-test
+[ f ] [ CHAR: x 5 "tuvwxyz" >vector index-from ] unit-test
[ f ] [ CHAR: a 0 "tuvwxyz" >vector index-from ] unit-test
SYMBOL: foo
-[ f ] [ \ foo constant? ] unit-test
\ No newline at end of file
+[ f ] [ \ foo constant? ] unit-test
: float-pixels>byte-pixels* ( floats scale bias -- bytes )
'[
- [ _ 255.0 * v*n _ 255.0 * v+n float-4 int-4 vconvert ] 4 napply
+ [ _ 255.0 * v*n _ 255.0 * v+n float-4 int-4 vconvert ] 4 napply
[ int-4 short-8 vconvert ] 2bi@
short-8 uchar-16 vconvert
] data-map( float-4[4] -- uchar-16 ) ; inline
255 25 51 76
76 51 229 127
25 255 255 255
- }
+ }
] [
float-array{
0.5 0.75 1.0 0.25
255 25 51 76
76 51 229 127
25 255 255 255
- }
+ }
] [
float-array{
0.5 0.75 1.0 0.25
255 25 51 76
76 51 229 127
25 255 255 255
- }
+ }
] [
float-array{
0.5 0.75 1.0 0.25
0.1 1.0 1.5 2.0
5.0
} [
- [ 255.0 v*n float-4 int-4 vconvert ] 4 napply
+ [ 255.0 v*n float-4 int-4 vconvert ] 4 napply
[ int-4 short-8 vconvert ] 2bi@
short-8 uchar-16 vconvert
] data-map( float-4[4] -- uchar-16 )
[ { [ length ] [ drop ] [ drop ] [ drop ] [ drop ] } spread ]
} 5 ncleave
! [fortran-invoke]
- [
+ [
c:void "funpack" "funtimes_"
{ pointer: { c:char 12 } pointer: c:longlong pointer: c:float pointer: complex-float pointer: c:short c:long }
alien-invoke
] 6 nkeep
! [fortran-results>]
- shuffle( aa ba ca da ea ab -- aa ab ba ca da ea )
+ shuffle( aa ba ca da ea ab -- aa ab ba ca da ea )
{
[ drop ]
[ drop ]
[ c:float "funpack" "fun_times_" { pointer: { c:float 0 } } alien-invoke ]
1 nkeep
! [fortran-results>]
- shuffle( reta aa -- reta aa )
+ shuffle( reta aa -- reta aa )
{ [ ] [ drop ] } spread
] ] [
"REAL" "funpack" "FUN_TIMES" { "REAL(*)" }
! [fortran-invoke]
[
c:void "funpack" "fun_times_"
- { pointer: complex-float pointer: { c:float 0 } }
+ { pointer: complex-float pointer: { c:float 0 } }
alien-invoke
] 2 nkeep
! [fortran-results>]
! [fortran-invoke]
[
c:void "funpack" "fun_times_"
- { pointer: { c:char 20 } long }
+ { pointer: { c:char 20 } long }
alien-invoke
] 2 nkeep
! [fortran-results>]
- shuffle( reta retb -- reta retb )
+ shuffle( reta retb -- reta retb )
{ [ ] [ ascii alien>nstring ] } spread
] ] [
"CHARACTER*20" "funpack" "FUN_TIMES" { }
! [fortran-invoke]
[
c:void "funpack" "fun_times_"
- { pointer: { c:char 10 } long pointer: { c:char 20 } pointer: c:float pointer: { c:char 30 } c:long c:long }
+ { pointer: { c:char 10 } long pointer: { c:char 20 } pointer: c:float pointer: { c:char 30 } c:long c:long }
alien-invoke
] 7 nkeep
! [fortran-results>]
- shuffle( reta retb aa ba ca ab cb -- reta retb aa ab ba ca cb )
+ shuffle( reta retb aa ba ca ab cb -- reta retb aa ab ba ca cb )
{
[ ]
[ ascii alien>nstring ]
io.pathnames kernel math sequences sorting tools.test ;
IN: annotations.tests
-!NOTE testing toplevel form
+!NOTE testing toplevel form
: three ( -- x )
!BROKEN english plz
! triggers string
[ B{ 4 6 97 98 99 100 101 102 } ] [ "abcdef" >ber ] unit-test
- [ B{ 69 6 97 98 99 100 101 102 } ] [
- 5 "abcdef" >ber-application-string
+ [ B{ 69 6 97 98 99 100 101 102 } ] [
+ 5 "abcdef" >ber-application-string
] unit-test
- [ B{ 133 6 97 98 99 100 101 102 } ] [
- 5 "abcdef" >ber-contextspecific-string
+ [ B{ 133 6 97 98 99 100 101 102 } ] [
+ 5 "abcdef" >ber-contextspecific-string
] unit-test
! triggers array
[ B{ 48 4 49 50 51 52 } ] [ { 1 2 3 4 } >ber-sequence ] unit-test
- [ B{ 96 4 49 50 51 52 } ] [
+ [ B{ 96 4 49 50 51 52 } ] [
{ 1 2 3 4 } >ber-appsequence
] unit-test
- [ B{ 160 4 49 50 51 52 } ] [
+ [ B{ 160 4 49 50 51 52 } ] [
{ 1 2 3 4 } >ber-contextspecific-array
] unit-test
! Uppercase
{ "A" } [ "a\n" [ ",----------[----------------------.,----------]"
- get-brainfuck ] with-string-reader ] unit-test
+ get-brainfuck ] with-string-reader ] unit-test
! cat
[ "123u" ]
[ "123u" <sequence-parser> take-c-integer ] unit-test
-
(*
-f(2 * (y+1)) + f(2 * (f(2 * (z[0])))) % f(2 * (0)) + t(1);
-f(2 * (2+(3,4)-0,1)) | f(2 * (~ 5)) & f(2 * (0,1))^m(0,1);
-int i[] = { 1, 23, 4, 5, };
-char c[2][6] = { "hello", "" };
+f(2 * (y+1)) + f(2 * (f(2 * (z[0])))) % f(2 * (0)) + t(1);
+f(2 * (2+(3,4)-0,1)) | f(2 * (~ 5)) & f(2 * (0,1))^m(0,1);
+int i[] = { 1, 23, 4, 5, };
+char c[2][6] = { "hello", "" };
*)
[ t ] [ "text/html; charset=utf-8" (content-type)
[ H{ { "charset" { "utf-8" } } } = ]
[ "text/html" = ] bi* and ] unit-test
-
S{ foo { x 1 } { y 0.5 } { z 20 } { w 25 } }
S{ foo { x 2 } { y 1.0 } { z 30 } { w 35 } }
S{ foo { x 3 } { y 1.5 } { z 40 } { w 45 } }
- }
+ }
] [
T{ vectored-foo
{ x int-array{ 0 1 2 3 } }
IN: crypto.barrett.tests
[ 0x1f63edfb7e838622c7412eafaf0439cf0cdf3aae8bdd09e2de69b509a53883a83560d5ce50ea039e4 ] [ 0x827c67f31b2b46afa49ed95d7f7a3011e5875f7052d4c55437ce726d3c6ce0dc9c445fda63b6dc4e 16 barrett-mu ] unit-test
-
[ 123456789 ] [ 129 generate-rsa-keypair 123456789 over rsa-encrypt swap rsa-decrypt ] unit-test
[ 123456789 ] [ 130 generate-rsa-keypair 123456789 over rsa-encrypt swap rsa-decrypt ] unit-test
[ 123 ] [ 3233 2753 17 <rsa> 123 over rsa-encrypt swap rsa-decrypt ] unit-test
-
[ "asdf" ] [ "asdf" "key" [ xor-crypt ] [ xor-crypt ] bi >string ] unit-test
[ "" ] [ "" "key" xor-crypt >string ] unit-test
[ "a longer message...!" ] [
- "a longer message...!"
+ "a longer message...!"
"." [ xor-crypt ] [ xor-crypt ] bi >string
] unit-test
[ "a longer message...!" ] [
"if\t" "resource:extra/unix/unix.factor" normalize-path "\t91" 3append 1array
{ { if { "resource:extra/unix/unix.factor" 91 } } } ctag-strings =
] unit-test
-
V{ if { "path" 1 } }
{ if { "path" 1 } }
{ { "path" V{ if { "path" 1 } } } } >hashtable
- etag-vector =
+ etag-vector =
] unit-test
! etag-pair
17
{ "1234567890" "12345" } 2 lines>bytes =
] unit-test
-
+
! etag
[ t ]
[
USING: cuda.devices tools.test ;
IN: cuda.devices.tests
-[ 1 5 100 ] [ 5 20 100 10 (distribute-jobs) ] unit-test
-[ 2 5 100 ] [ 10 20 100 10 (distribute-jobs) ] unit-test
-[ 2 5 100 ] [ 10 20 200 5 (distribute-jobs) ] unit-test
-[ 2 5 100 ] [ 10 20 300 6 (distribute-jobs) ] unit-test
-[ 2 6 120 ] [ 11 20 300 6 (distribute-jobs) ] unit-test
-[ 1 10 200 ] [ 10 20 200 10 (distribute-jobs) ] unit-test
-[ 1 10 0 ] [ 10 0 200 10 (distribute-jobs) ] unit-test
-[ 2 5 0 ] [ 10 0 200 9 (distribute-jobs) ] unit-test
-
+[ 1 5 100 ] [ 5 20 100 10 (distribute-jobs) ] unit-test
+[ 2 5 100 ] [ 10 20 100 10 (distribute-jobs) ] unit-test
+[ 2 5 100 ] [ 10 20 200 5 (distribute-jobs) ] unit-test
+[ 2 5 100 ] [ 10 20 300 6 (distribute-jobs) ] unit-test
+[ 2 6 120 ] [ 11 20 300 6 (distribute-jobs) ] unit-test
+[ 1 10 200 ] [ 10 20 200 10 (distribute-jobs) ] unit-test
+[ 1 10 0 ] [ 10 0 200 10 (distribute-jobs) ] unit-test
+[ 2 5 0 ] [ 10 0 200 9 (distribute-jobs) ] unit-test
} }
} ptx>string
] unit-test
-
"Hello Curses!" [
8 random 8 random ccolor addch
] each crefresh
-
+
2 seconds sleep
] with-curses ;
H{ { "roses" "lutefisk" } { "tulips" "lox" } } compile-test-assoc>map
natural-sort
] unit-test
-
e1 e0 next-edge<<
e2 e1 next-edge<<
e0 e2 next-edge<<
-
+
e0 ;
[
{ T{ ast-expression f V{ T{ ast-using f V{ "foo" "bar" } } } } } [
"USING: foo bar ;" 'statement' parse
] unit-test
-
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz1234567890"
flip-text flip-text
] unit-test
-
] with-forestdb-tester
] unit-test
-] unless
\ No newline at end of file
+] unless
} cleave ]
} cleave
] ] [ array-of-textures [bind-uniform-textures] ] unit-test
-
"""ERROR: 0:1: Bad command or filename
INFO: 0:11: The operation completed successfully
NOT:A:LOG:LINE""" replace-log-line-numbers ] unit-test
-
: next! ( seq -- elt ) [ first ] [ 1 rotate! ] bi ;
:: smoke-test ( graph -- pass? )
- supported-formats get-global next! :> -T
+ supported-formats get-global next! :> -T
supported-layouts get-global next! :> -K
[
graph "smoke-test" -T -K graphviz
] unit-test
[ { 1.5 } ] [ NHS{ 1.5 } members ] unit-test
-
[ t ] [ "foo@bar.com" mint check-stamp ] unit-test
-[ t ] [
- <hashcash>
- "foo@bar.com" >>resource
- 16 >>bits
+[ t ] [
+ <hashcash>
+ "foo@bar.com" >>resource
+ 16 >>bits
mint* check-stamp ] unit-test
-[ t ] [
+[ t ] [
"1:20:040927:mertz@gnosis.cx::odVZhQMP:7ca28" check-stamp
] unit-test
] unit-test
[ { { 1.0 1000 } } ] [ NH{ { 1.0 1000 } } >alist ] unit-test
-
[ "Italy" ] [ "Italy" unquote ] unit-test
[ "Italy" ] [ "'Italy'" unquote ] unit-test
[ "Italy" ] [ "\"Italy\"" unquote ] unit-test
-
! Copyright (C) 2010 Jon Harper.
! See http://factorcode.org/license.txt for BSD license.
USING: tools.test images.viewer images.viewer.private kernel accessors sequences images
-namespaces ui ui.gadgets.debug math opengl.textures opengl.textures.private
+namespaces ui ui.gadgets.debug math opengl.textures opengl.textures.private
models ;
IN: images.viewer.tests
: (gen-image) ( dim -- bitmap )
product 3 * [ 200 ] BV{ } replicate-as ;
: gen-image ( dim -- image )
- dup (gen-image) <image> swap >>bitmap swap >>dim
+ dup (gen-image) <image> swap >>bitmap swap >>dim
RGB >>component-order ubyte-components >>component-type ;
[ ] [ { 50 50 } gen-image "s" set ] unit-test
[ ] [ "s" get <image-gadget> "ig" set ] unit-test
"ig" get [
[ t ] [ "ig" get image-gadget-texture single-texture? ] unit-test
-] with-grafted-gadget
+] with-grafted-gadget
[ ] [ "s" get <model> "m" set ] unit-test
[ ] [ { 150 150 } gen-image "s1" set ] unit-test
{ op "+" }
} ] [ "1+2*3" build-infix-ast ] unit-test
-[ T{ ast-op
+[ T{ ast-op
{ left T{ ast-number { value 1 } } }
{ right T{ ast-number { value 2 } } }
{ op "+" }
H{ { "key with \n esc\ape \r codes \""
"value with \t esc\ape codes" } } ini>string
] unit-test
-
[ binary ] [ HEX{ 31 32 33 C2 A0 00 } detect-byte-array ] unit-test
[ binary ] [ HEX{ 31 32 33 C2 A0 00 30 } detect-byte-array ] unit-test
-
[ 3 ] [
<< "resource:extra/llvm/reader/add.bc" install-bc >> 1 2 add
-] unit-test
\ No newline at end of file
+] unit-test
! See http://factorcode.org/license.txt for BSD license.
USING: destructors llvm.jit llvm.wrappers tools.test ;
-[ ] [ "test" <module> "test" add-module "test" remove-module ] unit-test
\ No newline at end of file
+[ ] [ "test" <module> "test" add-module "test" remove-module ] unit-test
[ ] [ "test" <module> dispose ] unit-test
[ ] [ "test" <module> <provider> dispose ] unit-test
-[ ] [ "llvm.jit" vocabs member? [ "test" <module> <provider> <engine> dispose ] unless ] unit-test
\ No newline at end of file
+[ ] [ "llvm.jit" vocabs member? [ "test" <module> <provider> <engine> dispose ] unless ] unit-test
<label-binarizer> { 1 2 6 4 2 } over fit-y
{ 1 6 } over transform-y swap inverse-transform-y
] unit-test
-
linux target-os set
x86.32 target-cpu set
f target-variant set
-
+
[ "linux-x86-32" ] [ platform ] unit-test
] with-scope
"Factor.app" useless-files member?
] with-variable
] unit-test
-
+
[ t ] [
linux target-os [
"Factor.app" useless-files member?
IN: mason.release.upload.tests
USING: mason.release.upload tools.test ;
-
[ t ] [ 3 gammaln 0.6931471805599456 eps ~ ] unit-test
[ t ] [ 11 gammaln 15.10441257307984 eps ~ ] unit-test
[ t ] [ 9000000000000000000000000000000000000000000 gammaln 8.811521863477754e44 eps ~ ] unit-test
-
}
svector{ 1.0 2.0 3.0 1.0 }
M.V
-] unit-test
+] unit-test
[ svector{ -2.0 1.0 3.0 14.0 } ] [
smatrix{
{ 0.0 1.0 0.0 1.0 }
} Mtranspose
svector{ 1.0 2.0 3.0 }
M.V
-] unit-test
+] unit-test
[ dvector{ 3.0 1.0 6.0 } ] [
dmatrix{
}
dvector{ 1.0 2.0 3.0 1.0 }
M.V
-] unit-test
+] unit-test
[ dvector{ -2.0 1.0 3.0 14.0 } ] [
dmatrix{
{ 0.0 1.0 0.0 1.0 }
} Mtranspose
dvector{ 1.0 2.0 3.0 }
M.V
-] unit-test
+] unit-test
[ cvector{ 3.0 C{ 1.0 2.0 } 6.0 } ] [
cmatrix{
}
cvector{ 1.0 2.0 3.0 1.0 }
M.V
-] unit-test
+] unit-test
[ cvector{ -2.0 C{ 1.0 2.0 } 3.0 14.0 } ] [
cmatrix{
{ 0.0 1.0 0.0 1.0 }
} Mtranspose
cvector{ 1.0 2.0 3.0 }
M.V
-] unit-test
+] unit-test
[ zvector{ 3.0 C{ 1.0 2.0 } 6.0 } ] [
zmatrix{
} Mtranspose
zvector{ 1.0 2.0 3.0 }
M.V
-] unit-test
+] unit-test
! V(*)
{ 2.0 3.0 0.0 1.0 0.0 }
} Mtranspose 2 1 3 2 Msub
] unit-test
-
! Copyright (C) 2009 Jason W. Merrill.
! See http://factorcode.org/license.txt for BSD license.
-USING: tools.test math.dual kernel accessors math math.functions
+USING: tools.test math.dual kernel accessors math math.functions
math.constants ;
IN: math.dual.tests
[ 2 ] [ 1 1 <dual> 2 d^ epsilon-part>> ] unit-test
[ 2.0 .25 ] [ 4 1 <dual> dsqrt unpack-dual ] unit-test
[ 2 -1 ] [ -2 1 <dual> dabs unpack-dual ] unit-test
-[ -2 -1 ] [ 2 1 <dual> dneg unpack-dual ] unit-test
\ No newline at end of file
+[ -2 -1 ] [ 2 1 <dual> dneg unpack-dual ] unit-test
{ 1 12 123 1234 } [ bits>double roundtrip ] each
100 [ -10.0 10.0 uniform-random-float roundtrip ] times
-
SPECIALIZED-ARRAY: float-4
IN: math.matrices.simd.tests
-[
+[
S{ matrix4 f
float-4-array{
float-4{ 3.0 0.0 0.0 0.0 }
}
] [ float-4{ 3.0 4.0 2.0 0.0 } scale-matrix4 ] unit-test
-[
+[
S{ matrix4 f
float-4-array{
float-4{ 1/8. 0.0 0.0 0.0 }
}
] [ float-4{ 8.0 4.0 2.0 0.0 } ortho-matrix4 ] unit-test
-[
+[
S{ matrix4 f
float-4-array{
float-4{ 0.0 0.0 -1.0 0.0 }
} transpose-matrix4
] unit-test
-[
+[
S{ matrix4 f
float-4-array{
float-4{ 1.0 0.0 0.0 0.0 }
float-4{ 0.0 0.0 0.0 1.0 }
}
}
- 1.0e-7 m~
+ 1.0e-7 m~
] unit-test
[ t ] [
float-4{ 0.0 0.0 0.0 1.0 }
}
}
- 1.0e-7 m~
+ 1.0e-7 m~
] unit-test
[
}
}
] [
- 3.0
+ 3.0
S{ matrix4 f
float-4-array{
float-4{ 1.0 0.0 0.0 5.0 }
float-4{ 0.0 0.0 0.0 1.0 }
}
}
- 1.0e-7 m~
+ 1.0e-7 m~
] unit-test
[ t ] [
float-4{ 0.0 0.0 0.0 1.0 }
}
}
- 1.0e-7 m~
+ 1.0e-7 m~
] unit-test
[ t ] [ 0 pi 2 / [ sin ] integrate-simpson 1 .000000001 ~abs ] unit-test
[ t ] [ 0 pi [ sin ] integrate-simpson 2 .00000001 ~abs ] unit-test
[ t ] [ 0 pi 2 * [ sin ] integrate-simpson 0 .00000000001 ~abs ] unit-test
-
[ { 3 2 -1 -2 3 0 4 1 } ] [ { 7 1 6 6 3 -5 4 2 } haar ] unit-test
[ { 7 1 6 6 3 -5 4 2 } ] [ { 3 2 -1 -2 3 0 4 1 } rev-haar ] unit-test
-
[ { "5" "valuex" } ] [
[ x y z 3array m/getseq values natural-sort ] with-memcached
] unit-test
-
-
-
-
dup 76 pile-alloc drop
] with-destructors
] [ not-enough-pile-space? ] must-fail-with
-
[ V{ 3 2 1 } ] [ 3 V{ 1 2 3 } testing ] unit-test
[ "heyyeh" ] [ 4 "yeh" testing ] unit-test
[ { 4 2 0 } ] [ 5 { 0 2 4 } testing ] unit-test
-[ { 5 0 2 4 } ] [ "a" get ] unit-test
\ No newline at end of file
+[ { 5 0 2 4 } ] [ "a" get ] unit-test
[ f ] [ "history" get back>> empty? ] unit-test
[ t ] [ "history" get forward>> empty? ] unit-test
-
[ "morse code 123" ] [
[MORSE
- __ ___ ._. ... . /
- _._. ___ _.. . /
+ __ ___ ._. ... . /
+ _._. ___ _.. . /
.____ ..___ ...__
MORSE] ] unit-test
-- --- .-. ... . /
-.-. --- -.. .
MORSE] ] [
- "morse code" >morse morse>
+ "morse code" >morse morse>
] unit-test
[ "factor rocks!" ] [
[MORSE
- ..-. .- -.-. - --- .-. /
+ ..-. .- -.-. - --- .-. /
.-. --- -.-. -.- ... -.-.--
MORSE] ] unit-test
! [ ] [ "sos" 0.075 play-as-morse* ] unit-test
"resource:extra/msxml-to-csv/test.xml" msxml>csv
"test.csv" temp-file utf8 file>csv
"resource:extra/msxml-to-csv/test.csv" utf8 file>csv =
-] unit-test
\ No newline at end of file
+] unit-test
:: cl-string-array ( str -- alien )
str ascii encode 0 suffix :> str-buffer
- str-buffer length malloc &free :> str-alien
+ str-buffer length malloc &free :> str-alien
str-alien str-buffer dup length memcpy str-alien ;
-
+
:: opencl-square ( in -- out )
0 f 0 uint <ref> [ clGetPlatformIDs cl-success ] keep uint deref
dup void* <c-array> [ f clGetPlatformIDs cl-success ] keep first
CL_DEVICE_TYPE_DEFAULT 1 f void* <ref> [ f clGetDeviceIDs cl-success ] keep void* deref :> device-id
f 1 device-id void* <ref> f f 0 int <ref> [ clCreateContext ] keep int deref cl-success :> context
context device-id 0 0 int <ref> [ clCreateCommandQueue ] keep int deref cl-success :> queue
-
+
[
context 1 kernel-source cl-string-array void* <ref>
f 0 int <ref> [ clCreateProgramWithSource ] keep int deref cl-success
context CL_MEM_READ_ONLY in byte-length f
0 int <ref> [ clCreateBuffer ] keep int deref cl-success :> input
-
+
context CL_MEM_WRITE_ONLY in byte-length f
0 int <ref> [ clCreateBuffer ] keep int deref cl-success :> output
kernel 0 cl_mem heap-size input void* <ref> clSetKernelArg cl-success
kernel 1 cl_mem heap-size output void* <ref> clSetKernelArg cl-success
kernel 2 uint heap-size in length uint <ref> clSetKernelArg cl-success
-
+
queue kernel 1 f in length ulonglong <ref> f
0 f f clEnqueueNDRangeKernel cl-success
-
+
queue clFinish cl-success
queue output CL_TRUE 0 in byte-length in length float <c-array>
FROM: alien.c-types => float ;
SPECIALIZED-ARRAY: float
IN: opencl.tests
-
+
STRING: kernel-source
__kernel void square(
__global float* input,
! Testing sp
{ { } } [
- " abcd" "a" token parse list>array
+ " abcd" "a" token parse list>array
] unit-test
{ { T{ parse-result f "a" T{ slice f 3 6 " abcd" } } } } [
- " abcd" "a" token sp parse list>array
+ " abcd" "a" token sp parse list>array
] unit-test
! Testing just
{ { T{ parse-result f "abcd" T{ slice f 4 4 "abcd" } } } } [
"abcd" "abcd" token "abc" token <|> just parse list>array
-] unit-test
+] unit-test
! Testing <@
{ { T{ parse-result f 48 T{ slice f 1 5 "01234" } } } } [
- "01234" [ digit? ] satisfy parse list>array
+ "01234" [ digit? ] satisfy parse list>array
] unit-test
{ { T{ parse-result f 0 T{ slice f 1 5 "01234" } } } } [
- "01234" [ digit? ] satisfy [ digit> ] <@ parse list>array
+ "01234" [ digit? ] satisfy [ digit> ] <@ parse list>array
] unit-test
! Testing some
] unit-test
[
- "begin1" "begin" token some parse
-] must-fail
+ "begin1" "begin" token some parse
+] must-fail
{ "begin" } [
- "begin" "begin" token some parse
+ "begin" "begin" token some parse
] unit-test
! <& parser and &> parser
"1234" "1" token <*> parse list>array
] unit-test
-{
+{
{
T{ parse-result f { "1" "1" "1" "1" } T{ slice f 4 7 "1111234" } }
T{ parse-result f { "1" "1" "1" } T{ slice f 3 7 "1111234" } }
"1111234" "1" token <*> parse list>array
] unit-test
-{
+{
{
T{ parse-result f { "1111" } T{ slice f 4 7 "1111234" } }
T{ parse-result f { "111" } T{ slice f 3 7 "1111234" } }
"1234" "1" token <+> parse list>array
] unit-test
-{
+{
{
T{ parse-result f { "1" "1" "1" "1" } T{ slice f 4 7 "1111234" } }
T{ parse-result f { "1" "1" "1" } T{ slice f 3 7 "1111234" } }
SYMBOL: sum
: range ( r from to -- n )
- over - 1 + rot [
+ over - 1 + rot [
'[ over + @ drop ] each-integer drop f
] bshift 2nip ; inline
[ 55 ] [
- 0 sum set
+ 0 sum set
[ 1 10 range sum get + sum set f ] breset drop
sum get
] unit-test
{ 4 H{ } }
} <dijkstra> find-path
] unit-test
-
USING: pdf tools.test ;
IN: pdf.tests
-
[ 72.0 ] [ "1in" string>points ] unit-test
[ 108.0 ] [ "1.5in" string>points ] unit-test
-
IN: peg.expr.tests
{ 5 } [
- "2+3" expr
+ "2+3" expr
] unit-test
{ 6 } [
- "2*3" expr
+ "2*3" expr
] unit-test
{ 14 } [
- "2+3*4" expr
+ "2+3*4" expr
] unit-test
{ 17 } [
- "2+3*4+3" expr
+ "2+3*4+3" expr
] unit-test
{ 23 } [
- "2+3*(4+3)" expr
+ "2+3*(4+3)" expr
] unit-test
{ T{ ast-begin f V{ T{ ast-number f 123 } } } } [
"123;" parse-javascript
-] unit-test
\ No newline at end of file
+] unit-test
"123; 'hello'; foo(x);" javascript
] unit-test
-{ t } [
+{ t } [
"""
var x=5
var y=10
] unit-test
-{ t } [
+{ t } [
"""
function foldl(f, initial, seq) {
for(var i=0; i< seq.length; ++i)
}""" main \ javascript rule (parse) remaining>> length zero?
] unit-test
-{ t } [
+{ t } [
"""
ParseState.prototype.from = function(index) {
var r = new ParseState(this.input, this.index + index);
return r;
}""" main \ javascript rule (parse) remaining>> length zero?
] unit-test
-
T{ ast-name f "x" }
")"
";"
- }
+ }
} [
"123; 'hello'; foo(x);" tokenize-javascript
] unit-test
{ V{ T{ ast-regexp f "<(w+)[^>]*?)/>" "g" } } } [
"/<(\\w+)[^>]*?)\\/>/g" tokenize-javascript
-] unit-test
\ No newline at end of file
+] unit-test
IN: peg.pl0.tests
{ t } [
- "CONST foo = 1;" "block" \ pl0 rule (parse) remaining>> empty?
+ "CONST foo = 1;" "block" \ pl0 rule (parse) remaining>> empty?
] unit-test
{ t } [
] unit-test
{ t } [
- "VAR foo,bar , baz;" "block" \ pl0 rule (parse) remaining>> empty?
+ "VAR foo,bar , baz;" "block" \ pl0 rule (parse) remaining>> empty?
] unit-test
{ t } [
- "foo := 5" "statement" \ pl0 rule (parse) remaining>> empty?
+ "foo := 5" "statement" \ pl0 rule (parse) remaining>> empty?
] unit-test
{ t } [
- "BEGIN foo := 5 END" "statement" \ pl0 rule (parse) remaining>> empty?
+ "BEGIN foo := 5 END" "statement" \ pl0 rule (parse) remaining>> empty?
] unit-test
{ t } [
- "IF 1=1 THEN foo := 5" "statement" \ pl0 rule (parse) remaining>> empty?
+ "IF 1=1 THEN foo := 5" "statement" \ pl0 rule (parse) remaining>> empty?
] unit-test
{ t } [
- "WHILE 1=1 DO foo := 5" "statement" \ pl0 rule (parse) remaining>> empty?
+ "WHILE 1=1 DO foo := 5" "statement" \ pl0 rule (parse) remaining>> empty?
] unit-test
{ t } [
- "WHILE ODD 1 DO foo := 5" "statement" \ pl0 rule (parse) remaining>> empty?
+ "WHILE ODD 1 DO foo := 5" "statement" \ pl0 rule (parse) remaining>> empty?
] unit-test
{ t } [
- "PROCEDURE square; BEGIN squ:=x*x END" "block" \ pl0 rule (parse) remaining>> empty?
+ "PROCEDURE square; BEGIN squ:=x*x END" "block" \ pl0 rule (parse) remaining>> empty?
] unit-test
{ t } [
[ t ] [ "localhost" alive? ] unit-test
[ t ] [ "127.0.0.1" alive? ] unit-test
[ f ] [ "0.0.0.0" alive? ] unit-test
-] when
\ No newline at end of file
+] when
T{ quadtree f T{ rect f { 0.0 -1.0 } { 1.0 1.0 } } { 0.0 -0.25 } "a" f f f f t }
T{ quadtree f T{ rect f { -1.0 0.0 } { 1.0 1.0 } } f f f f f f t }
T{ quadtree f T{ rect f { 0.0 0.0 } { 1.0 1.0 } } { 0.25 0.25 } "b" f f f f t }
- f
+ f
} ] [
unit-bounds <quadtree>
"a" { 0.0 -0.25 } value>>key
SYMBOL: spong
[ [ spong { spoon bong } { } define-tuple-class-with-roles ] with-compilation-unit ]
-[ role-slot-overlap? ] must-fail-with
+[ role-slot-overlap? ] must-fail-with
[ [ spong { spoon bong } { } define-role ] with-compilation-unit ]
-[ role-slot-overlap? ] must-fail-with
+[ role-slot-overlap? ] must-fail-with
! can't try to inherit multiple tuple classes
TUPLE: tool blade ;
SYMBOL: knife
[ knife { utensil tool } { } define-tuple-class-with-roles ]
-[ multiple-inheritance-attempted? ] must-fail-with
+[ multiple-inheritance-attempted? ] must-fail-with
! make sure method dispatch works
GENERIC: poke ( pokee poker -- result )
[ 120 ] [ 5 [ almost-fac ] Y call ] unit-test
[ 8 ] [ 6 [ almost-fib ] Y call ] unit-test
[ 61 ] [ 3 3 [ almost-ack ] Y call ] unit-test
-
IN: rpn.tests
USING: rpn lists tools.test ;
-[ { 2 } ] [ "4 2 -" rpn-parse rpn-eval list>array ] unit-test
\ No newline at end of file
+[ { 2 } ] [ "4 2 -" rpn-parse rpn-eval list>array ] unit-test
{ { "Th" "ree" } { "Fo" "ur" } { "Fi" "ve" } }
[ append ] V{ 1 2 } clone [ <replacer> assoc>map ] keep eq?
] unit-test
-
} clone 1 <n-based-assoc> ; inline
[ "December" t ]
-[ 12 months at* ] unit-test
+[ 12 months at* ] unit-test
[ f f ]
-[ 13 months at* ] unit-test
+[ 13 months at* ] unit-test
[ f f ]
-[ 0 months at* ] unit-test
+[ 0 months at* ] unit-test
[ 12 ] [ months assoc-size ] unit-test
} ] [ "Smarch" 13 months [ set-at ] keep seq>> ] unit-test
[ V{ } ] [ months [ clear-assoc ] keep seq>> ] unit-test
-
-
IN: sequences.squish.tests
[ { { 1 2 3 } { 4 } { 5 6 } } ] [
- V{ { 1 2 3 } V{ { 4 } { 5 6 } } }
+ V{ { 1 2 3 } V{ { 4 } { 5 6 } } }
[ vector? ] { } squish
] unit-test
T{ foo { a 1 } { b 2 } { c 3 } } clone
[ { "b" "a" "c" } {set-slots} ] keep
] unit-test
-
{ }
{ { T{ ast-block { body { "a" } } } } }
} test-compilation call first call
-] unit-test
\ No newline at end of file
+] unit-test
[ [ fake-local ] ] [ "jumble" lexenv get lookup-writer ] unit-test
[ [ fake-self y<< ] ] [ "y" lexenv get lookup-writer ] unit-test
-[ "blahblah" lexenv get lookup-writer ] must-fail
\ No newline at end of file
+[ "blahblah" lexenv get lookup-writer ] must-fail
USING: smalltalk.parser smalltalk.compiler.return tools.test ;
-[ t ] [ "(i <= 1) ifTrue: [^1] ifFalse: [^((Fib new i:(i-1)) compute + (Fib new i:(i-2)) compute)]" parse-smalltalk need-return-continuation? ] unit-test
\ No newline at end of file
+[ t ] [ "(i <= 1) ifTrue: [^1] ifFalse: [^((Fib new i:(i-1)) compute + (Fib new i:(i-2)) compute)]" parse-smalltalk need-return-continuation? ] unit-test
[ 5 ] [ "|x| x:=5. x" eval-smalltalk ] unit-test
[ 11 ] [ "[:i| |x| x:=5. i+x] value: 6" eval-smalltalk ] unit-test
[ t ] [ "class Blah [method foo [5]]. Blah new foo" eval-smalltalk tuple? ] unit-test
-[ 196418 ] [ "vocab:smalltalk/eval/fib.st" eval-smalltalk-file ] unit-test
\ No newline at end of file
+[ 196418 ] [ "vocab:smalltalk/eval/fib.st" eval-smalltalk-file ] unit-test
[ ] [ "class Foo []. Tests blah " parse-smalltalk drop ] unit-test
-[ ] [ "vocab:smalltalk/parser/test.st" ascii file-contents parse-smalltalk drop ] unit-test
\ No newline at end of file
+[ ] [ "vocab:smalltalk/parser/test.st" ascii file-contents parse-smalltalk drop ] unit-test
IN: smalltalk.printer.tests
USING: smalltalk.printer tools.test ;
-[ "#((1 2) 'hi')" ] [ { { 1 2 } "hi" } smalltalk>string ] unit-test
\ No newline at end of file
+[ "#((1 2) 'hi')" ] [ { { 1 2 } "hi" } smalltalk>string ] unit-test
{ { } } [ { } dup natural-bubble-sort! ] unit-test
{ { 1 } } [ { 1 } dup natural-bubble-sort! ] unit-test
{ { 1 2 3 4 5 } } [ { 1 4 2 5 3 } dup natural-bubble-sort! ] unit-test
-
10 iota >array randomize
[ swap insort-right! ] each
] unit-test
-
{ "fred" "wilma" "pebbles" "dino" "barney" "betty" "bamm-bamm" }
[ length ] heapsort-with
] unit-test
-
2
00:00:15,000 --> 00:00:18,000 X1:53 X2:303 Y1:438 Y2:453
-<font color="cyan">At the left we can see...</font>"""
+<font color="cyan">At the left we can see...</font>"""
parse-srt-string
] unit-test
"rotate(30)" svg-transform>affine-transform
{ $[ 0.75 sqrt ] 0.5 }
{ -0.5 $[ 0.75 sqrt ] }
- { 0.0 0.0 } <affine-transform>
+ { 0.0 0.0 } <affine-transform>
0.001 a~
] unit-test
[ 4800 ] [ 3 4 rows-score ] unit-test
[ 1 ] [ <default-tetris> dup 3 score-rows dup 3 score-rows dup 3 score-rows level>> ] unit-test
[ 2 ] [ <default-tetris> dup 4 score-rows dup 4 score-rows dup 2 score-rows level>> ] unit-test
-
[ "key1" -1 "key2" 0 "key3" 0 ]
[ T{ avl-node f "key1" f f
- T{ avl-node f "key2" f
+ T{ avl-node f "key2" f
T{ avl-node f "key3" f f f 1 } f -1 } 2 }
[ double-rotate ] go-left
[ left>> dup key>> swap balance>> ] keep
[ "key1" 0 "key2" 0 "key3" 0 ]
[ T{ avl-node f "key1" f f
T{ avl-node f "key2" f
- T{ avl-node f "key3" f f f 0 } f -1 } 2 }
+ T{ avl-node f "key3" f f f 0 } f -1 } 2 }
[ double-rotate ] go-left
[ left>> dup key>> swap balance>> ] keep
[ right>> dup key>> swap balance>> ] keep
[ "key1" 0 "key2" 1 "key3" 0 ]
[ T{ avl-node f "key1" f f
T{ avl-node f "key2" f
- T{ avl-node f "key3" f f f -1 } f -1 } 2 }
+ T{ avl-node f "key3" f f f -1 } f -1 } 2 }
[ double-rotate ] go-left
[ left>> dup key>> swap balance>> ] keep
[ right>> dup key>> swap balance>> ] keep
AVL{
{ 7 "seven" }
{ 9 "nine" }
- { 4 "four" }
- { 4 "replaced four" }
+ { 4 "four" }
+ { 4 "replaced four" }
{ 7 "replaced seven" }
} clone ;
TREE{
{ 7 "seven" }
{ 9 "nine" }
- { 4 "four" }
- { 4 "replaced four" }
+ { 4 "four" }
+ { 4 "replaced four" }
{ 7 "replaced seven" }
} clone ;
{ 1 } [ 3 inches [ palms ] undo ] unit-test
{ 1 } [ 16 nails [ yards ] undo ] unit-test
{ 1 } [ 8 fingers [ yards ] undo ] unit-test
-
: testfn ( a b c d -- a+b c+d )
+ [ + ] dip ;
-
+
[ 3 7 ]
[ reset-word-timer
\ testfn [ reset ] [ add-timer ] bi
- 1 2 3 4 testfn ] unit-test
\ No newline at end of file
+ 1 2 3 4 testfn ] unit-test
! { "option" t }
! { "but" H{ { "y" "is a string" } { "n" "is a string" } } }
! }
-!
+!
! CONSTANT: construct-bool-str """canonical: yes
! answer: NO
! logical: True
! option: on
-!
-!
+!
+!
! but:
! y: is a string
! n: is a string
! """
-!
+!
! ${ construct-bool-obj } [ $ construct-bool-str yaml> ] unit-test
! ${ construct-bool-obj } [ $ construct-bool-obj >yaml yaml> ] unit-test
! binary: 0b1010_0111_0100_1010_1110
! sexagesimal: 190:20:30
! """
-!
+!
! ${ construct-int-obj } [ $ construct-int-str yaml> ] unit-test
! ${ construct-int-obj } [ $ construct-int-obj >yaml yaml> ] unit-test
IN: zoneinfo.tests
{ t }
-[ "PST8PDT" find-zone-rules and >boolean ] unit-test
\ No newline at end of file
+[ "PST8PDT" find-zone-rules and >boolean ] unit-test
projects / factor.git / commitdiff