Commit ece9fa32 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

Rename package-system to package-inferred-system.

parent 30562050
......@@ -54,7 +54,7 @@ XCL ?= xcl
header_lisp := header.lisp
driver_lisp := uiop/package.lisp uiop/common-lisp.lisp uiop/utility.lisp uiop/os.lisp uiop/pathname.lisp uiop/filesystem.lisp uiop/stream.lisp uiop/image.lisp uiop/run-program.lisp uiop/lisp-build.lisp uiop/configuration.lisp uiop/backward-driver.lisp uiop/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 parse-defsystem.lisp bundle.lisp concatenate-source.lisp backward-interface.lisp package-system.lisp interface.lisp user.lisp footer.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 parse-defsystem.lisp bundle.lisp concatenate-source.lisp backward-interface.lisp package-inferred-system.lisp interface.lisp user.lisp footer.lisp
all_lisp := $(header_lisp) $(driver_lisp) $(defsystem_lisp)
# Making ASDF itself should be our first, default, target:
......
......@@ -3,7 +3,7 @@
;;; ;;;
;;; Free Software available under an MIT-style license. ;;;
;;; ;;;
;;; Copyright (c) 2001-2013 Daniel Barlow and contributors ;;;
;;; Copyright (c) 2001-2014 Daniel Barlow and contributors ;;;
;;; ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
......@@ -61,11 +61,11 @@
(:file "bundle" :depends-on ("lisp-action" "operate" "parse-defsystem"))
(:file "concatenate-source" :depends-on ("plan" "parse-defsystem" "bundle"))
(:file "backward-interface" :depends-on ("operate" "output-translations"))
(:file "package-system" :depends-on ("system" "find-system" "parse-defsystem"))
(:file "package-inferred-system" :depends-on ("system" "find-system" "parse-defsystem"))
(:file "interface" :depends-on
("parse-defsystem" "concatenate-source"
"backward-interface" "backward-internals"
"output-translations" "source-registry" "package-system"))
"output-translations" "source-registry" "package-inferred-system"))
(:file "user" :depends-on ("interface"))
(:file "footer" :depends-on ("user"))))
......@@ -78,10 +78,10 @@
:version "3.1.0.114" ;; to be automatically updated by make bump-version
:depends-on ()
#+asdf3 :encoding #+asdf3 :utf-8
:class #.(if (find-class 'package-system nil) 'package-system 'system)
:class #.(if (find-class 'package-inferred-system nil) 'package-inferred-system 'system)
;; For most purposes, asdf itself specially counts as a builtin system.
;; If you want to link it or do something forbidden to builtin systems,
;; specify separate dependencies on UIOP (aka asdf-driver) and asdf/defsystem.
;; specify separate dependencies on uiop (aka asdf-driver) and asdf/defsystem.
#+asdf3 :builtin-system-p #+asdf3 t
:components ((:module "build" :components ((:file "asdf"))))
:in-order-to (#+asdf3 (prepare-op (monolithic-concatenate-source-op :asdf/defsystem))))
......
......@@ -127,7 +127,7 @@ Defining systems with defsystem
* A more involved example::
* The defsystem grammar::
* Other code in .asd files::
* The package-system extension::
* The package-inferred-system extension::
The object model of ASDF
......@@ -938,7 +938,7 @@ software.
* A more involved example::
* The defsystem grammar::
* Other code in .asd files::
* The package-system extension::
* The package-inferred-system extension::
@end menu
@node The defsystem form, A more involved example, Defining systems with defsystem, Defining systems with defsystem
......@@ -1537,7 +1537,7 @@ which in conjunction with if-component-dep-fails would offer
a roundabout way to express conditional compilation.
@node Other code in .asd files, The package-system extension, The defsystem grammar, Defining systems with defsystem
@node Other code in .asd files, The package-inferred-system extension, The defsystem grammar, Defining systems with defsystem
@section Other code in .asd files
Files containing @code{defsystem} forms
......@@ -1565,8 +1565,8 @@ of output from ASDF operations.
@end itemize
@node The package-system extension, , Other code in .asd files, Defining systems with defsystem
@section The package-system extension
@node The package-inferred-system extension, , Other code in .asd files, Defining systems with defsystem
@section The package-inferred-system extension
Starting with ASDF 3.0.3,
ASDF supports a one-package-per-file style of programming,
......@@ -1574,7 +1574,7 @@ whereby each file is its own system,
and dependencies are deduced from the @code{defpackage} form.
In this style, packages referring to a same-named system (downcased);
and if a system is defined with @code{:class package-system},
and if a system is defined with @code{:class package-inferred-system},
then system names that start with that name
(using the slash @code{/} separator)
refer to files under the filesystem hierarchy where the system is defined.
......@@ -1589,12 +1589,12 @@ It is used by ASDF itself (starting with ASDF 3) and by @code{lisp-interface-lib
To use this style, choose a toplevel system name, e.g. @code{my-lib},
and create a file @file{my-lib.asd}
with the @code{:class :package-system} option in its @code{defsystem}.
with the @code{:class :package-inferred-system} option in its @code{defsystem}.
For instance:
@example
#-asdf (error "my-lib requires ASDF 3")
(defsystem my-lib
:class :package-system
:class :package-inferred-system
:defsystem-depends-on (:asdf-package-system)
:depends-on (:my-lib/src/all)
:in-order-to ((test-op (load-op :my-lib/test/all)))
......@@ -1605,9 +1605,9 @@ For instance:
In the code above, the
@code{:defsystem-depends-on (:asdf-package-system)} is
for compatibility with older versions of ASDF 3 (ASDF 2 not supported),
for compatibility with older versions of ASDF 3 (ASDF 2 is not supported),
and requires the @code{asdf-package-system} library to be present
(it is implicitly provided by ASDF starting with ASDF 3.0.3).
(it is implicitly provided by ASDF starting with ASDF 3.1.1).
The function @code{register-system-packages} has to be called to register
packages used or provided by your system and its components
......
......@@ -12,7 +12,7 @@
:asdf/operation :asdf/action :asdf/lisp-action
:asdf/output-translations :asdf/source-registry
:asdf/plan :asdf/operate :asdf/parse-defsystem :asdf/bundle :asdf/concatenate-source
:asdf/backward-internals :asdf/backward-interface :asdf/package-system)
:asdf/backward-internals :asdf/backward-interface :asdf/package-inferred-system)
;; Note: (1) we are NOT automatically reexporting everything from previous packages.
;; (2) we only reexport UIOP functionality when backward-compatibility requires it.
(:export
......@@ -59,7 +59,8 @@
#:static-file #:doc-file #:html-file
#:file-type #:source-file-type
#:package-system #:register-system-packages
#:package-inferred-system #:register-system-packages
#:package-system ;; backward-compatibility during migration, to be removed in a further release.
#:component-children ; component accessors
#:component-children-by-name
......@@ -122,7 +123,7 @@
#:missing-dependency-of-version
#:circular-dependency ; errors
#:duplicate-names #:non-toplevel-system #:non-system-system
#:package-system-missing-package-error
#:package-inferred-system-missing-package-error
#:operation-definition-warning #:operation-definition-error
#:try-recompiling
......
;;;; -------------------------------------------------------------------------
;;;; Package systems in the style of quick-build or faslpath
(uiop:define-package :asdf/package-system
(:recycle :asdf/package-system :asdf)
(uiop:define-package :asdf/package-inferred-system
(:recycle :asdf/package-inferred-system :asdf/package-system :asdf)
(:use :uiop/common-lisp :uiop
:asdf/defsystem ;; Using the old name of :asdf/parse-defsystem for compatibility
:asdf/upgrade :asdf/component :asdf/system :asdf/find-system :asdf/lisp-action)
(:export
#:package-system #:register-system-packages #:sysdef-package-system-search
#:*defpackage-forms* #:*package-systems* #:package-system-missing-package-error))
(in-package :asdf/package-system)
#:package-inferred-system #:sysdef-package-inferred-system-search
#:package-system ;; backward compatibility only. To be removed.
#:register-system-packages
#:*defpackage-forms* #:*package-inferred-systems* #:package-inferred-system-missing-package-error))
(in-package :asdf/package-inferred-system)
(with-upgradability ()
(defparameter *defpackage-forms* '(cl:defpackage uiop:define-package))
(defun initial-package-systems-table ()
(defun initial-package-inferred-systems-table ()
(let ((h (make-hash-table :test 'equal)))
(dolist (p (list-all-packages))
(dolist (n (package-names p))
(setf (gethash n h) t)))
h))
(defvar *package-systems* (initial-package-systems-table))
(defvar *package-inferred-systems* (initial-package-inferred-systems-table))
(defclass package-system (system)
(defclass package-inferred-system (system)
())
;; For backward compatibility only. To be removed in an upcoming release:
(defclass package-system (package-inferred-system) ())
(defun defpackage-form-p (form)
(and (consp form)
(member (car form) *defpackage-forms*)))
......@@ -39,12 +44,12 @@
(with-input-file (f file)
(stream-defpackage-form f)))
(define-condition package-system-missing-package-error (system-definition-error)
(define-condition package-inferred-system-missing-package-error (system-definition-error)
((system :initarg :system :reader error-system)
(pathname :initarg :pathname :reader error-pathname))
(:report (lambda (c s)
(format s (compatfmt "~@<No package form found while ~
trying to define package-system ~A from file ~A~>")
trying to define package-inferred-system ~A from file ~A~>")
(error-system c) (error-pathname c)))))
(defun package-dependencies (defpackage-form)
......@@ -73,23 +78,23 @@ the DEFPACKAGE-FORM uses it or imports a symbol from it."
"Register SYSTEM as providing PACKAGES."
(let ((name (or (eq system t) (coerce-name system))))
(dolist (p (ensure-list packages))
(setf (gethash (package-designator-name p) *package-systems*) name))))
(setf (gethash (package-designator-name p) *package-inferred-systems*) name))))
(defun package-name-system (package-name)
"Return the name of the SYSTEM providing PACKAGE-NAME, if such exists,
otherwise return a default system name computed from PACKAGE-NAME."
(check-type package-name string)
(if-let ((system-name (gethash package-name *package-systems*)))
(if-let ((system-name (gethash package-name *package-inferred-systems*)))
system-name
(string-downcase package-name)))
(defun package-system-file-dependencies (file &optional system)
(defun package-inferred-system-file-dependencies (file &optional system)
(if-let (defpackage-form (file-defpackage-form file))
(remove t (mapcar 'package-name-system (package-dependencies defpackage-form)))
(error 'package-system-missing-package-error :system system :pathname file)))
(error 'package-inferred-system-missing-package-error :system system :pathname file)))
(defun same-package-system-p (system name directory subpath dependencies)
(and (eq (type-of system) 'package-system)
(defun same-package-inferred-system-p (system name directory subpath dependencies)
(and (eq (type-of system) 'package-inferred-system)
(equal (component-name system) name)
(pathname-equal directory (component-pathname system))
(equal dependencies (component-sideway-dependencies system))
......@@ -101,26 +106,29 @@ otherwise return a default system name computed from PACKAGE-NAME."
(and (slot-boundp child 'relative-pathname)
(equal (slot-value child 'relative-pathname) subpath))))))))
(defun sysdef-package-system-search (system)
(defun sysdef-package-inferred-system-search (system)
(let ((primary (primary-system-name system)))
(unless (equal primary system)
(let ((top (find-system primary nil)))
(when (typep top 'package-system)
(when (typep top 'package-inferred-system)
(if-let (dir (system-source-directory top))
(let* ((sub (subseq system (1+ (length primary))))
(f (probe-file* (subpathname dir sub :type "lisp")
:truename *resolve-symlinks*)))
(when (file-pathname-p f)
(let ((dependencies (package-system-file-dependencies f system))
(let ((dependencies (package-inferred-system-file-dependencies f system))
(previous (cdr (system-registered-p system))))
(if (same-package-system-p previous system dir sub dependencies)
(if (same-package-inferred-system-p previous system dir sub dependencies)
previous
(eval `(defsystem ,system
:class package-system
:class package-inferred-system
:source-file nil
:pathname ,dir
:depends-on ,dependencies
:components ((cl-source-file "lisp" :pathname ,sub)))))))))))))))
(with-upgradability ()
(pushnew 'sysdef-package-system-search *system-definition-search-functions*))
(pushnew 'sysdef-package-inferred-system-search *system-definition-search-functions*)
(setf *system-definition-search-functions*
(remove (find-symbol* :sysdef-package-system-search :asdf/package-system nil)
*system-definition-search-functions*)))
(defpackage :test-asdf/dll-test (:use)) ;; dummy, for package-system dependencies.
(defpackage :test-asdf/dll-test (:use)) ;; dummy, for package-inferred-system dependencies.
#+ecl
(ffi:clines "
......
(defpackage :test-asdf/dll-user (:use)) ;; dummy, for package-system dependencies.
(defpackage :test-asdf/dll-user (:use)) ;; dummy, for package-inferred-system dependencies.
(in-package :test-package)
......
(defpackage :l-file
(:use :asdf :uiop :cl) ;; asdf/package-system dependencies
(:use :asdf :uiop :cl) ;; asdf/package-inferred-system dependencies
(:export #:cl-source-file.l))
(in-package :l-file)
......
(cl:defpackage :l-operation
(:use :asdf :uiop :cl) ;; asdf/package-system dependencies
(:use :asdf :uiop :cl) ;; asdf/package-inferred-system dependencies
(:export #:op #:*x*))
(cl:in-package :l-operation)
......
(defpackage :test-asdf/monodll-1 (:use)) ;; dummy, for package-system dependencies.
(defpackage :test-asdf/monodll-1 (:use)) ;; dummy, for package-inferred-system dependencies.
#+ecl
(ffi:clines "
......
(defpackage :test-asdf/monodll-user (:use)) ;; dummy, for package-system dependencies.
(defpackage :test-asdf/monodll-user (:use)) ;; dummy, for package-inferred-system dependencies.
(in-package :test-package)
(ffi:def-function "always_42" () :returning :int)
(defpackage :test-asdf/monodll (:use :test-asdf/monodll-1)) ;; dummy, for package-system dependencies.
(defpackage :test-asdf/monodll (:use :test-asdf/monodll-1)) ;; dummy, for package-inferred-system dependencies.
#+ecl
(ffi:clines "
......
(register-directory (subpathname *test-directory* "package-inferred-system-test/"))
(load-system :package-inferred-system-test/a/x)
(load-system :package-inferred-system-test/d)
(signals package-inferred-system-missing-package-error (load-system :package-inferred-system-test/e))
;; No such file.
(signals missing-component (load-system :package-inferred-system-test/f))
(defpackage package-inferred-system-test/a (:use cl))
(defpackage package-inferred-system-test/a/x (:use common-lisp package-inferred-system-test/c))
(defpackage package-inferred-system-test/b (:use cl package-inferred-system-test/a))
(defpackage package-inferred-system-test/c (:use cl package-inferred-system-test/a))
(defpackage package-inferred-system-test/d (:use cl package-inferred-system-test/b package-inferred-system-test/c))
;; This file is missing a defpackage form, and loading it as a package-system should trigger an error.
;; This file is missing a defpackage form, and loading it as a package-inferred-system should trigger an error.
(in-package :asdf-test)
(in-package :asdf)
(defsystem package-inferred-system-test
:class package-inferred-system
:defsystem-depends-on
#.(unless (find-class 'package-inferred-system nil) '(:asdf-package-inferred-system)))
(register-directory (subpathname *test-directory* "package-system-test/"))
(load-system :package-system-test/a/x)
(load-system :package-system-test/d)
(signals package-system-missing-package-error (load-system :package-system-test/e))
;; No such file.
(signals missing-component (load-system :package-system-test/f))
(defpackage package-system-test/a (:use cl))
(defpackage package-system-test/a/x (:use common-lisp package-system-test/c))
(defpackage package-system-test/b (:use cl package-system-test/a))
(defpackage package-system-test/c (:use cl package-system-test/a))
(defpackage package-system-test/d (:use cl package-system-test/b package-system-test/c))
(in-package :asdf)
(defsystem package-system-test
:class package-system
:defsystem-depends-on
#.(unless (find-class 'package-system nil) '(:asdf-package-system)))
......@@ -339,7 +339,7 @@ upgrade_tags () {
#
# The 3.1 series provides the 3.1 feature, meaning users can rely on
# all the stabilization work done in 3.0 so far, plus extra developments
# in UIOP, package-system, and more robustification.
# in UIOP, package-inferred-system, and more robustification.
#
# We return the above designated versions in order of decreasing relevance,
# which pretty much means REQUIRE and most recent first.
......
......@@ -2,7 +2,7 @@
(:use :cl :asdf))
(in-package :test-asdf-system)
(defsystem :test-asdf :class package-system)
(defsystem :test-asdf :class package-inferred-system)
(defsystem :test-asdf/all
:version "0"
......
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