Commit 38eb8a7c authored by Francois-Rene Rideau's avatar Francois-Rene Rideau Committed by Robert Goldman

Introduce macro os-cond

On ABCL, os testing is at runtime.
On all other implementations, it's at compile-time.
SBCL can optimize some runtime tests and then complain about unreachable code.
os-cond abstracts over OS conditionalization and makes everyone happy.
Needed by an upcoming configuration change.

Plus minor typographical fixes.
parent 0464b2c7
......@@ -160,10 +160,10 @@ itself.")) ;; operation on a system and its dependencies
((member :dll :lib :shared-library :static-library :program :object :program)
(compile-file-type :type bundle-type))
((member :image) #-allegro "image" #+allegro "dxl")
((member :dll :shared-library) (cond ((os-macosx-p) "dylib") ((os-unix-p) "so") ((os-windows-p) "dll")))
((member :lib :static-library) (cond ((os-unix-p) "a")
((os-windows-p) (if (featurep '(:or :mingw32 :mingw64)) "a" "lib"))))
((eql :program) (cond ((os-unix-p) nil) ((os-windows-p) "exe")))))
((member :dll :shared-library) (os-cond ((os-macosx-p) "dylib") ((os-unix-p) "so") ((os-windows-p) "dll")))
((member :lib :static-library) (os-cond ((os-unix-p) "a")
((os-windows-p) (if (featurep '(:or :mingw32 :mingw64)) "a" "lib"))))
((eql :program) (os-cond ((os-unix-p) nil) ((os-windows-p) "exe")))))
(defun bundle-output-files (o c)
(let ((bundle-type (bundle-type o)))
......
......@@ -7,6 +7,7 @@
(:use :uiop/common-lisp :uiop/package :uiop/utility)
(:export
#:featurep #:os-unix-p #:os-macosx-p #:os-windows-p #:os-genera-p #:detect-os ;; features
#:os-cond
#:getenv #:getenvp ;; environment variables
#:implementation-identifier ;; implementation identifier
#:implementation-type #:*implementation-type*
......@@ -73,6 +74,10 @@ except on ABCL where it might change between FASL compilation and runtime."
(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.")))))
(defmacro os-cond (&rest clauses)
#+abcl `(cond ,@clauses)
#-abcl (loop* :for (test . body) :in clauses :when (eval test) :return `(progn ,@body)))
(detect-os))
;;;; Environment variables: getting them, and parsing them.
......@@ -109,20 +114,19 @@ use getenvp to return NIL in such a case."
#-(or abcl allegro clasp clisp clozure cmu cormanlisp ecl gcl genera lispworks mcl mkcl sbcl scl xcl)
(error "~S is not supported on your implementation" 'getenv))
(defsetf getenv (x) (val)
(defsetf getenv (x) (val)
"Set an environment variable."
(declare (ignorable x val))
#+clisp `(system::setenv ,x ,val)
#+ecl `(ext:setenv ,x ,val)
#+allegro `(setf (sys:getenv ,x) ,val)
#+clisp `(system::setenv ,x ,val)
#+clozure `(ccl:setenv ,x ,val)
#+cmu `(unix:unix-setenv ,x ,val 1)
#+ecl `(ext:setenv ,x ,val)
#+lispworks `(hcl:setenv ,x ,val)
#+mkcl `(mkcl:setenv ,x ,val)
#+sbcl `(progn (require :sb-posix) (symbol-call :sb-posix :setenv ,x ,val 1))
#-(or allegro clisp clozure ecl lispworks mkcl sbcl cmu)
'(error "SETF ~S is not supported on your implementation" 'getenv))
#-(or allegro clisp clozure cmu ecl lispworks mkcl sbcl)
'(error "~S ~S is not supported on your implementation" 'setf 'getenv))
(defun getenvp (x)
"Predicate that is true if the named variable is present in the libc environment,
......
......@@ -404,9 +404,9 @@ For an empty type, *UNSPECIFIC-PATHNAME-TYPE* is returned."
"Coerce NAME into a PATHNAME using standard Unix syntax.
Unix syntax is used whether or not the underlying system is Unix;
on such non-Unix systems it is only usable but for relative pathnames;
but especially to manipulate relative pathnames portably, it is of crucial
to possess a portable pathname syntax independent of the underlying OS.
on such non-Unix systems it is reliably usable only for relative pathnames.
This function is especially useful to manipulate relative pathnames portably,
where it is of crucial to possess a portable pathname syntax independent of the underlying OS.
This is what PARSE-UNIX-NAMESTRING provides, and why we use it in ASDF.
When given a PATHNAME object, just return it untouched.
......
......@@ -104,7 +104,7 @@ for use within a POSIX Bourne shell, outputing to S."
(defun escape-shell-token (token &optional s)
"Escape a token for the current operating system shell"
(cond
(os-cond
((os-unix-p) (escape-sh-token token s))
((os-windows-p) (escape-windows-token token s))))
......
......@@ -277,7 +277,7 @@ and return that"
(defun null-device-pathname ()
"Pathname to a bit bucket device that discards any information written to it
and always returns EOF when read from"
(cond
(os-cond
((os-unix-p) #p"/dev/null")
((os-windows-p) #p"NUL") ;; Q: how many Lisps accept the #p"NUL:" syntax?
(t (error "No /dev/null on your OS"))))
......@@ -528,13 +528,13 @@ If a string, repeatedly read and evaluate from it, returning the last values."
(with-upgradability ()
(defun default-temporary-directory ()
"Return a default directory to use for temporary files"
(or
(when (os-unix-p)
(os-cond
((os-unix-p)
(or (getenv-pathname "TMPDIR" :ensure-directory t)
(parse-native-namestring "/tmp/")))
(when (os-windows-p)
((os-windows-p)
(getenv-pathname "TEMP" :ensure-directory t))
(subpathname (user-homedir-pathname) "tmp/")))
(t (subpathname (user-homedir-pathname) "tmp/"))))
(defvar *temporary-directory* nil "User-configurable location for temporary files")
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment