source: trunk/source/tests/ansi-tests/disassemble.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 12 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 2.3 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sun May 18 20:47:58 2003
4;;;; Contains: Tests of DISASSEMBLE
5
6(in-package :cl-test)
7
8(defun disassemble-it (fn)
9  (let (val)
10    (values
11     (notnot
12      (stringp
13       (with-output-to-string (*standard-output*)
14                              (setf val (disassemble fn)))))
15     val)))
16
17(deftest disassemble.1
18  (disassemble-it 'car)
19  t nil)
20
21(deftest disassemble.2
22  (disassemble-it (symbol-function 'car))
23  t nil)
24
25(deftest disassemble.3
26  (disassemble-it '(lambda (x y) (cons y x)))
27  t nil)
28
29(deftest disassemble.4
30  (disassemble-it (eval '(function (lambda (x y) (cons x y)))))
31  t nil)
32
33(deftest disassemble.5
34  (disassemble-it
35   (funcall (compile nil '(lambda () (let ((x 0)) #'(lambda () (incf x)))))))
36  t nil)
37
38(deftest disassemble.6
39  (let ((name 'disassemble.fn.1))
40    (fmakunbound name)
41    (eval `(defun ,name (x) x))
42    (disassemble-it name))
43  t nil)
44
45(deftest disassemble.7
46  (let ((name 'disassemble.fn.2))
47    (fmakunbound name)
48    (eval `(defun ,name (x) x))
49    (compile name)
50    (disassemble-it name))
51  t nil)
52
53(deftest disassemble.8
54  (progn
55    (eval '(defun (setf disassemble-example-fn) (val arg)
56             (setf (car arg) val)))
57    (disassemble-it '(setf disassemble-example-fn)))
58  t nil)
59
60(deftest disassemble.9
61  (progn
62    (eval '(defgeneric disassemble-example-fn2 (x y z)))
63    (disassemble-it 'disassemble-example-fn2))
64  t nil)
65
66(deftest disassemble.10
67  (progn
68    (eval '(defgeneric disassemble-example-fn3 (x y z)))
69    (eval '(defmethod disassemble-example-fn3 ((x t)(y t)(z t)) (list x y z)))
70    (disassemble-it 'disassemble-example-fn3))
71  t nil)
72
73(deftest disassemble.11
74  (let ((fn 'disassemble-example-fn4))
75    (when (fboundp fn) (fmakunbound fn))
76    (eval `(defun ,fn (x) x))
77    (let ((is-compiled? (typep (symbol-function fn) 'compiled-function)))
78      (multiple-value-call
79       #'values
80       (disassemble-it fn)
81       (if is-compiled? (notnot (typep (symbol-function fn) 'compiled-function))
82         (not (typep (symbol-function fn) 'compiled-function))))))
83  t nil t)
84
85;;; Error tests
86
87(deftest disassemble.error.1
88  (signals-error (disassemble) program-error)
89  t)
90
91(deftest disassemble.error.2
92  (signals-error (disassemble 'car nil) program-error)
93  t)
94
95(deftest disassemble.error.3
96  (check-type-error #'disassemble
97                    (typef '(or function symbol (cons (eql setf) (cons symbol null)))))
98  nil)
99
Note: See TracBrowser for help on using the repository browser.