! 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

! 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: 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: 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