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
Loading
Loading
Loading
Loading
+1 −1
Original line number Diff line number Diff line
@@ -74,7 +74,7 @@
  :licence "MIT"
  :description "Another System Definition Facility"
  :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 ()
  #+asdf3 :encoding #+asdf3 :utf-8
  ;; For most purposes, asdf itself specially counts as a builtin system.
+1 −1
Original line number Diff line number Diff line
;;; -*- 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:
;;; please mail to <asdf-devel@common-lisp.net>.
+5 −4
Original line number Diff line number Diff line
@@ -73,7 +73,7 @@ This is designed to abstract away the implementation specific quit forms."
    #+gcl (lisp:quit 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)
    #+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)
    #+sbcl #.(let ((exit (find-symbol* :exit :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."
    (system::print-backtrace :out stream :limit count)
    #+(or clozure mcl)
    (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))
    #+(or cmu scl)
    (let ((debug:*debug-print-level* *print-level*)
@@ -200,11 +201,11 @@ This is designed to abstract away the implementation specific quit forms."
    #+(or cmu scl) extensions:*command-line-strings*
    #+ecl (loop :for i :from 0 :below (si:argc) :collect (si:argv i))
    #+gcl si:*command-args*
    #+genera nil
    #+(or genera mcl) nil
    #+lispworks sys:*line-arguments-list*
    #+sbcl sb-ext:*posix-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"))

  (defun command-line-arguments (&optional (arguments (raw-command-line-arguments)))
+12 −9
Original line number Diff line number Diff line
@@ -33,20 +33,23 @@

  (defun os-windows-p ()
    (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 ()
    (or #+genera t))

  (defun os-oldmac-p ()
    (or #+mcl t))

  (defun detect-os ()
    (flet ((yes (yes) (pushnew yes *features*))
           (no (no) (setf *features* (remove no *features*))))
      (cond
        ((os-unix-p) (yes :os-unix) (no :os-windows) (no :genera))
        ((os-windows-p) (yes :os-windows) (no :os-unix) (no :genera))
        ((os-genera-p) (no :os-unix) (no :os-windows) (yes :genera))
        (t (error "Congratulations for trying XCVB on an operating system~%~
that is neither Unix, nor Windows, nor even Genera.~%Now you port it.")))))
    (loop* :with o
           :for (feature . detect) :in '((:os-unix . os-unix-p) (:os-windows . os-windows-p)
                                         (:genera . os-genera-p) (:os-oldmac . os-oldmac-p))
           :when (and (not o) (funcall detect)) :do (setf o feature) (pushnew o *features*)
           :else :do (setf *features* (remove feature *features*))
           :finally
           (return (or o (error "Congratulations for trying ASDF on an operating system~%~
that is neither Unix, nor Windows, nor Genera, nor even old MacOS.~%Now you port it.")))))

  (detect-os))

+5 −2
Original line number Diff line number Diff line
@@ -107,6 +107,7 @@
    "Takes arguments like CL:MAKE-PATHNAME in the CLHS, and
   tries hard to make a pathname that will actually behave as documented,
   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))
    (apply 'make-pathname
           (append
@@ -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
    ;; strings and lists of strings or :unspecific
    ;; 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
                       :host (or #+cmu lisp::*unix-host*)
                       #+scl ,@'(:scheme nil :scheme-specific-part nil
                                 :username nil :password nil :parameters nil :query nil :fragment nil)
                       ;; 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))))

@@ -455,7 +458,7 @@ to throw an error if the pathname is absolute"
                 (make-pathname*
                  :directory (unless file-only (cons relative path))
                  :name name :type type
                  :defaults (or defaults *nil-pathname*))
                  :defaults (or #-mcl defaults *nil-pathname*))
                 (remove-plist-keys '(:type :dot-dot :defaults) keys))))))

  (defun unix-namestring (pathname)
Loading