source: trunk/source/tests/ansi-tests/get-macro-character.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: 3.7 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sun Jan  2 15:54:27 2005
4;;;; Contains: Tests of GET-MACRO-CHARACTER
5
6(in-package :cl-test)
7
8(compile-and-load "reader-aux.lsp")
9
10(def-syntax-test get-macro-character.1
11  (loop for c across "()';\"`,#"
12        collect
13        (let ((vals (multiple-value-list (get-macro-character c))))
14          (list
15           (=t (length vals) 2)
16           (or (notnot (functionp (car vals)))
17               (and (symbolp (car vals))
18                    (notnot (fboundp (car vals)))))
19           (notnot (cadr vals)))))
20  ((t t nil) (t t nil) (t t nil) (t t nil)
21   (t t nil) (t t nil) (t t nil) (t t t)))
22
23(def-syntax-test get-macro-character.2
24  (loop for c across (concatenate
25                      'string
26                      "abcdefghijklmnopqrstuvwxyz"
27                      "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
28                      "1234567890!@$%^&*_-+={[}]<>?/~")
29        for (fn non-term-p) = (multiple-value-list
30                               (get-macro-character c))
31        unless (or (null fn) non-term-p)
32        collect (list c fn non-term-p))
33  nil)
34
35(def-syntax-test get-macro-character.3
36  (loop for rt in (list nil *readtable* (copy-readtable))
37        collect
38        (loop for c across "()';\"`,#"
39              collect
40              (let ((vals (multiple-value-list (get-macro-character c rt))))
41                (list
42                 (=t (length vals) 2)
43                 (or (notnot (functionp (car vals)))
44                     (and (symbolp (car vals))
45                          (notnot (fboundp (car vals)))))
46                 (notnot (cadr vals))))))
47  (((t t nil) (t t nil) (t t nil) (t t nil)
48    (t t nil) (t t nil) (t t nil) (t t t))
49   ((t t nil) (t t nil) (t t nil) (t t nil)
50    (t t nil) (t t nil) (t t nil) (t t t))
51   ((t t nil) (t t nil) (t t nil) (t t nil)
52    (t t nil) (t t nil) (t t nil) (t t t))))
53
54(def-syntax-test get-macro-character.4
55  (loop for rt in (list nil *readtable* (copy-readtable))
56        nconc
57        (loop for c across (concatenate
58                            'string
59                            "abcdefghijklmnopqrstuvwxyz"
60                            "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
61                            "1234567890!@$%^&*_-+={[}]<>?/~")
62              for (fn non-term-p) = (multiple-value-list
63                                     (get-macro-character c rt))
64              unless (or (null fn) non-term-p)
65              collect (list rt c fn non-term-p)))
66  nil)
67
68;;; Copying a readtable preserves the reader macros
69
70(def-syntax-test get-macro-character.5
71  (let ((rt (copy-readtable)))
72    (loop for c across +standard-chars+
73          for (fn1 ntp1) = (multiple-value-list (get-macro-character c))
74          for (fn2 ntp2) = (multiple-value-list (get-macro-character c rt))
75          unless (and (or (not (symbolp fn1))
76                          (not (symbolp fn2))
77                          (eql fn1 fn2))
78                      (if ntp1 ntp2 (not ntp2)))
79          collect (list c fn1 ntp1 fn2 ntp2)))
80  nil)
81
82(def-syntax-test get-macro-character.6
83  (let ((rt (copy-readtable)))
84    (loop for i below (min 65536 char-code-limit)
85          for c = (code-char i)
86          for (fn1 ntp1) = (if c (multiple-value-list (get-macro-character c))
87                             '(nil nil))
88          for (fn2 ntp2) = (if c (multiple-value-list (get-macro-character c rt))
89                             '(nil nil))
90          unless (and (or (not (symbolp fn1))
91                          (not (symbolp fn2))
92                          (eql fn1 fn2))
93                      (if ntp1 ntp2 (not ntp2)))
94          collect (list c fn1 ntp1 fn2 ntp2)))
95  nil)
96
97(def-syntax-test get-macro-character.7
98  (let ((rt (copy-readtable)))
99    (loop for i = (random (min char-code-limit (ash 1 24)))
100          for c = (code-char i)
101          for (fn1 ntp1) = (if c (multiple-value-list (get-macro-character c))
102                             '(nil nil))
103          for (fn2 ntp2) = (if c (multiple-value-list (get-macro-character c rt))
104                             '(nil nil))
105          repeat 10000
106          unless (and (or (not (symbolp fn1))
107                          (not (symbolp fn2))
108                          (eql fn1 fn2))
109                      (if ntp1 ntp2 (not ntp2)))
110          collect (list c fn1 ntp1 fn2 ntp2)))
111  nil)
112
113
114;;; Error tests
115
116(deftest get-macro-character.error.1
117  (signals-error (get-macro-character) program-error)
118  t)
119
120(deftest get-macro-character.error.2
121  (signals-error (get-macro-character #\; (copy-readtable) nil) program-error)
122  t)
123
124
Note: See TracBrowser for help on using the repository browser.