mirror of
git://git.code.sf.net/p/sbcl/sbcl
synced 2026-09-10 07:26:40 -04:00
61 lines
2.8 KiB
Common Lisp
61 lines
2.8 KiB
Common Lisp
(macrolet ((define-c-wrapper (lisp-name c-name)
|
|
`(defun ,lisp-name (key array)
|
|
(declare (sb-vm:word key))
|
|
(sb-sys:with-pinned-objects (array)
|
|
(let ((result
|
|
(sb-alien:alien-funcall
|
|
(sb-alien:extern-alien ,c-name
|
|
(function int sb-alien:unsigned
|
|
system-area-pointer int))
|
|
key
|
|
(sb-sys:vector-sap array) (length array))))
|
|
(unless (eql result -1)
|
|
(values result (aref array result))))))))
|
|
(define-c-wrapper c-bsearch<= "bsearch_lesseql_uword")
|
|
(define-c-wrapper c-bsearch>= "bsearch_greatereql_uword"))
|
|
|
|
(defun test-c-bsearch-sorted-vector ()
|
|
(dotimes (vector-len 51) ; test the edge case of an empty vector
|
|
(let ((maxval 10000)
|
|
(a (make-array vector-len :initial-element 0
|
|
:element-type 'sb-vm:word)))
|
|
(dotimes (i vector-len)
|
|
(let ((val (1+ (random maxval))))
|
|
(loop while (find val a) ; repeat until unique
|
|
do (setq val (1+ (random maxval))))
|
|
(setf (aref a i) val)))
|
|
(setq a (sort a #'<))
|
|
(map-into a (lambda (x) (* x 5)) a)
|
|
;; Keys less than the lowest in the array should not be found by <=
|
|
(assert (not (c-bsearch<= 0 a)))
|
|
(when (plusp vector-len)
|
|
(assert (not (c-bsearch<= (1- (aref a 0)) a))))
|
|
;; Keys larger than the largest item should not be found by >=
|
|
(assert (not (c-bsearch>= most-positive-fixnum a)))
|
|
(assert (not (c-bsearch>= most-positive-word a)))
|
|
(when (plusp vector-len)
|
|
(let ((greatest (aref a (1- vector-len))))
|
|
(loop for i from 1 to 20
|
|
do (assert (not (c-bsearch>= (+ greatest i) a))))))
|
|
(dotimes (i vector-len)
|
|
(let ((k (aref a i)))
|
|
(assert (= (c-bsearch<= k a) i)) ; exact match
|
|
(assert (= (c-bsearch>= k a) i)) ; exact match
|
|
;; Any key between K up to but excluding A[i+1] should find I by <=
|
|
(assert (= (c-bsearch<= (1+ k) a) i))
|
|
(let ((higher (if (< (1+ i) vector-len)
|
|
(1- (aref a (1+ i)))
|
|
(+ k 10000))))
|
|
(assert (= (c-bsearch<= higher a) i)))
|
|
;; Any key down to A[i-1] should find I by >=
|
|
(assert (= (c-bsearch>= (1- k) a) i))
|
|
(let ((lower (if (>= (1- i) 0)
|
|
(1+ (aref a (1- i)))
|
|
0)))
|
|
(assert (= (c-bsearch>= lower a) i))))))))
|
|
|
|
(compile 'test-c-bsearch-sorted-vector)
|
|
|
|
(with-test (:name :c-bsearch-sorted-vector)
|
|
(test-c-bsearch-sorted-vector))
|