Commit 7cb4550a authored by pfdietz's avatar pfdietz

Added tests for the twelve string comparison functions. string= has its own...

Added tests for the twelve string comparison functions.  string= has its own individual tests, but the others are only tested by calling a random test case generator 1000 times (as is string=).
parent 8ab7270a
......@@ -124,3 +124,8 @@
(load "string-trim.lsp")
(load "string-left-trim.lsp")
(load "string-right-trim.lsp")
;;; Tests of string comparison functions
(compile-and-load "string-aux.lsp")
(load "string-comparisons.lsp")
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Fri Oct 4 06:51:32 2002
;;;; Contains: Auxiliary functions for string testing
(in-package :cl-test)
(defun my-string-compare (string1 string2 comparison
&key (start1 0) end1 (start2 0) end2 case
&aux
(len1 (progn (assert (stringp string1))
(length string1)))
(len2 (progn (assert (stringp string2))
(length string2)))
(compare-fn
(case comparison
(< (if case #'char-lessp #'char<))
(<= (if case #'char-not-greaterp
#'char<=))
(= (if case #'char-equal #'char=))
(/= (if case #'char-not-equal #'char/=))
(> (if case #'char-greaterp #'char>))
(>= (if case #'char-not-lessp #'char>=))
(t (error "Bad comparison arg: ~A~%"
comparison))))
(equal-fn (if case #'char-equal #'char=)))
(assert (integerp start1))
(assert (integerp start2))
(unless end1 (setq end1 len1))
(unless end2 (setq end2 len2))
(assert (<= 0 start1 end1))
(assert (<= 0 start2 end2))
(loop
for i1 from start1
for i2 from start2
do
(cond
((= i1 end1)
(return
(cond
((= i2 end2)
;; Both ended -- equality case
(if (member comparison '(= <= >=))
end1
nil))
(t ;; string2 still extending
(if (member comparison '(/= < <=))
end1
nil)))))
((= i2 end2)
;; string1 still extending
(return
(if (member comparison '(/= > >=))
i1
nil)))
(t
(let ((c1 (char string1 i1))
(c2 (char string2 i2)))
(cond
((funcall equal-fn c1 c2))
(t ;; mismatch found -- what kind?
(return
(if (funcall compare-fn c1 c2)
i1
nil)))))))))
(defun make-random-string-compare-test (n)
(let* ((len (random n))
;; Lengths of the two strings
(len1 (if (or (coin) (= len 0)) len (+ len (random len))))
(len2 (if (or (coin) (= len 0)) len (+ len (random len))))
;; Lengths of the parts of the strings to be matched
(sublen1 (if (or (coin) (= len1 0)) (min len1 len2) (random len1)))
(sublen2 (if (or (coin) (= len2 0)) (min len2 sublen1) (random len2)))
;; Start and end of the substring of the first string
(start1 (if (coin 3) 0
(max 0 (min (1- len1) (random (- len1 sublen1 -1))))))
(end1 (+ start1 sublen1))
;; Start and end of the substring of the second string
(start2 (if (coin 3) 0
(max 0 (min (1- len2) (random (- len2 sublen2 -1))))))
(end2 (+ start2 sublen2))
;; generate the strings
(s1 (make-random-string len1))
(s2 (make-random-string len2)))
#|
(format t "len = ~A, len1 = ~A, len2 = ~A, sublen1 = ~A, sublen2 = ~A~%"
len len1 len2 sublen1 sublen2)
(format t "start1 = ~A, end1 = ~A, start2 = ~A, end2 = ~A~%"
start1 end1 start2 end2)
(format t "s1 = ~S, s2 = ~S~%" s1 s2)
|#
;; Sometimes we want them to have a common prefix
(when (coin)
(if (<= sublen1 sublen2)
(setf (subseq s2 start2 (+ start2 sublen1))
(subseq s1 start1 (+ start1 sublen1)))
(setf (subseq s1 start1 (+ start1 sublen2))
(subseq s2 start2 (+ start2 sublen2)))))
(values
s1
s2
(reduce #'nconc
(random-permute
(list
(if (and (= start1 0) (coin))
nil
(list :start1 start1))
(if (and (= end1 len1) (coin))
nil
(list :end1 end1))
(if (and (= start2 0) (coin))
nil
(list :start2 start2))
(if (and (= end2 len2) (coin))
nil
(list :end2 end2))))))))
(defun random-string-compare-test (n comparison case &optional (iterations 1))
(loop for i from 1 to iterations
count
(multiple-value-bind (s1 s2 args)
(make-random-string-compare-test n)
;; (format t "Args = ~S~%" args)
(let ((x (apply (case comparison
(< (if case #'string-lessp #'string<))
(<= (if case #'string-not-greaterp
#'string<=))
(= (if case #'string-equal #'string=))
(/= (if case #'string-not-equal #'string/=))
(> (if case #'string-greaterp #'string>))
(>= (if case #'string-not-lessp #'string>=))
(t (error "Bad comparison arg: ~A~%" comparison)))
s1 s2 args))
(y (apply #'my-string-compare s1 s2 comparison :case case args)))
(not
(or (eql x y)
(and x y (eq comparison '=))))))))
(defun make-random-string (n)
(let ((s (make-string n)))
(if (coin)
(dotimes (i n)
(setf (char s i) (elt #(#\a #\b #\A #\B) (random 4))))
(dotimes (i n)
(dotimes (i n)
(setf (char s i)
(or (code-char (random 256))
(elt "abcdefghijklmnopqrstuvwyxzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
(random 62)))))))
s))
\ No newline at end of file
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Fri Oct 4 06:32:41 2002
;;;; Contains: Tests of string comparison functions
(in-package :cl-test)
(deftest string=.1
(not (string= "abc" (copy-seq "abc")))
nil)
(deftest string=.2
(string= "A" "a")
nil)
(deftest string=.3
(not (string= #\a "a"))
nil)
(deftest string=.4
(not (string= '|abc| (copy-seq "abc")))
nil)
(deftest string=.5
(not (string= (copy-seq "abc") '#:|abc|))
nil)
;;; Test that it doesn't stop at null characters
(deftest string=.6
(let ((s1 (copy-seq "abc"))
(s2 (copy-seq "abd"))
(c (or (code-char 0) #\a)))
(setf (char s1 1) c)
(setf (char s2 1) c)
(values (length s1) (length s2) (string= s1 s2)))
3 3 nil)
(deftest string=.7
(loop for i from 0 to 3
collect (not (string= "abc" "abd" :start1 0 :end1 i :end2 i)))
(nil nil nil t))
(deftest string=.8
(loop for i from 0 to 3
collect (not (string= "abc" "ab" :end1 i)))
(t t nil t))
(deftest string=.9
(loop for i from 0 to 3
collect (not (string= "abc" "abd" :start2 0 :end2 i :end1 i)))
(nil nil nil t))
(deftest string=.10
(loop for i from 0 to 3
collect (not (string= "ab" "abc" :end2 i)))
(t t nil t))
(deftest string=.11
(loop for i from 0 to 3
collect (not (string= "xyab" "ab" :start1 i)))
(t t nil t))
(deftest string=.12
(loop for i from 0 to 3
collect (not (string= "ab" "xyab" :start2 i)))
(t t nil t))
(deftest string=.13
(loop for i from 0 to 3
collect (not (string= "xyab" "ab" :start1 i :end1 nil)))
(t t nil t))
(deftest string=.14
(loop for i from 0 to 3
collect (not (string= "ab" "xyab" :start2 i :end2 nil)))
(t t nil t))
;;; Random tests (of all the string comparson functions)
(deftest random-string-comparison-tests
(loop for cmp in '(= /= < > <= >=)
append
(loop for case in '(nil t)
collect
(list cmp case
(random-string-compare-test 10 cmp case 1000))))
((= nil 0) (= t 0) (/= nil 0) (/= t 0) (< nil 0) (< t 0)
(> nil 0) (> t 0) (<= nil 0) (<= t 0) (>= nil 0) (>= t 0)))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment