support if sbcl's lisp-implementation-version return '2.4.10.roswell'
Some checks failed
Linux / build (, linux/amd64, musl) (push) Has been cancelled
Linux / build (aarch64, linux/arm64, musl64, arm64, ) (push) Has been cancelled
Linux / build (aarch64, linux/arm64, musl64, arm64, -glibc2.31) (push) Has been cancelled
Linux / build (aarch64, linux/arm64, musl64, arm64, -musl) (push) Has been cancelled
Linux / build (linux/amd64, deb, deb, x86-64) (push) Has been cancelled
Linux / build (linux/amd64, pandoc, docs, x86-64) (push) Has been cancelled
Linux / build (musl64, x86_64, ) (push) Has been cancelled
Linux / build (musl64, x86_64, -glibc2.31) (push) Has been cancelled
Linux / build (musl64, x86_64, -musl) (push) Has been cancelled
Linux / build (riscv64, linux/riscv64, musl64, riscv64, ) (push) Has been cancelled
Linux / build (riscv64, linux/riscv64, musl64, riscv64, -glibc2.31) (push) Has been cancelled
Linux / build (riscv64, linux/riscv64, musl64, riscv64, -musl) (push) Has been cancelled
osx / build (sbcl-bin/2.3.8, arm64) (push) Has been cancelled
osx / build (sbcl-bin/2.3.8, x86-64) (push) Has been cancelled
windows / build-windows (i686, i686, 32) (push) Has been cancelled
windows / build-windows (x86_64, amd64, 64) (push) Has been cancelled

This commit is contained in:
snmsts 2025-01-03 14:53:48 +09:00
parent 82f902bf43
commit 029e979374

View file

@ -308,13 +308,25 @@ As a hacky side effect, files with the same name as PROVIDE is not loaded.
(or *version-cache*
(setf *version-cache* (roswell '("roswell-internal-use" "version") :string t)))))
(defun implementation-version ()
"cut off after third? dot from lisp-implementation-version"
(let ((version (lisp-implementation-version)))
(loop with j = 0
for i from 0 to (1- (length version))
when (eql (aref version i) #\.)
do (incf j)
(when (= j 3)
(return-from implementation-version (subseq version 0 i))))
version))
#+sbcl
(when (ignore-errors (string-equal (opt "impl") "sbcl-bin" :end1 8))
(flet ((source (version)
(let ((path (merge-pathnames (format nil "src/sbcl-~A/" version) (opt "homedir"))))
(when (probe-file path)
(sb-ext:set-sbcl-source-location path)))))
(or (source (lisp-implementation-version))
(or (source (implementation-version))
(source "git"))))
(defun source-registry (arg &rest rest)