get-macro-character.lsp 4.46 KB
Newer Older
pfdietz's avatar
pfdietz committed
1 2 3 4 5 6 7
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sun Jan  2 15:54:27 2005
;;;; Contains: Tests of GET-MACRO-CHARACTER

(in-package :cl-test)

pfdietz's avatar
pfdietz committed
8 9
(compile-and-load "reader-aux.lsp")

pfdietz's avatar
pfdietz committed
10 11
(def-syntax-test get-macro-character.1
  (loop for c across "()';\"`,#"
sds's avatar
sds committed
12 13 14 15 16 17 18 19
        collect
        (let ((vals (multiple-value-list (get-macro-character c))))
          (list
           (=t (length vals) 2)
           (or (notnot (functionp (car vals)))
               (and (symbolp (car vals))
                    (notnot (fboundp (car vals)))))
           (notnot (cadr vals)))))
pfdietz's avatar
pfdietz committed
20 21 22 23 24
  ((t t nil) (t t nil) (t t nil) (t t nil)
   (t t nil) (t t nil) (t t nil) (t t t)))

(def-syntax-test get-macro-character.2
  (loop for c across (concatenate
sds's avatar
sds committed
25 26 27 28 29 30 31 32
                      'string
                      "abcdefghijklmnopqrstuvwxyz"
                      "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
                      "1234567890!@$%^&*_-+={[}]<>?/~")
        for (fn non-term-p) = (multiple-value-list
                               (get-macro-character c))
        unless (or (null fn) non-term-p)
        collect (list c fn non-term-p))
pfdietz's avatar
pfdietz committed
33 34 35 36
  nil)

(def-syntax-test get-macro-character.3
  (loop for rt in (list nil *readtable* (copy-readtable))
sds's avatar
sds committed
37 38 39 40 41 42 43 44 45 46
        collect
        (loop for c across "()';\"`,#"
              collect
              (let ((vals (multiple-value-list (get-macro-character c rt))))
                (list
                 (=t (length vals) 2)
                 (or (notnot (functionp (car vals)))
                     (and (symbolp (car vals))
                          (notnot (fboundp (car vals)))))
                 (notnot (cadr vals))))))
pfdietz's avatar
pfdietz committed
47 48 49 50 51 52 53 54 55
  (((t t nil) (t t nil) (t t nil) (t t nil)
    (t t nil) (t t nil) (t t nil) (t t t))
   ((t t nil) (t t nil) (t t nil) (t t nil)
    (t t nil) (t t nil) (t t nil) (t t t))
   ((t t nil) (t t nil) (t t nil) (t t nil)
    (t t nil) (t t nil) (t t nil) (t t t))))

(def-syntax-test get-macro-character.4
  (loop for rt in (list nil *readtable* (copy-readtable))
sds's avatar
sds committed
56 57 58 59 60 61 62 63 64 65
        nconc
        (loop for c across (concatenate
                            'string
                            "abcdefghijklmnopqrstuvwxyz"
                            "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
                            "1234567890!@$%^&*_-+={[}]<>?/~")
              for (fn non-term-p) = (multiple-value-list
                                     (get-macro-character c rt))
              unless (or (null fn) non-term-p)
              collect (list rt c fn non-term-p)))
pfdietz's avatar
pfdietz committed
66 67 68 69 70 71 72
  nil)

;;; Copying a readtable preserves the reader macros

(def-syntax-test get-macro-character.5
  (let ((rt (copy-readtable)))
    (loop for c across +standard-chars+
sds's avatar
sds committed
73 74 75 76 77 78 79
          for (fn1 ntp1) = (multiple-value-list (get-macro-character c))
          for (fn2 ntp2) = (multiple-value-list (get-macro-character c rt))
          unless (and (or (not (symbolp fn1))
                          (not (symbolp fn2))
                          (eql fn1 fn2))
                      (if ntp1 ntp2 (not ntp2)))
          collect (list c fn1 ntp1 fn2 ntp2)))
pfdietz's avatar
pfdietz committed
80 81 82 83 84
  nil)

(def-syntax-test get-macro-character.6
  (let ((rt (copy-readtable)))
    (loop for i below (min 65536 char-code-limit)
sds's avatar
sds committed
85 86 87 88 89 90 91 92 93 94
          for c = (code-char i)
          for (fn1 ntp1) = (if c (multiple-value-list (get-macro-character c))
                             '(nil nil))
          for (fn2 ntp2) = (if c (multiple-value-list (get-macro-character c rt))
                             '(nil nil))
          unless (and (or (not (symbolp fn1))
                          (not (symbolp fn2))
                          (eql fn1 fn2))
                      (if ntp1 ntp2 (not ntp2)))
          collect (list c fn1 ntp1 fn2 ntp2)))
pfdietz's avatar
pfdietz committed
95 96 97 98 99
  nil)

(def-syntax-test get-macro-character.7
  (let ((rt (copy-readtable)))
    (loop for i = (random (min char-code-limit (ash 1 24)))
sds's avatar
sds committed
100 101 102 103 104 105 106 107 108 109 110
          for c = (code-char i)
          for (fn1 ntp1) = (if c (multiple-value-list (get-macro-character c))
                             '(nil nil))
          for (fn2 ntp2) = (if c (multiple-value-list (get-macro-character c rt))
                             '(nil nil))
          repeat 10000
          unless (and (or (not (symbolp fn1))
                          (not (symbolp fn2))
                          (eql fn1 fn2))
                      (if ntp1 ntp2 (not ntp2)))
          collect (list c fn1 ntp1 fn2 ntp2)))
pfdietz's avatar
pfdietz committed
111 112 113 114 115 116 117 118 119 120 121 122 123 124
  nil)


;;; Error tests

(deftest get-macro-character.error.1
  (signals-error (get-macro-character) program-error)
  t)

(deftest get-macro-character.error.2
  (signals-error (get-macro-character #\; (copy-readtable) nil) program-error)
  t)