me/guix
Archived
1
0
Fork 0
Code Activity

gnu: sbcl-png: Fix compiling with sbcl >= 2.1.6.

Browse source 
* gnu/packages/patches/sbcl-png-fix-sbcl-compatibility.patch: New file.
* gnu/local.mk (dist_patch_DATA): Add it.
* gnu/packages/lisp-xyz.scm (sbcl-png)[source]: Use it.
This commit is contained in:
Guillaume Le Vaillant 2021-09-28 10:46:40 +02:00
parent 946ac3467e
commit dce9b98d55
No known key found for this signature in database
GPG key ID: 6BE8208ADF21FE3F
3 changed files with 64 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
gnu/local.mk
View file

@ -1742,6 +1742,7 @@ dist_patch_DATA = \
%D%/packages/patches/rust-openssl-sys-no-vendor.patch \
%D%/packages/patches/sbc-fix-build-non-x86.patch \
%D%/packages/patches/sbcl-clml-fix-types.patch \
%D%/packages/patches/sbcl-png-fix-sbcl-compatibility.patch \
%D%/packages/patches/scalapack-blacs-mpi-deprecations.patch \
%D%/packages/patches/scheme48-tests.patch \
%D%/packages/patches/scotch-build-parallelism.patch \

4
gnu/packages/lisp-xyz.scm
View file

@ -9408,7 +9408,9 @@ for reading and writing JPEG image files.")
(commit commit)))
(file-name (git-file-name "cl-png" version))
(sha256
(base32 "173hqwpd0rwqf95mfx1h9l9c3i8bb0gvnpspzmmz3g5x3440czy4"))))
(base32 "173hqwpd0rwqf95mfx1h9l9c3i8bb0gvnpspzmmz3g5x3440czy4"))
;; Patch to fix compiling with SBCL >= 2.1.6.
(patches (search-patches "sbcl-png-fix-sbcl-compatibility.patch"))))
(build-system asdf-build-system/sbcl)
(arguments
`(#:phases

60
gnu/packages/patches/sbcl-png-fix-sbcl-compatibility.patch Normal file
View file

@ -0,0 +1,60 @@
From 60bbad167b0691995a659121acda55392e4021b6 Mon Sep 17 00:00:00 2001
From: Andrew Berkley <ajb@dwavesys.com>
Date: Sun, 4 Jul 2021 12:50:34 -0700
Subject: [PATCH] Fix for sbcl 2.1.6
---
compat.lisp | 30 +++++++++++++++---------------
1 file changed, 15 insertions(+), 15 deletions(-)
diff --git a/compat.lisp b/compat.lisp
index 95a9869..ea6d1a1 100644
--- a/compat.lisp
+++ b/compat.lisp
@@ -1,12 +1,13 @@
(in-package #:png)
-#+sbcl ; Present in SBCL 1.0.24.
-(declaim (ftype (function (array) (values (simple-array * (*)) &optional))
- array-storage-vector))
-
#+sbcl
-(defun array-storage-vector (array)
- "Returns the underlying storage vector of ARRAY, which must be a non-displaced array.
+(macrolet ((make-array-storage-vector ()
+ (let ((%array-data-vector (or (find-symbol "%ARRAY-DATA-VECTOR" :sb-kernel)
+ (find-symbol "%ARRAY-DATA" :sb-kernel)))) ;; renamed in sbcl 2.1.6
+ `(progn
+ (declaim (ftype (function (array) (values (simple-array * (*)) &optional)) array-storage-vector))
+ (defun array-storage-vector (array)
+ "Returns the underlying storage vector of ARRAY, which must be a non-displaced array.
In SBCL, if ARRAY is a of type \(SIMPLE-ARRAY * \(*)), it is its own storage
vector. Multidimensional arrays, arrays with fill pointers, and adjustable
@@ -16,15 +17,14 @@ ARRAY, which this function returns.
Important note: the underlying vector is an implementation detail. Even though
this function exposes it, changes in the implementation may cause this
function to be removed without further warning."
- ;; KLUDGE: Without TRULY-THE the system is not smart enough to
- ;; figure out that the return value is always of the known type.
- (sb-ext:truly-the (simple-array * (*))
- (if (sb-kernel:array-header-p array)
- (if (sb-kernel:%array-displaced-p array)
- (error "~S cannot be used with displaced arrays. Use ~S instead."
- 'array-storage-vector 'array-displacement)
- (sb-kernel:%array-data-vector array))
- array)))
+ (sb-ext:truly-the (simple-array * (*))
+ (if (sb-kernel:array-header-p array)
+ (if (sb-kernel:%array-displaced-p array)
+ (error "~S cannot be used with displaced arrays. Use ~S instead."
+ 'array-storage-vector 'array-displacement)
+ (,%array-data-vector array))
+ array)))))))
+ (make-array-storage-vector))
#+allegro
(defmacro with-pointer-to-array-data ((ptr-var array) &body body)
--
2.33.0