! Use vocabulary tools.testest for testing. ! See https://github.com/codewars/testest USING: kata tools.testest system io kernel ; IN: kata.tests : run-tests ( -- ) "Display Factor version" describe#{ "test version" it#{ <{ vm-version dup print -> "0.99" }> }# }# ; MAIN: run-tests
- ! Use vocabulary tools.testest for testing.
- ! See https://github.com/codewars/testest
USING: kata tools.testest system io ;- USING: kata tools.testest system io kernel ;
- IN: kata.tests
- : run-tests ( -- )
- "Display Factor version" describe#{
- "test version" it#{
<{ vm-version print -> }>- <{ vm-version dup print -> "0.99" }>
- }#
- }#
- ;
- MAIN: run-tests
IN: kata
! Use vocabulary tools.testest for testing.
! See https://github.com/codewars/testest
USING: kata tools.testest system io ;
IN: kata.tests
: run-tests ( -- )
"Display Factor version" describe#{
"test version" it#{
<{ vm-version print -> }>
}#
}#
;
MAIN: run-tests
IN: kata
! Use vocabulary tools.testest for testing.
! See https://github.com/codewars/testest
USING: tools.testest ;
USING: accessors assocs compiler.errors io kernel namespaces prettyprint sequences sequences.extras sets source-files.errors tools.errors ;
IN: example.tests
: example ( -- )
linkage-errors get values errors.
;
: run-tests ( -- )
"Example" describe#{
"test case" it#{
<{ example -> }>
}#
}#
;
MAIN: run-tests
! Use vocabulary tools.testest for testing. ! See https://github.com/codewars/testest USING: kernel math foo sequences tools.testest ; IN: example.tests ! won't compile without 'first4' : y ( seq -- zero? ) x first4 [ - zero? ] 2bi@ and ; inline : run-tests ( -- ) "Example" describe#{ "test case" it#{ <{ { "nsew" } y -> t }> }# }# ; MAIN: run-tests
- ! Use vocabulary tools.testest for testing.
- ! See https://github.com/codewars/testest
USING: foo tools.testest ;- USING: kernel math foo sequences tools.testest ;
- IN: example.tests
- ! won't compile without 'first4'
- : y ( seq -- zero? ) x first4 [ - zero? ] 2bi@ and ; inline
- : run-tests ( -- )
- "Example" describe#{
- "test case" it#{
<{ { "s" } x -> { 0 0 0 1 } }>- <{ { "nsew" } y -> t }>
- }#
- }#
- ;
- MAIN: run-tests
USING: kernel parser sequences quotations prettyprint fry ; QUALIFIED-WITH: tools.testest tt IN: testest.extras : wrap-it ( quot -- wrapped ) '[ tt:it#{ _ dip tt:}# ] ; : wrap-describe ( quot -- wrapped ) '[ tt:describe#{ _ dip tt:}# ] ; SYNTAX: it#{ \ tt:}# parse-until >quotation wrap-it suffix! \ call suffix! ; SYNTAX: describe#{ \ tt:}# parse-until >quotation wrap-describe suffix! \ call suffix! ;
- USING: kernel parser sequences quotations prettyprint fry ;
- QUALIFIED-WITH: tools.testest tt
- IN: testest.extras
- : wrap-it ( quot -- wrapped )
- '[ tt:it#{ _ dip tt:}# ] ;
- : wrap-describe ( quot -- wrapped )
- '[ tt:describe#{ _ dip tt:}# ] ;
- SYNTAX: it#{ \ tt:}# parse-until >quotation wrap-it suffix! \ call suffix! ;
SYNTAX: describe#{ \ tt:}# parse-until >quotation wrap-describe suffix! \ call suffix! ;- SYNTAX: describe#{ \ tt:}# parse-until >quotation wrap-describe suffix! \ call suffix! ;
USING: kernel tools.testest math prettyprint io ; QUALIFIED-WITH: testest.extras te IN: testest.tests : run-tests ( -- ) "Example" te:describe#{ "hello" te:it#{ <{ 1 1 + -> 2 }> }# "fail" te:it#{ <{ 1 1 + -> 3 }> }# "nested describe" te:describe#{ "pass" te:it#{ <{ 1 1 + -> 2 }> }# "fail" te:it#{ ! Nothing on the stack "Nothing on the stack!" print get-datastack . <{ 1 1 + -> 3 }> }# }# }# "nested its should pass" te:describe#{ "level 1" te:it#{ "level 2" te:it#{ "level 3" te:it#{ <{ 1 1 + -> 2 }> }# }# }# }# ; MAIN: run-tests
- USING: kernel tools.testest math prettyprint io ;
- QUALIFIED-WITH: testest.extras te
- IN: testest.tests
- : run-tests ( -- )
- "Example" te:describe#{
- "hello" te:it#{
- <{ 1 1 + -> 2 }>
- }#
- "fail" te:it#{
- <{ 1 1 + -> 3 }>
- }#
- "nested describe" te:describe#{
- "pass" te:it#{
- <{ 1 1 + -> 2 }>
- }#
- "fail" te:it#{
- ! Nothing on the stack
- "Nothing on the stack!" print
- get-datastack .
- <{ 1 1 + -> 3 }>
- }#
- }#
- }#
- "nested its should pass" te:describe#{
- "level 1" te:it#{
- "level 2" te:it#{
- "level 3" te:it#{
- <{ 1 1 + -> 2 }>
- }#
- }#
- }#
- }#
- ;
- MAIN: run-tests
USING: example tools.testest ;
IN: example
: example ( -- n ) 5 ;
! Use vocabulary tools.testest for testing.
! See https://github.com/codewars/testest
USING: example locals prettyprint tools.testest ;
IN: example.tests
:: run-tests ( -- )
"Example" describe#{
"test case" it#{
5 :> g 0 :> e!
<{ example e! 1 -> 1 }>
e .
<{ g -> example }>
}#
}#
;
MAIN: run-tests
USING: math arrays sequences quotations kernel ; IN: kata : foo1 ( -- x ) [ even? ] 1array first ; : foo2 ( x -- r ) [ even? ] 1array first filter ; : foo3 ( x -- r ) [ even? ] filter ;
- USING: math arrays sequences quotations kernel ;
- IN: kata
- : foo1 ( -- x ) [ even? ] 1array first ;
: foo2 ( x -- r ) [ even? ] 1array first filter ;- : foo2 ( x -- r ) [ even? ] 1array first filter ;
- : foo3 ( x -- r ) [ even? ] filter ;
USING: kata tools.testest sequences ; IN: kata.tests : run-tests ( -- ) "Example" describe#{ "Foo1" it#{ <{ { 1 2 3 4 5 } foo1 filter -> { 2 4 } }> }# "Foo2" it#{ <{ { 1 2 3 4 5 } foo2 -> { 2 4 } }> }# "Foo3" it#{ <{ { 1 2 3 4 5 } foo3 -> { 2 4 } }> }# }# ; MAIN: run-tests
- USING: kata tools.testest sequences ;
- IN: kata.tests
- : run-tests ( -- )
- "Example" describe#{
- "Foo1" it#{
- <{ { 1 2 3 4 5 } foo1 filter -> { 2 4 } }>
- }#
- "Foo2" it#{
- <{ { 1 2 3 4 5 } foo2 -> { 2 4 } }>
- }#
- "Foo3" it#{
- <{ { 1 2 3 4 5 } foo3 -> { 2 4 } }>
- }#
- }#
- ;
- MAIN: run-tests
USING: math ;
FROM: example.preloaded => ERROR: error <{ ;
IN: example
ERROR: bad msg ;
C: <bad> bad
: solve ( -- bad ) "Exception" <bad> ;
: solve* ( -- * ) "!Exception" bad ;
: solve/0* ( -- * ) 1 0 / "!Exception" bad ;
USING: tools.testest accessors classes classes.error debugger formatting inspector io io.streams.string kernel math namespaces
present prettyprint prettyprint.backend prettyprint.custom prettyprint.sections sequences splitting summary ;
FROM: example => solve solve* solve/0* <bad> bad ;
FROM: example.preloaded => <{ error >cw describe#{ it#{ ;
IN: example.tests
! https://github.com/codewars/runner/blob/main/docs/messages.md
! M: error-class error. drop "found error class!" write ;
! M: error present call-next-method "&{" "}&" surround ;
! M: error pprint* present text ;
! M: error error. present write ;
! M: bad error. dup call-next-method "bad -- " write msg>> write ;
! M: bad pprint* msg>> "ERROR:⚠ bad: " " ⚠" surround text ;
! M: bad pprint* msg>> "ERROR: bad ⚠" "⚠" surround text ;
SYMBOL: ERROR:{
SYMBOL: ERROR{
SYMBOL: E{
: pprint-error ( error-tuple -- ) [ ERROR{ ] dip [ class-of ] [ tuple>assoc ] bi \ } (pprint-tuple) ;
! : pprint-error ( obj -- ) error. ;
M: tuple pprint* dup class-of error-class? [ pprint-error ] [ pprint-tuple ] if ;
! M: tuple error. dup class-of error-class? [ pprint-short ] [ describe ] if ;
M: tuple error. dup class-of error-class? [ summary write ] [ describe ] if ;
TUPLE: test a b c d ;
ERROR: custom-error error-message integer-argument ;
M: custom-error summary [ error-message>> ] [ integer-argument>> ] bi "%s:%d" sprintf ;
: run-tests ( -- )
"System and custom errors tests" describe#{
"Unexpected system error in user code" it#{
<{ 1 0 / -> 1 }>
}#
"Unexpected custom error in user code" it#{
<{ "thrown custom error" 1 custom-error -> 1 }>
}#
"Expected custom error" it#{
<{ "thrown custom error" 1 custom-error -> "thrown custom error" 1 custom-error }>
}#
"Missing expected custom error" it#{
<{ 1 -> "thrown custom error" 1 custom-error }>
}#
}#
"Messages" describe#{
"test" it#{
! [ [ 0 1 "%d\n%d" printf ] with-message write ] [ <{ 0 -> 0 }> ] with-passed
[ 0 1 "%d\n%d" printf ] [ <{ "HW!" write 0 -> 0 }> ] with-passed
<{ "HW!" write -> }>
}#
}#
"Print tuples" describe#{
"test failed printing" it#{
<{ 1 "two" 3.0 "four" test boa -> }>
<{ 1 "two" 3.0 "four" -> 1 "two" 3.0 "four" 5 }>
}#
}#
"Time flush" describe#{
0 [
"test" it#{
<{ 1 1000 [ 4 * ] times -> 114813069527425452423283320117768198402231770208869520047764273682576626139237031385665948631650626991844596463898746277344711896086305533142593135616665318539129989145312280000688779148240044871428926990063486244781615463646388363947317026040466353970904996558162398808944629605623311649536164221970332681344168908984458505602379484807914058900934776500429002716706625830522008132236281291761267883317206598995396418127021779858404042159853183251540889433902091920554957783589672039160081957216630582755380425583726015528348786419432054508915275783882625175435528800822842770817965453762184851149029376 }>
}#
] times
}#
"Try this" describe#{
"streams" it#{
<{ input-stream get . -> }>
<{ output-stream get . -> }>
}#
}#
"Example" describe#{
"test case" it#{
<{ solve class-of error-class? -> t }>
<{ solve class-of -> "Don't know" <bad> class-of }>
<{ solve -> "Don't know" <bad> }>
! <{ solve error. -> lf "Don't know" <bad> error. }>
<{ solve -> "Exception" <bad> }>
"from here on we use code throwing exceptions" write lf
"ERROR" it#{ <{ solve/0* -> 0 }> }#
<{ solve* -> "!Exception" bad }>
<{ solve* -> "!Don't know" bad }>
<{ solve* class-of -> "!Don't know class" bad class-of }> ! class-of is aborted by the throw
<{ solve/0* -> "!Exception" bad }>
<{ solve/0* -> "!Don't know" bad }>
[ [ expected>> first summary ] [ got>> first summary ] bi "Expected error: %s\nGot error: %s\n" printf ] [
<{ solve* -> "!Exception" bad }>
<{ solve* -> "!Don't know" bad }>
<{ solve* class-of -> "!Don't know class" bad class-of }> ! class-of is aborted by the throw
<{ solve/0* -> "!Exception" bad }>
<{ solve/0* -> "!Don't know" bad }>
] with-failed
}#
}#
"stack underflow" describe#{
"single test" it#{
<{ drop -> 0 }>
}#
"double test" it#{
<{ drop -> 0 }>
<{ drop drop -> 0 }>
}#
"double test" it#{
<{ drop -> 0 0 }>
<{ drop drop -> 0 0 }>
}#
"double test" it#{
<{ drop -> 0 0 }>
<{ drop drop -> 0 }>
}#
}#
;
MAIN: run-tests
\ First Forth Kumite
: hw ." Hello World!" ;
hw cr
\ Test Framework (ttester + extension) decimal s" test/ttester.fs" included : #ms ( dmicroseconds -- len c-addr ) <# # # # [char] . hold #s #> ; : describe#{ ( len c-addr -- ) cr ." <DESCRIBE::>" type cr utime ; : it#{ ( len c-addr -- ) cr ." <IT::>" type cr utime ; : }# ( -- ) utime cr ." <COMPLETEDIN::>" 2swap d- #ms type ." ms" cr ; create EXPECTED-RESULTS 32 cells allot variable RESULTS variable DIFFERENCES : <{ T{ ; : }> depth ACTUAL-DEPTH @ = if depth START-DEPTH @ > if depth START-DEPTH @ - dup RESULTS ! 0 do dup EXPECTED-RESULTS i cells + ! ACTUAL-RESULTS i cells + @ <> DIFFERENCES +! loop DIFFERENCES @ if cr ." <FAILED::>expected: " RESULTS @ 0 do EXPECTED-RESULTS i cells + @ . loop ." <:LF:> actual: " RESULTS @ 0 do ACTUAL-RESULTS i cells + @ . loop cr else cr ." <PASSED::>Test Passed" cr then then else cr ." <FAILED::>Wrong number of results. Expected:<:LF:>" ACTUAL-DEPTH @ . ." <:LF:>got:<:LF:>" depth . cr then F} ; \ Solution : solution ( a b -- a*b ) * ; \ Tests s" Basic Tests" describe#{ s" zeros" it#{ <{ 0 0 solution -> 0 }> <{ 0 1 solution -> 0 }> <{ 1 0 solution -> 0 }> }# s" non-zeros" it#{ \ intentionally broken tests \ <{ 1 1 solution -> 2 }> \ <{ 3 5 solution -> 8 }> <{ 1 1 solution -> 1 }> }# }#
- \ Test Framework (ttester + extension)
- decimal
- s" test/ttester.fs" included
- : #ms ( dmicroseconds -- len c-addr ) <# # # # [char] . hold #s #> ;
- : describe#{ ( len c-addr -- ) cr ." <DESCRIBE::>" type cr utime ;
- : it#{ ( len c-addr -- ) cr ." <IT::>" type cr utime ;
- : }# ( -- ) utime cr ." <COMPLETEDIN::>" 2swap d- #ms type ." ms" cr ;
- create EXPECTED-RESULTS 32 cells allot
- variable RESULTS
- variable DIFFERENCES
- : <{ T{ ;
- : }>
- depth ACTUAL-DEPTH @ = if
- depth START-DEPTH @ > if
- depth START-DEPTH @ - dup RESULTS ! 0 do
- dup EXPECTED-RESULTS i cells + !
- ACTUAL-RESULTS i cells + @ <> DIFFERENCES +!
- loop
- DIFFERENCES @ if
- cr ." <FAILED::>expected: "
- RESULTS @ 0 do EXPECTED-RESULTS i cells + @ . loop
- ." <:LF:> actual: "
- RESULTS @ 0 do ACTUAL-RESULTS i cells + @ . loop
- cr
- else
- cr ." <PASSED::>Test Passed" cr
- then
- then
- else
- cr ." <FAILED::>Wrong number of results. Expected:<:LF:>" ACTUAL-DEPTH @ . ." <:LF:>got:<:LF:>" depth . cr
- then
- F} ;
- \ Solution
- : solution ( a b -- a*b ) * ;
- \ Tests
- s" Basic Tests" describe#{
- s" zeros" it#{
- <{ 0 0 solution -> 0 }>
- <{ 0 1 solution -> 0 }>
- <{ 1 0 solution -> 0 }>
- }#
- s" non-zeros" it#{
- \ intentionally broken tests
<{ 1 1 solution -> 2 }><{ 3 5 solution -> 8 }>- \ <{ 1 1 solution -> 2 }>
- \ <{ 3 5 solution -> 8 }>
- <{ 1 1 solution -> 1 }>
- }#
- }#