Commit faddbbd0 authored by pfdietz's avatar pfdietz

Added tests for character-related functions (except character comparisons).

parent 737ba394
......@@ -5,6 +5,11 @@
(in-package :cl-test)
(defun char-type-error-check (fn)
(loop for x in *universe*
always (or (characterp x)
(eq (catch-type-error (funcall fn x)) 'type-error))))
(deftest character-class.1
(subtypep 'character t)
t t)
......@@ -113,11 +118,7 @@
t)
(deftest alpha-char-p.3
(loop for x in *universe*
always (if (characterp x)
(or (find x +alpha-chars+)
(not (alpha-char-p x)))
(eql (catch-type-error (alpha-char-p x)) 'type-error)))
(char-type-error-check #'alpha-char-p)
t)
(deftest alphanumericp.1
......@@ -132,13 +133,10 @@
t)
(deftest alphanumericp.3
(loop for x in *universe*
always (if (characterp x)
(or (find x +alphanumeric-chars+)
(not (alphanumericp x)))
(eql (catch-type-error (alphanumericp x)) 'type-error)))
(char-type-error-check #'alphanumericp)
t)
(deftest alphanumericp.4
(loop for x in *universe*
always (or (not (characterp x))
......@@ -234,9 +232,7 @@
nil)
(deftest graphic-char.3
(loop for x in *universe*
never (and (not (characterp x))
(not (eq (catch-type-error (graphic-char-p x)) 'type-error))))
(char-type-error-check #'graphic-char-p)
t)
(deftest standard-char-p.1
......@@ -259,7 +255,218 @@
t)
(deftest standard-char-p.3
(char-type-error-check #'standard-char-p)
t)
(deftest char-upcase.1
(loop for x in *universe*
always (or (characterp x)
(eq (catch-type-error (standard-char-p x)) 'type-error)))
always
(or (not (characterp x))
(let ((u (char-upcase x)))
(and
(or (lower-case-p x) (eql u x))
(eql u (char-upcase u))))))
t)
(deftest char-upcase.2
(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) (eql u x))
(eql u (char-upcase u))))))
t)
(deftest char-upcase.3
(map 'string #'char-upcase +alpha-chars+)
"ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQRSTUVWXYZ")
(deftest char-upcase.4
(char-type-error-check #'char-upcase)
t)
(deftest char-downcase.1
(loop for x in *universe*
always
(or (not (characterp x))
(let ((u (char-downcase x)))
(and
(or (upper-case-p x) (eql u x))
(eql u (char-downcase u))))))
t)
(deftest char-downcase.2
(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) (eql u x))
(eql u (char-downcase u))))))
t)
(deftest char-downcase.3
(map 'string #'char-downcase +alpha-chars+)
"abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz")
(deftest char-downcase.4
(char-type-error-check #'char-downcase)
t)
(deftest upper-case-p.1
(find-if-not #'upper-case-p +standard-chars+ :start 26 :end 52)
nil)
(deftest upper-case-p.2
(find-if #'upper-case-p +standard-chars+ :end 26)
nil)
(deftest upper-case-p.3
(find #'upper-case-p +standard-chars+ :start 52)
nil)
(deftest upper-case-p.4
(char-type-error-check #'upper-case-p)
t)
(deftest lower-case-p.1
(find-if-not #'lower-case-p +standard-chars+ :end 26)
nil)
(deftest lower-case-p.2
(find-if #'lower-case-p +standard-chars+ :start 26)
nil)
(deftest lower-case-p.3
(char-type-error-check #'lower-case-p)
t)
(deftest both-case-p.1
(loop for x in *universe*
always (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))))))
t)
(deftest both-case-p.2
(loop for i from 0 below (min 65536 char-code-limit)
for x = (code-char i)
always (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))))))
t)
(deftest both-case-p.3
(char-type-error-check #'both-case-p)
t)
(deftest char-code.1
(char-type-error-check #'char-code)
t)
(deftest char-code.2
(loop for i from 0 below (min 65536 char-code-limit)
for c = (code-char i)
always (or (not c)
(eql (char-code c) i)))
t)
(deftest code-char.1
(loop for x across +standard-chars+
always (eql (code-char (char-code x)) x))
t)
(deftest char-int.1
(loop for x across +standard-chars+
always (eql (char-int x) (char-code x)))
t)
(deftest char-int.2
(let ((c->i (make-hash-table :test #'equal))
(i->c (make-hash-table :test #'eql)))
(flet ((%insert
(c)
(or (not (characterp c))
(let* ((i (char-int c))
(j (gethash c c->i))
(d (gethash i i->c)))
(and
(or (null j) (eql j i))
(or (null d) (char= c d))
(progn
(setf (gethash c c->i) i)
(setf (gethash i i->c) c)
t))))))
(and
(loop for i from 0 below char-code-limit
always (%insert (code-char i)))
(every #'%insert +standard-chars+)
(every #'%insert *universe*))))
t)
(deftest char-name.1
(flet ((%check
(c)
(or (not (characterp c))
(let ((name (char-name c)))
(or (null name)
(and (stringp name)
(eql c (name-char name))))))))
(and
(loop for i from 0 below char-code-limit
always (%check (code-char i)))
(every #'%check +standard-chars+)
(every #'%check *universe*)))
t)
(deftest char-name.2
(string= (char-name #\Space) "Space")
t)
(deftest char-name.3
(string= (char-name #\Newline) "Newline")
t)
(deftest char-name.4
(loop for s in '("Rubout" "Page" "Backspace" "Return" "Tab" "Linefeed")
for c = (name-char s)
unless (or (not c) (string= (char-name c) s))
collect (list s c (char-name c)))
nil)
(deftest char-name.5
(char-type-error-check #'char-name)
t)
(deftest name-char.1
(loop for x in *universe*
for s = (catch-type-error (string x))
always
(or (eql s 'type-error)
(let ((c (name-char x)))
(or (not c)
(characterp c)
(string-equal (char-name c) s)))))
t)
(deftest name-char.2
(loop for s in '("RubOut" "PAGe" "BacKspace" "RetUrn" "Tab" "LineFeed"
"SpaCE" "NewLine")
always
(let ((c1 (name-char (string-upcase s)))
(c2 (name-char (string-downcase s)))
(c3 (name-char (string-capitalize s)))
(c4 (name-char s)))
(and (eql c1 c2) (eql c2 c3) (eql c3 c4))))
t)
......@@ -32,8 +32,7 @@
;;; Tests of packages
#|
(compile-file "packages-00.lsp")
(load "packages-00.o")
(compile-and-load "packages-00.lsp")
(load "packages-01.lsp")
(load "packages-02.lsp")
(load "packages-03.lsp")
......@@ -76,8 +75,7 @@
(load "find-if.lsp")
(load "find-if-not.lsp")
(load "position.lsp")
(compile-file "search-aux.lsp")
(load "search-aux.o")
(compile-and-load "search-aux.lsp")
(load "search-list.lsp")
(load "search-vector.lsp")
(load "search-bitvector.lsp")
......@@ -130,3 +128,7 @@
(load "string-comparisons.lsp")
(load "make-string.lsp")
;;; Tests for character functions
(load "character.lsp")
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment