;-*- Mode: Lisp -*- ;;;; Author: Paul Dietz ;;;; Created: Mon Jan 3 10:37:16 2005 ;;;; Contains: Tests of SET-MACRO-CHARACTER (in-package :cl-test) (def-syntax-test set-macro-character.1 (let ((*readtable* (copy-readtable)) (*package* (find-package :cl-test))) (let ((v1 (read-from-string "?!"))) (assert (eql v1 '?!)) (flet ((%f (stream char) (declare (ignore stream)) (assert (eql char #\?)) 17)) (let ((fn #'%f)) (assert (equal (multiple-value-list (set-macro-character #\? fn nil)) '(t))) (values (multiple-value-list (read-from-string "?!")) (multiple-value-list (read-from-string "!?"))))))) (17 1) (! 1)) (def-syntax-test set-macro-character.2 (let ((rt (copy-readtable)) (*package* (find-package :cl-test))) (let ((v1 (read-from-string "?!"))) (assert (eql v1 '?!)) (flet ((%f (stream char) (declare (ignore stream)) (assert (eql char #\?)) 17)) (let ((fn #'%f)) (assert (equal (multiple-value-list (set-macro-character #\? fn t rt)) '(t))) (let ((*readtable* rt)) (values (multiple-value-list (read-from-string "?!")) (multiple-value-list (read-from-string "!?")))))))) (17 1) (!? 2)) (defun set-macro-character.3-test-fn (stream char) (declare (ignore stream)) (assert (eql char #\?)) :foo) (def-syntax-test set-macro-character.3 (let ((*readtable* (copy-readtable)) (*package* (find-package :cl-test))) (let ((v1 (read-from-string "?!")) (fn 'set-macro-character.3-test-fn)) (assert (eql v1 '?!)) (assert (equal (multiple-value-list (set-macro-character #\? fn nil)) '(t))) (values (multiple-value-list (read-from-string "?!")) (multiple-value-list (read-from-string "!?"))))) (:foo 1) (! 1))