diff --git a/test/wild-module.asd b/test/wild-module.asd new file mode 100644 index 0000000000000000000000000000000000000000..8c090084e1a0eac97dfa6248a503f0e23b5dd397 --- /dev/null +++ b/test/wild-module.asd @@ -0,0 +1,6 @@ +;;; -*- Lisp -*- + +(asdf:defsystem wild-module + :version "0.0" + :components ((:wild-module "systems" + :pathname "*.asd"))) diff --git a/test/wild-module.script b/test/wild-module.script new file mode 100644 index 0000000000000000000000000000000000000000..d1b5d04dbc14eebf5947a05ec97481554809b41b --- /dev/null +++ b/test/wild-module.script @@ -0,0 +1,7 @@ +;;; -*- Lisp -*- + +(load "../asdf") +(load "../wild-modules") + +(setf asdf:*central-registry* '(*default-pathname-defaults*)) +(asdf:oos 'asdf:load-op 'wild-module) diff --git a/wild-modules.lisp b/wild-modules.lisp new file mode 100644 index 0000000000000000000000000000000000000000..0a7ea3f51dcf445e676e9351165f42f759e045d6 --- /dev/null +++ b/wild-modules.lisp @@ -0,0 +1,35 @@ +(in-package :asdf) + +(defclass wild-module (module) + ((component-class :accessor wild-module-component-class + :initform 'static-file :initarg :component-class) + (component-options :accessor wild-module-component-options + :initform nil :initarg :component-options))) + +(defmethod (setf module-components) (new-value (module wild-module)) + (declare (ignore new-value)) + (sysdef-error "Cannot explicitly set wild-module ~A's components. Please ~ +use a wild pathname instead." module)) + +(defmethod reinitialize-instance :after ((self wild-module) &key) + (let ((pathname (slot-value self 'relative-pathname))) + (and pathname + (not (wild-pathname-p pathname)) + (sysdef-error "Wild-module ~A specified with non-wild pathname ~A." + self pathname)) + (setf (slot-value self 'components) + (let* ((*default-pathname-defaults* (component-parent-pathname self)) + (files (directory (merge-pathnames (component-relative-pathname self)))) + (class (wild-module-component-class self)) + (options (wild-module-component-options self))) + (mapcar (lambda (file) + (apply #'make-instance class + :name (file-namestring file) + ;; XXX fails when wildcards are in + ;; the directory or higher parts. + :pathname file + :parent self + options)) + files))))) + +(export '(wild-module))