source: trunk/source/tests/ansi-tests/get-setf-expansion.lsp @ 8991

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

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

File size: 1.4 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Mon Jan 13 17:05:17 2003
4;;;; Contains: Tests for GET-SETF-EXPANSION
5
6(in-package :cl-test)
7
8(deftest get-setf-expansion.error.1
9  (signals-error (get-setf-expansion) program-error)
10  t)
11
12(deftest get-setf-expansion.error.2
13  (signals-error (get-setf-expansion 'x nil nil) program-error)
14  t)
15
16;;; FIXME
17;;; Tests for proper behavior will go here
18;;; There are tests in DEFINE-SETF-EXPANDER too
19
20;;; For a function on which the setf expansion is otherwise
21;;; undefined, produce a call to #'(setf <fn>).  Note: this
22;;; form has to be present, since portable code walkers may
23;;; grovel over the setf expansion (sorry, clisp).
24
25(deftest get-setf-expansion.1
26  (let* ((fn (gensym))
27         (vals (multiple-value-list (get-setf-expansion (list fn)))))
28    (values
29     (length vals)
30     (first  vals)
31     (second vals)
32     (length (third vals))
33     (block done
34       (subst-if nil
35                 #'(lambda (term)
36                     (when (equal term `(function (setf ,fn)))
37                       (return-from done :good)))
38                 (fourth vals)))
39     (if (equal (fifth vals) (list fn))
40         :good
41       (fifth vals))))
42  5 nil nil 1 :good :good)
43
44(deftest get-setf-expansion.2
45  (let* ((fn (gensym))
46         (vals (multiple-value-list (get-setf-expansion (list fn) nil))))
47    (length vals))
48  5)
49
50(deftest get-setf-expansion.3
51  (let* ((var (gensym))
52         (vals (multiple-value-list (get-setf-expansion var))))
53    (length vals))
54  5)
Note: See TracBrowser for help on using the repository browser.