commit 8582c68d127b0127f15e1a7f74265e3c0e9f3d87 Author: Shiro Kawai Date: Tue Dec 22 10:34:09 2020 -1000 Incorporate upstream fixes https://github.com/scheme-requests-for-implementation/srfi-134/commit/2bfd4b585c8140c25f4fdd9adef84ab3ceca67b3 diff --git a/lib/data/ideque.scm b/lib/data/ideque.scm index 484ca52b4..e4894e2d0 100644 --- a/lib/data/ideque.scm +++ b/lib/data/ideque.scm @@ -231,12 +231,12 @@ (define (%ideque-drop dq n) ; n is within the range (match-let1 ($ lenf f lenr r) dq (if (<= n lenf) - (check n (drop f n) lenr r) + (check (- lenf n) (drop f n) lenr r) (let1 lenr. (- lenr (- n lenf)) (check 0 '() lenr. (take r lenr.)))))) (define (%check-length dq n) - (unless (<= 0 n (- (ideque-length dq) 1)) + (unless (<= 0 n (ideque-length dq)) (error "argument is out of range:" n))) ;; API [srfi-134] diff --git a/test/include/ideque-tests.scm b/test/include/ideque-tests.scm index 63f3f73a0..5e4c9e023 100644 --- a/test/include/ideque-tests.scm +++ b/test/include/ideque-tests.scm @@ -50,6 +50,12 @@ (test-assert (ideque-empty? (ideque-remove-back (ideque 1)))) (test 0 (ideque-front (ideque-add-front (ideque 1 2 3) 0))) (test 0 (ideque-back (ideque-add-back (ideque 1 2 3) 0))) + ;; loss of front ideque + (let ((id (ideque #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f))) + (set! id (ideque-remove-front (ideque-add-back id 1))) + (set! id (ideque-remove-front (ideque-add-back id 1))) + (set! id (ideque-remove-front (ideque-add-back id 1))) + (test #f (ideque-front (ideque-take-right id 12)))) ) (test-group "ideque/other-accessors" @@ -63,7 +69,11 @@ (map ideque->list xs)))) lis))) (check 'ideque-take ideque-take take 7) + (test '(1 2 3 4) (ideque->list (ideque-take (ideque 1 2 3 4) 4))) + (test '(1 2 3 4) (ideque->list (ideque-take-right (ideque 1 2 3 4) 4))) (check 'ideque-drop ideque-drop drop 6) + (test '() (ideque->list (ideque-drop (ideque 1 2 3 4) 4))) + (test '() (ideque->list (ideque-drop-right (ideque 1 2 3 4) 4))) (check 'ideque-split-at ideque-split-at split-at 8) ;; out-of-range conditions (test-error (ideque->list (ideque-take (ideque 1 2 3 4 5 6 7) 10)))