FORM が XXX するか調べる方法

xyzzy-lisp

作業ログっていうかメモっていうか

Return Values

(expect (+ 2 1)
  (returns 3))
  • equal?
  • It is OK to ignore too many values
(let ((#1=#:results (multiple-value-list (+ 2 1))))
  (equal (list 3) #1#))
=> t

Condition

(expect (+ #\f #\o #\o)
  (signals 'type-error))

(multiple-value-bind (values condition)
    (handler-case
        (multiple-value-list (+ #\f #\o #\o))
      (condition (c)
        (values nil c)))
  (and (null values)
       (typep condition 'type-error)))
=> t

Output

(expect (format t "foo")
  (prints "foo" *standard-output*))
  • terpri on broadcast stream?
  • Omitting actual output?
(let* ((out (make-string-output-stream))
       (*standard-output* (make-broadcast-stream
                           *standard-output*
                           out)))
  (multiple-value-bind (values condition)
      (handler-case
          (multiple-value-list (format t "foo"))
        (condition (c)
          (values nil c)))
    (string= (get-output-stream-string out)
             "foo")))
foo
=> t

Binding

(expect (setq x 33)
  (binds 'x 33))
  • No need to protection for x?
(let* ((out (make-string-output-stream))
       (*standard-output* (make-broadcast-stream
                           *standard-output*
                           out)))
  (multiple-value-bind (values condition)
      (handler-case
          (multiple-value-list (setq x 33))
        (handler-case (c)
          (values nil c)))
    (eql (symbol-value 'x) 33)))
=> t

Function Call

(expect (progn (foo))
  (calls 'foo))
  • Call original function?
  • When it is not a function (not fboundp)
    • Not fboundp and nil in symbol-function aren't same
  • labels/flet
(let* ((out (make-string-output-stream))
       (*standard-output* (make-broadcast-stream
                           *standard-output*
                           out)))
  (let ((original-functions
         (mapcar (lambda (name)
                   (cons name (ignore-errors
                               (symbol-function name))))
           (list 'foo)))
        (function-called-p-alist
         (mapcar #'list (list 'foo))))
    (dolist (name (list 'foo))
      (let ((called? (assoc name function-called-p-alist)))
        (setf (symbol-function name)
              (lambda (&rest args)
                (setf (cdr called?) t)))))
    (multiple-value-bind (values condition)
        (handler-case
            (multiple-value-list (progn (foo)))
          (condition (c)
            (values nil c)))
      (prog1
          (every (lambda (name)
                   (cdr (assoc name function-called-p-alist)))
            (list 'foo))
        (dolist (name (list 'foo))
          (let ((fn (cdr (assoc name original-functions))))
            (if fn
                (setf (symbol-function name) fn)
              (fmakunbound name))))))))
=> t