Commit 77a4f446 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

2.26.160: fix getcwd for cmucl

Also, separate filesystem access functions from pathname object munging.
parent 67bec306
......@@ -42,7 +42,7 @@ XCL ?= xcl
# website, tag, install
header_lisp := header.lisp
driver_lisp := package.lisp common-lisp.lisp utility.lisp os.lisp pathname.lisp stream.lisp image.lisp run-program.lisp lisp-build.lisp configuration.lisp backward-driver.lisp driver.lisp
driver_lisp := package.lisp common-lisp.lisp utility.lisp os.lisp pathname.lisp filesystem.lisp stream.lisp image.lisp run-program.lisp lisp-build.lisp configuration.lisp backward-driver.lisp driver.lisp
defsystem_lisp := upgrade.lisp component.lisp system.lisp cache.lisp find-system.lisp find-component.lisp operation.lisp action.lisp lisp-action.lisp plan.lisp operate.lisp output-translations.lisp source-registry.lisp backward-internals.lisp defsystem.lisp bundle.lisp concatenate-source.lisp backward-interface.lisp interface.lisp user.lisp footer.lisp
# Making ASDF itself should be our first, default, target:
......@@ -51,11 +51,19 @@ build/asdf.lisp: $(wildcard *.lisp)
cat $(header_lisp) $(driver_lisp) $(defsystem_lisp) > $@
# This quickly locates such mistakes as unbalanced parentheses:
load: build/asdf.lisp
rlwrap sbcl \
load: load-in-sbcl
load-in-sbcl: build/asdf.lisp
rlwrap sbcl --eval '(setf *load-verbose* t *compile-verbose* t)' \
`for i in $(driver_lisp) $(defsystem_lisp) ; do echo --load $$i ; done` \
--eval '(in-package :asdf)'
load-in-cmucl: build/asdf.lisp
rlwrap cmucl -eval '(setf *load-verbose* t *compile-verbose* t *gc-verbose* nil)' \
`for i in $(driver_lisp) $(defsystem_lisp) ; do echo -load $$i ; done` \
-eval '(in-package :asdf)'
install: archive-copy
bump: bump-version
......
......@@ -2,7 +2,9 @@
(in-package :asdf)
(defun call-without-redefinition-warnings (thunk)
(handler-bind (#+clozure (ccl:compiler-warning #'muffle-warning))
(handler-bind ((or #+clozure ccl:compiler-warning
#+cmu kernel:simple-style-warning)
#'muffle-warning)
(funcall thunk)))
(defsystem :asdf-driver
......@@ -20,8 +22,9 @@ that you can't portably construct a complete program without using them."
(:file "common-lisp" :depends-on ("package"))
(:file "utility" :depends-on ("common-lisp"))
(:file "os" :depends-on ("utility"))
(:file "pathname" :depends-on ("os"))
(:file "stream" :depends-on ("pathname"))
(:file "pathname" :depends-on ("utility"))
(:file "filesystem" :depends-on ("os" "pathname"))
(:file "stream" :depends-on ("filesystem"))
(:file "image" :depends-on ("stream"))
(:file "run-program" :depends-on ("stream"))
(:file "lisp-build" :depends-on ("image"))
......
......@@ -62,7 +62,7 @@
:licence "MIT"
:description "Another System Definition Facility"
:long-description "ASDF builds Common Lisp software organized into defined systems."
:version "2.26.159" ;; to be automatically updated by make bump-version
:version "2.26.160" ;; 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.
......
......@@ -4,7 +4,7 @@
(asdf/package:define-package :asdf/configuration
(:recycle :asdf/configuration :asdf)
(:use :asdf/common-lisp :asdf/utility
:asdf/pathname :asdf/stream :asdf/os :asdf/image)
:asdf/os :asdf/pathname :asdf/filesystem :asdf/stream :asdf/image)
(:export
#:get-folder-path
#:user-configuration-directories #:system-configuration-directories
......
......@@ -4,13 +4,13 @@
(asdf/package:define-package :asdf/driver
(:nicknames :d :asdf-driver :asdf-utils)
(:use :asdf/common-lisp :asdf/package :asdf/utility
:asdf/pathname :asdf/stream :asdf/os :asdf/image
:asdf/os :asdf/pathname :asdf/stream :asdf/filesystem :asdf/image
:asdf/run-program :asdf/lisp-build
:asdf/configuration :asdf/backward-driver)
(:reexport
;; NB: excluding asdf/common-lisp
;; which include all of CL with compatibility modifications on select platforms.
:asdf/package :asdf/utility
:asdf/pathname :asdf/stream :asdf/os :asdf/image
:asdf/os :asdf/pathname :asdf/stream :asdf/filesystem :asdf/image
:asdf/run-program :asdf/lisp-build
:asdf/configuration :asdf/backward-driver))
This diff is collapsed.
;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
;;; This is ASDF 2.26.159: Another System Definition Facility.
;;; This is ASDF 2.26.160: Another System Definition Facility.
;;;
;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>.
......
......@@ -84,13 +84,15 @@ Note that ASDF ALWAYS raises an error if it fails to create an output file when
(defvar *uninteresting-compiler-conditions*
(append
;;#+clozure '(ccl:compiler-warning)
#+cmu '("Deleting unreachable code.")
#+sbcl
`(sb-c::simple-compiler-note
'(sb-c::simple-compiler-note
"&OPTIONAL and &KEY found in the same lambda list: ~S"
sb-int:package-at-variance
sb-kernel:uninteresting-redefinition
sb-kernel:undefined-alien-style-warning
;; sb-ext:implicit-generic-function-warning ; controversial, but let's allow it by default.
;; sb-ext:implicit-generic-function-warning ; Controversial. Let's allow it by default.
sb-kernel:lexical-environment-too-complex
sb-grovel-unknown-constant-condition ; defined above.
;; BEWARE: the below four are controversial to include here.
......@@ -98,7 +100,6 @@ Note that ASDF ALWAYS raises an error if it fails to create an output file when
sb-kernel:redefinition-with-defgeneric
sb-kernel:redefinition-with-defmethod
sb-kernel::redefinition-with-defmacro) ; not exported by old SBCLs
;;#+clozure '(ccl:compiler-warning)
'("No generic function ~S present when encountering macroexpansion of defmethod. Assuming it will be an instance of standard-generic-function.")) ;; from closer2mop
"Conditions that may be skipped while compiling")
......
......@@ -194,6 +194,12 @@ then returning the non-empty string value of the variable"
;;; Current directory
#+(or cmu scl)
(defun* parse-unix-namestring* (unix-namestring)
(multiple-value-bind (host device directory name type version)
(lisp::parse-unix-namestring unix-namestring 0 (length unix-namestring))
(make-pathname :host (or host #+cmu lisp::*unix-host*) :device device
:directory directory :name name :type type :version version)))
(defun* getcwd ()
"Get the current working directory as per POSIX getcwd(3), as a pathname object"
......@@ -202,8 +208,8 @@ then returning the non-empty string value of the variable"
#+allegro (excl::current-directory)
#+clisp (ext:default-directory)
#+clozure (ccl:current-directory)
#+(or cmu scl) (ext:parse-unix-namestring
(nth-value 1 (unix:unix-current-directory)) :ensure-directory t)
#+(or cmu scl) (parse-unix-namestring*
(strcat (nth-value 1 (unix:unix-current-directory)) "/"))
#+cormanlisp (pathname (pl::get-current-directory)) ;; Q: what type does it return?
#+ecl (ext:getcwd)
#+gcl (parse-namestring ;; this is a joke. Isn't there a better way?
......@@ -216,21 +222,21 @@ then returning the non-empty string value of the variable"
(error "getcwd not supported on your implementation")))
(defun* chdir (x)
"Change current directory, as per POSIX chdir(2)"
(declare (ignorable x))
(or #+abcl (java:jstatic "setProperty" "java.lang.System" "user.dir" (namestring x))
#+allegro (excl:chdir x)
#+clisp (ext:cd x)
#+clozure (setf (ccl:current-directory) x)
#+(or cmu scl) (unix:unix-chdir (ext:unix-namestring x))
#+cormanlisp (unless (zerop (win32::_chdir (namestring x)))
(error "Could not set current directory to ~A" x))
#+ecl (ext:chdir x)
#+genera (setf *default-pathname-defaults* (pathname x))
#+lispworks (hcl:change-directory x)
#+mkcl (mk-ext:chdir x)
#+sbcl (symbol-call :sb-posix :chdir (sb-ext:native-namestring x))
(error "chdir not supported on your implementation")))
"Change current directory, as per POSIX chdir(2), to a given pathname object"
(if-let (x (pathname x))
(or #+abcl (java:jstatic "setProperty" "java.lang.System" "user.dir" (namestring x))
#+allegro (excl:chdir x)
#+clisp (ext:cd x)
#+clozure (setf (ccl:current-directory) x)
#+(or cmu scl) (unix:unix-chdir (ext:unix-namestring x))
#+cormanlisp (unless (zerop (win32::_chdir (namestring x)))
(error "Could not set current directory to ~A" x))
#+ecl (ext:chdir x)
#+genera (setf *default-pathname-defaults* x)
#+lispworks (hcl:change-directory x)
#+mkcl (mk-ext:chdir x)
#+sbcl (symbol-call :sb-posix :chdir (sb-ext:native-namestring x))
(error "chdir not supported on your implementation"))))
;;;; -----------------------------------------------------------------
......
This diff is collapsed.
......@@ -3,7 +3,7 @@
(asdf/package:define-package :asdf/run-program
(:recycle :asdf/run-program :xcvb-driver)
(:use :asdf/common-lisp :asdf/utility :asdf/pathname :asdf/stream :asdf/os)
(:use :asdf/common-lisp :asdf/utility :asdf/pathname :asdf/os :asdf/filesystem :asdf/stream)
(:export
;;; Escaping the command invocation madness
#:easy-sh-character-p #:escape-sh-token #:escape-sh-command
......
......@@ -3,7 +3,7 @@
(asdf/package:define-package :asdf/stream
(:recycle :asdf/stream)
(:use :asdf/common-lisp :asdf/package :asdf/utility :asdf/os :asdf/pathname)
(:use :asdf/common-lisp :asdf/package :asdf/utility :asdf/os :asdf/pathname :asdf/filesystem)
(:export
#:*default-stream-element-type* #:*stderr* #:setup-stderr
#:with-safe-io-syntax #:call-with-safe-io-syntax
......
;;; -*- Lisp -*-
(trace parse-unix-namestring asdf::determine-system-directory)
(defsystem :test-system-pathnames
:pathname "sources/level1"
:components
......
......@@ -35,7 +35,7 @@
;; "2.345.6" would be a development version in the official upstream
;; "2.345.0.7" would be your seventh local modification of official release 2.345
;; "2.345.6.7" would be your seventh local modification of development version 2.345.6
(asdf-version "2.26.159")
(asdf-version "2.26.160")
(existing-asdf (find-class (find-symbol* :component :asdf nil) nil))
(existing-version *asdf-version*)
(already-there (equal asdf-version existing-version))
......
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