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.  Not a failure, since we can't force INLINE."
  22   (dflet ((foo/inline () 42))
  23     (if (eql 23 (foo/inline))
  24         (pass "INLINE declaration honored, so DFLET fails")
  25         (skip "INLINE declaration not honored, so DFLET works"))))
  26
  27 (def-test dflet.notinline.works ()
  28   "If a function is declared INLINE, but NOTINLINE is used locally,
  29 DFLET will work."
  30   (declare (notinline foo/inline))
  31   (dflet ((foo/inline () 42))
  32     (is (eql 42 (foo/inline)))))
  33 \f
  34 (defun foo/mock (&optional (string "Hello, World!"))
  35   (1+ (bar/mock string)))
  36
  37 (defun bar/mock (string)
  38   (length string))
  39
  40 (def-test dflet.simple-mock ()
  41   (dflet ((bar/mock (string)
  42             (cond
  43               ((equalp string "Hello, World!")
  44                42))))
  45     (is (eql 43 (foo/mock)))
  46     (is (eql 43 (foo/mock "HELLO, WORLD!")))))
  47
  48 (def-test dflet.package-locks ()
  49   "Either we can rebind LIST, or an error occurs and the binding is not
  50 modified."
  51   (let ((list #'list))
  52     (handler-case (dflet ((list ()))
  53                     (is (eql 42 (list))))
  54       (error ()
  55         (is (eq #'list list))))))
  56
  57 (defun foo/lock ()
  58   23)
  59
  60 (def-test dflet.package-locks.order.1 ()
  61   "Either we can rebind LIST, or an error occurs and both binding are
  62 restored."
  63   (let ((list #'list)
  64         (foo/lock #'foo/lock))
  65     (handler-case (dflet
  66                       ((foo/lock () 13)
  67                        (list () 42))
  68                     (is (eql 42 (list)))
  69                     (is (eql 13 (foo/lock))))
  70       (error ()
  71         (is (eq #'list list))
  72         (is (eq #'foo/lock foo/lock))))))