From d0968980b9bdea04b347832b2944a48afab3bd5c Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Tue, 1 Oct 2002 02:09:04 +0000 Subject: [PATCH] Added tests for various other string functions and classes. --- ansi-tests/string.lsp | 159 +++++++++++++++++++++++++++++++++++++++++- 1 file changed, 157 insertions(+), 2 deletions(-) diff --git a/ansi-tests/string.lsp b/ansi-tests/string.lsp index 245d660e..9de96d27 100644 --- a/ansi-tests/string.lsp +++ b/ansi-tests/string.lsp @@ -1,7 +1,7 @@ ;-*- Mode: Lisp -*- ;;;; Author: Paul Dietz ;;;; Created: Mon Sep 30 19:16:59 2002 -;;;; Contains: Tests for class and function STRING +;;;; Contains: Tests for string related functions and classes (in-package :cl-test) @@ -38,6 +38,161 @@ (type-error () :caught))) 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) + +;;; 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) + +;;; 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) + +;;; 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 + (not (not (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 + (not (not (simple-string-p (make-array + 4 :element-type 'base-char + :initial-contents '(#\a #\a #\a #\b))))) + t) + +(deftest simple-string-p.6 + (not (not (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) + +;;; 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 + (not (not (stringp "abcd"))) + t) + +(deftest stringp.3 + (not (not (stringp (make-array 4 :element-type 'character + :initial-contents '(#\a #\b #\c #\d))))) + t) + +(deftest stringp.4 + (not (not (stringp (make-array 4 :element-type 'base-char + :initial-contents '(#\a #\b #\c #\d))))) + t) + +(deftest stringp.5 + (not (not (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))) + (not (not (stringp s2)))) + t) -- GitLab