From 920b5eb02b1e1fd1c6c28395cade04e81fbee2bb Mon Sep 17 00:00:00 2001 From: Paul Khuong Date: Thu, 14 Nov 2013 16:51:18 -0500 Subject: [PATCH] New function SB-EXT:ASSERT-VERSION->= Executing (sb-ext:assert-version->= 1 1 13) signals a continuable error if the running SBCL is older than 1.1.13 (and an undefined function error before that). Based on a patch by Philip Munksgaard. Closes lp#674372. --- NEWS | 4 ++++ doc/manual/beyond-ansi.texinfo | 1 + package-data-list.lisp-expr | 5 ++++- src/code/late-extensions.lisp | 48 ++++++++++++++++++++++++++++++++++++++++ tests/interface.pure.lisp | 7 ++++++ 5 files changed, 64 insertions(+), 1 deletion(-) diff --git a/NEWS b/NEWS index ff74987..c9f52c7 100644 --- a/NEWS +++ b/NEWS @@ -13,6 +13,10 @@ changes relative to sbcl-1.1.13: include error messages instead of error codes. * enhancement: run-sbcl.sh is usefully handled by rlwrap. Thanks to William Cushing. (lp#1249183) + * enhancement: new function SB-EXT:ASSERT-VERSION->= accepts a version + specification (multiple integer arguments) and signals a continuable error + if the current SBCL version is lower (older) than the specification. + (lp#674372) * bug fix: EQUALP now compares correctly structures with raw slots larger than a single word. * bug fix: contribs couldn't be built on Windows with MinGW. diff --git a/doc/manual/beyond-ansi.texinfo b/doc/manual/beyond-ansi.texinfo index 75b1433..9825343 100644 --- a/doc/manual/beyond-ansi.texinfo +++ b/doc/manual/beyond-ansi.texinfo @@ -795,6 +795,7 @@ different type of generator. @include fun-sb-ext-delete-directory.texinfo @include fun-sb-ext-get-time-of-day.texinfo @include macro-sb-ext-wait-for.texinfo +@include fun-sb-ext-version-assert.texinfo @node Stale Extensions @comment node-name, next, previous, up diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 94fe875..ca67d02 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -871,7 +871,10 @@ like *STACK-TOP-HINT* and unsupported stuff like *TRACED-FUN-LIST*." #!+sb-simd-pack "%SIMD-PACK-UB32S" #!+sb-simd-pack "%SIMD-PACK-UB64S" #!+sb-simd-pack "%SIMD-PACK-DOUBLES" - #!+sb-simd-pack "%SIMD-PACK-SINGLES")) + #!+sb-simd-pack "%SIMD-PACK-SINGLES" + + ;; versioning utility + "ASSERT-VERSION->=")) #s(sb-cold:package-data :name "SB!FORMAT" diff --git a/src/code/late-extensions.lisp b/src/code/late-extensions.lisp index 48ee190..bcfaafe 100644 --- a/src/code/late-extensions.lisp +++ b/src/code/late-extensions.lisp @@ -436,3 +436,51 @@ Works on all CASable places." for ,new = (cdr ,old) until (eq ,old (setf ,old ,cas-form)) finally (return (car ,old)))))) + +(defun split-version-string (string) + (loop + with start = 0 + and end = (length string) + while (and start (< start end)) + for subversion = (multiple-value-bind (subversion next) + (parse-integer string :start start + :junk-allowed t) + (setf start + (and subversion + next + (< next end) + (eql #\. (aref string next)) + (1+ next))) + subversion) + when subversion + collect subversion)) + +(defun version>= (x y) + (unless (or x y) + (return-from version>= t)) + (let ((head-x (or (first x) 0)) + (head-y (or (first y) 0))) + (or (> head-x head-y) + (and (= head-x head-y) + (version>= (rest x) (rest y)))))) + +(defun assert-version->= (&rest subversions) + #!+sb-doc + "Asserts that the current SBCL is of version equal to or greater than +the version specified in the arguments. A continuable error is signaled +otherwise. + +The arguments specify a sequence of subversion numbers in big endian order. +They are compared lexicographically with the runtime version, and versions +are treated as though trailed by an unbounded number of 0s. + +For example, (assert-version->= 1 1 4) asserts that the current SBCL is +version 1.1.4[.0.0...] or greater, and (assert-version->= 1) that it is +version 1[.0.0...] or greater." + (let ((version (split-version-string (lisp-implementation-version)))) + (unless (version>= version subversions) + (cerror "Disregard this version requirement." + "SBCL ~A is too old for this program (version ~{~A~^.~} ~ + or later is required)." + (lisp-implementation-version) + subversions)))) diff --git a/tests/interface.pure.lisp b/tests/interface.pure.lisp index 7e43f97..824c25e 100644 --- a/tests/interface.pure.lisp +++ b/tests/interface.pure.lisp @@ -168,3 +168,10 @@ (funcall fun1 1/7) (funcall fun1 1/100000000000000000000000000) (assert (< (- (get-universal-time) start-time) 2)))) + +(with-test (:name :version-assert-ok) + (sb-ext:assert-version->= 1 1 13)) + +(with-test (:name :version-assert-fails) + (assert (raises-error? + (sb-ext:assert-version->= most-positive-fixnum)))) -- 1.7.10.4