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

Correctly export system-source-directory.

Reindent a form.
parent a9b6b710
No related branches found
No related tags found
No related merge requests found
...@@ -70,198 +70,198 @@ ...@@ -70,198 +70,198 @@
#:system-source-file))) #:system-source-file)))
(unless (equal asdf-version existing-version) (unless (equal asdf-version existing-version)
(labels ((rename-away (package) (labels ((rename-away (package)
(loop :with name = (package-name package) (loop :with name = (package-name package)
:for i :from 1 :for new = (format nil "~A.~D" name i) :for i :from 1 :for new = (format nil "~A.~D" name i)
:unless (find-package new) :do :unless (find-package new) :do
(rename-package-name package name new))) (rename-package-name package name new)))
(rename-package-name (package old new) (rename-package-name (package old new)
(let* ((old-names (cons (package-name package) (package-nicknames package))) (let* ((old-names (cons (package-name package) (package-nicknames package)))
(new-names (subst new old old-names :test 'equal)) (new-names (subst new old old-names :test 'equal))
(new-name (car new-names)) (new-name (car new-names))
(new-nicknames (cdr new-names))) (new-nicknames (cdr new-names)))
(rename-package package new-name new-nicknames))) (rename-package package new-name new-nicknames)))
(ensure-exists (name nicknames use) (ensure-exists (name nicknames use)
(let* ((previous (let* ((previous
(remove-duplicates (remove-duplicates
(remove-if (remove-if
#'null #'null
(mapcar #'find-package (cons name nicknames))) (mapcar #'find-package (cons name nicknames)))
:from-end t))) :from-end t)))
(cond (cond
(previous (previous
(map () #'rename-away (cdr previous)) ;; packages with conflicting (nick)names (map () #'rename-away (cdr previous)) ;; packages with conflicting (nick)names
(let ((p (car previous))) ;; previous package with same name (let ((p (car previous))) ;; previous package with same name
(rename-package p name nicknames) (rename-package p name nicknames)
(ensure-use p use) (ensure-use p use)
p)) p))
(t (t
(make-package name :nicknames nicknames :use use))))) (make-package name :nicknames nicknames :use use)))))
(find-sym (symbol package) (find-sym (symbol package)
(find-symbol (string symbol) package)) (find-symbol (string symbol) package))
(remove-symbol (symbol package) (remove-symbol (symbol package)
(let ((sym (find-sym symbol package))) (let ((sym (find-sym symbol package)))
(when sym (when sym
(unexport sym package) (unexport sym package)
(unintern sym package)))) (unintern sym package))))
(ensure-unintern (package symbols) (ensure-unintern (package symbols)
(dolist (sym symbols) (remove-symbol sym package))) (dolist (sym symbols) (remove-symbol sym package)))
(ensure-shadow (package symbols) (ensure-shadow (package symbols)
(shadow symbols package)) (shadow symbols package))
(ensure-use (package use) (ensure-use (package use)
(dolist (used (reverse use)) (dolist (used (reverse use))
(do-external-symbols (sym used) (do-external-symbols (sym used)
(unless (eq sym (find-sym sym package)) (unless (eq sym (find-sym sym package))
(remove-symbol sym package))) (remove-symbol sym package)))
(use-package used package))) (use-package used package)))
(ensure-fmakunbound (package symbols) (ensure-fmakunbound (package symbols)
(loop :for name :in symbols (loop :for name :in symbols
:for sym = (find-sym name package) :for sym = (find-sym name package)
:when sym :do (fmakunbound sym))) :when sym :do (fmakunbound sym)))
(ensure-export (package export) (ensure-export (package export)
(let ((syms (loop :for x :in export :collect (let ((syms (loop :for x :in export :collect
(intern (string x) package)))) (intern (string x) package))))
(do-external-symbols (sym package) (do-external-symbols (sym package)
(unless (member sym syms) (unless (member sym syms)
(remove-symbol sym package))) (remove-symbol sym package)))
(dolist (sym syms) (dolist (sym syms)
(export sym package)))) (export sym package))))
(ensure-package (name &key nicknames use unintern fmakunbound shadow export) (ensure-package (name &key nicknames use unintern fmakunbound shadow export)
(let ((p (ensure-exists name nicknames use))) (let ((p (ensure-exists name nicknames use)))
(ensure-unintern p unintern) (ensure-unintern p unintern)
(ensure-shadow p shadow) (ensure-shadow p shadow)
(ensure-export p export) (ensure-export p export)
(ensure-fmakunbound p fmakunbound) (ensure-fmakunbound p fmakunbound)
p))) p)))
(ensure-package (ensure-package
':asdf-utilities ':asdf-utilities
:nicknames '(#:asdf-extensions) :nicknames '(#:asdf-extensions)
:use '(#:common-lisp) :use '(#:common-lisp)
:unintern '(#:split #:make-collector) :unintern '(#:split #:make-collector)
:export :export
'(#:absolute-pathname-p '(#:absolute-pathname-p
#:aif #:aif
#:appendf #:appendf
#:asdf-message #:asdf-message
#:coerce-name #:coerce-name
#:directory-pathname-p #:directory-pathname-p
#:ends-with #:ends-with
#:ensure-directory-pathname #:ensure-directory-pathname
#:getenv #:getenv
#:get-uid #:get-uid
#:length=n-p #:length=n-p
#:merge-pathnames* #:merge-pathnames*
#:pathname-directory-pathname #:pathname-directory-pathname
#:pathname-sans-name+type ;; deprecated. Use pathname-directory-pathname #:pathname-sans-name+type ;; deprecated. Use pathname-directory-pathname
#:read-file-forms #:read-file-forms
#:remove-keys #:remove-keys
#:remove-keyword #:remove-keyword
#:resolve-symlinks #:resolve-symlinks
#:split-string #:split-string
#:component-name-to-pathname-components #:component-name-to-pathname-components
#:split-name-type #:split-name-type
#:system-registered-p #:system-registered-p
#:truenamize #:truenamize
#:while-collecting)) #:while-collecting))
(ensure-package (ensure-package
':asdf ':asdf
:use '(:common-lisp :asdf-utilities) :use '(:common-lisp :asdf-utilities)
:unintern `(#-ecl ,@redefined-functions :unintern `(#-ecl ,@redefined-functions
#:*asdf-revision* #:around #:asdf-method-combination #:*asdf-revision* #:around #:asdf-method-combination
#:split #:make-collector) #:split #:make-collector)
:fmakunbound `(#+ecl ,@redefined-functions :fmakunbound `(#+ecl ,@redefined-functions
#:system-source-file #:system-source-file
#:component-relative-pathname #:system-relative-pathname #:component-relative-pathname #:system-relative-pathname
#:system-source-directory #:process-source-registry
#:process-source-registry #:inherit-source-registry #:process-source-registry-directive)
#:inherit-source-registry #:process-source-registry-directive) :export
:export '(#:defsystem #:oos #:operate #:find-system #:run-shell-command
'(#:defsystem #:oos #:operate #:find-system #:run-shell-command #:system-definition-pathname #:find-component ; miscellaneous
#:system-definition-pathname #:find-component ; miscellaneous #:compile-system #:load-system #:test-system
#:compile-system #:load-system #:test-system #:compile-op #:load-op #:load-source-op
#:compile-op #:load-op #:load-source-op #:test-op
#:test-op #:operation ; operations
#:operation ; operations #:feature ; sort-of operation
#:feature ; sort-of operation #:version ; metaphorically sort-of an operation
#:version ; metaphorically sort-of an operation #:version-satisfies
#:version-satisfies
#:input-files #:output-files #:perform ; operation methods
#:input-files #:output-files #:perform ; operation methods #:operation-done-p #:explain
#:operation-done-p #:explain
#:component #:source-file
#:component #:source-file #:c-source-file #:cl-source-file #:java-source-file
#:c-source-file #:cl-source-file #:java-source-file #:static-file
#:static-file #:doc-file
#:doc-file #:html-file
#:html-file #:text-file
#:text-file #:source-file-type
#:source-file-type #:module ; components
#:module ; components #:system
#:system #:unix-dso
#:unix-dso
#:module-components ; component accessors
#:module-components ; component accessors #:component-pathname
#:component-pathname #:component-relative-pathname
#:component-relative-pathname #:component-name
#:component-name #:component-version
#:component-version #:component-parent
#:component-parent #:component-property
#:component-property #:component-system
#:component-system
#:component-depends-on
#:component-depends-on
#:system-description
#:system-description #:system-long-description
#:system-long-description #:system-author
#:system-author #:system-maintainer
#:system-maintainer #:system-license
#:system-license #:system-licence
#:system-licence #:system-source-file
#:system-source-file #:system-source-directory
#:system-relative-pathname #:system-relative-pathname
#:map-systems #:map-systems
#:operation-on-warnings #:operation-on-warnings
#:operation-on-failure #:operation-on-failure
;#:*component-parent-pathname* ;#:*component-parent-pathname*
#:*system-definition-search-functions* #:*system-definition-search-functions*
#:*central-registry* ; variables #:*central-registry* ; variables
#:*compile-file-warnings-behaviour* #:*compile-file-warnings-behaviour*
#:*compile-file-failure-behaviour* #:*compile-file-failure-behaviour*
#:*resolve-symlinks* #:*resolve-symlinks*
#:asdf-version #:asdf-version
#:operation-error #:compile-failed #:compile-warned #:compile-error #:operation-error #:compile-failed #:compile-warned #:compile-error
#:error-name #:error-name
#:error-pathname #:error-pathname
#:load-system-definition-error #:load-system-definition-error
#:error-component #:error-operation #:error-component #:error-operation
#:system-definition-error #:system-definition-error
#:missing-component #:missing-component
#:missing-component-of-version #:missing-component-of-version
#:missing-dependency #:missing-dependency
#:missing-dependency-of-version #:missing-dependency-of-version
#:circular-dependency ; errors #:circular-dependency ; errors
#:duplicate-names #:duplicate-names
#:try-recompiling #:try-recompiling
#:retry #:retry
#:accept ; restarts #:accept ; restarts
#:coerce-entry-to-directory #:coerce-entry-to-directory
#:remove-entry-from-registry #:remove-entry-from-registry
#:initialize-output-translations #:initialize-output-translations
#:clear-output-translations #:clear-output-translations
#:ensure-output-translations #:ensure-output-translations
#:apply-output-translations #:apply-output-translations
#:compile-file-pathname* #:compile-file-pathname*
#:*default-source-registries* #:*default-source-registries*
#:initialize-source-registry #:initialize-source-registry
#:compute-source-registry #:compute-source-registry
#:clear-source-registry #:clear-source-registry
#:ensure-source-registry #:ensure-source-registry
#:process-source-registry)) #:process-source-registry))
(eval `(defparameter ,(intern (string versym) (find-package :asdf)) ,asdf-version)))))) (eval `(defparameter ,(intern (string versym) (find-package :asdf)) ,asdf-version))))))
(in-package #:asdf) (in-package #:asdf)
......
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