Commit 0cd5ed96 authored by pfdietz's avatar pfdietz

Added tests of disassemble.

parent 5b564c78
......@@ -80,6 +80,9 @@ Results: ~A~%" expected-number form n results))))
"Like EQUALP, but guaranteed to return T for true."
(apply #'values (mapcar #'notnot (multiple-value-list (equalp x y)))))
(defun string=t (x y)
(notnot-mv (string= x y)))
(defun =t (x &rest args)
"Like =, but guaranteed to return T for true."
(apply #'values (mapcar #'notnot (multiple-value-list (apply #'= x args)))))
......
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sun May 18 20:47:58 2003
;;;; Contains: Tests of DISASSEMBLE
(in-package :cl-test)
(defun disassemble-it (fn)
(let (val)
(values
(notnot
(stringp
(with-output-to-string (*standard-output*)
(setf val (disassemble fn)))))
val)))
(deftest disassemble.1
(disassemble-it 'car)
t nil)
(deftest disassemble.2
(disassemble-it (symbol-function 'car))
t nil)
(deftest disassemble.3
(disassemble-it '(lambda (x y) (cons y x)))
t nil)
(deftest disassemble.4
(disassemble-it #'(lambda (x y) (cons y z)))
t nil)
(deftest disassemble.5
(disassemble-it (let ((x 0)) #'(lambda () (incf x))))
t nil)
(deftest disassemble.6
(let ((name 'disassemble.fn.1))
(fmakunbound name)
(eval `(defun ,name (x) x))
(disassemble-it name))
t nil)
(deftest disassemble.7
(let ((name 'disassemble.fn.2))
(fmakunbound name)
(eval `(defun ,name (x) x))
(compile name)
(disassemble-it name))
t nil)
......@@ -59,3 +59,4 @@
;;; Tests of system construction
(load "features.lsp")
(load "disassemble.lsp")
\ No newline at end of file
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment