101 lines
3.3 KiB
Plaintext
101 lines
3.3 KiB
Plaintext
;; Function To Be Tested: stringp
|
|
;;
|
|
;; Source: CLtL p. 75
|
|
;;
|
|
;; Chapter 6: Predicates Section 2-2: Specific Data Type Predicates
|
|
;;
|
|
;; Created By: Peter Reidy
|
|
;;
|
|
;; Creation Date: 21 September 86
|
|
;;
|
|
;; Last Update: 15 December 86
|
|
;;
|
|
;; Filed As: {eris}<lispcore>cml>test>6-2-2-stringp.test
|
|
;;
|
|
;; Syntax: stringp object
|
|
;;
|
|
;; Function Description: Returns non-nil iff object is a string (a one-dimensional array of type string-char, and NIL otherwise.
|
|
;;
|
|
;; Argument(s): object any cml object
|
|
;;
|
|
;; Returns: non-nil or NIL
|
|
;;
|
|
(do-test-group stringp-group
|
|
:before
|
|
(test-defun stringptest (object &optional (expected-value nil))
|
|
"See if (typep object 'string) <=> (stringp object), and if the string and its elements are of the proper type."
|
|
(let ((val (stringp object)))
|
|
(and
|
|
;; Test equivalence of stringp to typep...'string.
|
|
(eq val (typep object 'string))
|
|
;; non-nil for true cases, NIL for others.
|
|
(cond
|
|
(expected-value
|
|
val)
|
|
(t (null val))
|
|
) ; cond
|
|
;; Strings are one-dimensional arrays of type string-char.
|
|
(eq val (typep object '(array string-char (*))))
|
|
;; Strings are vectors of type string-char.
|
|
(eq val (typep object '(vector string-char)))
|
|
;; If the object is an array, see if it's the right kind of array.
|
|
(cond
|
|
(expected-value
|
|
(and
|
|
(= 1 (array-rank object))
|
|
;; The type must at least be consistent with 'string-char.
|
|
(subtypep 'string-char (array-element-type object))
|
|
) ; and
|
|
)
|
|
;; If it's not an array, it can't be the right kind; the test is moot
|
|
(t t)
|
|
) ; cond
|
|
) ; and
|
|
) ; let
|
|
) ; test-defun
|
|
;;
|
|
(do-test stringp-with-strings-test
|
|
(every #'(lambda (object) (stringptest object t))
|
|
(list
|
|
"string"
|
|
(symbol-name 'string)
|
|
(symbol-name (gensym))
|
|
(symbol-name (gentemp))
|
|
(symbol-name (make-symbol "string"))
|
|
(make-string (random 1000))
|
|
(make-string (random 1000) :initial-element #\$)
|
|
(make-array 1 :element-type 'string-char)
|
|
(make-array 1 :adjustable t :element-type 'string-char)
|
|
(make-array 20 :initial-element #\} :element-type 'string-char)
|
|
(make-array 20 :element-type 'string-char :initial-contents '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\a #\b #\c #\d #\e #\A #\B #\C #\D #\E))
|
|
(make-array 20 :element-type 'string-char :fill-pointer (random 20) :adjustable t :displaced-to (make-array (list (+ 20 (random 20)) (+ 20 (random 10))) :element-type 'string-char :initial-element #\}))
|
|
) ; list
|
|
) ; every
|
|
) ; do-test stringp-with-strings-test
|
|
;;
|
|
;; Symbols aren't strings
|
|
(do-test stringp-with-symbols-test
|
|
(every 'stringptest
|
|
(list
|
|
'string
|
|
(gensym)
|
|
(gentemp)
|
|
(make-symbol "string")
|
|
(make-symbol (make-array 20 :element-type 'string-char :fill-pointer (random 20) :adjustable t :displaced-to (make-array (list (+ 20 (random 20)) (+ 20 (random 10))) :element-type 'string-char :initial-element #\A )))
|
|
(make-symbol (symbol-name (gentemp)))
|
|
) ; list
|
|
) ; every
|
|
) ; do-test stringp-with-symbols-test
|
|
;;
|
|
;; Only one-dimensional string-char arrays are strings.
|
|
(do-test stringp-with-non-string-arrays-test
|
|
(every 'stringptest
|
|
(list
|
|
(make-array 6 :initial-contents '(#\s #\t #\r #\i #\n #\g))
|
|
) ; list
|
|
) ; every
|
|
) ; do-test stringp-with-non-string-arrays-test
|
|
) ; do-test-group
|
|
STOP
|
|
|