Commit e47f48c6 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

Fix default cache location on Windows, broken in 3.1.5 by new XDG setup

Also, tweak default parameters in source-registry after debugging on Allegro 10.
Add two debugging functions in test/script-support.
parent 5832e586
...@@ -20,7 +20,7 @@ ...@@ -20,7 +20,7 @@
#:default-user-source-registry #:default-system-source-registry #:default-user-source-registry #:default-system-source-registry
#:user-source-registry #:system-source-registry #:user-source-registry #:system-source-registry
#:user-source-registry-directory #:system-source-registry-directory #:user-source-registry-directory #:system-source-registry-directory
#:environment-source-registry #:process-source-registry #:environment-source-registry #:process-source-registry #:inherit-source-registry
#:compute-source-registry #:flatten-source-registry #:compute-source-registry #:flatten-source-registry
#:sysdef-source-registry-search)) #:sysdef-source-registry-search))
(in-package :asdf/source-registry) (in-package :asdf/source-registry)
...@@ -43,6 +43,8 @@ ...@@ -43,6 +43,8 @@
"Either NIL (for uninitialized), or an equal hash-table, mapping "Either NIL (for uninitialized), or an equal hash-table, mapping
system names to pathnames of .asd files") system names to pathnames of .asd files")
(defvar *source-registry-parameter* nil)
(defun source-registry-initialized-p () (defun source-registry-initialized-p ()
(typep *source-registry* 'hash-table)) (typep *source-registry* 'hash-table))
...@@ -264,7 +266,7 @@ after having found a .asd file? True by default.") ...@@ -264,7 +266,7 @@ after having found a .asd file? True by default.")
(dolist (directive (cdr (validate-source-registry-form form))) (dolist (directive (cdr (validate-source-registry-form form)))
(process-source-registry-directive directive :inherit inherit :register register)))) (process-source-registry-directive directive :inherit inherit :register register))))
(defun flatten-source-registry (&optional parameter) (defun flatten-source-registry (&optional (parameter *source-registry-parameter*))
(remove-duplicates (remove-duplicates
(while-collecting (collect) (while-collecting (collect)
(with-pathname-defaults () ;; be location-independent (with-pathname-defaults () ;; be location-independent
...@@ -277,7 +279,7 @@ after having found a .asd file? True by default.") ...@@ -277,7 +279,7 @@ after having found a .asd file? True by default.")
:test 'equal :from-end t)) :test 'equal :from-end t))
;; Will read the configuration and initialize all internal variables. ;; Will read the configuration and initialize all internal variables.
(defun compute-source-registry (&optional parameter (registry *source-registry*)) (defun compute-source-registry (&optional (parameter *source-registry-parameter*) (registry *source-registry*))
(dolist (entry (flatten-source-registry parameter)) (dolist (entry (flatten-source-registry parameter))
(destructuring-bind (directory &key recurse exclude) entry (destructuring-bind (directory &key recurse exclude) entry
(let* ((h (make-hash-table :test 'equal))) ; table to detect duplicates (let* ((h (make-hash-table :test 'equal))) ; table to detect duplicates
...@@ -307,8 +309,6 @@ after having found a .asd file? True by default.") ...@@ -307,8 +309,6 @@ after having found a .asd file? True by default.")
h))) h)))
(values)) (values))
(defvar *source-registry-parameter* nil)
(defun initialize-source-registry (&optional (parameter *source-registry-parameter*)) (defun initialize-source-registry (&optional (parameter *source-registry-parameter*))
;; Record the parameter used to configure the registry ;; Record the parameter used to configure the registry
(setf *source-registry-parameter* parameter) (setf *source-registry-parameter* parameter)
......
...@@ -40,11 +40,10 @@ Some constraints: ...@@ -40,11 +40,10 @@ Some constraints:
(proclaim '(optimize (speed #-gcl 2 #+gcl 1) (safety #-gcl 3 #+gcl 0) #-(or allegro gcl genera) (debug 3) (proclaim '(optimize (speed #-gcl 2 #+gcl 1) (safety #-gcl 3 #+gcl 0) #-(or allegro gcl genera) (debug 3)
#+(or cmu scl) (c::brevity 2) #+(or cmu scl) (ext:inhibit-warnings 3))) #+(or cmu scl) (c::brevity 2) #+(or cmu scl) (ext:inhibit-warnings 3)))
(defvar *trace-symbols* (defparameter *trace-symbols*
`(;; If you want to trace some stuff while debugging ASDF, `(;; If you want to trace some stuff while debugging ASDF,
;; here's a nice place to say what. ;; here's a nice place to say what.
;; These string designators will be interned in ASDF after it is loaded. ;; These string designators will be interned in ASDF after it is loaded.
;;#+ecl ,@'( :perform :input-files :output-files :compile-file* :compile-file-pathname* :load*) ;;#+ecl ,@'( :perform :input-files :output-files :compile-file* :compile-file-pathname* :load*)
)) ))
...@@ -426,7 +425,7 @@ is bound, write a message and exit on an error. If ...@@ -426,7 +425,7 @@ is bound, write a message and exit on an error. If
(defmacro with-asdf-conditions ((&optional verbose) &body body) (defmacro with-asdf-conditions ((&optional verbose) &body body)
`(call-with-asdf-conditions #'(lambda () ,@body) ,verbose)) `(call-with-asdf-conditions #'(lambda () ,@body) ,verbose))
(defun compile-asdf (&optional tag verbose upgradep) (defun compile-asdf (&optional tag (verbose nil) upgradep)
(let* ((alisp (asdf-lisp tag)) (let* ((alisp (asdf-lisp tag))
(afasl (asdf-fasl tag)) (afasl (asdf-fasl tag))
(tmp (make-pathname :name "asdf-tmp" :defaults afasl))) (tmp (make-pathname :name "asdf-tmp" :defaults afasl)))
...@@ -549,6 +548,13 @@ is bound, write a message and exit on an error. If ...@@ -549,6 +548,13 @@ is bound, write a message and exit on an error. If
(load-asdf-lisp) (load-asdf-lisp)
(clean-asdf-system)) (clean-asdf-system))
(defun hash-table-alist (h)
(loop for k being the hash-keys of h using (hash-value v) collect (cons k v)))
(defun registry ()
(let ((sr (asymval :*source-registry*)))
(when sr (sort (hta sr) 'string< :key 'car))))
(defun configure-asdf () (defun configure-asdf ()
(format t "Configuring ASDF~%") (format t "Configuring ASDF~%")
(when (asym :getenvp) (when (asym :getenvp)
......
...@@ -345,7 +345,7 @@ also \"Configuration DSL\"\) in the ASDF manual." ...@@ -345,7 +345,7 @@ also \"Configuration DSL\"\) in the ASDF manual."
(resolve-absolute-location (resolve-absolute-location
`(,(or (getenv-absolute-directory "XDG_CACHE_HOME") `(,(or (getenv-absolute-directory "XDG_CACHE_HOME")
(os-cond (os-cond
((os-windows-p) (xdg-data-home "cache")) ((os-windows-p) (xdg-data-home "cache/"))
(t (subpathname* (user-homedir-pathname) ".cache/")))) (t (subpathname* (user-homedir-pathname) ".cache/"))))
,more))) ,more)))
......
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