[gentoo-commits] proj/lisp:master commit in: dev-lisp/clisp/files/, dev-lisp/clisp/

[José María Alonso]

commit:     98b0d2bb15128cc2054b4785e0f52b7f872380f3
Author:     Chema Alonso Josa <nimiux <AT> gentoo <DOT> org>
AuthorDate: Sun Dec 10 15:50:33 2017 +0000
Commit:     José María Alonso <nimiux <AT> gentoo <DOT> org>
CommitDate: Sun Dec 10 15:50:33 2017 +0000
URL:        https://gitweb.gentoo.org/proj/lisp.git/commit/?id=98b0d2bb

dev-lisp/clisp: Adds glibc cfree and bdb patch

 dev-lisp/clisp/clisp-2.49.60.ebuild                |   1 +
 .../clisp-2.49.60-after_glibc_cfree_bdb.patch      | 207 +++++++++++++++++++++
 2 files changed, 208 insertions(+)

diff --git a/dev-lisp/clisp/clisp-2.49.60.ebuild b/dev-lisp/clisp/clisp-2.49.60.ebuild
index a8206d6f..76834662 100644
--- a/dev-lisp/clisp/clisp-2.49.60.ebuild
+++ b/dev-lisp/clisp/clisp-2.49.60.ebuild
@@ -58,6 +58,7 @@ src_prepare() {
 	if use alpha || use ia64; then
 		sed -i -e 's/-O2//g' src/makemake.in || die
 	fi
+	eapply "${FILESDIR}"/"${P}"-after_glibc_cfree_bdb.patch
 	eapply_user
 }
 

