set-syntax-from-char.lsp 3.41 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Jan 29 06:37:18 2005
;;;; Contains: Tests of SET-SYNTAX-FROM-CHAR

(in-package :cl-test)

(compile-and-load "reader-aux.lsp")

(defmacro def-set-syntax-from-char-test (name form &body expected-values)
  `(deftest ,name
     (with-standard-io-syntax
      (let ((*readtable* (copy-readtable nil)))
	(setf (readtable-case *readtable*) :preserve)
	,form))
     ,@expected-values))

;;; Test that constituent traits are not altered when a constituent character
;;; syntax type is set

(defmacro def-set-syntax-from-char-trait-test (c test-form expected-value)
  (setq c (typecase c
	    (character c)
	    ((or string symbol) (name-char (string c)))
	    (t nil)))
  (when c
    (format t "~A ~A~%" c (char-name c))
    `(def-set-syntax-from-char-test
       ,(intern (concatenate 'string "SET-SYNTAX-FROM-CHAR-TRAIT-X-" (or (char-name c)
									 (string c)))
		:cl-test)
       (let ((c ,c))
	 (values
	  (set-syntax-from-char c #\X)
	  ,test-form))
       t ,expected-value)))

(defmacro def-set-syntax-from-char-alphabetic-trait-test (c)
  `(def-set-syntax-from-char-trait-test ,c
     (let* ((*package* (find-package "CL-TEST"))
	    (sym (read-from-string (string c))))
       (list (let ((sym2 (find-symbol (string c))))
	       (or (eqt sym sym2)
		   (list sym sym2)))
	     (or (equalt (symbol-name sym) (string c))
		 (list (symbol-name sym) (string c)))))
     (t t)))

49
(loop for c across "\\|!\"#$%&'()*,;<=>?@[]^_`~{}+-/abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
50
51
      do (eval `(def-set-syntax-from-char-alphabetic-trait-test ,c)))

52
53
54
;;; The invalid constituent character trait of invalid and whitespace characters
;;; is exposed when they are turned into constituent characters

55
56
(defmacro def-set-syntax-from-char-invalid-trait-test (c)
  `(def-set-syntax-from-char-trait-test ,c
57
58
59
60
61
62
     (handler-case
      (let* ((*package* (find-package "CL-TEST"))
	     (sym (read-from-string (concatenate 'string (string c) "Z"))))
	sym)
      (reader-error (c) (declare (ignore c)) :good))
     :good))
63
64
65
66

(loop for name in '("Backspace" "Tab" "Newline" "Linefeed" "Page" "Return" "Space" "Rubout")
      do (eval `(def-set-syntax-from-char-invalid-trait-test ,name)))

67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
;;; Turning characters into single escape characters

(deftest set-syntax-from-char.single-escape
  (loop for c across +standard-chars+
	nconc
	(with-standard-io-syntax
	 (let ((*readtable* (copy-readtable nil))
	       (*package* (find-package "CL-TEST")))
	   (setf (readtable-case *readtable*) :preserve)
	   (let ((results
		  (list
		   (set-syntax-from-char c #\\)
		   (read-from-string (concatenate 'string (list c #\Z))))))
	     (unless (equal results '(t |Z|))
	       (list c results))))))
  nil)

(deftest set-syntax-from-char.multiple-escape.1
  (loop for c across +standard-chars+
	nconc
	(with-standard-io-syntax
	 (let ((*readtable* (copy-readtable nil))
	       (*package* (find-package "CL-TEST")))
	   (setf (readtable-case *readtable*) :preserve)
	   (let ((results
		  (list
		   (set-syntax-from-char c #\|)
		   (handler-case
		    (read-from-string (concatenate 'string (list c #\Z c)))
		    (error (c) c))
		   (handler-case
		    (read-from-string (concatenate 'string (list c #\Z #\|)))
		    (error (c) c))
		   (handler-case
		    (read-from-string (concatenate 'string (list #\| #\Z c)))
		    (error (c) c)))))
	     (unless (or (eql c #\Z) (equal results '(t |Z| |Z| |Z|)))
	       (list c results))))))
  nil)