diff options
| -rw-r--r-- | gnu/local.mk | 1 | ||||
| -rw-r--r-- | gnu/packages/guile.scm | 21 | ||||
| -rw-r--r-- | gnu/packages/patches/guile-gdbm-ffi-support-gdbm-1.14.patch | 53 |
3 files changed, 71 insertions, 4 deletions
diff --git a/gnu/local.mk b/gnu/local.mk index 010f1417fb..a03b482df2 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -742,6 +742,7 @@ dist_patch_DATA = \ %D%/packages/patches/guile-1.8-cpp-4.5.patch \ %D%/packages/patches/guile-2.2-default-utf8.patch \ %D%/packages/patches/guile-default-utf8.patch \ + %D%/packages/patches/guile-gdbm-ffi-support-gdbm-1.14.patch \ %D%/packages/patches/guile-linux-syscalls.patch \ %D%/packages/patches/guile-present-coding.patch \ %D%/packages/patches/guile-relocatable.patch \ diff --git a/gnu/packages/guile.scm b/gnu/packages/guile.scm index 1c8eaa9ec5..f6f8ef9b95 100644 --- a/gnu/packages/guile.scm +++ b/gnu/packages/guile.scm @@ -1134,6 +1134,15 @@ inspired by the SCSH regular expression system.") (base32 "1j8wrsw7v9w6qkl47xz0rdikg50v16nn6kbs3lgzcymjzpa7babj")))) (build-system trivial-build-system) + (inputs + `(("guile" ,guile-2.2) + ;; patch-and-repack doesn't work for git checkouts, + ;; so we must apply the patch manually. + ("patch" ,patch) + ("patch-file" ,(search-patch + "guile-gdbm-ffi-support-gdbm-1.14.patch")))) + (propagated-inputs + `(("gdbm" ,gdbm))) (arguments `(#:modules ((guix build utils)) @@ -1186,12 +1195,16 @@ inspired by the SCSH regular expression system.") (format #f "(dynamic-link \"~a/lib/libgdbm.so\")" (assoc-ref %build-inputs "gdbm")))) + ;; Apply the patch to add support for gdbm-1.14. + (let ((patch-command (string-append (assoc-ref %build-inputs "patch") + "/bin/patch")) + (patch-file (assoc-ref %build-inputs "patch-file"))) + (with-directory-excursion (dirname gdbm.scm-dest) + (format #t "applying '~a'...~%" patch-file) + (invoke patch-command "--force" "--input" patch-file))) + ;; compile to the destination (compile-file gdbm.scm-dest gdbm.go-dest))))) - (inputs - `(("guile" ,guile-2.2))) - (propagated-inputs - `(("gdbm" ,gdbm))) (home-page "https://github.com/ijp/guile-gdbm") (synopsis "Guile bindings to the GDBM library via Guile's FFI") (description diff --git a/gnu/packages/patches/guile-gdbm-ffi-support-gdbm-1.14.patch b/gnu/packages/patches/guile-gdbm-ffi-support-gdbm-1.14.patch new file mode 100644 index 0000000000..e6b578bdb7 --- /dev/null +++ b/gnu/packages/patches/guile-gdbm-ffi-support-gdbm-1.14.patch @@ -0,0 +1,53 @@ +From 1da99396dc65993ba34ac0370ca5d6acda6a3322 Mon Sep 17 00:00:00 2001 +From: Mark H Weaver <mhw@netris.org> +Date: Sun, 18 Mar 2018 07:02:37 -0400 +Subject: [PATCH] Add support for gdbm-1.14. + +As of gdbm-1.14, 'gdbm_errno' no longer exists as a binary interface. +It has been replaced by 'gdbm_errno_location', a function that returns +int*. We now use this new interface if it's available. +--- + gdbm.scm | 18 ++++++++++++++++-- + 1 file changed, 16 insertions(+), 2 deletions(-) + +diff --git a/gdbm.scm b/gdbm.scm +index b92992f..4d38cc3 100644 +--- a/gdbm.scm ++++ b/gdbm.scm +@@ -17,6 +17,9 @@ + ;; You should have received a copy of the GNU General Public License + ;; along with this program. If not, see <http://www.gnu.org/licenses/>. + ++;; Modified by Mark H Weaver <mhw@netris.org> in March 2018 to support ++;; gdbm-1.14 with its new 'gdbm_errno_location' interface. ++ + (define-module (gdbm) + #:use-module (system foreign) + #:use-module (rnrs bytevectors) +@@ -151,10 +154,21 @@ + + ;;; errors + +-(define %errno (dynamic-pointer "gdbm_errno" libgdbm)) ++(define %list-int ++ (list int)) ++ ++(define (dereference-int ptr) ++ (apply (lambda (errno) errno) ++ (parse-c-struct ptr %list-int))) ++ ++(define %errno-location ++ (or (false-if-exception ++ (let ((func (dynamic-func "gdbm_errno_location" libgdbm))) ++ (pointer->procedure '* func '()))) ++ (const (dynamic-pointer "gdbm_errno" libgdbm)))) + + (define (gdbm-errno) +- (pointer-address (dereference-pointer %errno))) ++ (dereference-int (%errno-location))) + + (define (gdbm-error) + (error (pointer->string (%gdbm-strerror (gdbm-errno))))) +-- +2.16.2 + |