1 files changed, 56 insertions, 0 deletions
diff --git a/dev-scheme/gauche/files/gauche-0.9.10-srfi-134.patch b/dev-scheme/gauche/files/gauche-0.9.10-srfi-134.patch
new file mode 100644
index 000000000000..1e9da832083e
--- /dev/null
+++ b/dev-scheme/gauche/files/gauche-0.9.10-srfi-134.patch
@@ -0,0 +1,56 @@
+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)))