X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fseq.impure.lisp;h=ffb1ec7d1b5b1830044f401c403f830ef22d6979;hb=a51d83191034919bc76367268929e234d62164db;hp=f6e79d325da5fcc0a926e39da273c2ae7d1d81be;hpb=ba871531b6b394da295c9a4527346e1e6327ccca;p=sbcl.git diff --git a/tests/seq.impure.lisp b/tests/seq.impure.lisp index f6e79d3..ffb1ec7 100644 --- a/tests/seq.impure.lisp +++ b/tests/seq.impure.lisp @@ -13,10 +13,11 @@ ;;;; absolutely no warranty. See the COPYING and CREDITS files for ;;;; more information. +(load "test-util.lisp") (load "assertoid.lisp") (defpackage :seq-test - (:use :cl :assertoid)) + (:use :cl :assertoid :test-util)) (in-package :seq-test) @@ -957,7 +958,8 @@ standard bashed) ;; fill vectors ;; a) the standard slow way - (fill standard c :start offset :end (+ offset n)) + (locally (declare (notinline fill)) + (fill standard c :start offset :end (+ offset n))) ;; b) the blazingly fast way (let ((value (loop for i from 0 by bitsize until (= i sb-vm:n-word-bits) @@ -1086,18 +1088,34 @@ ;;; FILL on lists (let ((l (list 1 2 3))) - (fill l 0 :start 1 :end 2) + (assert (eq l (fill l 0 :start 1 :end 2))) (assert (equal l '(1 0 3))) - (fill l 'x :start 2 :end 3) + (assert (eq l (fill l 'x :start 2 :end 3))) (assert (equal l '(1 0 x))) - (fill l 'y :start 1) + (assert (eq l (fill l 'y :start 1))) (assert (equal l '(1 y y))) - (fill l 'z :end 2) + (assert (eq l (fill l 'z :end 2))) (assert (equal l '(z z y))) - (fill l 1) + (assert (eq l (fill l 1))) (assert (equal l '(1 1 1))) (assert (raises-error? (fill l 0 :start 4))) (assert (raises-error? (fill l 0 :end 4))) (assert (raises-error? (fill l 0 :start 2 :end 1)))) + +;;; Both :TEST and :TEST-NOT provided +(with-test (:name :test-and-test-not-to-adjoin) + (let* ((wc 0) + (fun + (handler-bind (((and warning (not style-warning)) + (lambda (w) (incf wc)))) + (compile nil `(lambda (item test test-not) (adjoin item '(1 2 3 :foo) + :test test + :test-not test-not)))))) + (assert (= 1 wc)) + (assert (eq :error + (handler-case + (funcall fun 1 #'eql (complement #'eql)) + (error () + :error)))))) ;;; success