56 lines
2.3 KiB
Common Lisp
56 lines
2.3 KiB
Common Lisp
;;;; SPDX-License-Identifier AGPL-3.0-or-later
|
|
|
|
;;;; mocking.lisp A minimal function mocking framework
|
|
;;;; Copyright (C) 2022 Alejandro "HiPhish" Sanchez
|
|
;;;;
|
|
;;;; This file is part of CL-HSSG.
|
|
;;;;
|
|
;;;; CL-HSSG is free software: you can redistribute it and/or modify it under
|
|
;;;; the terms of the GNU Affero General Public License as published by the
|
|
;;;; Free Software Foundation, either version 3 of the License, or (at your
|
|
;;;; option) any later version.
|
|
;;;;
|
|
;;;; CL-HSSG is distributed in the hope that it will be useful, but WITHOUT ANY
|
|
;;;; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
|
|
;;;; FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
|
|
;;;; more details.
|
|
;;;;
|
|
;;;; You should have received a copy of the GNU Affero General Public License
|
|
;;;; along with CL-HSSG If not, see <https://www.gnu.org/licenses/>.(in-package #:hssg.artifact)
|
|
(defpackage #:hssg/test-mocking
|
|
(:documentation "A minimal function mocking framework.")
|
|
(:use #:cl)
|
|
(:export #:with-mock))
|
|
(in-package #:hssg/test-mocking)
|
|
|
|
|
|
(defun mock-to-save (original-name temp-name)
|
|
`(,temp-name (symbol-function ',original-name)))
|
|
|
|
(defun mock-to-restore (original-name temp-name)
|
|
`(setf (symbol-function ',original-name) ,temp-name))
|
|
|
|
(defun mock-to-injection (original-name temp-value)
|
|
`(setf (symbol-function ',original-name) ,temp-value))
|
|
|
|
|
|
(defmacro with-mock ((&rest mocks) &body body)
|
|
"Temporarily rebind symbol functions for the given symbols. Outside the form
|
|
the original bindings will be restored. This is useful to mock functions with
|
|
side effects during testing. Inside the mock body we can place our assertions
|
|
to e.g. test that the correct arguments were passed. Example:
|
|
|
|
;;; Hard-coded default values for the mocked functions
|
|
(with-mocks ((foo (lambda (x y) T))
|
|
(bar (lambda (x y) T)))
|
|
(assert (foo 1 2))
|
|
(assert (bar 3 4)))"
|
|
(let ((temp-names (loop for mock in mocks collect (gensym)))
|
|
(temp-values (mapcar #'cadr mocks))
|
|
(original-names (mapcar #'car mocks)))
|
|
`(let ,(mapcar #'mock-to-save original-names temp-names)
|
|
(unwind-protect
|
|
(progn
|
|
,@(mapcar #'mock-to-injection original-names temp-values)
|
|
,@body)
|
|
,@(mapcar #'mock-to-restore original-names temp-names)))))
|