207 lines
6.7 KiB
Plaintext
207 lines
6.7 KiB
Plaintext
;; These functions are defined once for the
|
|
;; test for chapter 23.
|
|
;; Not using "test-defun", for there is no reasonable way to undo it.
|
|
|
|
; Since DO-TEST reads in package XCL-TEST, all these functions must live there as well...
|
|
(in-package 'xcl-test)
|
|
|
|
; do so the tests will work on the 1108, give it a directory it can use
|
|
(if (not (il:lispdirectoryp 'il:lispfiles))
|
|
(il:createdskdirectory 'il:lispfiles))
|
|
|
|
(defun 23BUILD-PATHNAME (host &optional device (dir "CMLTEST") name type)
|
|
"build a path name with default directory, and if need generated name"
|
|
(make-pathname :host host :device device :directory dir
|
|
:name (if name name (string (gensym))) :type type))
|
|
|
|
(defun 23BUILD-FILE (pathname)
|
|
"build a file"
|
|
(let ((str (open pathname :direction :output)))
|
|
(close str)
|
|
str))
|
|
|
|
(defun 23File-SetUP (host &optional (type 'string-char))
|
|
"create a file of a certain element-type"
|
|
(cl:open (23BUILD-PATHNAME host) :direction :output :element-type type))
|
|
|
|
(defun 23Length-SetUP (host &optional (type 'string-char))
|
|
"create a file of a certain element-type"
|
|
(cl:open (23BUILD-PATHNAME host) :direction :io :element-type type))
|
|
|
|
(defun 23File-CleanUP (temp-stream)
|
|
"close the stream and delete the file"
|
|
(cl:close temp-stream)
|
|
(cl:delete-file temp-stream))
|
|
|
|
|
|
(defun 23BUILD-SYMBOL-FROM-PATHNAME (temp-pathname)
|
|
"get the name of a stream into SYMBOL form"
|
|
(make-symbol (namestring temp-pathname)))
|
|
|
|
(defun 23Delete-file-list (pathname-list)
|
|
" delete every file in the list"
|
|
(cl:mapcar #'cl:delete-file pathname-list))
|
|
|
|
|
|
|
|
(defun 23BUILD-LIST-OF-FILENAME-PATHNAMES
|
|
(host &optional (number 5) device (dir "CMLTEST") name type)
|
|
"return list of pathnames for created files on {host}<directory>"
|
|
(let ((results nil))
|
|
(dotimes (i number results)
|
|
(push (23BUILD-PATHNAME host device dir name type) results)
|
|
(23BUILD-FILE (CAR results))
|
|
)))
|
|
|
|
(defun 23BUILD-LIST-OF-STREAM
|
|
(host &optional (number 5) device (dir "CMLTEST") name type)
|
|
"return list of stream for created files on {host}<directory>"
|
|
(let ((results nil))
|
|
(dotimes (i number results)
|
|
(push (23BUILD-FILE (23BUILD-PATHNAME host device dir name type))
|
|
results)
|
|
)))
|
|
|
|
(defun 23BUILD-LIST-OF-FILENAME-STRING
|
|
(host &optional (number 5) device (dir "CMLTEST") name type)
|
|
"return list of strings for created files on {host}<directory>"
|
|
(let ((results nil) (temp-pathname nil))
|
|
(dotimes (i number results)
|
|
(setq temp-pathname (23BUILD-PATHNAME host device dir name type))
|
|
(push (namestring temp-pathname) results)
|
|
(23BUILD-FILE temp-pathname)
|
|
)))
|
|
|
|
(defun 23BUILD-LIST-OF-FILENAME-SYMBOL
|
|
(host &optional (number 5) device (dir "CMLTEST") name type)
|
|
"return list of symbols for created files on {host}<directory>"
|
|
(let ((results nil) (temp-pathname nil))
|
|
(dotimes (i number results)
|
|
(setq temp-pathname (23BUILD-PATHNAME host device dir name type))
|
|
(push (23BUILD-SYMBOL-FROM-PATHNAME temp-pathname) results)
|
|
(23BUILD-FILE temp-pathname)
|
|
)))
|
|
|
|
|
|
(defun 23TEST-PATHNAME-VALUE (pathname test-type value)
|
|
"common pattern of code, test for correct string or symbol"
|
|
(let ((result (case test-type
|
|
(HOST (pathname-host pathname))
|
|
(DEVICE (pathname-device pathname))
|
|
(DIRECTORY (pathname-directory pathname))
|
|
(NAME (pathname-name pathname))
|
|
(TYPE (pathname-type pathname))
|
|
(VERSION (pathname-version pathname))
|
|
)))
|
|
(if (equal test-type 'VERSION) (equal result value)
|
|
(or
|
|
(string-equal result value)
|
|
(and (typep result 'symbol)
|
|
(string-equal value (string result))))
|
|
)))
|
|
|
|
(defun 23TEST-NAMESTRING-VALUE (pathname test-type value)
|
|
"common pattern of code, test for correct string"
|
|
(let ((result (case test-type
|
|
(NAME (namestring pathname))
|
|
(FILE (file-namestring pathname))
|
|
(DIRECTORY (directory-namestring pathname))
|
|
(HOST (host-namestring pathname))
|
|
(ENOUGH (enough-namestring pathname))
|
|
)))
|
|
(string-equal result value)
|
|
))
|
|
|
|
(defun 23TEST-PATHNAME-VALUE-LIST (pathname-list test-type value)
|
|
"common pattern of code, test list for correct string or symbol"
|
|
(cl:every #'(lambda (item)
|
|
(23TEST-PATHNAME-VALUE item test-type value)) pathname-list))
|
|
|
|
(defun 23TEST-NAMESTRING-VALUE-LIST (pathname-list test-type value)
|
|
"common pattern of code, test list for correct string"
|
|
(cl:every #'(lambda (item)
|
|
(23TEST-NAMESTRING-VALUE item test-type value)) pathname-list))
|
|
|
|
(defun 23file-generator
|
|
(result-type host &optional number device dir name type)
|
|
"allow standard interface, so can just wory about type"
|
|
(case result-type
|
|
(STREAM (23BUILD-LIST-OF-STREAM host number device dir name type))
|
|
(STRING (23BUILD-LIST-OF-FILENAME-STRING
|
|
host number device dir name type))
|
|
(SYMBOL (23BUILD-LIST-OF-FILENAME-SYMBOL
|
|
host number device dir name type))
|
|
(otherwise (23BUILD-LIST-OF-FILENAME-PATHNAMES
|
|
host number device dir name type))
|
|
))
|
|
|
|
(defun 23Multiply-stream (stream-list)
|
|
"take a stream and create four types pointing to the same file"
|
|
(let ((result nil))
|
|
(dolist (item stream-list result)
|
|
(push item result)
|
|
(push (namestring item) result)
|
|
(push (pathname item) result)
|
|
(push (make-symbol (namestring item)) result)
|
|
)))
|
|
|
|
(defun 23THREE-TYPES (host device directory name type version)
|
|
"want in three types, no file, so no stream"
|
|
(let ((result (make-pathname
|
|
:host host :device device :directory directory
|
|
:name name :type type :version version)))
|
|
(list
|
|
result
|
|
(namestring result)
|
|
(make-symbol (namestring result))
|
|
)))
|
|
|
|
(defun 23Mul-No-Pathname (stream-list)
|
|
"take a stream and push it, string and symbol into a list"
|
|
(let ((result nil))
|
|
(dolist (item stream-list result)
|
|
(push item result)
|
|
(push (namestring item) result)
|
|
(push (make-symbol (namestring item)) result)
|
|
)))
|
|
|
|
(defun 23check-merge
|
|
(expect temp-pathname &optional defaults default-version)
|
|
"check both a pathname, and value is as expected."
|
|
(let ((result (merge-pathnames temp-pathname defaults default-version)))
|
|
(and
|
|
(pathnamep result)
|
|
(string-equal expect (namestring result))
|
|
; (equal expect (namestring result))
|
|
)))
|
|
|
|
(defun 23check-RENAME
|
|
(expect old-pathname new-pathname)
|
|
"check both a pathname, and value is as expected."
|
|
(let* ((result (multiple-value-list
|
|
(RENAME-file old-pathname new-pathname)))
|
|
(result-1 (first result))
|
|
(result-2 (second result))
|
|
(result-3 (third result)))
|
|
(and
|
|
(pathnamep result-1)
|
|
(pathnamep result-2)
|
|
(pathnamep result-3)
|
|
(string-equal expect (namestring (probe-file result-3)))
|
|
(probe-file new-pathname)
|
|
(not (probe-file result-2))
|
|
)))
|
|
|
|
(defun 23check-parse (expect temp-pathname)
|
|
"check get what want"
|
|
(let ((pathname (parse-namestring temp-pathname)))
|
|
(and
|
|
(pathnamep pathname)
|
|
(string-equal expect (namestring pathname))
|
|
)))
|
|
|
|
(defun 23check-parse-list (expect pathname-list)
|
|
"check a list, make sure get good results"
|
|
(cl:every #'(lambda (item) (23check-parse expect item)) pathname-list))
|
|
|