Commit 3d6555c8 authored by pfdietz's avatar pfdietz

Added FBOUNDP tests. Fixed some (SETF ...) tests. Added tests of SETF/SETQ on symbol macros.

parent 20de4186
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Mon Oct 7 22:37:22 2002
;;;; Contains: Tests of FBOUNDP
(in-package :cl-test)
(deftest fboundp.1
(not (fboundp 'car))
nil)
(deftest fboundp.2
(not (fboundp 'cdr))
nil)
(deftest fboundp.3
(not (fboundp 'defun)) ; a macro
nil)
(deftest fboundp.4
;; fresh symbols are not fbound
(let ((g (gensym))) (fboundp g))
nil)
(defun fboundp-5-fn (x) x)
(deftest fboundp.5
(not (fboundp 'fboundp-5-fn))
nil)
(eval-when (eval compile)
(ignore-errors
(defun (setf fboundp-6-accessor) (y x) (setf (car x) y))))
(deftest fboundp.6
(not (fboundp '(setf fboundp-6-accessor)))
nil)
(deftest fboundp.7
(let ((g (gensym))) (fboundp (list 'setf g)))
nil)
......@@ -39,8 +39,9 @@
(typep '(lambda (x) x) 'function)
nil)
(defun function-7-accessor-fn (x y) (setf (car x) y) y)
(defsetf function-7-accessor function-7-accessor-fn)
(eval-when (eval compile)
(ignore-errors
(defun (setf function-7-accessor) (y x) (setf (car x) y) y)))
(deftest function.7
(not (typep #'(setf function-7-accessor) 'function))
......
......@@ -39,8 +39,9 @@
(functionp '(lambda (x) x))
nil)
(defun functionp-7-accessor-fn (x y) (setf (car x) y) y)
(defsetf functionp-7-accessor functionp-7-accessor-fn)
(eval-when (eval compile)
(ignore-errors
(defun (setf functionp-7-accessor) (y x) (setf (car x) y) y)))
(deftest functionp.7
(not (functionp #'(setf functionp-7-accessor)))
......
......@@ -8,6 +8,7 @@
(load "places.lsp")
(load "constantly.lsp")
(load "complement.lsp")
(load "fboundp.lsp")
(load "function.lsp")
(load "functionp.lsp")
(load "lambda-list-keywords.lsp")
......
......@@ -235,4 +235,17 @@
(values (setf (%m x) 2)
(1+ (car x)))))
2 3)
\ No newline at end of file
;;; section 5.1.2.8 -- symbol macros
(deftest setf-symbol-macro.1
(symbol-macrolet ((x y))
(let ((y nil))
(values (setf x 1) x y)))
1 1 1)
;;; Symbol macros in SETQs are treated as if the form were a SETF
(deftest setf-symbol-macro.2
(symbol-macrolet ((x y))
(let ((y nil))
(values (setq x 1) x y)))
1 1 1)
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