Skip to content
Snippets Groups Projects
Commit e76a7457 authored by pfdietz's avatar pfdietz
Browse files

Begin adding tests for ~{ ~}

Move some string tests to their own more properly named files.
Add more tests for specialized strings.
parent 34ceedd8
No related branches found
No related tags found
No related merge requests found
;-*- 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))
repeat 2000
when (and c
(or (not (stringp s))
(not (= (length s) 1))
(not (eql c (char s 0)))))
collect (list i c s)))
nil)
;;; Tests for simple-string-p
(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)
(deftest string.16
(loop for s in *universe*
when (and (stringp s)
(not (eq s (string s))))
collect s)
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)
;;; Error tests
(deftest simple-string-p.8
:notes (:nil-vectors-are-strings)
(notnot-mv (simple-string-p (make-array '(0) :element-type nil)))
(deftest string.error.1
(signals-error (string) program-error)
t)
(deftest simple-string-p.9
:notes (:nil-vectors-are-strings)
(notnot-mv (simple-string-p (make-array '(37) :element-type nil)))
t)
;;; Tests of stringp
(deftest stringp.1
(loop for x in *universe*
always (if (typep x 'string)
(stringp x)
(not (stringp x))))
t)
(deftest stringp.2
(notnot (stringp "abcd"))
t)
(deftest stringp.3
(notnot (stringp (make-array 4 :element-type 'character
:initial-contents '(#\a #\b #\c #\d))))
t)
(deftest stringp.4
(notnot (stringp (make-array 4 :element-type 'base-char
:initial-contents '(#\a #\b #\c #\d))))
t)
(deftest stringp.5
(notnot (stringp (make-array 4 :element-type 'standard-char
:initial-contents '(#\a #\b #\c #\d))))
t)
(deftest stringp.6
(stringp 0)
nil)
(deftest stringp.7
(stringp #\a)
nil)
(deftest stringp.8
(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)))
(notnot (stringp s2)))
t)
(deftest stringp.9
:notes (:nil-vectors-are-strings)
(notnot-mv (stringp (make-array '(0) :element-type nil)))
t)
(deftest stringp.10
:notes (:nil-vectors-are-strings)
(notnot-mv (stringp (make-array '(37) :element-type nil)))
(deftest string.error.2
(signals-error (string nil nil) program-error)
t)
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sun Aug 29 17:32:20 2004
;;;; Contains: Tests of STRINGP
(in-package :cl-test)
(deftest stringp.1
(loop for x in *universe*
always (if (typep x 'string)
(stringp x)
(not (stringp x))))
t)
(deftest stringp.2
(notnot (stringp "abcd"))
t)
(deftest stringp.3
(notnot (stringp (make-array 4 :element-type 'character
:initial-contents '(#\a #\b #\c #\d))))
t)
(deftest stringp.4
(notnot (stringp (make-array 4 :element-type 'base-char
:initial-contents '(#\a #\b #\c #\d))))
t)
(deftest stringp.5
(notnot (stringp (make-array 4 :element-type 'standard-char
:initial-contents '(#\a #\b #\c #\d))))
t)
(deftest stringp.6
(stringp 0)
nil)
(deftest stringp.7
(stringp #\a)
nil)
(deftest stringp.8
(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)))
(notnot (stringp s2)))
t)
(deftest stringp.9
:notes (:nil-vectors-are-strings)
(notnot-mv (stringp (make-array '(0) :element-type nil)))
t)
(deftest stringp.10
:notes (:nil-vectors-are-strings)
(notnot-mv (stringp (make-array '(37) :element-type nil)))
t)
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment