Commit e76a7457 authored by pfdietz's avatar pfdietz

Begin adding tests for ~{ ~}

Move some string tests to their own more properly named files.
Add more tests for specialized strings.
parent 34ceedd8
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sun Aug 29 17:26:57 2004
;;;; Contains: Tests associated with BASE-STRING
(in-package :cl-test)
(deftest base-string.1
(subtypep* 'base-string 'string)
t t)
(deftest base-string.2
(subtypep* 'base-string 'vector)
t t)
(deftest base-string.3
(subtypep* 'base-string 'array)
t t)
(deftest base-string.4
(subtypep* 'base-string 'sequence)
t t)
(deftest base-string.5
(subtypep* '(array nil (*)) 'base-string)
nil t)
(deftest base-string.6
:notes (:nil-vectors-are-strings)
(subtypep* 'string 'base-string)
nil t)
......@@ -617,35 +617,3 @@
(deftest char-name.error.2
(signals-error (char-name #\a #\a) program-error)
t)
;;;
(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")
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 (eqlt c1 c2) (eqlt c2 c3) (eqlt c3 c4))))
t)
(deftest name-char.order.1
(let ((i 0))
(values
(name-char (progn (incf i) "Space"))
i))
#\Space 1)
(deftest name-char.error.1
(signals-error (name-char) program-error)
t)
(deftest name-char.error.2
(signals-error (name-char "space" "space") program-error)
t)
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Wed Aug 25 22:08:51 2004
;;;; Contains: Tests of the ~{ ... ~} format directives
(in-package :cl-test)
(compile-and-load "printer-aux.lsp")
(deftest format.{.1
(format nil "~{~
~}" nil)
"")
(deftest format.{.2
(format nil "~{ ~}" nil)
"")
(deftest format.{.3
(format nil "~{X Y Z~}" nil)
"")
(deftest format.{.4
(format nil "~{~A~}" '(1 2 3 4))
"1234")
(deftest format.{.5
(format nil "~{~{~A~}~}" '((1 2 3)(4 5)(6 7 8)))
"12345678")
(deftest format.{.6
(format nil "~{~1{~A~}~}" '((1 2 3)(4 5)(6 7 8)))
"146")
(deftest format.{.7
(format nil "~1{~
~}" nil)
"")
(deftest format.{.8
(loop for i from 0 to 10
for s = (format nil "~v{~A~}" i '(1 2 3 4 5 6 7 8 9 0))
unless (string= s (subseq "1234567890" 0 i))
collect (list i s))
nil)
(deftest format.{.9
(format nil "~#{~A~}" '(1 2 3 4 5 6 7) nil nil nil)
"1234")
;;; ~:{ ... ~}
(deftest format.\:{.1
(format nil "~:{(~A ~A)~}" '((1 2 3)(4 5)(6 7 8)))
"(1 2)(4 5)(6 7)")
......@@ -50,6 +50,7 @@
(compile-and-load "char-aux.lsp")
(load "character.lsp")
(load "char-compare.lsp")
(load "name-char.lsp")
;;; Tests of pathnames
(load "load-pathnames.lsp")
......
......@@ -41,3 +41,4 @@
;;; 22.3.7
(load "format-goto.lsp")
(load "format-conditional.lsp")
(load "format-brace.lsp")
......@@ -2,6 +2,11 @@
(load "char-schar.lsp")
(load "string.lsp")
(load "base-string.lsp")
(load "simple-string.lsp")
(load "simple-base-string.lsp")
(load "simple-string-p.lsp")
(load "stringp.lsp")
(load "string-upcase.lsp")
(load "string-downcase.lsp")
(load "string-capitalize.lsp")
......
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sun Aug 29 17:14:03 2004
;;;; Contains: Tests of NAME-CHAR
(in-package :cl-test)
(compile-and-load "char-aux.lsp")
(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")
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 (eqlt c1 c2) (eqlt c2 c3) (eqlt c3 c4))))
t)
(deftest name-char.order.1
(let ((i 0))
(values
(name-char (progn (incf i) "Space"))
i))
#\Space 1)
;;; Specialized sequence tests
(deftest name-char.specialized.1
(loop for etype in '(standard-char base-char character)
append
(loop for s in '("Rubout" "Page" "Backspace" "Return" "Tab" "Linefeed"
"Space" "Newline")
for s2 = (make-array (length s) :element-type 'base-char
:initial-contents s)
unless (eql (name-char s) (name-char s2))
collect (list s s2)))
nil)
(deftest name-char.specialized.2
(loop for etype in '(standard-char base-char character)
append
(loop for s in '("Rubout" "Page" "Backspace" "Return" "Tab" "Linefeed"
"Space" "Newline")
for s2 = (make-array (length s) :element-type etype
:adjustable t
:initial-contents s)
unless (eql (name-char s) (name-char s2))
collect (list etype s s2)))
nil)
(deftest name-char.specialized.3
(loop for etype in '(standard-char base-char character)
append
(loop for s in '("Rubout" "Page" "Backspace" "Return" "Tab" "Linefeed"
"Space" "Newline")
for s2 = (make-array (+ 3 (length s)) :element-type etype
:fill-pointer (length s)
:initial-contents (concatenate 'string s " "))
unless (eql (name-char s) (name-char s2))
collect (list etype s s2)))
nil)
(deftest name-char.specialized.4
(loop for etype in '(standard-char base-char character)
append
(loop for s in '("Rubout" "Page" "Backspace" "Return" "Tab" "Linefeed"
"Space" "Newline")
for s1 = (make-array (+ 4 (length s)) :element-type etype
:initial-contents (concatenate 'string " " s " "))
for s2 = (make-array (length s) :element-type etype
:displaced-to s1 :displaced-index-offset 2)
unless (eql (name-char s) (name-char s2))
collect (list etype s s2)))
nil)
;;; Error tests
(deftest name-char.error.1
(signals-error (name-char) program-error)
t)
(deftest name-char.error.2
(signals-error (name-char "space" "space") program-error)
t)
......@@ -7,6 +7,53 @@
;;; Most tests of this function are in files for other package-related operators
;;; Specialized sequence tests
(defmacro def-package-shadowing-symbols-test (test-name name-form)
`(deftest ,test-name
(let ((name ,name-form))
(safely-delete-package name)
(let ((p (make-package name :use nil)))
(package-shadowing-symbols p)))
nil))
(def-package-shadowing-symbols-test package-shadowing-symbols.1
(make-array 5 :element-type 'base-char :initial-contents "TEST1"))
(def-package-shadowing-symbols-test package-shadowing-symbols.2
(make-array 10 :element-type 'base-char
:fill-pointer 5
:initial-contents "TEST1?????"))
(def-package-shadowing-symbols-test package-shadowing-symbols.3
(make-array 10 :element-type 'character
:fill-pointer 5
:initial-contents "TEST1?????"))
(def-package-shadowing-symbols-test package-shadowing-symbols.4
(make-array 5 :element-type 'base-char :adjustable t
:initial-contents "TEST1"))
(def-package-shadowing-symbols-test package-shadowing-symbols.5
(make-array 5 :element-type 'character :adjustable t
:initial-contents "TEST1"))
(def-package-shadowing-symbols-test package-shadowing-symbols.6
(let* ((etype 'base-char)
(name0 (make-array 10 :element-type etype
:initial-contents "XXTEST1XXX")))
(make-array 5 :element-type etype :displaced-to name0
:displaced-index-offset 2)))
(def-package-shadowing-symbols-test package-shadowing-symbols.7
(let* ((etype 'character)
(name0 (make-array 10 :element-type etype
:initial-contents "XXTEST1XXX")))
(make-array 5 :element-type etype :displaced-to name0
:displaced-index-offset 2)))
;;; Error tests
(deftest package-shadowing-symbols.error.1
(signals-error (package-shadowing-symbols) program-error)
t)
......
......@@ -217,6 +217,17 @@
(multiple-value-list (parse-integer s2))))
"123" 3 t (123 3))
(deftest parse-integer.28a
(let* ((s (make-array 5 :initial-contents "a123b" :element-type 'character))
(s2 (make-array 3 :displaced-to s :displaced-index-offset 1
:element-type 'character)))
(values
s2
(length s2)
(equalpt "123" s2)
(multiple-value-list (parse-integer s2))))
"123" 3 t (123 3))
(deftest parse-integer.29
(let ((s (make-array 10 :initial-contents "1234567890"
:fill-pointer 3
......@@ -226,6 +237,15 @@
(multiple-value-list (parse-integer s))))
3 (123 3))
(deftest parse-integer.29a
(let ((s (make-array 10 :initial-contents "1234567890"
:fill-pointer 3
:element-type 'character)))
(values
(length s)
(multiple-value-list (parse-integer s))))
3 (123 3))
(deftest parse-integer.30
(let ((s (make-array 10 :initial-contents "1234567890"
:adjustable t
......@@ -240,6 +260,20 @@
(1234567890 10)
(123 3))
(deftest parse-integer.30a
(let ((s (make-array 10 :initial-contents "1234567890"
:adjustable t
:element-type 'character)))
(values
(length s)
(multiple-value-list (parse-integer s))
(progn
(adjust-array s 3 :element-type 'character)
(multiple-value-list (parse-integer s)))))
10
(1234567890 10)
(123 3))
(deftest parse-integer.31
(parse-integer "1234" :start 1)
234 4)
......
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sun Aug 29 17:30:40 2004
;;;; Contains: Tests associated with SIMPLE-BASE-STRING
(in-package :cl-test)
(deftest simple-base-string.1
(subtypep* 'simple-base-string 'string)
t t)
(deftest simple-base-string.2
(subtypep* 'simple-base-string 'vector)
t t)
(deftest simple-base-string.3
(subtypep* 'simple-base-string 'simple-array)
t t)
(deftest simple-base-string.4
(subtypep* 'simple-base-string 'array)
t t)
(deftest simple-base-string.5
(subtypep* 'simple-base-string 'sequence)
t t)
(deftest simple-base-string.6
(subtypep* 'simple-base-string 'base-string)
t t)
(deftest simple-base-string.7
(subtypep* 'simple-base-string 'simple-string)
t t)
(deftest simple-base-string.8
(subtypep* 'simple-base-string 'simple-vector)
nil t)
(deftest simple-base-string.9
(subtypep* '(simple-array nil (*)) 'simple-base-string)
nil t)
(deftest simple-base-string.10
(typep* (make-array '(0) :element-type nil) 'simple-base-string)
nil)
(deftest simple-base-string.11
(typep* (make-array '(12) :element-type nil) 'simple-base-string)
nil)
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sun Aug 29 17:31:24 2004
;;;; Contains: Tests of SIMPLE-STRING-P
(in-package :cl-test)
(deftest simple-string-p.1
(loop for x in *universe*
always (if (typep x 'simple-string)
(simple-string-p x)
(not (simple-string-p x))))
t)
(deftest simple-string-p.2
(notnot-mv (simple-string-p "ancd"))
t)
(deftest simple-string-p.3
(simple-string-p 0)
nil)
(deftest simple-string-p.4
(simple-string-p (make-array 4 :element-type 'character
:initial-contents '(#\a #\a #\a #\b)
:fill-pointer t))
nil)
(deftest simple-string-p.5
(notnot-mv
(simple-string-p (make-array
4 :element-type 'base-char
:initial-contents '(#\a #\a #\a #\b))))
t)
(deftest simple-string-p.6
(notnot-mv
(simple-string-p (make-array
4 :element-type 'standard-char
:initial-contents '(#\a #\a #\a #\b))))
t)
(deftest simple-string-p.7
(let* ((s (make-array 10 :element-type 'character
:initial-element #\a))
(s2 (make-array 4 :element-type 'character
:displaced-to s
:displaced-index-offset 2)))
(simple-string-p s2))
nil)
(deftest simple-string-p.8
:notes (:nil-vectors-are-strings)
(notnot-mv (simple-string-p (make-array '(0) :element-type nil)))
t)
(deftest simple-string-p.9
:notes (:nil-vectors-are-strings)
(notnot-mv (simple-string-p (make-array '(37) :element-type nil)))
t)
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sun Aug 29 17:27:46 2004
;;;; Contains: Tests associated with SIMPLE-STRING
(in-package :cl-test)
(deftest simple-string.1
(subtypep* 'simple-string 'string)
t t)
(deftest simple-string.2
(subtypep* 'simple-string 'vector)
t t)
(deftest simple-string.3
(subtypep* 'simple-string 'simple-array)
t t)
(deftest simple-string.4
(subtypep* 'simple-string 'array)
t t)
(deftest simple-string.5
(subtypep* 'simple-string 'sequence)
t t)
(deftest simple-string.6
(subtypep* 'simple-string '(simple-array * (*)))
t t)
(deftest simple-string.7
(subtypep* 'simple-string '(simple-array * 1))
t t)
(deftest simple-string.8
:notes (:nil-vectors-are-strings)
(subtypep* 'simple-string '(simple-array character (*)))
nil t)
(deftest simple-string.9
:notes (:nil-vectors-are-strings)
(subtypep* 'simple-string '(simple-array base-char (*)))
nil t)
(deftest simple-string.10
:notes (:nil-vectors-are-strings)
(subtypep* 'simple-string 'simple-base-string)
nil t)
(deftest simple-string.11
:notes (:nil-vectors-are-strings)
(subtypep* '(simple-array nil (*)) 'simple-string)
t t)
(deftest simple-string.12
:notes (:nil-vectors-are-strings)
(typep* (make-array '(0) :element-type nil) 'simple-string)
t)
(deftest simple-string.13
:notes (:nil-vectors-are-strings)
(typep* (make-array '(12) :element-type nil) 'simple-string)
t)
......@@ -67,246 +67,45 @@
(typep* (make-array '(0) :element-type nil) 'string)
t)
;;; Tests of base-string
(deftest base-string.1
(subtypep* 'base-string 'string)
t t)
(deftest base-string.2
(subtypep* 'base-string 'vector)
t t)
(deftest base-string.3
(subtypep* 'base-string 'array)
t t)
(deftest base-string.4
(subtypep* 'base-string 'sequence)
t t)
(deftest base-string.5
(subtypep* '(array nil (*)) 'base-string)
nil t)
(deftest base-string.6
:notes (:nil-vectors-are-strings)
(subtypep* 'string 'base-string)
nil t)
;;; Tests of simple-string
(deftest simple-string.1
(subtypep* 'simple-string 'string)
t t)
(deftest simple-string.2
(subtypep* 'simple-string 'vector)
t t)
(deftest simple-string.3
(subtypep* 'simple-string 'simple-array)
t t)
(deftest simple-string.4
(subtypep* 'simple-string 'array)
t t)
(deftest simple-string.5
(subtypep* 'simple-string 'sequence)
t t)
(deftest simple-string.6
(subtypep* 'simple-string '(simple-array * (*)))
t t)
(deftest simple-string.7
(subtypep* 'simple-string '(simple-array * 1))
t t)
(deftest simple-string.8
:notes (:nil-vectors-are-strings)
(subtypep* 'simple-string '(simple-array character (*)))
nil t)
(deftest simple-string.9
:notes (:nil-vectors-are-strings)
(subtypep* 'simple-string '(simple-array base-char (*)))
nil t)
(deftest simple-string.10
:notes (:nil-vectors-are-strings)
(subtypep* 'simple-string 'simple-base-string)
nil t)
(deftest simple-string.11
:notes (:nil-vectors-are-strings)
(subtypep* '(simple-array nil (*)) 'simple-string)
t t)
(deftest simple-string.12
:notes (:nil-vectors-are-strings)
(typep* (make-array '(0) :element-type nil) 'simple-string)
t)
(deftest simple-string.13
:notes (:nil-vectors-are-strings)
(typep* (make-array '(12) :element-type nil) 'simple-string)
t)
;;; Tests for simple-base-string
(deftest simple-base-string.1
(subtypep* 'simple-base-string 'string)
t t)
(deftest simple-base-string.2
(subtypep* 'simple-base-string 'vector)
t t)
(deftest simple-base-string.3
(subtypep* 'simple-base-string 'simple-array)
t t)
(deftest simple-base-string.4
(subtypep* 'simple-base-string 'array)
t t)
(deftest simple-base-string.5
(subtypep* 'simple-base-string 'sequence)
t t)
(deftest simple-base-string.6
(subtypep* 'simple-base-string 'base-string)
t t)
(deftest simple-base-string.7
(subtypep* 'simple-base-string 'simple-string)
t t)
(deftest simple-base-string.8
(subtypep* 'simple-base-string 'simple-vector)
nil t)
(deftest simple-base-string.9
(subtypep* '(simple-array nil (*)) 'simple-base-string)
nil t)
(deftest simple-base-string.10
(typep* (make-array '(0) :element-type nil) 'simple-base-string)
(deftest string.14
(let ((count 0))
(loop for i below (min char-code-limit 65536)
for c = (code-char i)
for s = (and c (string c))
when (and c
(or (not (stringp s))
(not (= (length s) 1))
(not (eql c (char s 0)))))
collect (progn (incf count) (list i c s))
until (>= count 100)))
nil)
(deftest simple-base-string.11
(typep* (make-array '(12) :element-type nil) 'simple-base-string)
(deftest string.15
(when (> char-code-limit 65536)
(loop for i = (random char-code-limit)
for c = (code-char i)
for s = (and c (string c))