gentoo resync : 29.01.2021

5 files changed, 129 insertions, 27 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)))
diff --git a/dev-scheme/gauche/files/gauche-0.9.10-sys-ctermid.patch b/dev-scheme/gauche/files/gauche-0.9.10-sys-ctermid.patch
new file mode 100644
index 000000000000..18e4d5d2295d
--- /dev/null
+++ b/dev-scheme/gauche/files/gauche-0.9.10-sys-ctermid.patch
@@ -0,0 +1,27 @@
+commit f3b4beb18f256e733a4c699e96118d47a2191b74
+Author: Shiro Kawai <shiro@acm.org>
+Date:   Wed Dec 23 16:22:10 2020 -1000
+
+    Fix sys-ctermid out-of-extent memory access bug
+
+    https://github.com/shirok/Gauche/issues/740
+
+diff --git a/src/libsys.scm b/src/libsys.scm
+index f253c08a4..7f433c184 100644
+--- a/src/libsys.scm
++++ b/src/libsys.scm
+@@ -460,11 +460,11 @@
+ (define-cproc sys-mkdtemp (template::<string>) Scm_SysMkdtemp)
+ 
+ ;; ctermid
+-(define-cproc sys-ctermid () ::<const-cstring>
++(define-cproc sys-ctermid ()
+   (.if "defined(GAUCHE_WINDOWS)"
+-       (return "CON")
++       (return '"CON")
+        (let* ([buf::(.array char [(+ L_ctermid 1)])])
+-         (return (ctermid buf)))))
++         (return (SCM_MAKE_STR_COPYING (ctermid buf))))))
+ 
+ ;;---------------------------------------------------------------------
+ ;; stdlib.h
diff --git a/dev-scheme/gauche/files/gauche-0.9.6-rfc.tls.patch b/dev-scheme/gauche/files/gauche-0.9.6-rfc.tls.patch
deleted file mode 100644
index cf570df0ed38..000000000000
--- a/dev-scheme/gauche/files/gauche-0.9.6-rfc.tls.patch
+++ /dev/null
@@ -1,12 +0,0 @@
---- a/ext/tls/ssltest-mod.scm
-+++ b/ext/tls/ssltest-mod.scm
-@@ -53,7 +53,8 @@
-      ($ format #t "~a\n" $ regexp-replace-all* line
-         #/\.\.\/ssl\// srcpath-replace
-         #/openssl /    kicker-replace
--        #/system\s*\(/      "safe_system(")))
-+        #/system\s*\(/ "safe_system("
-+        #/(s_server) / "\\1 -4 ")))
- 
-   (p "#include <errno.h>"
-      "int safe_system(const char *commands)"
diff --git a/dev-scheme/gauche/files/gauche-0.9.9-xz-info.patch b/dev-scheme/gauche/files/gauche-0.9.9-xz-info.patch
new file mode 100644
index 000000000000..e55f53606005
--- /dev/null
+++ b/dev-scheme/gauche/files/gauche-0.9.9-xz-info.patch
@@ -0,0 +1,31 @@
+--- a/lib/gauche/interactive/info.scm
++++ b/lib/gauche/interactive/info.scm
+@@ -137,7 +137,8 @@
+                             :paths paths
+                             :pred (^p (or (file-is-readable? p)
+                                           (file-is-readable? #"~|p|.gz")
+-                                          (file-is-readable? #"~|p|.bz2"))))
++                                          (file-is-readable? #"~|p|.bz2")
++                                          (file-is-readable? #"~|p|.xz"))))
+         (errorf "couldn't find info file ~s in paths: ~s" *info-file* paths))
+     ))
+ 
+--- a/lib/text/info.scm
++++ b/lib/text/info.scm
+@@ -64,6 +64,7 @@
+ 
+ ;; Find bzip2 location
+ (define bzip2  (find-file-in-paths "bzip2"))
++(define xz     (find-file-in-paths "xz"))
+ 
+ ;; Read an info file FILE, and returns a list of strings splitted by ^_ (#\u001f)
+ ;; If FILE is not found, look for compressed one.
+@@ -78,6 +79,8 @@
+                      (close-input-port zp)))))]
+           [(and bzip2 (file-exists? #"~|file|.bz2"))
+            (with-input-from-process #"~bzip2 -c -d ~|file|.bz2" thunk)]
++          [(and xz (file-exists? #"~|file|.xz"))
++           (with-input-from-process #"~xz -c -d ~|file|.xz" thunk)]
+           [else (error "can't find info file" file)]))
+   (with-input-from-info
+    (lambda ()
diff --git a/dev-scheme/gauche/files/gauche-xz-info.patch b/dev-scheme/gauche/files/gauche-xz-info.patch
index e55f53606005..5ca77a8d583d 100644
--- a/dev-scheme/gauche/files/gauche-xz-info.patch
+++ b/dev-scheme/gauche/files/gauche-xz-info.patch
@@ -1,31 +1,31 @@
 --- a/lib/gauche/interactive/info.scm
 +++ b/lib/gauche/interactive/info.scm
-@@ -137,7 +137,8 @@
-                             :paths paths
-                             :pred (^p (or (file-is-readable? p)
-                                           (file-is-readable? #"~|p|.gz")
--                                          (file-is-readable? #"~|p|.bz2"))))
-+                                          (file-is-readable? #"~|p|.bz2")
-+                                          (file-is-readable? #"~|p|.xz"))))
-         (errorf "couldn't find info file ~s in paths: ~s" *info-file* paths))
-     ))
+@@ -113,7 +113,8 @@
+                       :paths (get-info-paths)
+                       :pred (^p (or (file-is-readable? p)
+                                     (file-is-readable? #"~|p|.gz")
+-                                    (file-is-readable? #"~|p|.bz2")))))
++                                    (file-is-readable? #"~|p|.bz2")
++                                    (file-is-readable? #"~|p|.xz")))))
  
+ (define (handle-ambiguous-name entry-name)
+   (let* ([keys (map x->string (hash-table-keys (~ (get-info)'index)))]
 --- a/lib/text/info.scm
 +++ b/lib/text/info.scm
-@@ -64,6 +64,7 @@
+@@ -67,6 +67,7 @@
  
  ;; Find bzip2 location
  (define bzip2  (find-file-in-paths "bzip2"))
 +(define xz     (find-file-in-paths "xz"))
  
- ;; Read an info file FILE, and returns a list of strings splitted by ^_ (#\u001f)
- ;; If FILE is not found, look for compressed one.
-@@ -78,6 +79,8 @@
-                      (close-input-port zp)))))]
+ (cond-expand
+  [gauche.sys.zlib]
+@@ -90,6 +91,8 @@
+              (with-input-from-process #"~gzip -c -d ~|file|.gz" thunk)])]
            [(and bzip2 (file-exists? #"~|file|.bz2"))
             (with-input-from-process #"~bzip2 -c -d ~|file|.bz2" thunk)]
 +          [(and xz (file-exists? #"~|file|.xz"))
 +           (with-input-from-process #"~xz -c -d ~|file|.xz" thunk)]
            [else (error "can't find info file" file)]))
    (with-input-from-info
-    (lambda ()
+    (^[]