disassemble.lsp 1.93 KB
Newer Older
pfdietz's avatar
pfdietz committed
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
;-*- 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
30
  (disassemble-it (eval '(function (lambda (x y) (cons x y)))))
pfdietz's avatar
pfdietz committed
31
32
33
  t nil)

(deftest disassemble.5
34
35
  (disassemble-it
   (funcall (compile nil '(lambda () (let ((x 0)) #'(lambda () (incf x)))))))
pfdietz's avatar
pfdietz committed
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
  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)
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71

(deftest disassemble.8
  (progn
    (eval '(defun (setf disassemble-example-fn) (val arg)
	     (setf (car arg) val)))
    (disassemble-it '(setf disassemble-example-fn)))
  t nil)

(deftest disassemble.9
  (progn
    (eval '(defgeneric disassemble-example-fn2 (x y z)))
    (disassemble-it 'disassemble-example-fn2))
  t nil)

(deftest disassemble.10
  (progn
    (eval '(defgeneric disassemble-example-fn3 (x y z)))
    (eval '(defmethod disassemble-example-fn3 ((x t)(y t)(z t)) (list x y z)))
    (disassemble-it 'disassemble-example-fn3))
  t nil)
pfdietz's avatar
pfdietz committed
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87

;;; Error tests

(deftest disassemble.error.1
  (signals-error (disassemble) program-error)
  t)

(deftest disassemble.error.2
  (signals-error (disassemble 'car nil) program-error)
  t)

(deftest disassemble.error.3
  (check-type-error #'disassemble
		    (typef '(or function symbol (cons (eql setf) (cons symbol null)))))
  nil)