← Back to branch summary

~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

« back to all changes in this revision

Viewing changes to ansi-tests/disassemble.lsp

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2004-06-24 15:13:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040624151346-xh0xaaktyyp7aorc
Tags: 2.7.0-26
C_GC_OFFSET is 2 on m68k-linux

Show diffs side-by-side

added added

removed removed

Lines of Context:
ansi-tests/disassemble.lsp
 
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)