Skip to content
Snippets Groups Projects
Commit 5825d4ac authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

3.0.1.9: better OS detection for MCL and ABCL. Restore MCL support.

Thanks to Chun Tian (binghe) for his feedback.
MCL has issues with make-pathname failing to override defaults with an explicit NIL component.
parent 43811764
No related branches found
No related tags found
No related merge requests found
...@@ -74,7 +74,7 @@ ...@@ -74,7 +74,7 @@
:licence "MIT" :licence "MIT"
:description "Another System Definition Facility" :description "Another System Definition Facility"
:long-description "ASDF builds Common Lisp software organized into defined systems." :long-description "ASDF builds Common Lisp software organized into defined systems."
:version "3.0.1.8" ;; to be automatically updated by make bump-version :version "3.0.1.9" ;; to be automatically updated by make bump-version
:depends-on () :depends-on ()
#+asdf3 :encoding #+asdf3 :utf-8 #+asdf3 :encoding #+asdf3 :utf-8
;; For most purposes, asdf itself specially counts as a builtin system. ;; For most purposes, asdf itself specially counts as a builtin system.
......
;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*- ;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
;;; This is ASDF 3.0.1.8: Another System Definition Facility. ;;; This is ASDF 3.0.1.9: Another System Definition Facility.
;;; ;;;
;;; Feedback, bug reports, and patches are all welcome: ;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>. ;;; please mail to <asdf-devel@common-lisp.net>.
......
...@@ -73,7 +73,7 @@ This is designed to abstract away the implementation specific quit forms." ...@@ -73,7 +73,7 @@ This is designed to abstract away the implementation specific quit forms."
#+gcl (lisp:quit code) #+gcl (lisp:quit code)
#+genera (error "You probably don't want to Halt the Machine. (code: ~S)" code) #+genera (error "You probably don't want to Halt the Machine. (code: ~S)" code)
#+lispworks (lispworks:quit :status code :confirm nil :return nil :ignore-errors-p t) #+lispworks (lispworks:quit :status code :confirm nil :return nil :ignore-errors-p t)
#+mcl (ccl:quit) ;; or should we use FFI to call libc's exit(3) ? #+mcl (progn code (ccl:quit)) ;; or should we use FFI to call libc's exit(3) ?
#+mkcl (mk-ext:quit :exit-code code) #+mkcl (mk-ext:quit :exit-code code)
#+sbcl #.(let ((exit (find-symbol* :exit :sb-ext nil)) #+sbcl #.(let ((exit (find-symbol* :exit :sb-ext nil))
(quit (find-symbol* :quit :sb-ext nil))) (quit (find-symbol* :quit :sb-ext nil)))
...@@ -109,7 +109,8 @@ This is designed to abstract away the implementation specific quit forms." ...@@ -109,7 +109,8 @@ This is designed to abstract away the implementation specific quit forms."
(system::print-backtrace :out stream :limit count) (system::print-backtrace :out stream :limit count)
#+(or clozure mcl) #+(or clozure mcl)
(let ((*debug-io* stream)) (let ((*debug-io* stream))
(ccl:print-call-history :count count :start-frame-number 1) #+clozure (ccl:print-call-history :count count :start-frame-number 1)
#+mcl (ccl:print-call-history :detailed-p nil)
(finish-output stream)) (finish-output stream))
#+(or cmu scl) #+(or cmu scl)
(let ((debug:*debug-print-level* *print-level*) (let ((debug:*debug-print-level* *print-level*)
...@@ -200,11 +201,11 @@ This is designed to abstract away the implementation specific quit forms." ...@@ -200,11 +201,11 @@ This is designed to abstract away the implementation specific quit forms."
#+(or cmu scl) extensions:*command-line-strings* #+(or cmu scl) extensions:*command-line-strings*
#+ecl (loop :for i :from 0 :below (si:argc) :collect (si:argv i)) #+ecl (loop :for i :from 0 :below (si:argc) :collect (si:argv i))
#+gcl si:*command-args* #+gcl si:*command-args*
#+genera nil #+(or genera mcl) nil
#+lispworks sys:*line-arguments-list* #+lispworks sys:*line-arguments-list*
#+sbcl sb-ext:*posix-argv* #+sbcl sb-ext:*posix-argv*
#+xcl system:*argv* #+xcl system:*argv*
#-(or abcl allegro clisp clozure cmu ecl gcl genera lispworks sbcl scl xcl) #-(or abcl allegro clisp clozure cmu ecl gcl genera lispworks mcl sbcl scl xcl)
(error "raw-command-line-arguments not implemented yet")) (error "raw-command-line-arguments not implemented yet"))
(defun command-line-arguments (&optional (arguments (raw-command-line-arguments))) (defun command-line-arguments (&optional (arguments (raw-command-line-arguments)))
......
...@@ -33,20 +33,23 @@ ...@@ -33,20 +33,23 @@
(defun os-windows-p () (defun os-windows-p ()
(or #+abcl (featurep :windows) (or #+abcl (featurep :windows)
#+(and (not (or unix cygwin darwin)) (or win32 windows mswindows mingw32)) t)) #+(and (not (or abcl unix cygwin darwin)) (or win32 windows mswindows mingw32)) t))
(defun os-genera-p () (defun os-genera-p ()
(or #+genera t)) (or #+genera t))
(defun os-oldmac-p ()
(or #+mcl t))
(defun detect-os () (defun detect-os ()
(flet ((yes (yes) (pushnew yes *features*)) (loop* :with o
(no (no) (setf *features* (remove no *features*)))) :for (feature . detect) :in '((:os-unix . os-unix-p) (:os-windows . os-windows-p)
(cond (:genera . os-genera-p) (:os-oldmac . os-oldmac-p))
((os-unix-p) (yes :os-unix) (no :os-windows) (no :genera)) :when (and (not o) (funcall detect)) :do (setf o feature) (pushnew o *features*)
((os-windows-p) (yes :os-windows) (no :os-unix) (no :genera)) :else :do (setf *features* (remove feature *features*))
((os-genera-p) (no :os-unix) (no :os-windows) (yes :genera)) :finally
(t (error "Congratulations for trying XCVB on an operating system~%~ (return (or o (error "Congratulations for trying ASDF on an operating system~%~
that is neither Unix, nor Windows, nor even Genera.~%Now you port it."))))) that is neither Unix, nor Windows, nor Genera, nor even old MacOS.~%Now you port it.")))))
(detect-os)) (detect-os))
......
...@@ -107,6 +107,7 @@ ...@@ -107,6 +107,7 @@
"Takes arguments like CL:MAKE-PATHNAME in the CLHS, and "Takes arguments like CL:MAKE-PATHNAME in the CLHS, and
tries hard to make a pathname that will actually behave as documented, tries hard to make a pathname that will actually behave as documented,
despite the peculiarities of each implementation" despite the peculiarities of each implementation"
;; TODO: reimplement defaulting for MCL, whereby an explicit NIL should override the defaults.
(declare (ignorable host device directory name type version defaults)) (declare (ignorable host device directory name type version defaults))
(apply 'make-pathname (apply 'make-pathname
(append (append
...@@ -182,12 +183,14 @@ by default *DEFAULT-PATHNAME-DEFAULTS*, which cannot be NIL." ...@@ -182,12 +183,14 @@ by default *DEFAULT-PATHNAME-DEFAULTS*, which cannot be NIL."
;; see also "valid physical pathname host" in the CLHS glossary, that suggests ;; see also "valid physical pathname host" in the CLHS glossary, that suggests
;; strings and lists of strings or :unspecific ;; strings and lists of strings or :unspecific
;; But CMUCL decides to die on NIL. ;; But CMUCL decides to die on NIL.
;; MCL has issues with make-pathname, nil and defaulting
(declare (ignorable defaults))
#.`(make-pathname* :directory nil :name nil :type nil :version nil :device nil #.`(make-pathname* :directory nil :name nil :type nil :version nil :device nil
:host (or #+cmu lisp::*unix-host*) :host (or #+cmu lisp::*unix-host*)
#+scl ,@'(:scheme nil :scheme-specific-part nil #+scl ,@'(:scheme nil :scheme-specific-part nil
:username nil :password nil :parameters nil :query nil :fragment nil) :username nil :password nil :parameters nil :query nil :fragment nil)
;; the default shouldn't matter, but we really want something physical ;; the default shouldn't matter, but we really want something physical
:defaults defaults)) #-mcl ,@'(:defaults defaults)))
(defvar *nil-pathname* (nil-pathname (translate-logical-pathname (user-homedir-pathname)))) (defvar *nil-pathname* (nil-pathname (translate-logical-pathname (user-homedir-pathname))))
...@@ -455,7 +458,7 @@ to throw an error if the pathname is absolute" ...@@ -455,7 +458,7 @@ to throw an error if the pathname is absolute"
(make-pathname* (make-pathname*
:directory (unless file-only (cons relative path)) :directory (unless file-only (cons relative path))
:name name :type type :name name :type type
:defaults (or defaults *nil-pathname*)) :defaults (or #-mcl defaults *nil-pathname*))
(remove-plist-keys '(:type :dot-dot :defaults) keys)))))) (remove-plist-keys '(:type :dot-dot :defaults) keys))))))
(defun unix-namestring (pathname) (defun unix-namestring (pathname)
......
...@@ -52,7 +52,7 @@ You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSIO ...@@ -52,7 +52,7 @@ You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSIO
;; "3.4.5.67" would be a development version in the official upstream of 3.4.5. ;; "3.4.5.67" would be a development version in the official upstream of 3.4.5.
;; "3.4.5.0.8" would be your eighth local modification of official release 3.4.5 ;; "3.4.5.0.8" would be your eighth local modification of official release 3.4.5
;; "3.4.5.67.8" would be your eighth local modification of development version 3.4.5.67 ;; "3.4.5.67.8" would be your eighth local modification of development version 3.4.5.67
(asdf-version "3.0.1.8") (asdf-version "3.0.1.9")
(existing-version (asdf-version))) (existing-version (asdf-version)))
(setf *asdf-version* asdf-version) (setf *asdf-version* asdf-version)
(when (and existing-version (not (equal asdf-version existing-version))) (when (and existing-version (not (equal asdf-version existing-version)))
......
"3.0.1.8" "3.0.1.9"
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment