Ad
IN: kata
IN: kata
Code
Diff
  • USING: ;
    IN: foo
    
    : bla ;
    • USING: ;
    • IN: foo
    • : bla ( -- ) 3 ;
    • : bla ;
Code
Diff
  • 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: example tools.testest ;
IN: example
: example ( --  n ) 5 ;
Code
Diff
  • 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: 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 ;
\ First Forth Kumite
: hw ." Hello World!" ;
hw cr
Code
Diff
  • \ 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 }>
    • }#
    • }#