Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
ansi-test
ansi-test
Commits
10ba407e
Commit
10ba407e
authored
Apr 14, 2010
by
sds
Browse files
use `collect' instead of `always' to display problematic objects in the error
parent
3d8aea7c
Changes
3
Hide whitespace changes
Inline
Side-by-side
ansi-tests/char-aux.lsp
View file @
10ba407e
...
...
@@ -61,27 +61,26 @@
(eqt (catch-type-error (funcall fn x)) 'type-error)))))
(defun standard-char.5.body ()
(loop for i from 0 below (min 65536 char-code-limit)
alway
s (
le
t (
(c (code
-char
i))
)
(not (and (typep c '
standard-char)
(not (standard-char-p c)))))
))
(loop for i from 0 below (min 65536 char-code-limit)
for c = (code-char i)
unles
s (
no
t (
and (typep c 'standard
-char)
(not (
standard-char
-p c)))
)
collect c
))
(defun extended-char.3.body ()
(loop for i from 0 below (min 65536 char-code-limit)
always (let ((c (code-char i)))
(not (and (typep c 'base-char)
(typep c 'extended-char)
)))))
(loop for i from 0 below (min 65536 char-code-limit) for c = (code-char i)
unless (not (and (typep c 'base-char)
(typep c 'extended-char)))
collect c))
(defun character.1.body ()
(loop for i from 0 below (min 65536 char-code-limit)
always (let ((c (code-char i))
)
(or (null
c)
(
let ((s (string c)))
(and
(eqlt (character
c
) c)
(eqlt (character
s
) c)
(eqlt (character (make-symbol s)) c)))))
))
(loop for i from 0 below (min 65536 char-code-limit)
for c = (code-char i)
unless (or (null c
)
(let ((s (string
c)
))
(
and
(eqlt (character c) c)
(eqlt (character
s
) c)
(eqlt (character
(make-symbol s)
) c)
)))
collect c
))
(defun character.2.body ()
(loop for x in *universe*
...
...
@@ -95,19 +94,20 @@
do (return x)))
(defun characterp.2.body ()
(loop for i from 0 below (min 65536 char-code-limit)
always (let ((c (code-char i)
))
(or (null c) (characterp
c))
)))
(loop for i from 0 below (min 65536 char-code-limit)
for c = (code-char i)
unless (or (null c) (characterp c
))
collect
c))
(defun characterp.3.body ()
(loop for x in *universe*
alway
s (let ((p (characterp x))
unles
s (let ((p (characterp x))
(q (typep x 'character)))
(if p (notnot q) (not q)))))
(if p (notnot q) (not q)))
collect x))
(defun alphanumericp.4.body ()
(loop for x in *universe*
alway
s (or (not (characterp x))
unles
s (or (not (characterp x))
(if (or (digit-char-p x) (alpha-char-p x))
(alphanumericp x)
;; The hyperspec has an example that claims alphanumeric ==
...
...
@@ -115,13 +115,13 @@
;; that there can be numeric characters for which digit-char-p
;; returns NIL. Therefore, I've weakened the next line
;; (not (alphanumericp x))
t
))
))
t
))
collect x
))
(defun alphanumericp.5.body ()
(loop for i from 0 below (min 65536 char-code-limit)
for x = (code-char i)
alway
s (or (not (characterp x))
unles
s (or (not (characterp x))
(if (or (digit-char-p x) (alpha-char-p x))
(alphanumericp x)
;; The hyperspec has an example that claims alphanumeric ==
...
...
@@ -129,8 +129,8 @@
;; that there can be numeric characters for which digit-char-p
;; returns NIL. Therefore, I've weakened the next line
;; (not (alphanumericp x))
t
))
))
t
))
collect x
))
(defun digit-char.1.body.old ()
(loop for r from 2 to 36 always
...
...
@@ -153,110 +153,121 @@
(defun digit-char-p.1.body ()
(loop for x in *universe*
alway
s (not (and (characterp x)
unles
s (not (and (characterp x)
(not (alphanumericp x))
(digit-char-p x)))))
(digit-char-p x)))
collect x))
(defun digit-char-p.2.body ()
(loop for i from 0 below (min 65536 char-code-limit)
for x = (code-char i)
alway
s (or (not x)
unles
s (or (not x)
(not (and (not (alphanumericp x))
(digit-char-p x))))))
(digit-char-p x))))
collect x))
(defun digit-char-p.3.body ()
(loop for r from 2 to 35
always
for bad =
(loop for i from r to 35
for c = (char +extended-digit-chars+ i)
never (or (digit-char-p c r)
(digit-char-p (char-downcase c) r)))))
when (or (digit-char-p c r)
(digit-char-p (char-downcase c) r))
collect i)
when bad collect (cons r bad)))
(defun digit-char-p.4.body ()
(loop for r from 2 to 35
always
for bad =
(loop for i from 0 below r
for c = (char +extended-digit-chars+ i)
always (and (eqlt (digit-char-p c r) i)
(eqlt (digit-char-p (char-downcase c) r) i)))))
unless (and (eqlt (digit-char-p c r) i)
(eqlt (digit-char-p (char-downcase c) r) i))
collect i)
when bad collect (cons r bad)))
(defun standard-char-p.2.body ()
(loop for x in *universe*
alway
s (or (not (characterp x))
unles
s (or (not (characterp x))
(find x +standard-chars+)
(not (standard-char-p x)))))
(not (standard-char-p x)))
collect x))
(defun standard-char-p.2a.body ()
(loop for i from 0 below (min 65536 char-code-limit)
for x = (code-char i)
alway
s (or (not (characterp x))
unles
s (or (not (characterp x))
(find x +standard-chars+)
(not (standard-char-p x)))))
(not (standard-char-p x)))
collect x))
(defun char-upcase.1.body ()
(loop for x in *universe*
always
(or (not (characterp
x))
(let ((u (char-upcase x)))
(and
(or (lower-case-p x) (eqlt u x
))
(eqlt u (char-upcase u)))))
))
unless (or (not (characterp x))
(let ((u (char-upcase
x))
)
(and
(or (lower-case-p x) (eqlt u x))
(eqlt u (char-upcase u)))
))
collect x
))
(defun char-upcase.2.body ()
(loop for i from 0 below (min 65536 char-code-limit)
for x = (code-char i)
always
(or (not x
)
(let ((u (char-upcase x)))
(and
(or (lower-case-p x) (eqlt u x
))
(eqlt u (char-upcase u)))))
))
unless (or (not x)
(let ((u (char-upcase x))
)
(and
(or (lower-case-p x) (eqlt u x))
(eqlt u (char-upcase u)))
))
collect x
))
(defun char-downcase.1.body ()
(loop for x in *universe*
always
(or (not (characterp
x))
(let ((u (char-downcase x)))
(and
(or (upper-case-p x) (eqlt u x
))
(eqlt u (char-downcase u)))))
))
unless (or (not (characterp x))
(let ((u (char-downcase
x))
)
(and
(or (upper-case-p x) (eqlt u x))
(eqlt u (char-downcase u)))
))
collect x
))
(defun char-downcase.2.body ()
(loop for i from 0 below (min 65536 char-code-limit)
for x = (code-char i)
always
(or (not
x)
(let ((u (char-downcase x)))
(and
(or (upper-case-p x) (eqlt u x
))
(eqlt u (char-downcase u)))))
))
unless (or (not x)
(let ((u (char-downcase
x)
))
(and
(or (upper-case-p x) (eqlt u x))
(eqlt u (char-downcase u)))
))
collect x
))
(defun both-case-p.1.body ()
(loop for x in *universe*
alway
s (or (not (characterp x))
unles
s (or (not (characterp x))
(if (both-case-p x)
(and (graphic-char-p x)
(or (upper-case-p x)
(lower-case-p x)))
(not (or (upper-case-p x)
(lower-case-p x)))))))
(lower-case-p x)))))
collect x))
(defun both-case-p.2.body ()
(loop for i from 0 below (min 65536 char-code-limit)
for x = (code-char i)
alway
s (or (not (characterp x))
unles
s (or (not (characterp x))
(if (both-case-p x)
(and (graphic-char-p x)
(or (upper-case-p x)
(lower-case-p x)))
(not (or (upper-case-p x)
(lower-case-p x)))))))
(lower-case-p x)))))
collect x))
(defun char-code.2.body ()
(loop for i from 0 below (min 65536 char-code-limit)
for c = (code-char i)
always (or (not c)
(eqlt (char-code c) i))))
unless (or (not c)
(eqlt (char-code c) i))
collect c))
(defun char-int.2.fn ()
(declare (optimize (safety 3) (speed 1) (space 1)))
...
...
@@ -306,7 +317,7 @@
(declare (optimize (safety 3)))
(loop for x in *universe*
for s = (catch-type-error (string x))
alway
s
unles
s
(or (eqlt s 'type-error)
(let ((c (name-char x)))
(or (not c)
...
...
@@ -318,4 +329,5 @@
(and name
(string-equal name s)))
|#
)))))
)))
collect x))
ansi-tests/name-char.lsp
View file @
10ba407e
...
...
@@ -9,18 +9,19 @@
(deftest name-char.1
(name-char.1.body)
t
)
()
)
(deftest name-char.2
(loop for s in '("RubOut" "PAGe" "BacKspace" "RetUrn" "Tab" "LineFeed"
"SpaCE" "NewLine")
alway
s
unles
s
(let ((c1 (name-char (string-upcase s)))
(c2 (name-char (string-downcase s)))
(c3 (name-char (string-capitalize s)))
(c4 (name-char s)))
(and (eqlt c1 c2) (eqlt c2 c3) (eqlt c3 c4))))
t)
(and (eqlt c1 c2) (eqlt c2 c3) (eqlt c3 c4)))
collect s)
())
(deftest name-char.order.1
(let ((i 0))
...
...
ansi-tests/subtypep-array.lsp
View file @
10ba407e
...
...
@@ -140,7 +140,9 @@
(deftest string-is-not-vector-of-character.1
:notes (:nil-vectors-are-strings)
(subtypep* 'string '(vector character))
(or (subtypep* 'string '(vector character))
(subtypep* 'string '(vector base-char))
(subtypep* 'string '(vector extended-char)))
nil t)
(deftest vector-of-character-is-string.2
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment