;-*- Mode: Lisp -*- ;;;; Author: Paul Dietz ;;;; Created: Wed Aug 21 00:11:24 2002 ;;;; Contains: Tests for SORT (in-package :cl-test) (deftest sort-list.1 (let ((a (list 1 4 2 5 3))) (sort a #'<)) (1 2 3 4 5)) (deftest sort-list.2 (let ((a (list 1 4 2 5 3))) (sort a #'< :key #'-)) (5 4 3 2 1)) (deftest sort-list.3 (let ((a (list 1 4 2 5 3))) (sort a #'(lambda (x y) nil)) (sort a #'<)) (1 2 3 4 5)) ;;; ;;; Confirm that sort only permutes the sequence, even when given ;;; a comparison function that does not define a total order. ;;; (deftest sort-list.4 (loop repeat 100 always (let ((a (list 1 2 3 4 5 6 7 8 9 0)) (cmp (make-array '(10 10)))) (loop for i from 0 to 9 do (loop for j from 0 to 9 do (setf (aref cmp i j) (zerop (logand (random 1024) 512))))) (setq a (sort a #'(lambda (i j) (aref cmp i j)))) (and (eqlt (length a) 10) (equalt (sort a #'<) '(0 1 2 3 4 5 6 7 8 9))))) t) (deftest sort-vector.1 (let ((a (copy-seq #(1 4 2 5 3)))) (sort a #'<)) #(1 2 3 4 5)) (deftest sort-vector.2 (let ((a (copy-seq #(1 4 2 5 3)))) (sort a #'< :key #'-)) #(5 4 3 2 1)) (deftest sort-vector.3 (let ((a (copy-seq #(1 4 2 5 3)))) (sort a #'(lambda (x y) nil)) (sort a #'<)) #(1 2 3 4 5)) (deftest sort-vector.4 (let ((a (make-array 10 :initial-contents '(10 40 20 50 30 15 45 25 55 35) :fill-pointer 5))) (sort a #'<)) #(10 20 30 40 50)) (deftest sort-vector.5 (loop repeat 100 always (let ((a (vector 1 2 3 4 5 6 7 8 9 0)) (cmp (make-array '(10 10)))) (loop for i from 0 to 9 do (loop for j from 0 to 9 do (setf (aref cmp i j) (zerop (logand (random 1024) 512))))) (setq a (sort a #'(lambda (i j) (aref cmp i j)))) (and (eqlt (length a) 10) (equalpt (sort a #'<) #(0 1 2 3 4 5 6 7 8 9))))) t) (deftest sort-vector.6 (do-special-integer-vectors (v #(1 4 7 3 2 6 5) nil) (let ((sv (sort v #'<))) (assert (equalp sv #(1 2 3 4 5 6 7))))) nil) (deftest sort-vector.7 (do-special-integer-vectors (v #(0 1 1 0 1 1 0 1 0) nil) (let ((sv (sort v #'<))) (assert (equalp sv #(0 0 0 0 1 1 1 1 1))))) nil) (deftest sort-vector.8 (do-special-integer-vectors (v #(0 -1 -1 0 -1 -1 0 -1 0) nil) (let ((sv (sort v #'>))) (assert (equalp sv #(0 0 0 0 -1 -1 -1 -1 -1))))) nil) (deftest sort-vector.9 (let* ((ivals '(1 4 7 3 2 6 5)) (sivals '(1 2 3 4 5 6 7)) (len (length ivals))) (loop for etype in '(short-float single-float double-float long-float rational) for vals = (loop for i in ivals collect (coerce i etype)) for svals = (loop for i in sivals collect (coerce i etype)) for vec = (make-array len :element-type etype :initial-contents vals) for svec = (sort vec #'<) unless (and (eql (length svec) len) (every #'eql svals svec)) collect (list etype vals svec))) nil) (deftest sort-vector.10 (let* ((ivals '(1 4 7 3 2 6 5)) (sivals '(1 2 3 4 5 6 7)) (len (length ivals))) (loop for cetype in '(short-float single-float double-float long-float rational) for etype = `(complex ,cetype) for vals = (loop for i in ivals collect (complex (coerce i cetype) (coerce (- i) cetype))) for svals = (loop for i in sivals collect (complex (coerce i cetype) (coerce (- i) cetype))) for vec = (make-array len :element-type etype :initial-contents vals) for svec = (sort vec #'(lambda (x y) (< (abs x) (abs y)))) unless (and (eql (length svec) len) (every #'eql svals svec)) collect (list etype vals svec))) nil) ;;; Bit vectors (deftest sort-bit-vector.1 (let ((a (copy-seq #*10011101))) (sort a #'<)) #*00011111) (deftest sort-bit-vector.2 (let ((a (copy-seq #*10011101))) (values (sort a #'< :key #'-) a)) #*11111000 #*11111000) (deftest sort-bit-vector.3 (let ((a (make-array 10 :initial-contents '(1 0 0 1 1 1 1 0 1 1) :element-type 'bit :fill-pointer 5))) (sort a #'<)) #*00111) (deftest sort-string.1 (let ((a (copy-seq "10011101"))) (values (sort a #'char<) a)) "00011111" "00011111") (deftest sort-string.2 (let ((a (copy-seq "10011101"))) (values (sort a #'char< :key #'(lambda (c) (if (eql c #\0) #\1 #\0))) a)) "11111000" "11111000") (deftest sort-string.3 (let ((a (make-array 10 :initial-contents "1001111011" :element-type 'character :fill-pointer 5))) (sort a #'char<)) "00111") (deftest sort-string.4 (do-special-strings (s "aebdc" nil) (let ((s2 (sort s #'char<))) (assert (eq s s2)) (assert (string= s2 "abcde")))) nil) ;;; Order of evaluation tests (deftest sort.order.1 (let ((i 0) x y) (values (sort (progn (setf x (incf i)) (list 1 7 3 2)) (progn (setf y (incf i)) #'<)) i x y)) (1 2 3 7) 2 1 2) (deftest sort.order.2 (let ((i 0) x y z) (values (sort (progn (setf x (incf i)) (list 1 7 3 2)) (progn (setf y (incf i)) #'<) :key (progn (setf z (incf i)) #'-)) i x y z)) (7 3 2 1) 3 1 2 3) ;;; Error cases (deftest sort.error.1 (signals-error (sort) program-error) t) (deftest sort.error.2 (signals-error (sort nil) program-error) t) (deftest sort.error.3 (signals-error (sort nil #'< :key) program-error) t) (deftest sort.error.4 (signals-error (sort nil #'< 'bad t) program-error) t) (deftest sort.error.5 (signals-error (sort nil #'< 'bad t :allow-other-keys nil) program-error) t) (deftest sort.error.6 (signals-error (sort nil #'< 1 2) program-error) t) (deftest sort.error.7 (signals-error (sort (list 1 2 3 4) #'identity) program-error) t) (deftest sort.error.8 (signals-error (sort (list 1 2 3 4) #'< :key #'cons) program-error) t) (deftest sort.error.9 (signals-error (sort (list 1 2 3 4) #'< :key #'car) type-error) t) (deftest sort.error.10 (signals-error (sort (list 1 2 3 4) #'elt) type-error) t) (deftest sort.error.11 (check-type-error #'(lambda (x) (sort x #'<)) #'sequencep) nil)