├── .gitignore ├── .travis.yml ├── LICENSE ├── README.md ├── arguments ├── info.rkt ├── main.rkt ├── main.scrbl └── tests │ └── syntax.rkt ├── mock-rackunit ├── info.rkt ├── rackunit.rkt └── rackunit.scrbl └── mock ├── info.rkt ├── main.rkt ├── main.scrbl └── private ├── base.rkt ├── base.scrbl ├── function.rkt ├── function.scrbl ├── guide.scrbl ├── history.rkt ├── history.scrbl ├── not-implemented.rkt ├── opaque.rkt ├── opaque.scrbl ├── reference.scrbl ├── stub-class.rkt ├── stub.rkt ├── stub.scrbl ├── syntax-class.rkt ├── syntax-param.rkt ├── syntax-test.rkt ├── syntax-util.rkt ├── syntax.rkt ├── syntax.scrbl ├── util-doc.rkt └── util.rkt /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | *.bak 3 | *.css 4 | *.html 5 | *.js 6 | *.rktd 7 | *.sxref 8 | compiled 9 | doc 10 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: c 2 | sudo: false 3 | env: 4 | global: 5 | - RACKET_DIR=~/racket 6 | matrix: 7 | - RACKET_VERSION=6.4 8 | - RACKET_VERSION=6.5 9 | - RACKET_VERSION=6.6 10 | - RACKET_VERSION=6.7 11 | - RACKET_VERSION=6.8 12 | - RACKET_VERSION=6.9 13 | - RACKET_VERSION=6.10 14 | - RACKET_VERSION=HEAD 15 | 16 | matrix: 17 | allow_failures: 18 | - env: RACKET_VERSION=HEAD 19 | 20 | before_install: 21 | - git clone https://github.com/greghendershott/travis-racket.git ../travis-racket 22 | - cat ../travis-racket/install-racket.sh | bash 23 | - export PATH="${RACKET_DIR}/bin:${PATH}" 24 | - raco pkg install --auto cover cover-codecov doc-coverage 25 | 26 | install: 27 | - raco pkg install --auto 28 | $TRAVIS_BUILD_DIR/arguments 29 | $TRAVIS_BUILD_DIR/mock 30 | $TRAVIS_BUILD_DIR/mock-rackunit 31 | 32 | script: 33 | - raco test -p arguments mock mock-rackunit 34 | - raco doc-coverage arguments mock mock/rackunit 35 | - raco cover -f codecov -p arguments mock mock-rackunit 36 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2016 Jack Firth 4 | Modified work Copyright 2016 Google Inc. 5 | 6 | Permission is hereby granted, free of charge, to any person obtaining a copy 7 | of this software and associated documentation files (the "Software"), to deal 8 | in the Software without restriction, including without limitation the rights 9 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 10 | copies of the Software, and to permit persons to whom the Software is 11 | furnished to do so, subject to the following conditions: 12 | 13 | The above copyright notice and this permission notice shall be included in all 14 | copies or substantial portions of the Software. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 17 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 18 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 19 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 20 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 21 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 22 | SOFTWARE. 23 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # racket-mock [![Build Status](https://travis-ci.org/jackfirth/racket-mock.svg?branch=master)](https://travis-ci.org/jackfirth/racket-mock) [![codecov](https://codecov.io/gh/jackfirth/racket-mock/branch/master/graph/badge.svg)](https://codecov.io/gh/jackfirth/racket-mock) [![Stories in Ready](https://badge.waffle.io/jackfirth/racket-mock.png?label=ready&title=Ready)](https://waffle.io/jackfirth/racket-mock) 2 | Mocks for Racket testing. 3 | 4 | ```bash 5 | raco pkg install mock 6 | raco pkg install mock-rackunit # RackUnit integration 7 | ``` 8 | 9 | Documentation: [`mock`](http://docs.racket-lang.org/mock@mock/index.html), [`mock-rackunit`](http://docs.racket-lang.org/mock-rackunit@mock-rackunit/index.html) 10 | 11 | This library defines *mocks*, which are "fake" implementations of functions that record calls made to them. 12 | Two separate packages are provided, the main package `mock` and the RackUnit checks package `mock-rackunit`. 13 | In standard uses, the `mock-rackunit` dependency is needed only for test code. For a thorough introduction, see [The Mock Guide](http://docs.racket-lang.org/mock@mock/mock-guide.html). For a full API reference, see [The Mock Reference](http://docs.racket-lang.org/mock@mock/mock-reference.html). 14 | 15 | Example: 16 | 17 | ```racket 18 | (require mock mock/rackunit) 19 | 20 | (define/mock (foo) 21 | ; in test, don't call the real bar 22 | #:mock bar #:as bar-mock #:with-behavior (const "wow!") 23 | (bar)) 24 | 25 | (define (bar) "bam!") 26 | 27 | (foo) ; "bam!" 28 | 29 | (with-mocks foo 30 | (foo) ; "wow!" 31 | (check-mock-num-calls 1 bar-mock)) 32 | ``` 33 | -------------------------------------------------------------------------------- /arguments/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | (define collection "arguments") 3 | (define scribblings '(("main.scrbl" () ("Data Structures") "arguments"))) 4 | (define version "1.2.1") 5 | (define deps 6 | '("base")) 7 | (define build-deps 8 | '("racket-doc" 9 | "rackunit-lib" 10 | "scribble-lib")) 11 | -------------------------------------------------------------------------------- /arguments/main.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/contract/base) 4 | 5 | (provide define/arguments 6 | lambda/arguments) 7 | 8 | (provide 9 | (contract-out 10 | [keyword-hash? flat-contract?] 11 | [arguments? predicate/c] 12 | [arguments-positional (-> arguments? list?)] 13 | [arguments-keyword (-> arguments? keyword-hash?)] 14 | [arguments-merge (->* () #:rest (listof arguments?) arguments?)] 15 | [arguments (unconstrained-domain-> arguments?)] 16 | [apply/arguments (-> procedure? arguments? any)] 17 | [make-arguments (-> list? keyword-hash? arguments?)] 18 | [empty-arguments arguments?])) 19 | 20 | (require racket/list 21 | syntax/parse/define) 22 | 23 | (module+ test 24 | (require racket/format 25 | rackunit)) 26 | 27 | 28 | (define keyword-hash? (hash/c keyword? any/c #:immutable #t #:flat? #t)) 29 | 30 | (module+ test 31 | (check-true (keyword-hash? (hash '#:foo 'bar '#:baz "blah"))) 32 | (check-false (keyword-hash? (make-hash '((#:foo . bar) (#:baz . "blah"))))) 33 | (check-false (keyword-hash? (hash '#:foo 'bar '#:baz "blah" 0 1)))) 34 | 35 | (define (kws+vs->hash kws vs) (make-immutable-hash (map cons kws vs))) 36 | 37 | (define (arguments-custom-write args port mode) 38 | (define recur 39 | (case mode 40 | [(#t) write] 41 | [(#f) display] 42 | [else (lambda (p port) (print p port mode))])) 43 | (write-string "(arguments" port) 44 | (for ([arg (in-list (arguments-positional args))]) 45 | (write-string " " port) 46 | (recur arg port)) 47 | (define kwargs (arguments-keyword args)) 48 | (define kws (sort (hash-keys (arguments-keyword args)) keywordstring kw) port) 53 | (write-string " " port) 54 | (recur arg port)) 55 | (write-string ")" port)) 56 | 57 | (struct arguments (positional keyword) 58 | #:transparent 59 | #:constructor-name make-arguments 60 | #:omit-define-syntaxes 61 | #:methods gen:custom-write 62 | [(define write-proc arguments-custom-write)]) 63 | 64 | (define-simple-macro (lambda/arguments args:id body:expr ...+) 65 | (make-keyword-procedure 66 | (λ (kws kw-vs . vs) 67 | (define args (make-arguments vs (kws+vs->hash kws kw-vs))) 68 | body ...))) 69 | 70 | (define-simple-macro (define/arguments (id:id args:id) body:expr ...+) 71 | (define id (lambda/arguments args body ...))) 72 | 73 | (define/arguments (arguments args) args) 74 | 75 | (module+ test 76 | (test-equal? "Args constructors should agree when given no values" 77 | (arguments) (make-arguments '() (hash))) 78 | (test-equal? "Args constructors should agree when given positional values" 79 | (arguments 1 2 3) (make-arguments '(1 2 3) (hash))) 80 | (test-equal? "Args constructors should agree when given keyword values" 81 | (arguments #:foo 'bar #:baz "blah") 82 | (make-arguments '() (hash '#:foo 'bar '#:baz "blah"))) 83 | (test-equal? 84 | "Args constructors should agree when given positional and keyword values" 85 | (arguments 1 2 3 #:foo 'bar #:baz "blah") 86 | (make-arguments '(1 2 3) (hash '#:foo 'bar '#:baz "blah"))) 87 | (test-equal? 88 | "Args value should write the same as positional-first keyword sorted call" 89 | (~s (arguments 1 #:foo 'bar 2 3 #:baz "blah")) 90 | "(arguments 1 2 3 #:baz \"blah\" #:foo bar)") 91 | (test-equal? 92 | "Args value should display the same as positional-first keyword sorted call" 93 | (~a (arguments 1 #:foo 'bar 2 3 #:baz "blah")) 94 | "(arguments 1 2 3 #:baz blah #:foo bar)") 95 | (test-equal? 96 | "Args value should print the same as positional-first keyword sorted call" 97 | (~v (arguments 1 #:foo 'bar 2 3 #:baz "blah")) 98 | "(arguments 1 2 3 #:baz \"blah\" #:foo 'bar)") 99 | (test-begin 100 | "Args values should print unambiguosly in the face of quoted positional keywords" 101 | (check-not-equal? (~v (arguments #:foo 'bar)) 102 | (~v (arguments '#:foo 'bar))))) 103 | 104 | (define (apply/arguments f args) 105 | (define vs (arguments-positional args)) 106 | (define kwargs 107 | (sort (hash->list (arguments-keyword args)) keyword arguments?)]{ 36 | Returns all arguments given, in the form of an @args-tech{arguments structure}. 37 | Accepts both positional and keyword arguments. 38 | @(args-examples 39 | (arguments 1 2 3 #:foo "bar"))} 40 | 41 | @defproc[(make-arguments [positional list?] [keyword keyword-hash?]) 42 | arguments?]{ 43 | Returns an @args-tech{arguments structure} with @racket[positional] and 44 | @racket[keyword] as its arguments. 45 | @(args-examples 46 | (make-arguments '(1 2 3) (hash '#:foo "bar")))} 47 | 48 | @deftogether[ 49 | (@defthing[#:kind "value" arguments? predicate/c] 50 | @defproc[(arguments-positional [arguments arguments?]) list?] 51 | @defproc[(arguments-keyword [arguments arguments?]) keyword-hash?])]{ 52 | Predicate and accessors for @args-tech{arguments structures}.} 53 | 54 | @defproc[(apply/arguments [f procedure?] [args arguments?]) any]{ 55 | Calls @racket[f] with @racket[args] and returns whatever values are returned by 56 | @racket[f]. 57 | @(args-examples 58 | (apply/arguments sort 59 | (arguments '("fooooo" "bar" "bazz") < 60 | #:key string-length))) 61 | @history[#:added "1.1" 62 | #:changed "1.2.1" @begin{Fixed bug where improper keyword sorting 63 | caused nondeterministic contract exceptions}]} 64 | 65 | @defproc[(arguments-merge [args arguments?] ...) arguments?]{ 66 | Returns a combination of the given @racket[args]. The returned @args-tech{ 67 | arguments structure} contains all the positional and keyword arguments of each 68 | @racket[args] structure. Positional arguments are ordered left to right, and 69 | if two @racket[args] structures have duplicate keyword arguments the rightmost 70 | @racket[args] takes precedence. When called with no arguments, returns 71 | @racket[empty-arguments]. 72 | @(args-examples 73 | (arguments-merge (arguments 1 #:foo 2 #:bar 3) 74 | (arguments 'a 'b #:foo 'c)) 75 | (arguments-merge)) 76 | @history[#:added "1.3"]} 77 | 78 | @defform[(lambda/arguments args-id body ...+)]{ 79 | Constructs an anonymous function that accepts any number of arguments, collects 80 | them into an @args-tech{arguments structure}, and binds that structure to 81 | @racket[args-id] in the @racket[body] forms. 82 | @(args-examples 83 | (define pos-sum 84 | (lambda/arguments args 85 | (apply + (arguments-positional args)))) 86 | (pos-sum 1 2 3) 87 | (pos-sum 1 2 3 #:foo 'bar)) 88 | @history[#:added "1.2"]} 89 | 90 | @defform[(define/arguments (id args-id) body ...+)]{ 91 | Defines @racket[id] as a function that accepts any number of arguments, 92 | collects them into an @args-tech{arguments structure}, and binds that structure 93 | to @racket[args-id] in the @racket[body] forms. 94 | @(args-examples 95 | (define/arguments (keywords-product args) 96 | (for/product ([(k v) (in-hash (arguments-keyword args))]) 97 | v)) 98 | (keywords-product #:foo 2 #:bar 3) 99 | (keywords-product 'ignored #:baz 6 #:blah 4)) 100 | @history[#:added "1.2"]} 101 | 102 | @defthing[#:kind "value" empty-arguments arguments?]{ 103 | The empty @args-tech{arguments structure}. Equivalent to @racket[(arguments)].} 104 | 105 | @defthing[#:kind "value" keyword-hash? flat-contract?]{ 106 | A flat contract that recognizes immutable hashes whose keys are keywords. 107 | Equivalent to @racket[(hash/c keyword? any/c #:flat? #t #:immutable #t)]. Used 108 | for the keyword arguments of an @args-tech{arguments structure}. 109 | @(args-examples 110 | (keyword-hash? (hash '#:foo "bar")) 111 | (keyword-hash? (make-hash '((#:foo . "bar")))) 112 | (keyword-hash? (hash 'foo "bar")))} 113 | -------------------------------------------------------------------------------- /arguments/tests/syntax.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require arguments 4 | rackunit) 5 | 6 | (define/arguments (get-positional args) 7 | (arguments-positional args)) 8 | 9 | (check-equal? (get-positional 1 2 3) '(1 2 3)) 10 | (check-equal? (get-positional) '()) 11 | (check-equal? (get-positional 1 2 3 #:foo 'bar) (get-positional 1 2 3)) 12 | -------------------------------------------------------------------------------- /mock-rackunit/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | (define collection "mock") 3 | (define scribblings '(("rackunit.scrbl" () ("Testing") "mock-rackunit"))) 4 | (define version "1.2") 5 | (define deps 6 | '(("base" #:version "6.4") 7 | ("mock" #:version "2.0") 8 | "rackunit-lib")) 9 | (define build-deps 10 | '("racket-doc" 11 | "rackunit-doc" 12 | "scribble-lib" 13 | "sweet-exp")) 14 | (define test-omit-paths 15 | '(#rx"\\.scrbl$" 16 | #rx"info\\.rkt$")) 17 | (define cover-omit-paths 18 | '("rackunit.rkt")) 19 | -------------------------------------------------------------------------------- /mock-rackunit/rackunit.rkt: -------------------------------------------------------------------------------- 1 | #lang sweet-exp racket/base 2 | 3 | provide check-mock-calls 4 | check-mock-called-with? 5 | check-mock-num-calls 6 | check-call-history-names 7 | 8 | require racket/list 9 | rackunit 10 | syntax/parse/define 11 | mock 12 | 13 | (define-simple-macro (with-check-info/id (id:id ...) body ...+) 14 | (with-check-info (['id id] ...) body ...)) 15 | 16 | (define no-calls-made-message "No calls were made matching the expected arguments") 17 | 18 | (define-check (check-mock-calls mock expected-call-args-list) 19 | (define actual-num-calls (mock-num-calls mock)) 20 | (define expected-num-calls (length expected-call-args-list)) 21 | (define actual-call-args-list (map mock-call-args (mock-calls mock))) 22 | (with-check-info/id (mock) 23 | (with-check-info/id (actual-num-calls expected-num-calls) 24 | (when (< actual-num-calls expected-num-calls) 25 | (define missing-calls (drop expected-call-args-list (length actual-call-args-list))) 26 | (with-check-info/id (missing-calls) 27 | (fail-check "Mock called less times than expected"))) 28 | (when (> actual-num-calls expected-num-calls) 29 | (define extra-calls (drop actual-call-args-list (length expected-call-args-list))) 30 | (with-check-info/id (extra-calls) 31 | (fail-check "Mock called more times than expected")))) 32 | (for ([actual-call-args (in-list actual-call-args-list)] 33 | [expected-call-args (in-list expected-call-args-list)] 34 | [which-call (in-naturals)]) 35 | (with-check-info/id (which-call actual-call-args expected-call-args) 36 | (unless (equal? actual-call-args expected-call-args) 37 | (fail-check "Mock called with unexpected arguments")))))) 38 | 39 | (module+ test 40 | (test-case "Should check that a mocks calls exactly match a given list of arguments" 41 | (define void-mock (mock #:name 'void-mock #:behavior void)) 42 | (check-mock-calls void-mock '()) 43 | (void-mock 1 2 3) 44 | (check-mock-calls void-mock (list (arguments 1 2 3))) 45 | (void-mock 'foo) 46 | (void-mock 'bar) 47 | (check-mock-calls void-mock (list (arguments 1 2 3) (arguments 'foo) (arguments 'bar))))) 48 | 49 | (define-check (check-mock-called-with? mock args) 50 | (with-check-info (['expected-args args] 51 | ['actual-calls (mock-calls mock)]) 52 | (unless (mock-called-with? mock args) (fail-check no-calls-made-message)))) 53 | 54 | (module+ test 55 | (test-case "Should check if a mock's been called with given arguments" 56 | (define m (mock #:behavior void)) 57 | (m 1 2 3) 58 | (check-mock-called-with? m (arguments 1 2 3)))) 59 | 60 | (define-simple-check (check-mock-num-calls mock expected-num-calls) 61 | (equal? (mock-num-calls mock) expected-num-calls)) 62 | 63 | (module+ test 64 | (test-case "Should check if a mock's been called a certain number of times" 65 | (define m (mock #:behavior void)) 66 | (check-mock-num-calls m 0) 67 | (m 1 2 3) 68 | (check-mock-num-calls m 1) 69 | (m 'foo) 70 | (m 'bar) 71 | (check-mock-num-calls m 3))) 72 | 73 | (define-simple-check (check-call-history-names history expected-call-names) 74 | (define actual-num-calls (call-history-count history)) 75 | (define expected-num-calls (length expected-call-names)) 76 | (define actual-call-names (map mock-call-name (call-history-calls history))) 77 | (with-check-info/id (history) 78 | (with-check-info/id (actual-num-calls expected-num-calls) 79 | (when (< actual-num-calls expected-num-calls) 80 | (define missing-call-names 81 | (drop expected-call-names (length actual-call-names))) 82 | (with-check-info/id (missing-call-names) 83 | (fail-check "Mock call history contained fewer calls than expected"))) 84 | (when (> actual-num-calls expected-num-calls) 85 | (define extra-call-names 86 | (drop actual-call-names (length expected-call-names))) 87 | (with-check-info/id (extra-call-names) 88 | (fail-check "Mock call history contained more calls than expected")))) 89 | (for ([actual-call-name (in-list actual-call-names)] 90 | [expected-call-name (in-list expected-call-names)] 91 | [which-call (in-naturals)]) 92 | (with-check-info/id (which-call actual-call-name expected-call-name) 93 | (unless (equal? actual-call-name expected-call-name) 94 | (fail-check "Unexpected mock called")))))) 95 | 96 | (module+ test 97 | (test-case "Should check if mocks have been called in proper order" 98 | (define h (call-history)) 99 | (define m1 (mock #:name 'm1 #:behavior void #:external-histories (list h))) 100 | (define m2 (mock #:name 'm2 #:behavior void #:external-histories (list h))) 101 | (m1 'foo) 102 | (m2 'bar) 103 | (m1 'baz) 104 | (check-call-history-names h (list 'm1 'm2 'm1)))) 105 | -------------------------------------------------------------------------------- /mock-rackunit/rackunit.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | @(require (for-label mock/rackunit) 3 | mock/private/util-doc 4 | scribble/example) 5 | @(define (make-mock-eval) 6 | (make-base-eval #:lang 'racket/base 7 | '(require mock mock/rackunit racket/format racket/function racket/file))) 8 | 9 | @(define-syntax-rule (mock-rackunit-examples example ...) 10 | (examples #:eval (make-mock-eval) example ...)) 11 | 12 | @title{Mock RackUnit Checks} 13 | @defmodule[mock/rackunit #:packages ("mock-rackunit")] 14 | 15 | This package provides @racketmodname[rackunit] checks for working with @mock-tech{mocks} 16 | from the @racketmodname[mock] library. 17 | 18 | @defproc[(check-mock-calls [m mock] [args-list (listof arguments)]) void?]{ 19 | A @racketmodname[rackunit] check that passes if @racket[m] has been called with each 20 | @racket[args] in their given order and no other times. 21 | @(mock-rackunit-examples 22 | (define void-mock (mock #:behavior void)) 23 | (void-mock 1) 24 | (void-mock 'foo) 25 | (check-mock-calls void-mock (list (arguments 1))) 26 | (check-mock-calls void-mock (list (arguments 1) (arguments 'foo))) 27 | (check-mock-calls void-mock (list (arguments 'foo) (arguments 1))) 28 | (check-mock-calls 29 | void-mock (list (arguments 1) (arguments 'foo) (arguments #:bar "baz"))))} 30 | 31 | @defproc[(check-mock-called-with? [m mock?] [args arguments]) void?]{ 32 | A @racketmodname[rackunit] check that passes if @racket[m] has 33 | been called with @racket[args]. 34 | @(mock-rackunit-examples 35 | (define void-mock (mock #:behavior void)) 36 | (check-mock-called-with? void-mock (arguments 'foo)) 37 | (void-mock 'foo) 38 | (check-mock-called-with? void-mock (arguments 'foo)))} 39 | 40 | @defproc[(check-mock-num-calls [m mock?] [n exact-positive-integer?]) void?]{ 41 | A @racketmodname[rackunit] check that passes if @racket[m] has 42 | been called exactly @racket[n] times. 43 | @(mock-rackunit-examples 44 | (define void-mock (mock #:behavior void)) 45 | (check-mock-num-calls void-mock 1) 46 | (void-mock 'foo) 47 | (check-mock-num-calls void-mock 1))} 48 | 49 | @defproc[(check-call-history-names [h call-history?] [names (listof symbol?)]) 50 | void?]{ 51 | A @racketmodname[rackunit] check that passes if @racket[h] contains a history 52 | of calls by mocks with @racket[names]. 53 | @(mock-rackunit-examples 54 | (define h (call-history)) 55 | (define m1 (mock #:name 'm1 #:behavior void #:external-histories (list h))) 56 | (define m2 (mock #:name 'm2 #:behavior void #:external-histories (list h))) 57 | (m1 'foo) 58 | (m2 'bar) 59 | (check-call-history-names h (list 'm1 'm2)) 60 | (m1 'baz) 61 | (check-call-history-names h (list 'm1 'm2))) 62 | @history[#:added "1.2"]} 63 | -------------------------------------------------------------------------------- /mock/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | (define collection "mock") 3 | (define scribblings '(("main.scrbl" (multi-page) ("Testing") "mock"))) 4 | (define version "2.2") 5 | (define deps 6 | '("arguments" 7 | ("base" #:version "6.4") 8 | "fancy-app" 9 | "reprovide-lang")) 10 | (define build-deps 11 | '("racket-doc" 12 | "scribble-lib" 13 | "sweet-exp")) 14 | (define implies 15 | '("arguments")) 16 | (define compile-omit-paths 17 | '("private")) 18 | (define test-omit-paths 19 | '(#rx"\\.scrbl$" 20 | #rx"info\\.rkt$" 21 | #rx"util-doc\\.rkt$")) 22 | -------------------------------------------------------------------------------- /mock/main.rkt: -------------------------------------------------------------------------------- 1 | #lang sweet-exp reprovide 2 | arguments 3 | except-in "private/base.rkt" 4 | mock-reset-all! 5 | "private/function.rkt" 6 | except-in "private/history.rkt" 7 | call-history-reset-all! 8 | "private/opaque.rkt" 9 | "private/syntax.rkt" 10 | "private/stub.rkt" 11 | -------------------------------------------------------------------------------- /mock/main.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | @(require "private/util-doc.rkt") 3 | 4 | @title[#:style '(toc)]{Mocks} 5 | @defmodule[mock #:packages ("mock")] 6 | @author[@author+email["Jack Firth" "jackhfirth@gmail.com"]] 7 | 8 | This library includes functions and forms for working with 9 | @define-mock-tech{mocks}. A mock is a "fake" function 10 | used in place of the real thing during testing to simplify 11 | the test and ensure only a single unit and not it's complex 12 | dependencies is being tested. Mocks record all arguments they're 13 | called with and results they return for tests to inspect and verify. 14 | Mocks are most useful for testing code that calls procedures with 15 | side effects like mutation and IO. 16 | 17 | source code: @url["https://github.com/jackfirth/racket-mock"] 18 | 19 | For integration with @racketmodname[rackunit #:indirect], see the 20 | @racketmodname[mock/rackunit #:indirect] module in the @racket[mock-rackunit] 21 | package. 22 | 23 | @table-of-contents[] 24 | @include-section["private/guide.scrbl"] 25 | @include-section["private/reference.scrbl"] 26 | -------------------------------------------------------------------------------- /mock/private/base.rkt: -------------------------------------------------------------------------------- 1 | #lang sweet-exp racket/base 2 | 3 | require racket/contract/base 4 | 5 | provide 6 | with-mock-behavior 7 | contract-out 8 | current-mock-name (-> (or/c symbol? #f)) 9 | current-mock-calls (-> (listof mock-call?)) 10 | current-mock-num-calls (-> exact-nonnegative-integer?) 11 | mock? predicate/c 12 | mock (->* () 13 | (#:name symbol? 14 | #:behavior procedure? 15 | #:external-histories (listof call-history?)) 16 | mock?) 17 | mock-name (-> mock? (or/c symbol? #f)) 18 | mock-reset! (-> mock? void?) 19 | mock-reset-all! (->* () #:rest (listof mock?) void?) 20 | mock-calls (-> mock? (listof mock-call?)) 21 | mock-called-with? (-> mock? arguments? boolean?) 22 | mock-num-calls (-> mock? exact-nonnegative-integer?) 23 | struct (exn:fail:unexpected-arguments exn:fail) 24 | ([message string?] 25 | [continuation-marks continuation-mark-set?] 26 | [args arguments?]) 27 | 28 | require arguments 29 | fancy-app 30 | racket/match 31 | racket/function 32 | rackunit 33 | syntax/parse/define 34 | "history.rkt" 35 | "util.rkt" 36 | 37 | module+ test 38 | require rackunit 39 | racket/format 40 | 41 | 42 | (struct exn:fail:unexpected-arguments exn:fail (args) #:transparent) 43 | 44 | (define (format-positional-args-message args) 45 | (apply string-append 46 | (map (λ (arg) (format "\n ~v" arg)) args))) 47 | 48 | (module+ test 49 | (check-equal? (format-positional-args-message '(1 foo "blah")) 50 | "\n 1\n 'foo\n \"blah\"")) 51 | 52 | (define (format-keyword-args-message kwargs) 53 | (apply string-append 54 | (hash-map kwargs (λ (kw arg) (format "\n ~a: ~v" kw arg))))) 55 | 56 | (define (unexpected-call-message source-name 57 | #:positional positional-msg 58 | #:keyword keyword-msg) 59 | (define (arg-part type msg) (format "\n ~a: ~a" type msg)) 60 | (define first-part (format "~a: unexpectedly called" source-name)) 61 | (if (or positional-msg keyword-msg) 62 | (format "~a with arguments~a~a" 63 | first-part 64 | (if positional-msg (arg-part 'positional positional-msg) "") 65 | (if keyword-msg (arg-part 'keyword keyword-msg) "")) 66 | first-part)) 67 | 68 | (module+ test 69 | (check-equal? (unexpected-call-message 'foo #:positional #f #:keyword #f) 70 | "foo: unexpectedly called") 71 | (check-equal? (unexpected-call-message 'foo #:positional "pos" #:keyword #f) 72 | "foo: unexpectedly called with arguments\n positional: pos") 73 | (check-equal? (unexpected-call-message 'foo #:positional #f #:keyword "kw") 74 | "foo: unexpectedly called with arguments\n keyword: kw") 75 | (check-equal? (unexpected-call-message 'foo #:positional "pos" #:keyword "kw") 76 | "foo: unexpectedly called with arguments 77 | positional: pos 78 | keyword: kw")) 79 | 80 | (define (make-raise-unexpected-arguments-exn source-name) 81 | (make-keyword-procedure 82 | (λ (kws kw-vs . vs) 83 | (define kwargs (make-immutable-hash (map cons kws kw-vs))) 84 | (define message 85 | (unexpected-call-message source-name 86 | #:positional (format-positional-args-message vs) 87 | #:keyword (format-keyword-args-message kwargs))) 88 | (raise 89 | (exn:fail:unexpected-arguments 90 | message (current-continuation-marks) (make-arguments vs kwargs)))))) 91 | 92 | (define (make-mock-proc-parameter source-name) 93 | (define message 94 | (format "~a: can't be called outside mock behavior" source-name)) 95 | (make-parameter 96 | (thunk (raise (make-exn:fail message (current-continuation-marks)))))) 97 | 98 | (define-simple-macro (define-mock-proc-parameter proc-id:id id:id) 99 | (define-values (proc-id id) 100 | (values (make-mock-proc-parameter 'id) 101 | (lambda () ((proc-id)))))) 102 | 103 | (define-mock-proc-parameter current-mock-name-proc current-mock-name) 104 | (define-mock-proc-parameter current-mock-calls-proc current-mock-calls) 105 | (define-mock-proc-parameter current-mock-num-calls-proc current-mock-num-calls) 106 | 107 | (module+ test 108 | (test-exn "Mock reflection params should only be callable inside behavior" 109 | #rx"current-mock-name: can't be called outside mock behavior" 110 | current-mock-name)) 111 | 112 | (define call-mock-behavior 113 | (make-keyword-procedure 114 | (λ (kws kw-vs a-mock . vs) 115 | (define name (mock-name a-mock)) 116 | (define current-behavior (mock-behavior a-mock)) 117 | (define history (mock-history a-mock)) 118 | (define calls (call-history-calls history)) 119 | (define results 120 | (parameterize ([current-mock-name-proc (const name)] 121 | [current-mock-calls-proc (const calls)] 122 | [current-mock-num-calls-proc (const (length calls))]) 123 | (with-values-as-list 124 | (keyword-apply (current-behavior) kws kw-vs vs)))) 125 | (define args 126 | (make-arguments vs (make-immutable-hash (map cons kws kw-vs)))) 127 | (define call (mock-call #:name name #:args args #:results results)) 128 | (call-history-record! history call) 129 | (for ([external-history (in-list (mock-external-histories a-mock))]) 130 | (call-history-record! external-history call)) 131 | (apply values results)))) 132 | 133 | (define (mock-custom-write a-mock port mode) 134 | (write-string "#string name) port)) 139 | (write-string ">" port)) 140 | 141 | (struct mock (name behavior history external-histories) 142 | #:property prop:procedure call-mock-behavior 143 | #:property prop:object-name (struct-field-index name) 144 | #:constructor-name make-mock 145 | #:omit-define-syntaxes 146 | #:methods gen:custom-write 147 | [(define write-proc mock-custom-write)]) 148 | 149 | (define (mock #:behavior [given-behavior #f] 150 | #:name [name #f] 151 | #:external-histories [external-histories (list)]) 152 | (define behavior 153 | (or given-behavior raise-unexpected-mock-call)) 154 | (make-mock name (make-parameter behavior) (call-history) external-histories)) 155 | 156 | (define (mock-calls a-mock) 157 | (call-history-calls (mock-history a-mock))) 158 | 159 | (module+ test 160 | (test-case "Mocks should record calls made with them" 161 | (define m (mock #:behavior ~a #:name 'test-mock-for-testing)) 162 | (check-equal? (m 0) "0") 163 | (check-equal? (m 0 #:width 3 #:align 'left) "0 ") 164 | (check-equal? (mock-calls m) 165 | (list (mock-call #:name 'test-mock-for-testing 166 | #:args (arguments 0) 167 | #:results '("0")) 168 | (mock-call #:name 'test-mock-for-testing 169 | #:args (arguments 0 #:width 3 #:align 'left) 170 | #:results '("0 "))))) 171 | (test-case "Mocks should record calls in external histories" 172 | (define h (call-history)) 173 | (define m1 (mock #:behavior void #:name 'm1 #:external-histories (list h))) 174 | (define m2 (mock #:behavior void #:name 'm2 #:external-histories (list h))) 175 | (m1 'foo) 176 | (m2 'bar) 177 | (m1 'baz) 178 | (define expected-calls 179 | (list 180 | (mock-call #:name 'm1 #:args (arguments 'foo) #:results (list (void))) 181 | (mock-call #:name 'm2 #:args (arguments 'bar) #:results (list (void))) 182 | (mock-call #:name 'm1 #:args (arguments 'baz) #:results (list (void))))) 183 | (check-equal? (call-history-calls h) expected-calls)) 184 | (test-equal? 185 | "Mocks should print like named procedures, but identify themselves as mocks" 186 | (~a (mock #:name 'foo)) "#") 187 | (test-equal? "Anonymous mocks should print like a procedure named mock" 188 | (~a (mock)) "#") 189 | (define return-mock-name (thunk* (current-mock-name))) 190 | (test-equal? 191 | "The current mock name should be available to behaviors" 192 | ((mock #:name 'foo #:behavior return-mock-name) 1 2 3) 'foo) 193 | (test-equal? 194 | "The current mock name should be false for anonymous mocks" 195 | ((mock #:behavior return-mock-name) 1 2 3) #f) 196 | (define return-mock-calls (thunk* (current-mock-calls))) 197 | (test-begin 198 | "The current mock call history should be available to behaviors" 199 | (define calls-mock (mock #:behavior return-mock-calls)) 200 | (check-equal? (calls-mock 1 2 3) '()) 201 | (check-equal? (calls-mock #:foo 'bar) 202 | (list (mock-call #:args (arguments 1 2 3) 203 | #:results (list (list)))))) 204 | (define return-mock-count (thunk* (current-mock-num-calls))) 205 | (test-begin 206 | "The current mock call count should be available to behaviors" 207 | (define count-mock (mock #:behavior return-mock-count)) 208 | (check-equal? (count-mock 1 2 3) 0) 209 | (check-equal? (count-mock #:foo 'bar) 1) 210 | (check-equal? (count-mock 'a #:b 'c) 2))) 211 | 212 | (define mock-num-calls (compose length mock-calls)) 213 | 214 | (module+ test 215 | (test-case "Mocks should record how many times they've been called" 216 | (define m (mock #:behavior ~a)) 217 | (check-equal? (m 0) "0") 218 | (check-equal? (m 1) "1") 219 | (check-equal? (m 2) "2") 220 | (check-equal? (mock-num-calls m) 3))) 221 | 222 | (define (mock-called-with? mock args) 223 | (for/or ([call (in-list (mock-calls mock))]) 224 | (equal? args (mock-call-args call)))) 225 | 226 | (module+ test 227 | (test-case "Mock call arguments should be queryable" 228 | (define m (mock #:behavior void)) 229 | (m 0) 230 | (m 10) 231 | (check-true (mock-called-with? m (arguments 0))) 232 | (check-true (mock-called-with? m (arguments 10))) 233 | (check-false (mock-called-with? m (arguments 42)))) 234 | (test-case "Default mock behavior should throw" 235 | (check-exn exn:fail:unexpected-arguments? 236 | (thunk ((mock) 10 #:foo 'bar))))) 237 | 238 | (define (mock-reset! a-mock) 239 | (call-history-reset! (mock-history a-mock))) 240 | 241 | (module+ test 242 | (test-case "Resetting a mock should erase its call history" 243 | (define m (mock #:behavior void)) 244 | (m 'foo) 245 | (check-equal? (mock-num-calls m) 1) 246 | (mock-reset! m) 247 | (check-equal? (mock-num-calls m) 0)) 248 | (test-case "Resetting a mock should not erase its external histories" 249 | (define h (call-history)) 250 | (define m (mock #:behavior void #:external-histories (list h))) 251 | (m 'foo) 252 | (mock-reset! m) 253 | (check-equal? (call-history-count h) 1))) 254 | 255 | (define-simple-macro (with-mock-behavior ([mock:expr new-behavior:expr] ...) body ...) 256 | (parameterize ([(mock-behavior mock) new-behavior] ...) body ...)) 257 | 258 | (module+ test 259 | (test-case "Mock behavior should be changeable" 260 | (define num-proc-mock (mock #:behavior add1)) 261 | (check-equal? (num-proc-mock 0) 1) 262 | (with-mock-behavior ([num-proc-mock sub1]) 263 | (check-equal? (num-proc-mock 0) -1)))) 264 | 265 | (define raise-unexpected-mock-call 266 | (make-keyword-procedure 267 | (λ (kws kw-vs . vs) 268 | (define proc (make-raise-unexpected-arguments-exn (or (current-mock-name) 'mock))) 269 | (keyword-apply proc kws kw-vs vs)))) 270 | 271 | (define (mock-reset-all! . mocks) 272 | (for-each mock-reset! mocks)) 273 | -------------------------------------------------------------------------------- /mock/private/base.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | @(require "util-doc.rkt") 3 | 4 | @title{Core Mock API} 5 | 6 | @defproc[(mock? [v any/c]) boolean?]{ 7 | Predicate identifying @mock-tech{mocks}. 8 | @(mock-examples 9 | (mock? (mock #:behavior void)) 10 | (mock? void))} 11 | 12 | @defproc[(mock [#:behavior behavior-proc procedure? #f] 13 | [#:name name symbol? #f] 14 | [#:external-histories histories (listof call-history?) (list)]) 15 | mock?]{ 16 | Returns a @mock-tech{mock} that records arguments its called with and results 17 | it returns. When called as a procedure, the mock consults its current 18 | @define-behavior-tech{behavior}, a procedure initalized to @racket[behavior-proc] 19 | that defines how the mock responds to arguments, and stores a @racket[mock-call] 20 | containing the give arguments and the result values of the behavior. The mock's 21 | list of calls can be queried with @racket[mock-calls] and erased with 22 | @racket[mock-reset!]. The mock's behavior can be temporarily altered using 23 | @racket[with-mock-behavior]. If @racket[behavior] is not provided, the mock by 24 | default raises an @racket[exn:fail:unexpected-arguments] with a message in terms 25 | of @racket[name]. 26 | @(mock-examples 27 | (define quotient/remainder-mock 28 | (mock #:behavior quotient/remainder)) 29 | (quotient/remainder-mock 10 3) 30 | (mock? quotient/remainder-mock) 31 | (define uncallable-mock (mock #:name 'uncallable-mock)) 32 | (eval:error (uncallable-mock 1 2 3 #:foo 'bar #:bar "blah"))) 33 | In addition to recording calls itself, the returned mock records calls in each 34 | of the given @racket[histories]. The call histories in @racket[histories] are 35 | not reset with @racket[call-history-reset!] when the returned mock is reset 36 | with @racket[mock-reset!]. External histories can be shared between mocks, 37 | allowing tests to verify the order in which a set of mocks is called. 38 | @(mock-examples 39 | (define h (call-history)) 40 | (define m1 (mock #:name 'm1 #:behavior void #:external-histories (list h))) 41 | (define m2 (mock #:name 'm2 #:behavior void #:external-histories (list h))) 42 | (m1 'foo) 43 | (m2 'bar) 44 | (m1 'baz) 45 | (call-history-calls h))} 46 | 47 | @defproc[(mock-name [a-mock mock?]) (or/c symbol? #f)]{ 48 | Returns the name of @racket[a-mock] if present. 49 | @(mock-examples 50 | (mock-name (mock #:name 'foo)) 51 | (mock-name (mock))) 52 | @history[#:added "2.0"]} 53 | 54 | @define-persistent-mock-examples[mock-name-examples] 55 | @defproc[(current-mock-name) (or/c symbol? #f)]{ 56 | Returns the name of the current @mock-tech{mock} being called. This is for use 57 | in @behavior-tech{behaviors}, for example to raise an error with a message in 58 | terms of the mock currently being called. 59 | @(mock-name-examples 60 | (define (log-call . vs) 61 | (printf "Mock ~a called with ~a args" 62 | (or (current-mock-name) 'anonymous) 63 | (length vs))) 64 | (define log-mock (mock #:name 'log-mock #:behavior log-call)) 65 | (log-mock 1 2 3) 66 | (log-mock 'foo 'bar)) 67 | 68 | If called outside the context of a mock behavior call, raises @racket[exn:fail]. 69 | @(mock-name-examples 70 | (eval:error (current-mock-name))) 71 | 72 | If the mock being called is anonymous, returns @racket[#f]. 73 | @(mock-name-examples 74 | (define log-mock-anon (mock #:behavior log-call)) 75 | (log-mock-anon 1 2 3) 76 | (log-mock-anon 'foo 'bar)) 77 | @history[#:added "1.1"]} 78 | 79 | @defproc[(current-mock-calls) (listof mock-call?)]{ 80 | Returns a list of all the previous calls of the current @mock-tech{mock} being 81 | called. This is for use in @behavior-tech{behaviors}, for example to implement 82 | a behavior that returns a set of all keywords its ever been called with. 83 | @(mock-examples 84 | (define keyword-set 85 | (make-keyword-procedure 86 | (λ (kws _) 87 | (define (call-kws call) 88 | (hash-keys (arguments-keyword (mock-call-args call)))) 89 | (define prev-kws 90 | (append-map call-kws (current-mock-calls))) 91 | (apply set (append kws prev-kws))))) 92 | (define kw-set-mock (mock #:behavior keyword-set)) 93 | (kw-set-mock #:foo 'bar) 94 | (kw-set-mock #:baz "blah")) 95 | 96 | If called outside the context of a mock behavior call, raises @racket[exn:fail]. 97 | @(mock-examples 98 | (eval:error (current-mock-calls))) 99 | @history[#:added "1.2"]} 100 | 101 | @defproc[(current-mock-num-calls) exact-nonnegative-integer?]{ 102 | Returns the number of times the current @mock-tech{mock} being called has already 103 | been called. This is for use in @behavior-tech{beahviors}, for example to log the 104 | number of times this mock has been called. 105 | @(mock-examples 106 | (define (log-count) 107 | (printf "Mock called ~a times previously" (current-mock-num-calls))) 108 | (define count-mock (mock #:behavior log-count)) 109 | (count-mock) 110 | (count-mock) 111 | (mock-reset! count-mock) 112 | (count-mock)) 113 | 114 | If called outside the context of a mock behavior call, raises @racket[exn:fail]. 115 | @(mock-examples 116 | (eval:error (current-mock-num-calls))) 117 | @history[#:added "1.3"]} 118 | 119 | @defproc[(mock-reset! [m mock?]) void?]{ 120 | Erases the history of @racket[mock-call] values in @racket[m]. 121 | @(mock-examples 122 | (define void-mock (mock #:behavior void)) 123 | (void-mock 'foo) 124 | (mock-num-calls void-mock) 125 | (mock-reset! void-mock) 126 | (mock-num-calls void-mock))} 127 | 128 | @defform[(with-mock-behavior ([mock-expr behavior-expr] ...) body ...) 129 | #:contracts ([mock-expr mock?] [behavior-expr procedure?])]{ 130 | Evaluates each @racket[mock-expr] and @racket[behavior-expr] which must 131 | be a @mock-tech{mock} and a @racket[procedure?] respectively, then alters 132 | the mock's @behavior-tech{behavior} in the dynamic extent of 133 | @racket[body ...] to the given behavior procedure. This allows the 134 | same mock to behave differently between calls, which is useful for 135 | testing a procedure defined with @racket[define/mock] in different ways 136 | for different tests. 137 | @(mock-examples 138 | (define num-mock (mock #:behavior add1)) 139 | (num-mock 10) 140 | (with-mock-behavior ([num-mock sub1]) 141 | (num-mock 10)) 142 | (num-mock 10) 143 | (mock-calls num-mock))} 144 | 145 | @deftogether[ 146 | (@defproc[(mock-call [#:name name (or/c symbol? #f) #f] 147 | [#:args args arguments? (arguments)] 148 | [#:results results list? (list)]) 149 | mock-call?] 150 | @defproc[(mock-call? [v any/c]) boolean?] 151 | @defproc[(mock-call-args [call mock-call?]) arguments?] 152 | @defproc[(mock-call-name [call mock-call?]) (or/c symbol? #f)] 153 | @defproc[(mock-call-results [call mock-call?]) list?])]{ 154 | Constructor, predicate, and accessors of a structure containing the 155 | @args-tech{arguments} and result values of a single call to a @mock-tech{mock} 156 | with name @racket[name]. 157 | @(mock-examples 158 | (mock-call #:name 'magnificent-mock 159 | #:args (arguments 1 2 #:foo 'bar) 160 | #:results (list 'value 'another-value))) 161 | @history[#:changed "2.0" @elem{Changed from a plain struct to a keyword-based 162 | constructor and added a name field.}]} 163 | 164 | @defproc[(mock-calls [m mock?]) (listof mock-call?)]{ 165 | Returns a list of all the calls made so far with @racket[m] in order, as 166 | a list of @racket[mock-call?] structs. 167 | @(mock-examples 168 | (define void-mock (mock #:behavior void)) 169 | (void-mock 10 3) 170 | (void-mock 'foo 'bar 'baz) 171 | (mock-calls void-mock))} 172 | 173 | @defproc[(mock-called-with? [m mock?] [args arguments?]) boolean?]{ 174 | Returns @racket[#t] if @racket[m] has ever been called with @racket[args], 175 | returns @racket[#f] otherwise. 176 | @(mock-examples 177 | (define ~a-mock (mock #:behavior ~a)) 178 | (~a-mock 0 #:width 3 #:align 'left) 179 | (mock-called-with? ~a-mock (arguments 0 #:align 'left #:width 3)))} 180 | 181 | @defproc[(mock-num-calls [m mock?]) exact-nonnegative-integer?]{ 182 | Returns the number of times @racket[m] has been called. 183 | @(mock-examples 184 | (define void-mock (mock #:behavior void)) 185 | (void-mock 10 3) 186 | (void-mock 'foo 'bar 'baz) 187 | (mock-num-calls void-mock))} 188 | 189 | @defstruct*[(exn:fail:unexpected-arguments exn:fail) ([args arguments?]) #:transparent]{ 190 | An exception type used by @mock-tech{mocks} that don't expect to be called at all.} 191 | -------------------------------------------------------------------------------- /mock/private/function.rkt: -------------------------------------------------------------------------------- 1 | #lang sweet-exp racket/base 2 | 3 | require racket/contract/base 4 | 5 | provide 6 | contract-out 7 | const/kw (-> any/c procedure?) 8 | const-raise (-> any/c procedure?) 9 | const-raise-exn 10 | (->* () (#:message string? #:constructor exn-constructor/c) procedure?) 11 | const-series (->* () (#:repeat? boolean?) #:rest list? procedure?) 12 | void/kw (unconstrained-domain-> void?) 13 | 14 | require racket/function 15 | "util.rkt" 16 | 17 | module+ test 18 | require rackunit 19 | 20 | 21 | (define exn-constructor/c (-> string? continuation-mark-set? any/c)) 22 | 23 | (define (const/kw v) 24 | (make-keyword-procedure (const v))) 25 | 26 | (module+ test 27 | (check-equal? ((const/kw 1)) 1) 28 | (check-equal? ((const/kw 1) 'arg) 1) 29 | (check-equal? ((const/kw 1) #:foo 'arg) 1) 30 | (check-equal? ((const/kw 1) 'arg #:foo 'arg) 1)) 31 | 32 | (define void/kw (const/kw (void))) 33 | 34 | (module+ test 35 | (check-equal? (void/kw #:foo 'arg) (void))) 36 | 37 | (define (const-raise v) 38 | (thunk* (raise v))) 39 | 40 | (module+ test 41 | (struct foo ()) 42 | (check-exn foo? (const-raise (foo))) 43 | (check-exn foo? (thunk ((const-raise (foo)) 'arg))) 44 | (check-exn foo? (thunk ((const-raise (foo)) #:foo 'arg)))) 45 | 46 | (define (const-raise-exn #:message [msg "failure"] 47 | #:constructor [exn-constructor make-exn:fail]) 48 | (thunk* (raise (exn-constructor msg (current-continuation-marks))))) 49 | 50 | (module+ test 51 | (check-exn #rx"failure" (const-raise-exn)) 52 | (check-exn exn:fail? (const-raise-exn)) 53 | (check-exn #rx"custom message" (const-raise-exn #:message "custom message")) 54 | (struct custom-exn exn:fail () #:transparent) 55 | (check-exn custom-exn? (const-raise-exn #:constructor custom-exn))) 56 | 57 | (define (const-series #:repeat? [repeat? #f] . vs) 58 | (define vec (vector->immutable-vector (list->vector vs))) 59 | (define vec-len (vector-length vec)) 60 | (define repeat?/len (and repeat? (not (zero? vec-len)))) 61 | 62 | (define index-box (box 0)) 63 | (define (cycle-index i) (if repeat?/len (modulo i vec-len) i)) 64 | (define (index) 65 | (define i (cycle-index (unbox index-box))) 66 | (unless (< i (vector-length vec)) 67 | (raise-arguments-error 68 | 'const-series "called more times than number of arguments" 69 | "num-calls" i)) 70 | i) 71 | (define (index++!) (box-transform! index-box add1)) 72 | 73 | (make-keyword-procedure 74 | (lambda (kws kw-args . rest) 75 | (begin0 (vector-ref vec (index)) (index++!))))) 76 | 77 | (module+ test 78 | (define a-b-c-proc (const-series 'a 'b 'c)) 79 | (check-equal? (a-b-c-proc 'arg) 'a) 80 | (check-equal? (a-b-c-proc #:foo 'arg) 'b) 81 | (check-equal? (a-b-c-proc 'arg #:foo 'arg) 'c) 82 | (check-exn exn:fail:contract? a-b-c-proc) 83 | (check-exn #rx"called more times than number of arguments" a-b-c-proc) 84 | (check-exn #rx"num-calls" a-b-c-proc) 85 | (define a-b-c-proc/repeat (const-series 'a 'b 'c #:repeat? #t)) 86 | (void 87 | (a-b-c-proc/repeat) 88 | (a-b-c-proc/repeat) 89 | (a-b-c-proc/repeat)) 90 | (check-equal? (a-b-c-proc/repeat) 'a)) 91 | -------------------------------------------------------------------------------- /mock/private/function.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | @(require "util-doc.rkt") 3 | 4 | @title{Behavior Construction Utilities} 5 | 6 | @defproc[(const/kw [v any/c]) procedure?]{ 7 | Like @racket[const], but the returned procedure accepts keyword arguments. 8 | @(mock-examples 9 | ((const/kw 'a) 1) 10 | ((const/kw 'a) #:foo 2)) 11 | @history[#:added "1.5"]} 12 | 13 | @defthing[void/kw (unconstrained-domain-> void?)]{ 14 | Like @racket[void], but accepts keyword arguments. 15 | @(mock-examples 16 | (void/kw 1) 17 | (void/kw #:foo 2)) 18 | @history[#:added "1.5"]} 19 | 20 | @defproc[(const-raise [v any/c]) procedure?]{ 21 | Like @racket[const/kw], but instead of returning @racket[v] the returned 22 | procedure always @racket[raise]s @racket[v] whenever it's called. 23 | @(mock-examples 24 | (eval:error ((const-raise 'a) 1)) 25 | (eval:error ((const-raise 'a) #:foo 2))) 26 | @history[#:added "1.5"]} 27 | 28 | @defproc[(const-raise-exn 29 | [#:message msg string? "failure"] 30 | [#:constructor ctor 31 | (-> string? continuation-mark-set? any/c) make-exn:fail]) 32 | procedure?]{ 33 | Like @racket[const-raise], but designed for raising exceptions. More precisely, 34 | the returned procedure raises the result of 35 | @racket[(ctor msg (current-continuation-marks))] whenever it's called. 36 | @(mock-examples 37 | (eval:error ((const-raise-exn) 1)) 38 | (eval:error ((const-raise-exn #:message "some other failure") #:foo 2)) 39 | (define (exn/custom-message msg marks) 40 | (make-exn:fail (format "custom: ~a" msg) marks)) 41 | (eval:error ((const-raise-exn #:constructor exn/custom-message) #:bar 3))) 42 | @history[#:added "1.5"]} 43 | 44 | @defproc[(const-series [v any/c] ... [#:reset? reset? boolean? #f]) procedure?]{ 45 | Returns a procedure that ignores positional and keyword arguments and returns 46 | the first @racket[v] when called for the first time, the second @racket[v] when 47 | called for the second time, the third on the third time, and so on until no 48 | more @racket[v]s remain. Then, calls cause the procedure to fail with an 49 | exception if @racket[reset?] is false. Otherwise, the pattern resets. 50 | @(mock-examples 51 | (define ab-proc (const-series 'a 'b)) 52 | (eval:check (ab-proc 1) 'a) 53 | (eval:check (ab-proc #:foo 2) 'b) 54 | (eval:error (ab-proc #:bar 3)) 55 | (define ab-proc (const-series 'a 'b #:repeat? #t)) 56 | (eval:check (ab-proc) 'a) 57 | (eval:check (ab-proc) 'b) 58 | (eval:check (ab-proc) 'a)) 59 | @history[#:added "1.5"]} 60 | -------------------------------------------------------------------------------- /mock/private/guide.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | @(require "util-doc.rkt") 3 | 4 | @title[#:tag "mock-guide"]{The Mock Guide} 5 | 6 | This guide is intended for programmers who are familiar with Racket but new to working 7 | with @mock-tech{mocks}. It contains a description of the high level concepts associated 8 | with the @racketmodname[mock] library, as well as examples and use cases. For a complete 9 | description of the @racketmodname[mock] API, see @secref{mock-reference}. 10 | 11 | @table-of-contents[] 12 | 13 | @section{Introduction to Mocks} 14 | @define-persistent-mock-examples[mock-intro-examples] 15 | 16 | The @racketmodname[mock] library defines @mock-tech{mocks}, procedures that record how 17 | they're used and can have their response to calls dynamically altered. Mocks are most 18 | useful when testing imperative code or code with side effects, serving as "fake" 19 | implementations in tests for verifying real implementations are used correctly. For 20 | example, consider the following procedure: 21 | 22 | @mock-intro-examples[ 23 | (define (call/secret proc) 24 | (proc "secret") 25 | (void)) 26 | (call/secret print) 27 | (call/secret values)] 28 | 29 | How can a test verify that the secret value is passed correctly? It would be one thing 30 | if @racket[call/secret] returned the result of the call, then we could simply pass in 31 | @racket[values] and verify that the whole thing returns @racket["secret"]. But because 32 | the result of the call is discarded, we somehow need to use a procedure that records a 33 | history of all calls made with it so we can check that history afterwards. This is 34 | precisely what mocks are for. 35 | 36 | @mock-intro-examples[ 37 | (define secret-mock (mock #:behavior void)) 38 | (call/secret secret-mock) 39 | (mock-calls secret-mock)] 40 | 41 | Mocks are constructed by the @racket[mock] function. They're procedures that behave 42 | exactly like whatever their current @behavior-tech{behavior} is, but they also keep a 43 | record of all calls made with them. In the previous example, we construct the mock 44 | @racket[secret-mock] that behaves like the @racket[void] procedure. If the behavior is 45 | unspecified the mock will throw an error whenver its called, so we choose @racket[void] 46 | as its behavior since @racket[call/secret] doesn't need a return value from the procedure 47 | it's given. After evaluating @racket[(call/secret secret-mock)], the @racket[secret-mock] 48 | has a procedure call in its saved history that is accessible via @racket[mock-calls]. Now 49 | we can query this history in tests. We can also clear a mock's history of calls using 50 | @racket[mock-reset!], allowing us to clean up after a test. 51 | 52 | @mock-intro-examples[ 53 | (mock-num-calls secret-mock) 54 | (mock-reset! secret-mock) 55 | (mock-num-calls secret-mock)] 56 | 57 | @section{Using Mocks in Place of Dependencies} 58 | @define-persistent-mock-examples[mock-deps-examples] 59 | 60 | In the previous section we used mocks to test a higher order function @racket[call/secret]. 61 | Mocks also help when dealing with code that performs operations with side effects. In 62 | tests, we simply replace the operation procedure with a mock. To do this, we can take a 63 | procedure that calls side effectful dependencies and convert it to a higher order procedure 64 | like @racket[call/secret], which accepts the side effectful dependencies as inputs. Consider 65 | a procedure that looks up a favorite color from a file, then prints a message based on that 66 | color. 67 | 68 | @mock-deps-examples[ 69 | (define (print-favorite-color-message) 70 | (define color (file->string "color-preference.txt")) 71 | (define message 72 | (case color 73 | [("blue") "Your favorite color is blue. Like the ocean!"] 74 | [("red") "Your favorite color is red. Fiery, fiery red!"] 75 | [("green") "Your favorite color is green. I love forests!"] 76 | [else "I haven't got much to say about your favorite color."])) 77 | (displayln message))] 78 | 79 | Testing this procedure is definitely tricky. There's input from the 80 | @racket["color-preferences.txt"] file to worry about along with output via 81 | @racket[displayln]. To properly test this procedure, let's alter it slightly. 82 | We'll pass in the side effectful dependency procedures as arguments. 83 | 84 | @mock-deps-examples[ 85 | (define (print-favorite-color-message #:read-with [file->string file->string] 86 | #:print-with [displayln displayln]) 87 | (define color (file->string "color-preference.txt")) 88 | (define message 89 | (case color 90 | [("blue") "Your favorite color is blue. Like the ocean!"] 91 | [("red") "Your favorite color is red. Fiery, fiery red!"] 92 | [("green") "Your favorite color is green. I love forests!"] 93 | [else "I haven't got much to say about your favorite color."])) 94 | (displayln message))] 95 | 96 | Much better. By passing in the procedures we use for reading and writing as 97 | arguments, we allow tests to specify that input and output should be performed 98 | with mocks. Using the real functions by default also means we don't affect any 99 | existing code using @racket[print-favorite-color-message]. Now let's try using 100 | mocks. 101 | 102 | @mock-deps-examples[ 103 | (define file-mock (mock #:behavior (const "green"))) 104 | (define displayln-mock (mock #:behavior void)) 105 | (print-favorite-color-message #:read-with file-mock 106 | #:print-with displayln-mock) 107 | (mock-calls file-mock) 108 | (mock-calls displayln-mock)] 109 | 110 | By using @racket[const] we're able to easily setup tests that exercise a 111 | particular codepath. We can test side effectful code! There's still more to 112 | discuss, the following sections discuss adjusting mock behavior and automatically 113 | mocking out dependencies. 114 | 115 | @section{Dynamically Changing Mock Behavior} 116 | @define-persistent-mock-examples[mock-behavior-examples] 117 | 118 | Mocks have a @italic{behavior}, which defines what they return when called. This 119 | behavior is not fixed; mocks can have their behavior changed dynamically using 120 | @racket[with-mock-behavior]. This allows the same mock to respond differently to 121 | different calls while retaining a history of all calls. Recall the favorite color 122 | procedure we defined in the previous section: 123 | 124 | @mock-behavior-examples[ 125 | (define (print-favorite-color-message #:read-with [file->string file->string] 126 | #:print-with [displayln displayln]) 127 | (define color (file->string "color-preference.txt")) 128 | (define message 129 | (case color 130 | [("blue") "Your favorite color is blue. Like the ocean!"] 131 | [("red") "Your favorite color is red. Fiery, fiery red!"] 132 | [("green") "Your favorite color is green. I love forests!"] 133 | [else "I haven't got much to say about your favorite color."])) 134 | (displayln message))] 135 | 136 | If we want to test more than one branch of this code, we need our @racket[file->string] 137 | mock to return different results. We could use different mocks, but then each mock has 138 | a separate call history. In this particular case that's not a problem, but for the sake 139 | of a good example we'll assume we want a combined history. We can use 140 | @racket[with-mock-behavior] to dynmaically control the behavior of a mock. 141 | 142 | @mock-behavior-examples[ 143 | (define file-mock (mock #:behavior (const "green"))) 144 | (define displayln-mock (mock #:behavior void)) 145 | (print-favorite-color-message #:read-with file-mock 146 | #:print-with displayln-mock) 147 | (with-mock-behavior ([file-mock (const "blue")]) 148 | (print-favorite-color-message #:read-with file-mock 149 | #:print-with displayln-mock)) 150 | (mock-calls displayln-mock)] 151 | 152 | A mocks behavior is a @tech[#:doc '(lib "scribblings/guide/guide.scrbl")]{parameter} under the hood, so @racket[with-mock-behavior] 153 | acts similarly to @racket[parameterize]. While here we could have made a second mock, 154 | in the next section we'll introduce automatic mocking which defines one mock per 155 | dependency for us. 156 | 157 | @section{Automatic Mocking with Syntax} 158 | @define-persistent-mock-examples[mock-syntax-examples] 159 | 160 | In the previous sections we transformed procedures we wanted to test into higher order 161 | functions that accepted their dependencies as input. This let us construct a mock for 162 | each dependency and pass it in to inspect how the procedure called its dependencies. 163 | This was a fairly mechanical translation. In this section we introduce @racket[define/mock], 164 | a syntactic form that automates mocking out dependencies in this fashion. Recall again our 165 | favorite color procedure. 166 | 167 | @mock-examples[ 168 | (define (print-favorite-color-message) 169 | (define color (file->string "color-preference.txt")) 170 | (define message 171 | (case color 172 | [("blue") "Your favorite color is blue. Like the ocean!"] 173 | [("red") "Your favorite color is red. Fiery, fiery red!"] 174 | [("green") "Your favorite color is green. I love forests!"] 175 | [else "I haven't got much to say about your favorite color."])) 176 | (displayln message))] 177 | 178 | We previously mocked out the @racket[file->string] and @racket[displayln] procedures. 179 | This was done in three steps: 180 | 181 | @itemlist[ 182 | @item{Add a parameter for each dependency procedure that defaults to the real one.} 183 | @item{Define a mock for each dependency procedure with appropriate behavior} 184 | @item{Call @racket[print-favorite-color-message] with the mocks as its dependencies, 185 | adjusting mock behavior and resetting mocks as necessary.}] 186 | 187 | The @racket[define/mock] form automates the first two steps of this process. 188 | 189 | @mock-syntax-examples[ 190 | (define/mock (print-favorite-color-message) 191 | #:mock file->string #:as file-mock #:with-behavior (const "blue") 192 | #:mock displayln #:as display-mock #:with-behavior void 193 | (define color (file->string "color-preference.txt")) 194 | (define message 195 | (case color 196 | [("blue") "Your favorite color is blue. Like the ocean!"] 197 | [("red") "Your favorite color is red. Fiery, fiery red!"] 198 | [("green") "Your favorite color is green. I love forests!"] 199 | [else "I haven't got much to say about your favorite color."])) 200 | (displayln message))] 201 | 202 | The details of how this works are covered in @secref{mock-reference}, but the gist is 203 | that each @racket[#:mock] clause mocks out a single dependency procedure and defines a 204 | mock with the name given in the @racket[#:as] clause. The @racket[#:with-behavior] clause 205 | defines the default behavior for each mock. However, the mocks are not immediately 206 | available to client code - their definitions must be brought into scope using a 207 | @racket[with-mocks] form. 208 | 209 | @mock-syntax-examples[ 210 | (eval:error file-mock) 211 | (eval:error (print-favorite-color-message)) 212 | (with-mocks print-favorite-color-message 213 | (print-favorite-color-message) 214 | (println (mock-calls display-mock)))] 215 | 216 | The @racket[with-mocks] form also takes care of calling @racket[mock-reset!] on every 217 | mock associated with @racket[print-favorite-color-message]. 218 | 219 | @mock-syntax-examples[ 220 | (with-mocks print-favorite-color-message 221 | (print-favorite-color-message) 222 | (println (mock-num-calls display-mock))) 223 | (with-mocks print-favorite-color-message 224 | (println (mock-num-calls display-mock)))] 225 | 226 | This makes setting up mocked dependencies much simpler. The @racket[define/mock] form 227 | has a few other options to control its behavior, see @secref{mock-reference} for details. 228 | 229 | @define-persistent-mock-examples[mock-stub-examples/manual] 230 | @define-persistent-mock-examples[mock-stub-examples] 231 | @section{Stubbing Undefined Dependencies} 232 | 233 | When testing with mocks, we're able to test how a procedure calls its dependencies 234 | without actually using real dependencies. In theory then, there's no reason those 235 | dependencies need to be implemented before we write our test. Consider a procedure in a 236 | web application that checks whether the current user is authenticated. What are its 237 | dependencies? Clearly there must be some sort of @racket[user] datatype and a 238 | @racket[user-admin?] predicate. There must also be a way to determine the user associated 239 | with the current request, call that @racket[current-user]. And if the user isn't an admin, 240 | there must be some sort of @racket[raise-non-admin-access-error] procedure to throw an 241 | exception indicating the lack of access. We can try and define a 242 | @racket[check-current-user-admin] procedure in terms of these pieces before defining the 243 | pieces, but our code won't compile. 244 | 245 | @mock-examples[ 246 | (define (check-current-user-admin) 247 | (define user (current-user)) 248 | (unless (user-admin? user) 249 | (raise-non-admin-access-error user)))] 250 | 251 | If we're testing @racket[check-current-user-admin] with mocks, since all those dependencies 252 | will be mocked out anyway we could just define fake implementations for them. 253 | 254 | @mock-stub-examples/manual[ 255 | (define current-user #f) 256 | (define user-admin? #f) 257 | (define raise-non-admin-access-error #f) 258 | (define/mock (check-current-user-admin) 259 | #:mock current-user #:with-behavior (const "user") 260 | #:mock user-admin? #:with-behavior (const #t) 261 | #:mock raise-non-admin-access-error 262 | (define user (current-user)) 263 | (unless (user-admin? user) 264 | (raise-non-admin-access-error user)))] 265 | 266 | Now we can test @racket[check-current-user-admin] without properly defining real dependencies. 267 | 268 | @mock-stub-examples/manual[ 269 | (with-mocks check-current-user-admin 270 | (check-current-user-admin) 271 | (mock-calls raise-non-admin-access-error) 272 | (with-mock-behavior ([user-admin? (const #f)] 273 | [raise-non-admin-access-error void]) 274 | (check-current-user-admin) 275 | (println (mock-calls raise-non-admin-access-error))))] 276 | 277 | Nice as this approach could be, it's still rather tedious to define each of those fake 278 | dependencies. And if they're @emph{actually} called, the error message is a terrible one 279 | about the evils of treating @racket[#f] as a procedure. The @racketmodname[mock] library 280 | provides a @racket[stub] form for automatically defining these sorts of fake implementations. 281 | 282 | @mock-stub-examples[ 283 | (stub current-user user-admin? raise-non-admin-access-error) 284 | (define/mock (check-current-user-admin) 285 | #:mock current-user #:with-behavior (const "user") 286 | #:mock user-admin? #:with-behavior (const #f) 287 | #:mock raise-non-admin-access-error 288 | (define user (current-user)) 289 | (unless (user-admin? user) 290 | (raise-non-admin-access-error user)))] 291 | 292 | We can now better control the order in which we implement procedures, writing tests as we 293 | go and even writing code in a test-first fashion. 294 | 295 | @section{Mocking and Opaque Values} 296 | 297 | Libraries often define "special" values that can't be inspected and are only obtainable 298 | through the library, such as database connections or other "opaque" values. When mocking 299 | dependency functions from that library, we often end up in a situation where a mocked 300 | dependency produces one of these values and another mock consumes it. In this case, it 301 | doesn't matter at all what the producer returns. 302 | 303 | @mock-examples[ 304 | (stub db-connect! db-list-ids) 305 | (define/mock (list-db-user-ids) 306 | #:mock db-connect! #:with-behavior (const "some random value") 307 | #:mock db-list-ids #:with-behavior (const '(1 2 3)) 308 | (db-list-ids (db-connect!) 'users)) 309 | (with-mocks list-db-user-ids 310 | (println (list-db-user-ids)) 311 | (println (mock-calls db-list-ids)))] 312 | 313 | We could have returned any value at all from the @racket[db-connect!] procedure, for unit 314 | testing purposes all we care about is that whatever @racket[db-connect!] returns is passed 315 | in properly to @racket[db-list-ids]. However, this could lead to problems if we accidentally 316 | passed the "connection" value somewhere else. If given to a procedure that prints out a string, 317 | instead of throwing an error we'll get "some random value" printed out unexpectedly. What we'd 318 | really like is to create some value that can @emph{only} be used as a mock connection. The 319 | @racket[define-opaque] form lets us define opaque values, which are completely black-boxed 320 | values with no meaning that any procedure could extract from them. 321 | 322 | @mock-examples[ 323 | (stub db-connect! db-list-ids) 324 | (define-opaque test-connection) 325 | (define/mock (list-db-user-ids) 326 | #:mock db-connect! #:with-behavior (const test-connection) 327 | #:mock db-list-ids #:with-behavior (const '(1 2 3)) 328 | (db-list-ids (db-connect!) 'users)) 329 | (with-mocks list-db-user-ids 330 | (println (list-db-user-ids)) 331 | (println (mock-calls db-list-ids))) 332 | (eval:error (add1 test-connection)) 333 | (test-connection? test-connection)] 334 | 335 | In this example, we've defined an opaque @racket[test-connection] value that our tests can 336 | look for. It's impossible to misuse this value, and it helpfully identifies itself in error 337 | messages when passed around unexpectedly. The @racket[define-opaque] form defines both an 338 | opaque value and a predicate that can be used to recognize that value. In tests, we can 339 | look for the opaque value in mock call history with the predicate or @racket[equal?]. 340 | 341 | In addition to @racket[define-opaque], the @racket[define/mock] form provides a handy syntax 342 | for defining an opaque value that only that definition's mocks and @racket[with-mocks] 343 | enclosed code can reference. Simply add the identifier in an @racket[#:opaque] clause. 344 | 345 | @mock-examples[ 346 | (stub db-connect! db-list-ids) 347 | (define/mock (list-db-user-ids) 348 | #:opaque test-connection 349 | #:mock db-connect! #:with-behavior (const test-connection) 350 | #:mock db-list-ids #:with-behavior (const '(1 2 3)) 351 | (db-list-ids (db-connect!) 'users)) 352 | (with-mocks list-db-user-ids 353 | (println (list-db-user-ids)) 354 | (println (mock-calls db-list-ids))) 355 | (eval:error test-connection)] 356 | 357 | The @racket[#:opaque] clause can define multiple opaque values at once by surrounding them 358 | in parentheses. See @racket[define/mock]'s documentation in @secref{mock-reference} for 359 | details. 360 | -------------------------------------------------------------------------------- /mock/private/history.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/contract/base) 4 | 5 | (provide 6 | (contract-out 7 | [mock-call 8 | (->* () (#:name (or/c symbol? #f) #:args arguments? #:results list?) 9 | mock-call?)] 10 | [mock-call? predicate/c] 11 | [mock-call-args (-> mock-call? arguments?)] 12 | [mock-call-name (-> mock-call? (or/c symbol? #f))] 13 | [mock-call-results (-> mock-call? list?)] 14 | [call-history (-> call-history?)] 15 | [call-history? predicate/c] 16 | [call-history-record! (-> call-history? mock-call? void?)] 17 | [call-history-reset! (-> call-history? void?)] 18 | [call-history-reset-all! (->* () #:rest (listof call-history?) void?)] 19 | [call-history-calls (-> call-history? (listof mock-call?))] 20 | [call-history-count (-> call-history? exact-nonnegative-integer?)])) 21 | 22 | (require arguments 23 | "util.rkt") 24 | 25 | (module+ test 26 | (require rackunit)) 27 | 28 | 29 | (struct mock-call (name args results) 30 | #:transparent #:omit-define-syntaxes #:constructor-name make-mock-call) 31 | 32 | (define (mock-call #:name [name #f] 33 | #:args [args (arguments)] 34 | #:results [results (list)]) 35 | (make-mock-call name args results)) 36 | 37 | (module+ test 38 | (check-equal? (mock-call) 39 | (mock-call #:name #f #:args (arguments) #:results (list)))) 40 | 41 | (struct call-history (calls-box) 42 | #:transparent #:omit-define-syntaxes #:constructor-name make-call-history) 43 | 44 | (define (call-history) (make-call-history (box '()))) 45 | 46 | (define (call-history-record! history call) 47 | (box-cons-end! (call-history-calls-box history) call)) 48 | 49 | (define (call-history-reset! history) 50 | (set-box! (call-history-calls-box history) '())) 51 | 52 | (define (call-history-reset-all! . histories) 53 | (for-each call-history-reset! histories)) 54 | 55 | (define (call-history-calls history) 56 | (unbox (call-history-calls-box history))) 57 | 58 | (define (call-history-count history) (length (call-history-calls history))) 59 | 60 | (module+ test 61 | (define (foo-call n) 62 | (mock-call #:name 'foo #:args (arguments 'a 'b 'c) #:results (list n))) 63 | (define (bar-call n) 64 | (mock-call #:name 'bar #:args (arguments 'a 'b 'c) #:results (list n))) 65 | (define test-history (call-history)) 66 | (check-pred call-history? test-history) 67 | (check-pred void? (call-history-record! test-history (foo-call 1))) 68 | (check-pred void? (call-history-record! test-history (bar-call 1))) 69 | (check-pred void? (call-history-record! test-history (foo-call 2))) 70 | (check-equal? (call-history-calls test-history) 71 | (list (foo-call 1) (bar-call 1) (foo-call 2))) 72 | (check-equal? (call-history-count test-history) 3)) 73 | -------------------------------------------------------------------------------- /mock/private/history.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | @(require "util-doc.rkt") 3 | 4 | @title{Mock Call Histories} 5 | 6 | @defproc[(call-history) call-history?]{ 7 | Constructs a fresh mock call history value. Every @mock-tech{mock} has an 8 | associated call history, although external call histories can be shared between 9 | mocks. Call histories store a log of @racket[mock-call] values in the order the 10 | calls were made.} 11 | 12 | @defproc[(call-history? [v any/c]) boolean?]{ 13 | Returns true when @racket[v] is a @racket[call-history] value, and false 14 | otherwise.} 15 | 16 | @defproc[(call-history-record! [history call-history?] [call mock-call?]) 17 | void?]{ 18 | Saves @racket[call] in @racket[history] as the most recent mock call.} 19 | 20 | @defproc[(call-history-calls [history call-history?]) (listof mock-call?)]{ 21 | Returns a list of all calls recorded in @racket[history] with 22 | @racket[call-history-record!]. The list contains calls in order of least recent 23 | to most recent. 24 | @(mock-examples 25 | (define history (call-history)) 26 | (call-history-record! history 27 | (mock-call #:name 'foo 28 | #:args (arguments 1 2 3) 29 | #:results (list 'foo))) 30 | (call-history-record! history 31 | (mock-call #:name 'bar 32 | #:args (arguments 10 20 30) 33 | #:results (list 'bar))) 34 | (call-history-calls history))} 35 | 36 | @defproc[(call-history-count [history call-history?]) (listof mock-call?)]{ 37 | Returns the number of calls recorded in @racket[history]. 38 | @(mock-examples 39 | (define history (call-history)) 40 | (call-history-count history) 41 | (call-history-record! history (mock-call)) 42 | (call-history-count history))} 43 | 44 | @defproc[(call-history-reset! [history call-history?]) void?]{ 45 | Erases all calls from @racket[history], in a similar manner to 46 | @racket[mock-reset!]. 47 | @(mock-examples 48 | (define history (call-history)) 49 | (call-history-record! history (mock-call)) 50 | (call-history-reset! history) 51 | (call-history-calls history))} 52 | -------------------------------------------------------------------------------- /mock/private/not-implemented.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (provide (struct-out exn:fail:not-implemented) 4 | not-implemented-proc 5 | raise-not-implemented) 6 | 7 | (struct exn:fail:not-implemented exn:fail () #:transparent) 8 | 9 | (define (not-implemented-proc proc-name) 10 | (make-keyword-procedure 11 | (λ (kws kw-vs . vs) 12 | (raise-not-implemented proc-name)))) 13 | 14 | (define (raise-not-implemented proc-name) 15 | (define message (format "procedure ~a hasn't been implemented" proc-name)) 16 | (raise (exn:fail:not-implemented message (current-continuation-marks)))) 17 | -------------------------------------------------------------------------------- /mock/private/opaque.rkt: -------------------------------------------------------------------------------- 1 | #lang sweet-exp racket/base 2 | 3 | provide define-opaque 4 | 5 | require syntax/parse/define 6 | for-syntax racket/base 7 | racket/syntax 8 | "syntax-util.rkt" 9 | 10 | module+ test 11 | require rackunit 12 | 13 | 14 | (define-syntax-parser define-single-opaque 15 | [(_ id:id (~optional (~seq #:name name-id:id))) 16 | (with-syntax ([id? (predicate-id #'id)] 17 | [reflect-id (or (attribute name-id) #'id)]) 18 | #'(begin 19 | (struct internal () 20 | #:reflection-name 'reflect-id 21 | #:omit-define-syntaxes 22 | #:constructor-name make-instance) 23 | (define id (make-instance)) 24 | (define id? internal?)))]) 25 | 26 | (define-simple-macro 27 | (define-opaque (~and (~seq id:id (~optional (~seq #:name name-id))) 28 | (~seq part ...)) ...) 29 | (begin (define-single-opaque part ...) ...)) 30 | 31 | (module+ test 32 | (test-case "Single opaque definition" 33 | (define-single-opaque foo) 34 | (check-pred foo? foo) 35 | (check-equal? foo foo) 36 | (check-equal? (object-name foo) 'foo) 37 | (check-equal? (object-name foo?) 'foo?)) 38 | (test-case "Single opaque definition renamed" 39 | (define-single-opaque barrr #:name bar) 40 | (check-pred barrr? barrr) 41 | (check-equal? (object-name barrr) 'bar) 42 | (check-equal? (object-name barrr?) 'bar?)) 43 | (test-case "Multiple opaque definitions with intermixed renames" 44 | (define-opaque foo bar #:name Bar baz) 45 | (check-pred foo? foo) 46 | (check-pred bar? bar) 47 | (check-pred baz? baz) 48 | (check-equal? (object-name bar) 'Bar))) 49 | -------------------------------------------------------------------------------- /mock/private/opaque.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | @(require "util-doc.rkt") 3 | 4 | @title{Opaque Values} 5 | Often libraries work with values whose representations are unknown to clients, 6 | values which can only be constructed via those libraries. For example, a database 7 | library may define a database connection value and a @racket[database-connection?] 8 | predicate, and only allow construction of connections via a @racket[database-connect!] 9 | procedure. This is powerful for library creators but tricky for testers, as tests 10 | likely don't want to spin up a database just to verify they've called the library 11 | procedures correctly. The @racketmodname[mock] library provides utilities for 12 | defining @define-opaque-tech{opaque values} that @mock-tech{mocks} can interact with. 13 | 14 | @defform[(define-opaque clause ...) 15 | #:grammar ([clause (code:line id)])]{ 16 | Defines an @opaque-tech{opaque} value and predicate for each @racket[id]. Each 17 | given @racket[id] is bound to the value, and each predicate is bound to an 18 | identifier matching the format of @racket[id?]. 19 | @mock-examples[ 20 | (define-opaque foo bar) 21 | foo 22 | foo? 23 | (foo? foo) 24 | (equal? foo foo)] 25 | 26 | If @racket[name-id] is provided, 27 | it is used for the reflective name of each opaque value and predicate. Otherwise, 28 | @racket[id] is used. 29 | @mock-examples[ 30 | (define-opaque foo #:name FOO) 31 | foo 32 | foo?] 33 | 34 | Additionally, @racket[define/mock] provides syntax for defining opaque values.} 35 | -------------------------------------------------------------------------------- /mock/private/reference.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @title[#:tag "mock-reference"]{The Mock Reference} 4 | 5 | This document describes the complete API of the @racketmodname[mock] library. 6 | For a gentler introduction and use cases, see @secref{mock-guide}. 7 | 8 | @table-of-contents[] 9 | 10 | @include-section["base.scrbl"] 11 | @include-section["function.scrbl"] 12 | @include-section["history.scrbl"] 13 | @include-section["opaque.scrbl"] 14 | @include-section["syntax.scrbl"] 15 | @include-section["stub.scrbl"] 16 | -------------------------------------------------------------------------------- /mock/private/stub-class.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (provide stubs) 4 | 5 | (require (for-template racket/base 6 | "not-implemented.rkt") 7 | syntax/parse 8 | "syntax-util.rkt") 9 | 10 | 11 | (define-syntax-class stub-header 12 | (pattern plain-id:id 13 | #:attr definition 14 | #'(define plain-id (not-implemented-proc 'plain-id))) 15 | (pattern header:definition-header 16 | #:attr definition 17 | #'(define header (raise-not-implemented 'header.id)))) 18 | 19 | (define-splicing-syntax-class stubs 20 | (pattern (~seq stubbed:stub-header ...+) 21 | #:attr definitions #'(begin stubbed.definition ...))) 22 | -------------------------------------------------------------------------------- /mock/private/stub.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (provide stub 4 | (struct-out exn:fail:not-implemented)) 5 | 6 | (require syntax/parse/define 7 | "not-implemented.rkt" 8 | (for-syntax "stub-class.rkt")) 9 | 10 | (module+ test 11 | (require racket/function 12 | rackunit)) 13 | 14 | 15 | (define-simple-macro (stub stubs:stubs) stubs.definitions) 16 | 17 | (module+ test 18 | (stub foo (bar v) ((baz k) #:blah v)) 19 | (check-exn exn:fail:not-implemented? (thunk (foo 1 2 #:a 'b))) 20 | (check-exn exn:fail:not-implemented? (thunk (bar 1))) 21 | (check-exn exn:fail:contract:arity? (thunk (bar 1 2))) 22 | (check-not-exn (thunk (baz 1))) 23 | (check-exn exn:fail:not-implemented? (thunk ((baz 1) #:blah "blahhhh")))) 24 | -------------------------------------------------------------------------------- /mock/private/stub.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | @(require "util-doc.rkt") 3 | 4 | @title{Stub Implementations} 5 | @mock-tech{Mocks} and @racket[define/mock] make it possible to test procedures 6 | before the procedures they call have been implemented. However, if the procedures 7 | called haven't been defined, a compilation error will occur despite the fact 8 | that they're not used in test. To assist with this, the @racketmodname[mock] 9 | library provides syntax for defining @define-stub-tech{stubs}, procedures that 10 | haven't been implemented and throw immediately when called. The term "stub" is 11 | used in different ways by different languages and libraries, but that is the 12 | definition used by this library. 13 | 14 | @defform[(stub header ...) 15 | #:grammar ([header id (header arg ...) (header arg ... . rest)])]{ 16 | Defines each @racket[header] as a @stub-tech{stub} procedure that immediately 17 | throws a @racket[exn:fail:not-implemented]. If @racket[header] is only an 18 | identifier, the procedure accepts any positional and keyword arguments. 19 | Otherwise, it accepts exactly the arguments specified in @racket[header]. 20 | @mock-examples[ 21 | (stub foo (bar v) ((baz k) #:blah v)) 22 | (eval:error (foo 1 2 #:a 'b)) 23 | (eval:error (bar 1)) 24 | (eval:error (bar 1 2)) 25 | (baz 1) 26 | (eval:error ((baz 1) #:blah "blahhhh"))]} 27 | 28 | @defstruct*[(exn:fail:not-implemented exn:fail) () #:transparent]{ 29 | An exception type thrown by @stub-tech{stubs} whenever they're called.} 30 | -------------------------------------------------------------------------------- /mock/private/syntax-class.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (provide definition-header/mock 4 | id/mock) 5 | 6 | (require (for-syntax racket/base) 7 | (for-template racket/base 8 | racket/splicing 9 | "base.rkt" 10 | "history.rkt" 11 | "opaque.rkt" 12 | "syntax-param.rkt") 13 | racket/match 14 | racket/syntax 15 | syntax/parse 16 | syntax/parse/experimental/template 17 | syntax/stx 18 | syntax/transformer 19 | "syntax-util.rkt") 20 | 21 | 22 | (define-splicing-syntax-class id/alt-name 23 | #:attributes (orig alt id fresh) 24 | (pattern (~seq orig:id (~optional (~seq #:as alt:id))) 25 | #:attr id (template (?? alt orig)) 26 | #:attr fresh (generate-temporary #'id))) 27 | 28 | (define-splicing-syntax-class mock-clause 29 | (pattern (~seq #:mock mocked-id:id/alt-name 30 | (~optional (~seq #:with-behavior given-behavior:expr))) 31 | #:attr definition 32 | (template 33 | (define mocked-id.fresh 34 | (mock #:name 'mocked-id.id 35 | #:external-histories histories 36 | (?? (?@ #:behavior given-behavior))))) 37 | #:attr binding #'[mocked-id.orig mocked-id.fresh] 38 | #:attr static-info 39 | #'(binding-static-info #'mocked-id.id #'mocked-id.fresh))) 40 | 41 | (define-splicing-syntax-class mock-param-clause 42 | #:attributes (definition 43 | [binding 1] 44 | parameterization 45 | binding-info 46 | parameterization-info) 47 | (pattern (~seq #:mock-param mocked-id:id/alt-name 48 | (~optional (~seq #:with-behavior given-behavior:expr))) 49 | #:attr definition 50 | (template 51 | (define mocked-id.fresh 52 | (mock #:name 'mocked-id.id 53 | #:external-histories histories 54 | (?? (?@ #:behavior given-behavior))))) 55 | #:attr [binding 1] 56 | (if (attribute mocked-id.alt) 57 | (list #'[mocked-id.alt mocked-id.fresh]) 58 | (list)) 59 | #:attr parameterization #'[mocked-id.orig mocked-id.fresh] 60 | #:attr binding-info 61 | (if (attribute mocked-id.alt) 62 | #'(binding-static-info #'mocked-id.alt #'mocked-id.fresh) 63 | #'(values #f)) 64 | #:attr parameterization-info 65 | #'(binding-static-info #'mocked-id.orig #'mocked-id.fresh))) 66 | 67 | (define-splicing-syntax-class mocks-clause 68 | (pattern (~seq (~or clause:mock-clause param-clause:mock-param-clause) ...) 69 | #:attr definitions 70 | #'(begin clause.definition ... param-clause.definition ...) 71 | #:attr bindings 72 | #'(clause.binding ... param-clause.binding ... ...) 73 | #:attr paramerizations #'(param-clause.parameterization ...) 74 | #:attr static-info 75 | #'(filter values 76 | (list clause.static-info ... 77 | param-clause.binding-info ...)) 78 | #:attr param-static-info 79 | #'(list param-clause.parameterization-info ...))) 80 | 81 | (define-splicing-syntax-class opaque-clause 82 | #:attributes (definitions [binding 1] static-info) 83 | (pattern (~seq) 84 | #:attr definitions #'(begin) 85 | #:attr [binding 1] (list) 86 | #:attr static-info #'(list)) 87 | (pattern (~seq #:opaque id:id) 88 | #:with id? (predicate-id #'id) 89 | #:with fresh-id (generate-temporary #'id) 90 | #:with fresh-id? (predicate-id #'fresh-id) 91 | #:attr definitions #'(define-opaque fresh-id #:name id) 92 | #:attr [binding 1] (list #'[id fresh-id] #'[id? fresh-id?]) 93 | #:attr static-info #'(list (binding-static-info #'id #'fresh-id) 94 | (binding-static-info #'id? #'fresh-id?))) 95 | (pattern (~seq #:opaque (id:id ...)) 96 | #:with (id? ...) (stx-map predicate-id #'(id ...)) 97 | #:with (fresh-id ...) (generate-temporaries #'(id ...)) 98 | #:with (fresh-id? ...) (stx-map predicate-id #'(fresh-id ...)) 99 | #:attr definitions #'(begin (define-opaque fresh-id #:name id) ...) 100 | #:attr [binding 1] 101 | (syntax->list #'([id fresh-id] ... [id? fresh-id?] ...)) 102 | #:attr static-info 103 | #'(map binding-static-info 104 | (syntax->list #'(id ... id? ...)) 105 | (syntax->list #'(fresh-id ... fresh-id? ...))))) 106 | 107 | (define-splicing-syntax-class history-clause 108 | #:attributes (definitions [binding 1] static-info stxparam) 109 | (pattern (~seq) 110 | #:attr definitions #'(begin) 111 | #:attr [binding 1] (list) 112 | #:attr static-info #'(list) 113 | #:attr stxparam #'(make-variable-like-transformer #'(list))) 114 | (pattern (~seq #:history id:id) 115 | #:with fresh-id (generate-temporary #'id) 116 | #:attr definitions #'(define fresh-id (call-history)) 117 | #:attr [binding 1] (list #'[id fresh-id]) 118 | #:attr static-info #'(list (binding-static-info #'id #'fresh-id)) 119 | #:attr stxparam #'(make-variable-like-transformer #'(list fresh-id)))) 120 | 121 | (define-splicing-syntax-class define/mock-options 122 | #:attributes 123 | (definitions override-bindings opaques-info history-info mocks-info 124 | param-mocks-info) 125 | (pattern (~seq opaque:opaque-clause history:history-clause mocks:mocks-clause) 126 | #:attr definitions 127 | #'(begin opaque.definitions 128 | history.definitions 129 | (splicing-syntax-parameterize ([histories history.stxparam]) 130 | (splicing-let (opaque.binding ... history.binding ...) 131 | mocks.definitions))) 132 | #:attr override-bindings #'mocks.bindings 133 | #:attr opaques-info #'opaque.static-info 134 | #:attr history-info #'history.static-info 135 | #:attr mocks-info #'mocks.static-info 136 | #:attr param-mocks-info #'mocks.param-static-info)) 137 | 138 | (define-splicing-syntax-class definition-header/mock 139 | #:attributes 140 | (header/plain header/mock definitions override-bindings static-definition) 141 | (pattern (~seq header:definition-header options:define/mock-options) 142 | #:attr header/plain #'header.fresh 143 | #:attr header/mock #'header.fresh-secondary 144 | #:attr definitions #'options.definitions 145 | #:attr override-bindings #'options.override-bindings 146 | #:attr static-definition 147 | #'(define-syntax header.id 148 | (static-val-transformer 149 | #'header.fresh-id 150 | (mocks-syntax-info #'header.fresh-id-secondary 151 | options.opaques-info 152 | options.history-info 153 | options.mocks-info 154 | options.param-mocks-info))))) 155 | 156 | (struct binding-static-info (id bound-id) #:transparent) 157 | (struct mocks-syntax-info (proc-id opaques histories mocks param-mocks) #:transparent) 158 | 159 | (define (mock-bindings mock-static-infos) 160 | (map (match-lambda [(binding-static-info mock-id mock-impl-id) 161 | (list (syntax-local-introduce mock-id) mock-impl-id)]) 162 | mock-static-infos)) 163 | 164 | (define-syntax-class id/mock 165 | #:description "define/mock identifier" 166 | #:attributes ([binding 1] [parameterization 1] reset-expr) 167 | (pattern id:id 168 | #:do [(define static (static-val #'id))] 169 | #:fail-unless (mocks-syntax-info? static) 170 | (format "identifier ~a not bound with define/mock" (syntax-e #'id)) 171 | #:do 172 | [(match-define 173 | (mocks-syntax-info proc-id opaques histories mocks param-mocks) 174 | static)] 175 | #:with proc-id proc-id 176 | #:with ([mock-id mock-impl-id] ...) (mock-bindings mocks) 177 | #:with ([param-mock-id param-mock-impl-id] ...) 178 | (mock-bindings param-mocks) 179 | #:with (opaque-binding ...) (mock-bindings opaques) 180 | #:with ([history-id history-impl-id] ...) (mock-bindings histories) 181 | #:attr reset-expr 182 | #'(begin (mock-reset-all! mock-impl-id ...) 183 | (mock-reset-all! param-mock-impl-id ...) 184 | (call-history-reset-all! history-impl-id ...)) 185 | #:attr [binding 1] 186 | (syntax->list 187 | #'([id proc-id] 188 | opaque-binding ... 189 | [history-id history-impl-id] ... 190 | [mock-id mock-impl-id] ...)) 191 | #:attr [parameterization 1] 192 | (syntax->list #'([param-mock-id param-mock-impl-id] ...)))) 193 | -------------------------------------------------------------------------------- /mock/private/syntax-param.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (provide histories) 4 | 5 | (require (for-syntax racket/base) 6 | racket/stxparam) 7 | 8 | 9 | (define-syntax-parameter histories #f) 10 | -------------------------------------------------------------------------------- /mock/private/syntax-test.rkt: -------------------------------------------------------------------------------- 1 | #lang sweet-exp racket/base 2 | 3 | require racket/function 4 | rackunit 5 | syntax/macro-testing 6 | arguments 7 | "base.rkt" 8 | "history.rkt" 9 | "syntax.rkt" 10 | 11 | (define (not-mock? v) (not (mock? v))) 12 | 13 | (define/mock (bar) 14 | #:mock foo #:with-behavior (const "fake") 15 | (foo)) 16 | 17 | (define (foo) "real") 18 | 19 | (test-equal? "Should use real implementation when called normally" 20 | (bar) "real") 21 | (test-pred "Should not bind mocks outside with-mocks" 22 | not-mock? foo) 23 | 24 | (test-case "Should reset mocks after with-mocks scope" 25 | (with-mocks bar 26 | (check-equal? (mock-num-calls foo) 0) 27 | (bar) 28 | (check-equal? (mock-num-calls foo) 1)) 29 | (with-mocks bar 30 | (check-equal? (mock-num-calls foo) 0))) 31 | 32 | (with-mocks bar 33 | (test-equal? "Should use mock implementation in with-mocks" 34 | (bar) "fake") 35 | (test-pred "Should bind mocks inside with-mocks" 36 | mock? foo)) 37 | 38 | (module+ test 39 | (test-case "Should behave identically in submod when called normally" 40 | (check-equal? (bar) "real") 41 | (check-pred not-mock? foo)) 42 | (test-case "Should behave identically in submod when called in with-mocks" 43 | (with-mocks bar 44 | (check-equal? (bar) "fake") 45 | (check-pred mock? foo)))) 46 | 47 | (let () 48 | (define/mock (bar-local) 49 | #:mock foo #:with-behavior (const "fake") 50 | (foo)) 51 | 52 | (test-case "Should behave identically in local definition context when called normally" 53 | (check-equal? (bar-local) "real") 54 | (check-pred not-mock? foo)) 55 | (test-case "Should behave identically in local definition context when called in with-mocks" 56 | (with-mocks bar-local 57 | (check-equal? (bar-local) "fake") 58 | (check-pred mock? foo)))) 59 | 60 | (test-case "Should use given binding instead of mocked procedure id" 61 | (define/mock (bar-explicit) 62 | #:mock foo #:as foo-mock #:with-behavior (const "fake") 63 | (foo)) 64 | (with-mocks bar-explicit 65 | (check-not-exn bar-explicit) 66 | (check-pred not-mock? foo) 67 | (check-pred mock? foo-mock))) 68 | 69 | (test-case "Should use default mock behavior (throwing) when behavior unspecified" 70 | (define/mock (bar-default-behavior) 71 | #:mock foo 72 | (foo)) 73 | (with-mocks bar-default-behavior 74 | (check-exn exn:fail:unexpected-arguments? bar-default-behavior))) 75 | 76 | (test-case "Should allow positional, keyword, and rest arguments" 77 | (define/mock (bar-args arg #:keyword kwarg . rest) 78 | #:mock foo #:with-behavior (const "fake") 79 | (foo)) 80 | (check-equal? (bar-args #f #:keyword 'foo 1 2 3) "real") 81 | (with-mocks bar-args 82 | (check-equal? (bar-args #f #:keyword 'foo 1 2 3) "fake"))) 83 | 84 | (test-case "Should define opaque value and make it available in mock behaviors" 85 | (define/mock (bar-opaque) 86 | #:opaque foo-result 87 | #:mock foo #:with-behavior (const foo-result) 88 | (foo)) 89 | (check-equal? (bar-opaque) "real") 90 | (with-mocks bar-opaque 91 | (check-pred foo-result? foo-result) 92 | (check-equal? (bar-opaque) foo-result))) 93 | 94 | (test-case "Should work with multiple opaque values" 95 | (define/mock (bar-opaque-multi) 96 | #:opaque (left right) 97 | #:mock foo #:with-behavior (const (cons left right)) 98 | (foo)) 99 | (check-equal? (bar-opaque-multi) "real") 100 | (with-mocks bar-opaque-multi 101 | (check-pred left? left) 102 | (check-pred right? right) 103 | (check-equal? (bar-opaque-multi) (cons left right)))) 104 | 105 | (test-case "Should raise a syntax error when used with a normal procedure" 106 | (define (bar-normal) 107 | (foo)) 108 | (check-equal? (bar-normal) "real") 109 | (check-exn #rx"bar-normal not bound with define/mock" 110 | (thunk 111 | (convert-compile-time-error (with-mocks bar-normal (void)))))) 112 | 113 | (test-case "Should raise a syntax error when with-mocks is nested" 114 | (define/mock (bar1) #:mock foo (foo)) 115 | (define/mock (bar2) #:mock foo (foo)) 116 | (check-equal? (bar1) "real") 117 | (check-equal? (bar2) "real") 118 | (check-exn #rx"nested use of with-mocks not allowed" 119 | (thunk 120 | (convert-compile-time-error 121 | (with-mocks bar1 (with-mocks bar2 (void))))))) 122 | 123 | (test-case "Should add an external history to all mocks when defined" 124 | (define/mock (bar/history) 125 | #:history bar-history 126 | #:mock foo #:with-behavior void 127 | (foo)) 128 | (with-mocks bar/history 129 | (bar/history) 130 | (check-equal? (call-history-count bar-history) 1))) 131 | 132 | (test-case "Should allow mocking of procedure-containing parameters" 133 | (define current-foo (make-parameter foo)) 134 | (define (foo/param) ((current-foo))) 135 | (test-case "Should provide mock in param by default" 136 | (define/mock (bar/param) 137 | #:mock-param current-foo #:with-behavior (const "foo-param") 138 | (foo/param)) 139 | (with-mocks bar/param 140 | (check-equal? (bar/param) "foo-param") 141 | (check-equal? (mock-num-calls (current-foo)) 1))) 142 | (test-case "Should provide mock directly when given binding" 143 | (define/mock (bar/param/name) 144 | #:mock-param current-foo #:as foo-mock #:with-behavior (const "foo-param") 145 | (foo/param)) 146 | (with-mocks bar/param/name 147 | (check-equal? (bar/param/name) "foo-param") 148 | (check-equal? (mock-num-calls foo-mock) 1)))) 149 | -------------------------------------------------------------------------------- /mock/private/syntax-util.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (provide definition-header 4 | predicate-id 5 | static-val 6 | static-val-transformer) 7 | 8 | (require racket/function 9 | racket/syntax 10 | syntax/parse) 11 | 12 | 13 | (define (predicate-id id-stx) 14 | (format-id id-stx "~a?" id-stx)) 15 | 16 | (define-syntax-class definition-header 17 | (pattern (~or root-id:id 18 | (~or (subheader:definition-header (~or arg-clause kwarg-clause) ...) 19 | (subheader:definition-header (~or arg-clause kwarg-clause) ... . rest-arg:id))) 20 | #:attr id 21 | (or (attribute root-id) (attribute subheader.id)) 22 | #:attr fresh-id 23 | (if (attribute root-id) 24 | (generate-temporary #'id) 25 | (attribute subheader.fresh-id)) 26 | #:attr fresh 27 | (cond [(attribute root-id) #'fresh-id] 28 | [(attribute rest-arg) 29 | #'(subheader.fresh arg-clause ... kwarg-clause ... . rest-arg)] 30 | [else #'(subheader.fresh arg-clause ... kwarg-clause ...)]) 31 | #:attr fresh-id-secondary 32 | (if (attribute root-id) 33 | (generate-temporary #'id) 34 | (attribute subheader.fresh-id-secondary)) 35 | #:attr fresh-secondary 36 | (cond [(attribute root-id) #'fresh-id-secondary] 37 | [(attribute rest-arg) 38 | #'(subheader.fresh-secondary arg-clause ... kwarg-clause ... . rest-arg)] 39 | [else #'(subheader.fresh-secondary arg-clause ... kwarg-clause ...)]))) 40 | 41 | (struct static-val-transformer (id value) 42 | #:property prop:rename-transformer (struct-field-index id)) 43 | 44 | (define (static-val static-trans-stx) 45 | (define-values (trans _) 46 | (syntax-local-value/immediate static-trans-stx (thunk (values #f #f)))) 47 | (and trans (static-val-transformer-value trans))) 48 | -------------------------------------------------------------------------------- /mock/private/syntax.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (provide define/mock 4 | with-mocks) 5 | 6 | (require racket/splicing 7 | racket/stxparam 8 | syntax/parse/define 9 | (for-syntax racket/base 10 | syntax/parse 11 | "syntax-class.rkt")) 12 | 13 | 14 | (define-simple-macro 15 | (define/mock header:definition-header/mock body:expr ...+) 16 | (begin 17 | (define header.header/plain body ...) 18 | header.definitions 19 | (splicing-let header.override-bindings (define header.header/mock body ...)) 20 | header.static-definition)) 21 | 22 | (define-simple-macro (with-mocks/impl proc:id/mock body:expr ...) 23 | (let (proc.binding ...) 24 | (parameterize (proc.parameterization ...) 25 | body ...) 26 | proc.reset-expr)) 27 | 28 | (define-for-syntax (with-mocks/nested stx) 29 | (raise-syntax-error #f "nested use of with-mocks not allowed" stx)) 30 | 31 | (define-syntax-parameter with-mocks 32 | (syntax-parser 33 | [(_ proc:id/mock body:expr ...) 34 | #'(syntax-parameterize ([with-mocks with-mocks/nested]) 35 | (with-mocks/impl proc body ...))])) 36 | -------------------------------------------------------------------------------- /mock/private/syntax.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | @(require "util-doc.rkt") 3 | 4 | @title{Mocking Dependencies} 5 | 6 | @mock-tech{Mocks} by themselves provide useful low-level building blocks, but often 7 | to use them a function needs to be implemented twice - once using mocks for the purpose 8 | of testing, and once using real functions to provide actual functionality. The 9 | @racketmodname[mock] library provides a shorthand syntax for defining both implementations 10 | at once. 11 | 12 | @defform[ 13 | #:id define/mock 14 | (define/mock header 15 | opaque-clause history-clause 16 | mock-clause ... 17 | body ...) 18 | #:grammar ([header id (header arg ...) (header arg ... . rest)] 19 | [opaque-clause (code:line) 20 | (code:line #:opaque opaque-id:id) 21 | (code:line #:opaque (opaque-id:id ...))] 22 | [history-clause (code:line) 23 | (code:line #:history history-id:id)] 24 | [mock-clause (code:line #:mock mock-id mock-as mock-default) 25 | (code:line #:mock-param param-id mock-as mock-default)] 26 | [mock-as (code:line) (code:line #:as mock-as-id)] 27 | [mock-default (code:line) (code:line #:with-behavior behavior-expr)]) 28 | #:contracts ([behavior-expr procedure?])]{ 29 | Like @racket[define] except two versions of @racket[id] are defined, a normal 30 | definition and a definition where each @racket[mock-id] is defined as a 31 | @mock-tech{mock} within @racket[body ...]. This alternate definition is used 32 | whenever @racket[id] is called within a @racket[(with-mocks id ...)] form. Each 33 | mock uses @racket[beavhior-expr] as its @behavior-tech{behavior} if provided, 34 | and is bound to @racket[mock-as-id] or @racket[mock-id] within 35 | @racket[(with-mocks id ...)] for use with checks like 36 | @racket[check-mock-called-with?]. Each @racket[opaque-id] is defined as an 37 | @opaque-tech{opaque-value} using @racket[define-opaque], and each 38 | @racket[behavior-expr] may refer to any @racket[opaque-id]. If provided, 39 | @racket[history-id] is bound as a @racket[call-history] and each mock uses 40 | @racket[history-id] as an external call history. The @racket[id] is bound as a 41 | rename transformer with @racket[define-syntax], but also includes information 42 | used by @racket[with-mocks] to bind @racket[id], each @racket[mock-id] or 43 | @racket[mock-as-id], and each @racket[opaque-id]. 44 | @(mock-examples 45 | (define/mock (foo) 46 | #:mock bar #:as bar-mock #:with-behavior (const "wow!") 47 | (bar)) 48 | (define (bar) "bam!") 49 | (displayln (foo)) 50 | (with-mocks foo 51 | (displayln (foo)) 52 | (displayln (mock-calls bar-mock)))) 53 | 54 | Opaque values are bound and available in both @racket[with-mocks] forms and mock 55 | behavior expressions, and can be used to represent difficult to construct values like 56 | database connections. 57 | @(mock-examples 58 | (define/mock (foo/opaque) 59 | #:opaque special 60 | #:mock bar #:as bar-mock #:with-behavior (const special) 61 | (bar)) 62 | (define (bar) "bam!") 63 | (eval:error special) 64 | (foo/opaque) 65 | (with-mocks foo/opaque 66 | (displayln special) 67 | (displayln (special? (foo/opaque))))) 68 | 69 | If @racket[#:as mock-as] is not provided, @racket[mock-id] is used instead. This means 70 | @racket[with-mocks] forms cannot reference both the mock and the mocked dependency 71 | simultaneously. 72 | @(mock-examples 73 | (define/mock (foo/default-binding) 74 | #:mock bar #:with-behavior (const "wow!") 75 | (bar)) 76 | (define (bar) "bam!") 77 | (foo/default-binding) 78 | (with-mocks foo/default-binding 79 | (displayln (foo/default-binding)) 80 | ;; no way to refer to real bar in here 81 | (displayln (mock-calls bar)))) 82 | 83 | If @racket[#:with-behavior behavior-expr] is not provided, the default behavior of 84 | @racket[mock] is used. If a @racket[with-mocks] form expects the mock to be called, 85 | @racket[with-mock-behavior] must also be used within the @racket[with-mocks] form to 86 | setup the correct mock behavior. 87 | @(mock-examples 88 | (define/mock (foo/no-behavior) 89 | #:mock bar 90 | (bar)) 91 | (define (bar) "bam!") 92 | (foo/no-behavior) 93 | (eval:error 94 | (with-mocks foo/no-behavior 95 | (foo/no-behavior)))) 96 | 97 | Parameters can be mocked by using the @racket[#:mock-param] form of 98 | @racket[mock-clause] instead of @racket[#:mock]. When a parameter is mocked, 99 | the parameter is expected to contain a procedure and will be parameterized to 100 | a mock when the defined procedure is called within the @racket[with-mocks] 101 | form. If @racket[#:as mock-as-id] is provided, the mock used in the parameter 102 | is bound to @racket[mock-as-id]; otherwise it is available by calling the 103 | parameter. 104 | @(mock-examples 105 | (define current-bar (make-parameter (const "bam!"))) 106 | (define (bar) ((current-bar))) 107 | (define/mock (foo/param) 108 | #:mock-param current-bar #:with-behavior (const "wow!") 109 | (bar)) 110 | (eval:check (foo/param) "bam!") 111 | (with-mocks foo/param 112 | (displayln (foo/param)))) 113 | @history[#:changed "2.0" "Added #:call-history option"] 114 | @history[#:changed "2.1" "Added #:mock-param option"]} 115 | 116 | @defform[(with-mocks proc/mocks-id body ...)]{ 117 | Looks up static mocking information associated with @racket[proc/mocks-id], which must 118 | have been defined with @racket[define/mock], and binds a few identifiers within @racket[body ...]. 119 | The identifier @racket[proc/mocks-id] is bound to a separate implementation that calls 120 | @mock-tech{mocks}, and any mocked procedures defined by @racket[proc/mocks-id] are bound 121 | to their mocks. See @racket[define/mock] for details and an example. The @racket[body ...] 122 | forms are in a new internal definition context surrounded by an enclosing @racket[let].} 123 | -------------------------------------------------------------------------------- /mock/private/util-doc.rkt: -------------------------------------------------------------------------------- 1 | #lang sweet-exp racket/base 2 | 3 | provide 4 | args-tech 5 | behavior-tech 6 | define-behavior-tech 7 | define-mock-tech 8 | define-opaque-tech 9 | define-persistent-mock-examples 10 | define-stub-tech 11 | mock-examples 12 | mock-tech 13 | opaque-tech 14 | parameter-tech 15 | stub-tech 16 | for-label 17 | all-from-out mock 18 | racket/base 19 | racket/contract 20 | racket/list 21 | racket/file 22 | racket/function 23 | racket/set 24 | 25 | require 26 | scribble/example 27 | scribble/manual 28 | syntax/parse/define 29 | for-label mock 30 | racket/base 31 | racket/contract 32 | racket/list 33 | racket/file 34 | racket/function 35 | racket/set 36 | 37 | (define mock-doc 38 | '(lib "mock/main.scrbl")) 39 | 40 | (define-simple-macro (define-techs [key:str use-id:id def-id:id] ...) 41 | (begin 42 | (begin 43 | (define (def-id . pre-flow) (apply deftech #:key key pre-flow)) 44 | (define (use-id . pre-flow) (apply tech #:key key #:doc mock-doc pre-flow))) 45 | ...)) 46 | 47 | (define-techs 48 | ["behavior" behavior-tech define-behavior-tech] 49 | ["mock" mock-tech define-mock-tech] 50 | ["opaque" opaque-tech define-opaque-tech] 51 | ["stub" stub-tech define-stub-tech]) 52 | 53 | (define (args-tech . pre-flow) 54 | (apply tech 55 | #:doc '(lib "arguments/main.scrbl") 56 | #:key "arguments-struct" 57 | pre-flow)) 58 | 59 | (define (parameter-tech . pre-flow) 60 | (apply tech #:doc '(lib "scribblings/guide/guide.scrbl") pre-flow)) 61 | 62 | (define mock-requires 63 | '(mock racket/format racket/function racket/file racket/list racket/set)) 64 | 65 | (define (make-mock-eval) 66 | (make-base-eval #:lang 'racket/base 67 | (cons 'require mock-requires))) 68 | 69 | (define-syntax-rule (mock-examples example ...) 70 | (examples #:eval (make-mock-eval) example ...)) 71 | 72 | (define-syntax-rule (define-persistent-mock-examples id) 73 | (begin 74 | (define shared-eval (make-mock-eval)) 75 | (define-syntax-rule (id example (... ...)) 76 | (examples #:eval shared-eval example (... ...))))) 77 | -------------------------------------------------------------------------------- /mock/private/util.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (provide box-transform! 4 | with-values-as-list 5 | box-cons-end!) 6 | 7 | (require fancy-app 8 | racket/function) 9 | 10 | 11 | (define (box-transform! a-box f) 12 | (set-box! a-box (f (unbox a-box)))) 13 | 14 | (define-syntax-rule (with-values-as-list body ...) 15 | (call-with-values (thunk body ...) list)) 16 | 17 | (define (box-cons-end! a-box v) 18 | (box-transform! a-box (append _ (list v)))) 19 | --------------------------------------------------------------------------------