From 60bbad167b0691995a659121acda55392e4021b6 Mon Sep 17 00:00:00 2001 From: Andrew Berkley 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 m): Likewise. (deploy-managed-host): Likewise. (maybe-raise-unsupported-configuration-error): Likewise. * gnu/packages.scm (search-patch): Likewise. * gnu/services.scm (%service-with-default-value): Likewise. (files->etc-directory): Likewise. (fold-services): Likewise. * gnu/system.scm (locale-name->definition*): Likewise. * gnu/system/mapped-devices.scm (check-device-initrd-modules): Likewise. (check-luks-device): Likewise. * guix/channels.scm (latest-channel-instance): Likewise. * guix/cve.scm (json->cve-items): Likewise. * guix/git-authenticate.scm (commit-signing-key): Likewise. (commit-authorized-keys): Likewise. (authenticate-commit): Likewise. (verify-introductory-commit): Likewise. * guix/remote.scm (remote-pipe-for-gexp): Likewise. * guix/scripts/graph.scm (assert-package): Likewise. * guix/scripts/offload.scm (private-key-from-file*): Likewise. * guix/ssh.scm (authenticate-server*): Likewise. (open-ssh-session): Likewise. (remote-inferior): Likewise. * guix/ui.scm (matching-generations): Likewise. * guix/upstream.scm (package-update): Likewise. * tests/channels.scm ("latest-channel-instances, missing introduction for 'guix'"): Catch 'formatted-message?'. ("authenticate-channel, wrong first commit signer"): Likewise. * tests/lint.scm ("patches: not found"): Adjust message string. * tests/packages.scm ("patch not found yields a run-time error"): Catch 'formatted-message?'. * guix/lint.scm (check-patch-file-names): Handle 'formatted-message?'. (check-derivation): Ditto. Ludovic Courtès 2020-07-25utils: Move '&fix-hint' to (guix diagnostics)....* guix/utils.scm (&fix-hint): Move to... * guix/diagnostics.scm (&fix-hint): ... here. * gnu.scm: Adjust imports accordingly. * gnu/system/mapped-devices.scm: Likewise. * guix/channels.scm: Likewise. * guix/profiles.scm: Likewise. * guix/scripts/system/reconfigure.scm: Likewise. * guix/ssh.scm: Likewise. Ludovic Courtès 2020-07-25utils: Move <location> and '&error-location' to (guix diagnostics)....* guix/utils.scm (<location>, source-properties->location) (location->source-properties, &error-location): Move to... * guix/diagnostics.scm: ... here. * gnu.scm: Adjust imports accordingly. * gnu/machine.scm: Likewise. * gnu/system.scm: Likewise. * gnu/tests.scm: Likewise. * guix/inferior.scm: Likewise. * tests/channels.scm: Likewise. * tests/packages.scm: Likewise. Ludovic Courtès