diff --git a/data-and-control-flow/defsetf.lsp b/data-and-control-flow/defsetf.lsp index 89d5c58ecf1940e700baa1ff26a8175ec378981b..dc8904b2892110fa22a0ed40979a944823682058 100644 --- a/data-and-control-flow/defsetf.lsp +++ b/data-and-control-flow/defsetf.lsp @@ -154,3 +154,14 @@ (setf (defsetf.6-accessor x) 'c) x)) c (c . b)) + + + +;;; Test that defsetf works with places +(deftest defsetf.7a + (progn + (defsetf access-fn (x) (val-1 val-2) + `(list ,x ,val-1 ,val-2)) + (eval (read-from-string + "(setf (access-fn 1) (values 2 3))"))) + (1 2 3)) diff --git a/doit.lsp b/doit.lsp index b50e4c307a324b0dd66e92f8a7b1d0a1e815cd70..c3be0b96f5643a87caf624de47166b1d58019762 100644 --- a/doit.lsp +++ b/doit.lsp @@ -10,7 +10,13 @@ (let* ((fn (compile-file-pathname "doit.lsp")) (type (pathname-type fn)) (dir-pathname (make-pathname :name :wild :type type)) - (files (directory dir-pathname))) + (subdir-pathname (make-pathname :directory '(:relative :wild) + :name :wild :type type)) + (format-pathname (make-pathname :directory '(:relative "printer/format") + :name :wild :type type)) + (files (append (directory dir-pathname) + (directory subdir-pathname) + (directory format-pathname)))) (assert type) (assert (not (string-equal type "lsp"))) (mapc #'delete-file files)) diff --git a/makefile b/makefile index a10b20e333a48093dc152dbaa5bc522a2557a485..99cb36ff2c5811bcd389a05f88606d7dd10f022e 100644 --- a/makefile +++ b/makefile @@ -136,8 +136,8 @@ rt_1000_8: clean: - @rm -f auxiliary/*.{out,fas,cls,fasl,o,so,~,fn,x86f,ufsl,abcl,lib} - @rm -f sandbox/*.{out,fas,cls,fasl,o,so,~,fn,x86f,ufsl,abcl,lib} + @rm -f */*.{out,fas,cls,fasl,o,so,~,fn,x86f,ufsl,abcl,lib} + @rm -f */*/*.{out,fas,cls,fasl,o,so,~,fn,x86f,ufsl,abcl,lib} @rm -f test*.out *.cls *.fasl *.o *.so *~ *.fn *.x86f *.fasl *.ufsl *.abcl *.fas *.lib \#*\# @rm -f *.dfsl *.d64fsl @(cd beyond-ansi; $(MAKE) clean) diff --git a/reader/readtable-case.lsp b/reader/readtable-case.lsp index 85eec66b1cc71473e1316fd01843598bfa7c35e7..0e9d3a89c311da1458b2d8bfbddf78cccc184261 100644 --- a/reader/readtable-case.lsp +++ b/reader/readtable-case.lsp @@ -5,6 +5,8 @@ (in-package :cl-test) +;;; readtable-case setting + (deftest readtable-case.1 (with-standard-io-syntax (readtable-case *readtable*)) @@ -53,6 +55,35 @@ (list rtc rt2))))) nil) +;; readtable-case reading +(symbol-macrolet ((lookup-table + '(:SYMBOL ("zebra" "Zebra" "ZEBRA" "zebr\\a" "zebr\\A" "ZEBR\\a" "ZEBR\\A" "Zebr\\a" "Zebr\\A") + :UPCASE (|ZEBRA| |ZEBRA| |ZEBRA| |ZEBRa| |ZEBRA| |ZEBRa| |ZEBRA| |ZEBRa| |ZEBRA|) + :DOWNCASE (|zebra| |zebra| |zebra| |zebra| |zebrA| |zebra| |zebrA| |zebra| |zebrA|) + :PRESERVE (|zebra| |Zebra| |ZEBRA| |zebra| |zebrA| |ZEBRa| |ZEBRA| |Zebra| |ZebrA|) + :INVERT (|ZEBRA| |Zebra| |zebra| |ZEBRa| |ZEBRA| |zebra| |zebrA| |Zebra| |ZebrA|)))) + (macrolet + ((def-readtable-case-test (reader-case) + `(deftest ,(make-symbol (concatenate 'string "READTABLE-CASE.CASE-" + (symbol-name reader-case))) + (let ((*readtable* (copy-readtable))) + (setf (readtable-case *readtable*) ,reader-case) + (mapcar #'(lambda (x) + (read-from-string x)) + ',(getf lookup-table :symbol))) + ,(getf lookup-table reader-case)))) + (def-readtable-case-test :upcase) + (def-readtable-case-test :downcase) + (def-readtable-case-test :preserve) + (def-readtable-case-test :invert))) + +;; when readtable was :invert quoted characters may get inverted too +(deftest readtable.case.invert-char + (let ((*readtable* (copy-readtable))) + (setf (readtable-case *readtable*) :invert) + (read-from-string "#\\a")) + #\a 3) + ;;; Error cases (deftest readtable-case.error.1