gentoo-overlay/dev-scheme/gauche/files/gauche-0.9.10-srfi-134.patch

commit 8582c68d127b0127f15e1a7f74265e3c0e9f3d87
Author: Shiro Kawai <shiro@acm.org>
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 ($ <ideque> 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)))