diff --git a/ansi-tests/gclload2.lsp b/ansi-tests/gclload2.lsp index ee719cdc379deaa6b371e384d570539579009ce6..eddd01c31b39bf352fb6e319fefd8f47c3d6a906 100644 --- a/ansi-tests/gclload2.lsp +++ b/ansi-tests/gclload2.lsp @@ -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") + diff --git a/ansi-tests/string-aux.lsp b/ansi-tests/string-aux.lsp new file mode 100644 index 0000000000000000000000000000000000000000..9c459c67080d23718cc9e3780480f0d76734d3ff --- /dev/null +++ b/ansi-tests/string-aux.lsp @@ -0,0 +1,162 @@ +;-*- 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 diff --git a/ansi-tests/string-comparisons.lsp b/ansi-tests/string-comparisons.lsp new file mode 100644 index 0000000000000000000000000000000000000000..92db5fca7aff85112e842dd8f66310dae617c29d --- /dev/null +++ b/ansi-tests/string-comparisons.lsp @@ -0,0 +1,100 @@ +;-*- 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))) + + + + + + + + + + + +