#lang racket ;; ============================================================================= ;; ACI (Fall 2020): test-support.rkt ;; ============================================================================= ;; DO NOT EDIT THIS FILE ======================================================= (require "aci.rkt") (require syntax/macro-testing) (require rackunit rackunit/text-ui racket/sandbox) (require/expose rackunit/private/check (refail-check raise-error-if-not-thunk make-check-actual make-check-expected)) (provide define-test-suite define/provide-test-suite run-tests ; rename-out is needed here since we're overriding some definitions ; already defined by rackunit and racket/sandbox. (rename-out [*test-equal? test-equal?] [*test-not-equal? test-not-equal?] [*test-true test-true] [*test-false test-false] [*test-pred test-pred] [*test-exn test-exn]) test-raises-error-with-substring? test-aci) ;; GENERAL TESTING UTILITIES =================================================== ; Author: zespirit ; Defines the global per-test-case time limit. (define time-limit 2) ; run-check-with-time-limit :: (-> Any) ; Helper macro for defining the `check-with-timeout-*` forms below. It runs the ; given `thunk-to-run` within a `call-with-limits` sandbox, which implements the ; timeout functionality. (define-syntax-rule (run-check-with-time-limit thunk-to-run) ((let/cc timeout-escape (with-handlers ([exn:fail? (lambda (exn) (timeout-escape (lambda () (with-default-check-info* (list (make-check-message (string-append "Timed out; took longer than " (number->string time-limit) " seconds")) (make-check-info 'exn-message (exn-message exn)) (make-check-info 'exn exn)) (lambda () (fail-check))))))]) (call-with-limits time-limit #f thunk-to-run))))) ; check-with-timeout-equal? :: (-> Any) Any ; Defines a Rackunit check similar to the Rackunit-native `check-equal?`, but ; with a timeout. The timeout is defined globally by `time-limit`. Unlike ; `check-equal?`, this check takes the "actual" value as a thunk—this allows the ; "actual" expression to be run in a `call-with-limits` sandbox that ; implements the timeout functionality. (define-check (check-with-timeout-equal? actual-thunk expected) (run-check-with-time-limit (lambda () (letrec ([actual (actual-thunk)] [custom-check-infos (list (make-check-actual actual) (make-check-expected expected))]) (if (equal? actual expected) (lambda () (with-default-check-info* custom-check-infos (lambda () #t))) (lambda () (with-default-check-info* custom-check-infos (lambda () (fail-check))))))))) ; check-with-timeout-pred :: (Any -> Boolean) (-> Any) ; Defines a Rackunit check similar to the Rackunit-native `check-pred`, but with ; a timeout. The timeout is defined globally by `time-limit`. Unlike ; `check-pred`, this check takes the "actual" value as a thunk—this allows the ; "actual" expression to be run in a `call-with-limits` sandbox that ; implements the timeout functionality. (define-check (check-with-timeout-pred pred actual-thunk) (run-check-with-time-limit (lambda () (let ([actual (actual-thunk)]) (if (pred actual) (lambda () (with-default-check-info* (list (make-check-message "Predicate was satisfied by actual value") (make-check-actual actual)) (lambda () #t))) (lambda () (with-default-check-info* (list (make-check-message "Predicate was not satisfied by actual value") (make-check-actual actual)) (lambda () (fail-check))))))))) ; check-with-timeout-exn :: (Any -> Boolean) (-> Any) ; Defines a Rackunit check similar to the Rackunit-native `check-exn`, but with ; a timeout. The timeout is defined globally by `time-limit`. (define-check (check-with-timeout-exn raw-pred thunk-body) (let ([pred (cond [(regexp? raw-pred) (λ (x) (and (exn:fail? x) (regexp-match raw-pred (exn-message x))))] [(and (procedure? raw-pred) (procedure-arity-includes? raw-pred 1)) raw-pred] [else (raise-argument-error 'check-exn "(or/c (-> any/c any/c) regexp?)" raw-pred)])]) ; Do a quick check to see that thunk-body is actually a thunk (raise-error-if-not-thunk 'check-exn thunk-body) (run-check-with-time-limit (lambda () (let/ec inner-succeed (with-handlers (;; catch the exception we are looking for and ;; succeed [pred (lambda (exn) (inner-succeed (lambda () #t)))] ;; rethrow check failures if we aren't looking ;; for them [exn:test:check? (lambda (exn) (inner-succeed (lambda () (refail-check exn))))] ;; catch any other exception and raise an check ;; failure [exn:fail? (lambda (exn) (inner-succeed (lambda () (with-default-check-info* (list (make-check-message "Wrong exception raised") (make-check-info 'exn-message (exn-message exn)) (make-check-info 'exn exn)) (lambda () (fail-check))))))]) (thunk-body)) (inner-succeed (lambda () (with-default-check-info* (list (make-check-message "No exception raised")) (lambda () (fail-check)))))))))) ; *test-not-equal :: String Expression Expression ; Tests that `actual` and `expected` evaluate to the same value. (define-syntax-rule (*test-equal? name actual expected) (test-case name (check-with-timeout-equal? (convert-compile-time-error (thunk actual)) expected))) ; *test-not-equal :: String Expression Expression ; Tests that `actual` and `expected` evaluate to disjoint values. (define-syntax-rule (*test-not-equal? name actual expected) (test-case name (check-with-timeout-pred (lambda (actual-value) (not (equal? actual-value expected))) (convert-compile-time-error (thunk actual))))) ; *test-false :: String Expression ; Tests that `expr` evaluates to #t. (define-syntax-rule (*test-true name expr) (test-case name (check-with-timeout-equal? (convert-compile-time-error (thunk expr)) #t))) ; *test-false :: String Expression ; Tests that `expr` evaluates to #f. (define-syntax-rule (*test-false name expr) (test-case name (check-with-timeout-equal? (convert-compile-time-error (thunk expr)) #f))) ; *test-pred :: String (Any -> Boolean) (-> Any) ; Tests that `expr` returns a value that satisfies the given `pred` predicate. (define-syntax-rule (*test-pred name pred expr) (test-case name (check-with-timeout-pred pred (convert-compile-time-error (thunk expr))))) ; *test-exn :: String (Any -> Boolean) (-> Any) ; Tests that `exn-thunk` raises an exception that satisfies the given `pred` ; predicate. (define-syntax-rule (*test-exn name pred exn-thunk) (test-case name (check-with-timeout-exn pred (convert-compile-time-error exn-thunk)))) ; test-raises-error-with-substring? :: String (Expression ....) String ; Tests if the given `thunk-body` raises an error that contains the substring ; `error-string`. (define-syntax-rule (test-raises-error-with-substring? test-case-name thunk-body error-string) (*test-exn test-case-name (lambda (exn) (string-contains? (exn-message exn) error-string)) (convert-compile-time-error (thunk thunk-body)))) ;; ASSIGNMENT-SPECIFIC TESTING UTILITIES ======================================= (define-syntax (catch-error-block stx) (syntax-case stx () [(_ body ...) #'(let () (parameterize ([current-output-port (open-output-nowhere)]) (with-handlers ([(lambda (exn) (and (exn:fail? exn) (string-prefix? (exn-message exn) "halt"))) (lambda (x) (void))]) (convert-compile-time-error body)) ...))])) (define-syntax-rule (test-aci (aci-statements ...)) (let ([result (catch-error-block aci-statements ...)]) (reset-tabs) result))