daily pastebin goal
24%
SHARE
TWEET

Untitled

a guest Mar 22nd, 2019 47 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. #lang racket/base
  2. (require rackunit
  3.          rackunit/private/check-info
  4.          racket/string)
  5.  
  6.  
  7. (define (with-tag tag value)
  8.   (format "<~a::>~a" tag (string-replace value "\n" "<:LF:>")))
  9. (define complited "<COMPLITEDIN::>")
  10. (define passed "<PASSED::>Test Passed")
  11.  
  12.  
  13. (define (show-exn:test:check e)
  14.   (format "<FAILED::>Expected ~a but instead got ~a"
  15.           (get-check-expected e)
  16.           (get-check-actual e)))
  17.  
  18. (define (get-check-info-value exn name)
  19.   (ormap (lambda (info)
  20.            (and (eq? (check-info-name info) name)
  21.                 (check-info-value info)))
  22.          (exn:test:check-stack exn)))
  23.  
  24. (define (get-check-expected exn)
  25.   (pretty-info-value
  26.    (get-check-info-value exn 'expected)))
  27. (define (get-check-actual exn)
  28.   (pretty-info-value
  29.    (get-check-info-value exn 'actual)))
  30.  
  31.  
  32. (define (show-exn e)
  33.   (with-tag "ERROR" (exn-message e)))
  34.  
  35.  
  36. (define (fdown suite name before after seed)
  37.   (before)
  38.   (displayln (with-tag "DESCRIBE" name)))
  39.  
  40. (define (fup suite name before after seed kid-seed)
  41.   (displayln complited)
  42.   (after))
  43.  
  44. (define (fhere case name action seed)
  45.   (when name
  46.     (displayln (with-tag "IT" name)))
  47.   (define result
  48.     (with-handlers ([exn:test:check? show-exn:test:check]
  49.                     [exn? show-exn])
  50.       (action)
  51.       passed))
  52.   (displayln result)
  53.   (when name
  54.     (displayln complited)))
  55.  
  56.  
  57. (define (run-test-and-wrap-result test)
  58.   (define output (open-output-string))
  59.   (parameterize ([current-output-port output])
  60.     (foldts-test-suite fdown fup fhere '() test))
  61.   (get-output-string output))
  62.  
  63.  
  64. ;;; example
  65. (define a-test-suite
  66.   (test-suite
  67.    "This is a test suite"
  68.    (check-eq? 1 1)
  69.    (check-eq? 1 2)
  70.    (test-case "This is a success test case"
  71.               (check-eq? 1 1)
  72.               (check-equal? '(10 "a string") '(10 "a string")))
  73.    (test-case "This is a failed case"
  74.               (check-eq? 1 2)
  75.               (check-pred even? 3))
  76.    (test-suite
  77.     "Another test suite"
  78.     (test-case "This is a test case for test printing to console"
  79.                (println 'yes))
  80.     (test-case "Here will be an error!"
  81.                (/ 1 0)))))
  82.  
  83. (display (run-test-and-wrap-result a-test-suite))
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top