Commit e2e51ba4 authored by Eric Timmons's avatar Eric Timmons
Browse files

Support :asd forms in clpmfile without listing systems

parent efc93ed0
......@@ -93,8 +93,7 @@ clpmfile is located."
systems)
(list (make-instance 'fs-system-file-requirement
:source fs-source
:name (merge-pathnames asd-file
(clpmfile-pathname clpmfile))
:name asd-file
:why t)))))
(clpmfile-user-asd-files clpmfile))))
......
......@@ -100,7 +100,8 @@
(:project (or (typep req 'project-requirement)
(typep req 'vcs-project-requirement)))
(:system (typep req 'system-requirement))
(:asd-system (typep req 'fs-system-requirement)))
(:asd-system (typep req 'fs-system-requirement))
(:asd-file (typep req 'fs-system-file-requirement)))
(equal name (requirement-name req))))
(context-requirements context)))
......@@ -647,6 +648,9 @@ in place with the same name. Return the new requirement if it was modified."
(defmethod requirement-type-keyword ((req fs-system-requirement))
:asd-system)
(defmethod requirement-type-keyword ((req fs-system-file-requirement))
:asd-file)
(defmethod requirement-type-keyword ((req vcs-project-requirement))
:project)
......@@ -758,6 +762,23 @@ in place with the same name. Return the new requirement if it was modified."
(write-char #\Space stream)
(prin1 t stream))))
(defmethod serialize-context-requirement ((req fs-system-file-requirement) stream)
(pprint-logical-block (stream nil :prefix "(" :suffix ")")
(prin1 (requirement-type-keyword req) stream)
;; pathname
(write-char #\Space stream)
(pprint-newline :fill stream)
(prin1 :pathname stream)
(write-char #\Space stream)
(prin1 (requirement-name req) stream)
;; no deps
(when (requirement-no-deps-p req)
(write-char #\Space stream)
(pprint-newline :fill stream)
(prin1 :no-deps-p stream)
(write-char #\Space stream)
(prin1 t stream))))
(defmethod print-object ((context context) stream)
(pprint-logical-block (stream nil)
(print-unreadable-object (context stream :type t :identity t)
......
......@@ -88,6 +88,9 @@ satisfied. Returns one of :SAT, :UNSAT, or :UNKNOWN."))
(t
:sat))))
(defmethod requirement-state ((req fs-system-file-requirement) node)
:unknown)
(defmethod requirement-state ((req project-requirement) node)
"A project requirement is satisfied if a release for the project is active in
the search node and its version satisfies the requested version."
......@@ -151,13 +154,15 @@ a plist. This plist can contain :system-releases or :system-files."))
(list (list release
:system-files
(list (cons (system-release-system-file system-release) (list system-name)))))
;; (mapcar (lambda (release)
;; (list release :system-files (list (cons (release-system-release)))(release-system-files release))
;; ;;(list release :system-releases (list (release-system-release release system-name)))
;; )
;; releases)
))
(list (cons (system-release-system-file system-release) (list system-name)))))))
(defmethod resolve-requirement ((req fs-system-file-requirement) node)
;; Make a release from the file system.
(let* ((asd-pathname (requirement-name req))
(fs-source (requirement-source req))
(release (source-project-release fs-source :all :newest)))
(list (list release
:system-files (list (cons (release-system-file release asd-pathname) t))))))
(defmethod resolve-requirement ((req project-requirement) node)
"A project requirement is resolved by finding releases of the project that
......
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