PasteRack.org | ||
Paste # 38828 | ||
2017-01-17 20:03:18 | ||
Fork as a new paste. | ||
Paste viewed 834 times. | ||
Tweet | ||
Embed: | ||
#lang racket (require rackunit sexp-diff) ;; raco pkg install sexp-diff (provide check-sexp-equal?) ;; check-equal? doesn't even pretty-print the sexprs, which can be ;; very long and hard to compare. Anyway let's do even better and use ;; sexp-diff to highlight to diff. (define-check (check-sexp-equal? a b) (or (equal? a b) (fail-check (format "sexp-diff (#:new = actual, #:old = expected):~n~n~a" (pretty-format (first (sexp-diff b a))))))) (define-check (check-sexp-equal2? a b) (or (equal? a b) (with-check-info (['actual a] ['expected b] ['sexp-diff (first (sexp-diff b a))] ['key "sexp-diff (#:new = actual, #:old = expected)"]) (fail-check)))) (module+ test (define (check-stack->hash lst) (for/hash ([info (in-list lst)]) (values (check-info-name info) (check-info-value info)))) (define-check (check-exn-info? proc message info) (define failure (with-handlers ([exn:test:check? identity]) (parameterize ([current-check-around (λ (proc) (proc))]) (proc)) #f)) (unless failure (fail-check "No failure raised")) (define info-hash (check-stack->hash (exn:test:check-stack failure))) (check-equal? (exn-message failure) message "failed to match exn message") (for ([(k v) (in-hash info)]) (check-equal? (hash-ref info-hash k (not v)) v))) (let ([a '(a (foo bar foo bar b c d e f (g h i j k l)) (m n o p q (r s t u v w x y z)))] [b '(a (foo bar foo bar b c d e f (g h i j k l)) (m n o p q (r s t u v 0 x y z)))]) (check-exn-info? (thunk (check-equal? a b)) "Check failure" (hash 'actual a 'expected b)) ;; -------------------- ;; FAILURE ;; name: check-sexp-equal? ;; location: (#<path:/Users/ryan/Work/git/zenspider/check-sexp-equal/main.rkt> 52 0 1881 23) ;; expression: (check-sexp-equal? a b) ;; params: ((a (foo bar foo bar b c d e f (g h i j k l)) (m n o p q (r s t u v w x y z))) (a (foo bar foo bar b c d e f (g h i j k l)) (m n o p q (r s t u v 0 x y z)))) ;; ;; ; sexp-diff (#:new = actual, #:old = expected): ;; ; ;; ; '(a ;; ; (foo bar foo bar b c d e f (g h i j k l)) ;; ; (m n o p q (r s t u v #:new w #:old 0 x y z))) ;; ; /Users/ryan/Work/git/zenspider/check-sexp-equal/main.rkt:52:0 ;; -------------------- (check-exn-info? (thunk (check-sexp-equal? a b)) #<<DONE sexp-diff (#:new = actual, #:old = expected): '(a (foo bar foo bar b c d e f (g h i j k l)) (m n o p q (r s t u v #:new w #:old 0 x y z))) DONE (hash)) ;; -------------------- ;; FAILURE ;; actual: (a (foo bar foo bar b c d e f (g h i j k l)) (m n o p q (r s t u v w x y z))) ;; expected: (a (foo bar foo bar b c d e f (g h i j k l)) (m n o p q (r s t u v 0 x y z))) ;; sexp-diff: (a (foo bar foo bar b c d e f (g h i j k l)) (m n o p q (r s t u v #:new w #:old 0 x y z))) ;; key: "sexp-diff (#:new = actual, #:old = expected)" ;; name: check-sexp-equal2? ;; location: (#<path:/Users/ryan/Work/git/zenspider/check-sexp-equal/main.rkt> 58 0 2160 24) ;; expression: (check-sexp-equal2? a b) ;; ;; -------------------- (check-exn-info? (thunk (check-sexp-equal2? a b)) "Check failure" (hash 'actual a 'expected b 'sexp-diff '(a (foo bar foo bar b c d e f (g h i j k l)) (m n o p q (r s t u v #:new w #:old 0 x y z))))) (displayln 'done) ))
=>
standard-module-name-resolver: collection not found for module path: sexp-diff collection: "sexp-diff" in collection directories: /home/pasterack/.racket/6.6/collects /home/pasterack/racket66/collects ... [161 additional linked and package directories] context...: show-collection-err standard-module-name-resolver /home/pasterack/racket66/collects/racket/require-transform.rkt:266:2: expand-import /home/pasterack/racket66/collects/racket/private/reqprov.rkt:570:24 /home/pasterack/racket66/collects/racket/private/reqprov.rkt:558:5 /home/pasterack/racket66/collects/racket/require-transform.rkt:266:2: expand-import /home/pasterack/racket66/collects/racket/private/reqprov.rkt:266:21: try-next /home/pasterack/racket66/collects/racket/private/reqprov.rkt:347:21: try-next /home/pasterack/racket66/collects/racket/private/reqprov.rkt:243:2 /home/pasterack/racket66/collects/syntax/wrap-modbeg.rkt:46:4