tests/functions.lisp

   1 ;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-mock-tests; -*-
   2
   3 (in-package #:cl-mock-tests)
   4 \f
   5 (in-suite cl-mock)
   6
   7 (def-test progf.calls-binding ()
   8   (progf '(foo) (list (lambda () 23))
   9     (is (eql 23 (foo)))))
  10
  11 (def-test dflet.calls-binding ()
  12   (dflet ((foo () 23))
  13     (is (eql 23 (foo)))))
  14 \f
  15 (declaim (inline foo/inline))
  16 (defun foo/inline ()
  17   23)
  18
  19 (def-test dflet.inline.works ()
  20   "If a function is declared INLINE (and that request is honored), DFLET
  21 won't work."
  22   (dflet ((foo/inline () 42))
  23     (is (eql 23 (foo/inline)))))
  24
  25 (def-test dflet.notinline.works ()
  26   "If a function is declared INLINE, but NOTINLINE is used locally,
  27 DFLET will work."
  28   (declare (notinline foo/inline))
  29   (dflet ((foo/inline () 42))
  30     (is (eql 42 (foo/inline)))))
  31 \f
  32 (defun foo/mock (&optional (string "Hello, World!"))
  33   (1+ (bar/mock string)))
  34
  35 (defun bar/mock (string)
  36   (length string))
  37
  38 (def-test dflet.simple-mock ()
  39   (dflet ((bar/mock (string)
  40             (cond
  41               ((equalp string "Hello, World!")
  42                42))))
  43     (is (eql 43 (foo/mock)))
  44     (is (eql 43 (foo/mock "HELLO, WORLD!")))))
  45
  46 (def-test dflet.package-locks ()
  47   "Either we can rebind LIST, or an error occurs and the binding is not
  48 modified."
  49   (let ((list #'list))
  50     (handler-case (dflet ((list ()))
  51                     (is (eql 42 (list))))
  52       (error ()
  53         (is (eq #'list list))))))
  54
  55 (defun foo/lock ()
  56   23)
  57
  58 (def-test dflet.package-locks.order.1 ()
  59   "Either we can rebind LIST, or an error occurs and both binding are
  60 restored."
  61   (let ((list #'list)
  62         (foo/lock #'foo/lock))
  63     (handler-case (dflet
  64                       ((foo/lock () 13)
  65                        (list () 42))
  66                     (is (eql 42 (list)))
  67                     (is (eql 13 (foo/lock))))
  68       (error ()
  69         (is (eq #'list list))
  70         (is (eq #'foo/lock foo/lock))))))