diff --git a/dev-lisp/clisp/files/clisp-2.49.60-after_glibc_cfree_bdb.patch b/dev-lisp/clisp/files/clisp-2.49.60-after_glibc_cfree_bdb.patch
new file mode 100644
index 00000000..3ab075ba
--- /dev/null
+++ b/dev-lisp/clisp/files/clisp-2.49.60-after_glibc_cfree_bdb.patch
@@ -0,0 +1,207 @@
+diff --git a/modules/berkeley-db/bdb.c b/modules/berkeley-db/bdb.c
+index a266d41..942652a 100644
+--- a/modules/berkeley-db/bdb.c
++++ b/modules/berkeley-db/bdb.c
+@@ -2216,7 +2216,13 @@ DEFUN(BDB:DB-COMPACT, db &key TRANSACTION :START STOP FREE FILL TIMEOUT \
+   c_data.compact_timeout = timeout;
+   c_data.compact_pages = pages;
+   SYSCALL(db->compact,(db,txn,pstart,pstop,&c_data,flags,&end));
+-  pushSTACK(uint32_to_I(c_data.compact_empty_buckets));
++  /* ====
++   * compact_empty_buckets is in bdb-5.3 as part of output stats
++   * however this version use bdb-4.8 which does not have it
++   * ====
++   *
++   * pushSTACK(uint32_to_I(c_data.compact_empty_buckets));
++   * */
+   pushSTACK(uint32_to_I(c_data.compact_pages_free));
+   pushSTACK(uint32_to_I(c_data.compact_pages_examine));
+   pushSTACK(uint32_to_I(c_data.compact_levels));
+diff --git a/modules/bindings/glibc/linux.lisp b/modules/bindings/glibc/linux.lisp
+index c960753..2993990 100644
+--- a/modules/bindings/glibc/linux.lisp
++++ b/modules/bindings/glibc/linux.lisp
+@@ -1,7 +1,7 @@
+ ;; Foreign functions provided by the Linux C library version 6,
+ ;; i.e. the GNU C library version 2.0.7.
+ ;; Bruno Haible 10.4.1998, 19.4.1998
+-;; Sam Steingold 2002-2008, 2011
++;; Sam Steingold 2002-2008, 2011, 2013, 2016-2017
+ 
+ ;; NB: quite a few functions here have more portable counterparts in POSIX
+ 
+@@ -649,7 +649,6 @@
+ (def-call-out calloc (:arguments (nmemb size_t) (size size_t))
+   (:return-type c-pointer))
+ (def-call-out free (:arguments (ptr c-pointer)) (:return-type nil))
+-(def-call-out cfree (:arguments (ptr c-pointer)) (:return-type nil))
+ (def-call-out valloc (:arguments (size size_t)) (:return-type c-pointer))
+ 
+ (def-call-out abort (:arguments) (:return-type nil))
+@@ -687,9 +686,8 @@
+ (def-call-out system? (:arguments (null c-string))
+   (:return-type boolean) (:name "system"))
+ 
+-; You can uncomment this if your compiler sets __USE_GNU
+-; (def-call-out canonicalize_file_name (:arguments (name c-string))
+-;  (:return-type c-string :malloc-free))
++(def-call-out canonicalize_file_name (:arguments (name c-string))
++  (:return-type c-string :malloc-free) (:guard "defined(__USE_GNU)"))
+ 
+ (def-call-out realpath
+     (:arguments (name c-string)
+@@ -1041,9 +1039,8 @@
+ (def-call-out access (:arguments (name c-string) (type int))
+   (:return-type int))
+ 
+-; You can uncomment this if your compiler sets __USE_GNU
+-; (def-call-out euidaccess (:arguments (name c-string) (type int))
+-;   (:return-type int))
++(def-call-out euidaccess (:arguments (name c-string) (type int))
++  (:return-type int) (:guard "defined(__USE_GNU)"))
+ 
+ (defconstant SEEK_SET 0)
+ (defconstant SEEK_CUR 1)
+@@ -1094,9 +1091,8 @@
+ ;(def-call-out getcwd (:arguments (buf c-string :out) (size size_t)) ; ??
+ ;  (:return-type c-string))
+ 
+-; You can uncomment this if your compiler sets __USE_GNU
+-; (def-call-out get_current_dir_name (:arguments)
+-;   (:return-type c-string :malloc-free))
++(def-call-out get_current_dir_name (:arguments)
++  (:return-type c-string :malloc-free) (:guard "defined(__USE_GNU)"))
+ 
+ ;(def-call-out getwd (:arguments (buf c-string :out)) ; ??
+ ;  (:return-type c-string))
+@@ -1324,8 +1320,8 @@
+ ;    (:arguments (size int) (list (c-ptr (c-array gid_t ??)) :out)) ; ??
+ ;  (:return-type int))
+ 
+-; You can uncomment this if your compiler sets __USE_GNU
+-; (def-call-out group_member (:arguments (gid gid_t)) (:return-type boolean))
++(def-call-out group_member (:arguments (gid gid_t)) (:return-type boolean)
++   (:guard "defined(__USE_GNU)"))
+ (def-call-out setuid (:arguments (uid uid_t)) (:return-type int))
+ (def-call-out setreuid (:arguments (ruid uid_t) (euid uid_t))
+   (:return-type int))
+@@ -1822,8 +1818,8 @@
+   (:return-type c-string :malloc-free))
+ (def-call-out ungetc (:arguments (c int) (fp FILE))
+   (:return-type int))
+-; You can uncomment this if your compiler sets __USE_GNU
+-; (def-call-out fcloseall (:arguments) (:return-type int))
++(def-call-out fcloseall (:arguments) (:return-type int)
++  (:guard "defined(__USE_GNU)"))
+ (def-call-out fdopen (:arguments (fildes int) (mode c-string))
+   (:return-type c-pointer))
+ (def-call-out fileno (:arguments (fp FILE)) (:return-type int))
+@@ -1901,11 +1897,11 @@ typedef __off64_t clisp_dirent_off_t;
+   (:return-type (c-ptr-null dirent)))
+ (def-call-out readdir64 (:arguments (dirp c-pointer))
+   (:return-type (c-ptr-null dirent64)))
+-(def-call-out readdir_r
++(def-call-out readdir_r                 ; deprecated
+     (:arguments (dirp c-pointer) (entry (c-ptr dirent) :out :alloca)
+                 (result (c-ptr (c-ptr dirent)) :out :alloca)) ; ??
+   (:return-type int))
+-(def-call-out readdir64_r
++(def-call-out readdir64_r               ; deprecated
+     (:arguments (dirp c-pointer) (entry (c-ptr dirent64) :out :alloca)
+                 (result (c-ptr (c-ptr dirent64)) :out :alloca)) ; ??
+   (:return-type int))
+diff --git a/modules/bindings/glibc/test.tst b/modules/bindings/glibc/test.tst
+index f807389..b2c1222 100644
+--- a/modules/bindings/glibc/test.tst
++++ b/modules/bindings/glibc/test.tst
+@@ -5,6 +5,16 @@
+ (progn (require "linux") T) T
+ (listp (show (multiple-value-list (ext:module-info "linux" t)) :pretty t)) T
+ 
++(stringp (show (linux:get-domain-name))) T
++(stringp (show (linux:get-host-name))) T
++
++;; usually __USE_GNU is defined, so this should work:
++(let* ((d (linux:get_current_dir_name))
++       (c (linux:canonicalize_file_name (concatenate 'string d "/."))))
++  (or (string= d c)
++      (list :cur-dir d :canonical c)))
++T
++
+ (defparameter *d* (show (linux:opendir "."))) *D*
+ (linux:dirent64-d_name (show (linux:readdir64 *d*))) "."
+ (linux:dirent64-d_name (show (linux:readdir64 *d*))) ".."
+diff --git a/src/foreign1.lisp b/src/foreign1.lisp
+index 26a3ba5..0e43de7 100644
+--- a/src/foreign1.lisp
++++ b/src/foreign1.lisp
+@@ -1,6 +1,6 @@
+ ;;; Foreign function interface for CLISP
+ ;;; Bruno Haible 19.2.1995
+-;;; Sam Steingold 1998-2010
++;;; Sam Steingold 1998-2010, 2017
+ 
+ #+UNICODE
+ (progn
+@@ -805,14 +805,17 @@
+                 c-name (to-c-string c-name) (third variable) (first variable))
+         (when *foreign-guard* (format *coutput-stream* "# endif~%"))))
+     (dolist (function *function-list*)
+-      (let ((c-name (first function)))
+-        (when *foreign-guard*
+-          (format *coutput-stream* "# if defined(HAVE_~A)~%"
+-                  (string-upcase c-name)))
++      (let ((c-name (first function))
++            (guard (fourth function)))
++        (when guard
++          (format *coutput-stream* "# if ~A~%"
++                  (if (eq guard t)
++                      (format nil "defined(HAVE_~A)" (string-upcase c-name))
++                      guard)))
+         (format *coutput-stream*
+                 "  register_foreign_function((void*)&~A,~A,~D);~%"
+                 c-name (to-c-string c-name) (svref (second function) 3))
+-        (when *foreign-guard* (format *coutput-stream* "# endif~%"))))
++        (when guard (format *coutput-stream* "# endif~%"))))
+     (maphash (lambda (type fun-vec)
+                (declare (ignore type))
+                (let ((c-name (to-c-name (car fun-vec))))
+@@ -1083,7 +1086,7 @@
+ (defmacro DEF-CALL-OUT (&whole whole-form name &rest options)
+   (setq name (check-symbol name (first whole-form)))
+   (let* ((alist
+-          (parse-options options '(:name :arguments :return-type :language
++          (parse-options options '(:name :arguments :return-type :language :guard
+                                    :built-in :library :version :documentation)
+                          whole-form))
+          (def (gensym "DEF-CALL-OUT-"))
+@@ -1095,6 +1098,7 @@
+          (version (second (assoc :version alist)))
+          (c-name (foreign-name name (assoc :name alist)))
+          (built-in (second (assoc :built-in alist)))
++         (guard (get-assoc :guard alist '*foreign-guard*))
+          ;; Maximize sharing in .fas file, reuse options
+          ;; parse-c-function ignores unknown options, e.g. :name
+          (ctype `(PARSE-C-FUNCTION ',options ',whole-form)))
+@@ -1102,7 +1106,7 @@
+                   ',c-name ,ctype ',properties ,library ,version NIL)))
+        (EXT:COMPILER-LET ((,def ,ctype))
+          (EVAL-WHEN (COMPILE)
+-           (UNLESS ,LIBRARY (NOTE-C-FUN ',c-name ,def ',built-in)))
++           (UNLESS ,LIBRARY (NOTE-C-FUN ',c-name ,def ',built-in ,guard)))
+          (SYSTEM::EVAL-WHEN-COMPILE
+            (SYSTEM::C-DEFUN ',name (C-TYPE-TO-SIGNATURE ,ctype))))
+        (WHEN ,def                       ; found library function
+@@ -1110,10 +1114,10 @@
+          (SYSTEM::%PUTD ',name ,def))
+        ',name)))
+ 
+-(defun note-c-fun (c-name ctype built-in) ; not ABI, compile-time only
++(defun note-c-fun (c-name ctype built-in guard) ; not ABI, compile-time only
+   (when (system::prepare-coutput-file)
+     (prepare-module)
+-    (push (list c-name ctype built-in)
++    (push (list c-name ctype built-in guard)
+           *function-list*)))
+ 
+ (defun count-inarguments (arg-vector)