chiark / gitweb /
Add a boundp-function slot, which is required by virtual slot getter.
[clg] / tools / config.lisp
index 4d30a4ca56a52f8be1304cfacec48e14ba44303b..4b3341b08c20212d86afb8a6aee1e102aaca0f6f 100644 (file)
@@ -4,7 +4,7 @@ (defpackage #:pkg-config
   (:import-from #:sb-int #:featurep)
   (:export #:pkg-cflags #:pkg-libs #:pkg-exists-p #:pkg-version
            #:pkg-variable #:pkg-libdir #:tmpname)
-  (:export #:featurep #:sbcl>= #:sbcl< #:clisp>=))
+  (:export #:featurep #:sbcl>= #:sbcl< #:clisp>= #:clisp<))
 
 (in-package #:pkg-config)
 
@@ -25,7 +25,7 @@ (defun run-pkg-config (package error-p &rest options)
        (let* ((asdf::*verbose-out* nil)
               (exit-code 
                (asdf:run-shell-command 
-                "~A ~A ~:[~;--print-errors ~]~{~A ~} &>~A"
+                "~A ~A ~:[~;--print-errors ~]~{~A ~} >~A 2>&1"
                 *pkg-config* package error-p options outname)))
          (cond
           ((= exit-code 127) (error "Unable to run ~A" *pkg-config*))
@@ -122,9 +122,9 @@ (defun pkg-libdir (package)
 
 (defun |#?-reader| (stream subchar arg)
   (declare (ignore subchar arg))
-  (let ((not-p (when (char= (peek-char nil stream) #\-)
-                (read-char stream)))
-       (conditional (read stream t nil t)))
+  (let* ((not-p (when (char= (peek-char nil stream) #\-)
+                 (read-char stream)))
+        (conditional (read stream t nil t)))
     (cond
      (*read-suppress* (read stream t nil t))
      ((not *read-eval*)
@@ -144,30 +144,34 @@ (set-dispatch-macro-character #\# #\? #'|#?-reader|)
 #+sbcl
 (progn
   (defun sbcl-version ()
-    (let* ((dot1 (position #\. (lisp-implementation-version)))
-          (dot2 (position #\. (lisp-implementation-version) :start (1+ dot1))))
-      (values 
-       (parse-integer (lisp-implementation-version) :end dot1)
-       (parse-integer (lisp-implementation-version) :start (1+ dot1) :end dot2)
-       (if dot2
-          (parse-integer (lisp-implementation-version) :start (1+ dot2) :junk-allowed t)
-        0))))
-  (defun sbcl>= (req-major req-minor req-micro)
-    (multiple-value-bind (major minor micro) (sbcl-version)      
+    (values-list
+     (loop
+      repeat 4
+      ;; We use . and - as delimiters because some Linux
+      ;; distributions tend to patch SBCL and add a distro-specific
+      ;; version tag (like 1.0.19-gentoo).
+      for part in (split-string (lisp-implementation-version) :delimiter '(#\. #\-))
+      while (every #'digit-char-p part)
+      collect (parse-integer part))))
+  (defun sbcl>= (major minor micro &optional patch)
+    (multiple-value-bind (%major %minor %micro %patch) (sbcl-version)      
       (or 
-       (> major req-major)
-       (and (= major req-major) (> minor req-minor))
-       (and (= major req-major) (= minor req-minor) (>= micro req-micro)))))
-  (defun sbcl< (req-major req-minor req-micro)
-    (not (sbcl>= req-major req-minor req-micro))))
+       (> %major major)
+       (and (= %major major) (> %minor minor))
+       (and (= %major major) (= %minor minor) (> %micro micro))
+       (and 
+       (= %major major) (= %minor minor) (= %micro micro)
+       (>= (or %patch 0) (or patch 0))))))
+  (defun sbcl< (major minor micro &optional patch)
+    (not (sbcl>= major minor micro patch))))
 
 #-sbcl
 (progn
-  (defun sbcl>= (req-major req-minor req-micro)
-    (declare (ignore req-major req-minor req-micro))
+  (defun sbcl>= (major minor micro &optional patch)
+    (declare (ignore major minor micro patch))
     nil)
-  (defun sbcl< (req-major req-minor req-micro)
-    (declare (ignore req-major req-minor req-micro))
+  (defun sbcl< (major minor micro &optional patch)
+    (declare (ignore major minor micro patch))
     nil))
 
 #+clisp
@@ -181,9 +185,15 @@   (defun clisp>= (req-major req-minor)
     (multiple-value-bind (major minor) (clisp-version)      
       (or 
        (> major req-major)
-       (and (= major req-major) (> minor req-minor))))))
+       (and (= major req-major) (> minor req-minor)))))
+  (defun clisp< (req-major req-minor)
+    (not (clisp>= req-major req-minor))))
 
 #-clisp
-(defun clisp>= (req-major req-minor)
-  (declare (ignore req-major req-minor))
-  nil)
+(progn
+  (defun clisp>= (req-major req-minor)
+    (declare (ignore req-major req-minor))
+    nil)
+  (defun clisp< (req-major req-minor)
+    (declare (ignore req-major req-minor))
+    nil))