Commit 1d3220e1 authored by Eric Timmons's avatar Eric Timmons
Browse files

Remove slashes from requirement accessors

parent 8fc982d9
......@@ -101,14 +101,14 @@
(typep req 'vcs-project-requirement)))
(:system (typep req 'system-requirement))
(:asd-system (typep req 'fs-system-requirement)))
(equal name (requirement/name req))))
(equal name (requirement-name req))))
(context-requirements context)))
(defun context-add-requirement! (context req)
"If the requirement is new, add it. Otherwise modify an existing requirement
in place with the same name. Return the new requirement if it was modified."
(let ((existing-req (context-find-requirement context (requirement-type-keyword req)
(requirement/name req))))
(requirement-name req))))
(if existing-req
(progn
(log:debug "Replacing requirement ~A with ~A" existing-req req)
......@@ -571,7 +571,7 @@ in place with the same name. Return the new requirement if it was modified."
t)
(defun serialize-reverse-dep (req stream)
(let ((why (requirement/why req)))
(let ((why (requirement-why req)))
(pprint-logical-block (stream nil :prefix "(" :suffix ")")
(prin1 (extract-why why) stream)
(pprint-newline :mandatory stream)
......@@ -625,11 +625,11 @@ in place with the same name. Return the new requirement if it was modified."
;; ASD file into the groveler). We can ignore it because we'll
;; have the true reason elsewhere in the list.
(unless (or (eql t req)
(eql (requirement/why req) :grovel))
(eql (requirement-why req) :grovel))
(serialize-reverse-dep req stream))
(pprint-exit-if-list-exhausted)
(unless (or (eql t req)
(eql (requirement/why req) :grovel))
(eql (requirement-why req) :grovel))
(pprint-newline :mandatory stream)))))))))
;; ** Requirements
......@@ -659,41 +659,41 @@ in place with the same name. Return the new requirement if it was modified."
(prin1 :name stream)
(write-char #\Space stream)
(pprint-newline :miser stream)
(prin1 (requirement/name req) stream)
(prin1 (requirement-name req) stream)
;; Branch
(when (requirement/branch req)
(when (requirement-branch req)
(write-char #\Space stream)
(pprint-newline :fill stream)
(prin1 :branch stream)
(write-char #\Space stream)
(pprint-newline :miser stream)
(prin1 (requirement/branch req) stream))
(prin1 (requirement-branch req) stream))
;; Commit
(when (requirement/commit req)
(when (requirement-commit req)
(write-char #\Space stream)
(pprint-newline :fill stream)
(prin1 :commit stream)
(write-char #\Space stream)
(pprint-newline :miser stream)
(prin1 (requirement/commit req) stream))
(prin1 (requirement-commit req) stream))
;; Tag
(when (requirement/tag req)
(when (requirement-tag req)
(write-char #\Space stream)
(pprint-newline :fill stream)
(prin1 :tag stream)
(write-char #\Space stream)
(pprint-newline :miser stream)
(prin1 (requirement/tag req) stream))
(prin1 (requirement-tag req) stream))
;; Source
(when (requirement/source req)
(when (requirement-source req)
(write-char #\Space stream)
(pprint-newline :fill stream)
(prin1 :source stream)
(write-char #\Space stream)
(pprint-newline :miser stream)
(prin1 (source-name (requirement/source req)) stream))
(prin1 (source-name (requirement-source req)) stream))
;; no deps
(when (requirement/no-deps-p req)
(when (requirement-no-deps-p req)
(write-char #\Space stream)
(pprint-newline :fill stream)
(prin1 :no-deps-p stream)
......@@ -709,25 +709,25 @@ in place with the same name. Return the new requirement if it was modified."
(prin1 :name stream)
(write-char #\Space stream)
(pprint-newline :miser stream)
(prin1 (requirement/name req) stream)
(prin1 (requirement-name req) stream)
;; Version
(when (requirement/version-spec req)
(when (requirement-version-spec req)
(write-char #\Space stream)
(pprint-newline :fill stream)
(prin1 :version stream)
(write-char #\Space stream)
(pprint-newline :miser stream)
(prin1 (requirement/version-spec req) stream))
(prin1 (requirement-version-spec req) stream))
;; Source
(when (requirement/source req)
(when (requirement-source req)
(write-char #\Space stream)
(pprint-newline :fill stream)
(prin1 :source stream)
(write-char #\Space stream)
(pprint-newline :miser stream)
(prin1 (source-name (requirement/source req)) stream))
(prin1 (source-name (requirement-source req)) stream))
;; no deps
(when (requirement/no-deps-p req)
(when (requirement-no-deps-p req)
(write-char #\Space stream)
(pprint-newline :fill stream)
(prin1 :no-deps-p stream)
......@@ -742,16 +742,16 @@ in place with the same name. Return the new requirement if it was modified."
(pprint-newline :fill stream)
(prin1 :pathname stream)
(write-char #\Space stream)
(prin1 (requirement/pathname req) stream)
(prin1 (requirement-pathname req) stream)
;; Name
(write-char #\Space stream)
(pprint-newline :fill stream)
(prin1 :name stream)
(write-char #\Space stream)
(pprint-newline :miser stream)
(prin1 (requirement/name req) stream)
(prin1 (requirement-name req) stream)
;; no deps
(when (requirement/no-deps-p req)
(when (requirement-no-deps-p req)
(write-char #\Space stream)
(pprint-newline :fill stream)
(prin1 :no-deps-p stream)
......
......@@ -10,18 +10,18 @@
#:fs-system-file-requirement
#:fs-system-requirement
#:project-requirement
#:requirement/branch
#:requirement/commit
#:requirement/name
#:requirement/no-deps-p
#:requirement/pathname
#:requirement/repo
#:requirement/source
#:requirement/systems
#:requirement/system-files
#:requirement/tag
#:requirement/version-spec
#:requirement/why
#:requirement-branch
#:requirement-commit
#:requirement-name
#:requirement-no-deps-p
#:requirement-pathname
#:requirement-repo
#:requirement-source
#:requirement-systems
#:requirement-system-files
#:requirement-tag
#:requirement-version-spec
#:requirement-why
#:system-requirement
#:vcs-project-requirement
#:vcs-requirement
......@@ -32,27 +32,27 @@
(defclass requirement ()
((name
:initarg :name
:reader requirement/name
:reader requirement-name
:documentation
"The name of the thing being required. Typically a string, but may be other
objects (like pathnames).")
(source
:initarg :source
:initform nil
:accessor requirement/source
:accessor requirement-source
:documentation
"If non-NIL, the requirement must be satisfied using releases provided by
this source.")
(no-deps-p
:initarg :no-deps-p
:initform nil
:accessor requirement/no-deps-p
:accessor requirement-no-deps-p
:documentation
"If non-NIL, the requirement's dependencies do not need to be satisfied.")
(why
:initarg :why
:initform nil
:accessor requirement/why
:accessor requirement-why
:documentation
"The reason this requirement was generated."))
(:documentation
......@@ -62,7 +62,7 @@ this source.")
((version-spec
:initarg :version-spec
:initform nil
:accessor requirement/version-spec
:accessor requirement-version-spec
:documentation
"The version specifier that must be satisfied."))
(:documentation
......@@ -72,25 +72,25 @@ this source.")
((repo
:initarg :repo
:initform nil
:reader requirement/repo
:reader requirement-repo
:documentation
"The repo object describing the upstream repo for this requirement.")
(branch
:initarg :branch
:initform nil
:reader requirement/branch
:reader requirement-branch
:documentation
"If non-NIL, string naming the required branch.")
(commit
:initarg :commit
:initform nil
:reader requirement/commit
:reader requirement-commit
:documentation
"If non-NIL, string naming the required commit.")
(tag
:initarg :tag
:initform nil
:reader requirement/tag
:reader requirement-tag
:documentation
"If non-NIL, string naming the required tag."))
(:documentation
......@@ -110,13 +110,13 @@ this source.")
((systems
:initarg :systems
:initform nil
:reader requirement/systems
:reader requirement-systems
:documentation
"A list of system names to require.")
(system-files
:initarg :system-files
:initform nil
:reader requirement/system-files
:reader requirement-system-files
:documentation
"A list of system files to require."))
(:documentation
......@@ -130,7 +130,7 @@ in the project."))
(defclass fs-system-requirement (requirement)
((pathname
:initarg :pathname
:accessor requirement/pathname
:accessor requirement-pathname
:documentation
"The pathname to the asd file containing this system."))
(:documentation
......@@ -150,24 +150,24 @@ filesystem must be included. NAME is the pathname to the asd file."))
(prin1 :name stream)
(write-char #\Space stream)
(pprint-newline :miser stream)
(write (requirement/name req) :stream stream)
(write (requirement-name req) :stream stream)
;; version
(when (and (typep req 'versioned-requirement)
(requirement/version-spec req))
(requirement-version-spec req))
(write-char #\Space stream)
(pprint-newline :linear stream)
(prin1 :version stream)
(write-char #\Space stream)
(pprint-newline :miser stream)
(write (requirement/version-spec req) :stream stream))
(write (requirement-version-spec req) :stream stream))
;; why
(when (requirement/why req)
(when (requirement-why req)
(write-char #\Space stream)
(pprint-newline :linear stream)
(prin1 :why stream)
(write-char #\Space stream)
(pprint-newline :miser stream)
(write (requirement/why req) :stream stream))
(write (requirement-why req) :stream stream))
;; ID
(pprint-newline :linear stream))))
......
......@@ -75,15 +75,15 @@
(defun rewrite-vcs-req (req context)
"Given a VCS requirement and a context, "
(let ((existing-release (find (requirement/name req) (context-releases context)
(let ((existing-release (find (requirement-name req) (context-releases context)
:test #'equal :key (compose #'project-name #'release-project))))
(if (and existing-release (listp (release-version existing-release)))
(progn
(make-instance 'vcs-project-requirement
:name (requirement/name req)
:source (requirement/source req)
:why (requirement/why req)
:no-deps-p (requirement/no-deps-p req)
:name (requirement-name req)
:source (requirement-source req)
:why (requirement-why req)
:no-deps-p (requirement-no-deps-p req)
:commit (second (release-version existing-release))))
req)))
......@@ -91,7 +91,7 @@
(mapcar (lambda (req)
(if (and (not (eql update-projects t))
(typep req 'vcs-requirement)
(not (member (requirement/name req) update-projects :test #'equal)))
(not (member (requirement-name req) update-projects :test #'equal)))
(rewrite-vcs-req req context)
req))
reqs))
......
......@@ -45,7 +45,7 @@ source can be found."))
(defmethod find-requirement-source :around (req &optional (errorp t))
"If the requirement has a specific source set, use that. Otherwise, fallback
to searching."
(let ((out (or (requirement/source req)
(let ((out (or (requirement-source req)
(call-next-method))))
(or out
(when errorp
......@@ -55,19 +55,19 @@ to searching."
"Find the first source in *SOURCES* that provides the project. ERRORP is
handled by an :AROUND method."
(declare (ignore errorp))
(find-project-source (requirement/name req)))
(find-project-source (requirement-name req)))
(defmethod find-requirement-source ((req system-requirement) &optional errorp)
"Find the first source in *SOURCES* that provides the system. ERRORP is andled
by an :AROUND method."
(declare (ignore errorp))
(find-system-source (requirement/name req)))
(find-system-source (requirement-name req)))
(defmethod find-requirement-source ((req vcs-project-requirement) &optional errorp)
"Find the first source in *SOURCES* that provides the project. ERRORP is
handled by an :AROUND method."
(declare (ignore errorp))
(find-project-source (requirement/name req)))
(find-project-source (requirement-name req)))
;; * Requirement States
......@@ -77,13 +77,13 @@ handled by an :AROUND method."
satisfied. Returns one of :SAT, :UNSAT, or :UNKNOWN."))
(defmethod requirement-state ((req fs-system-requirement) node)
(let* ((system-name (requirement/name req))
(let* ((system-name (requirement-name req))
(system-release (node-find-system-if-active node system-name)))
(cond
((not system-release)
:unknown)
((not (eql (system-release-source system-release)
(requirement/source req)))
(requirement-source req)))
:unsat)
(t
:sat))))
......@@ -91,8 +91,8 @@ satisfied. Returns one of :SAT, :UNSAT, or :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."
(let* ((project-name (requirement/name req))
(version-spec (requirement/version-spec req))
(let* ((project-name (requirement-name req))
(version-spec (requirement-version-spec req))
(release (node-find-project-if-active node project-name)))
(cond
((not release)
......@@ -105,8 +105,8 @@ the search node and its version satisfies the requested version."
(defmethod requirement-state ((req system-requirement) node)
"A system requirement is satisfied if there is an active system release that
provides the system."
(let* ((system-name (requirement/name req))
(version-spec (requirement/version-spec req))
(let* ((system-name (requirement-name req))
(version-spec (requirement-version-spec req))
(system-release (node-find-system-if-active node system-name)))
(cond
((provided-system-p system-name)
......@@ -141,8 +141,8 @@ a plist. This plist can contain :system-releases or :system-files."))
(defmethod resolve-requirement ((req fs-system-requirement) node)
;; Make a release from the file system.
(let* ((system-name (requirement/name req))
(fs-source (requirement/source req))
(let* ((system-name (requirement-name req))
(fs-source (requirement-source req))
(system (source-system fs-source system-name))
(releases (system-releases system))
(release (first releases))
......@@ -164,11 +164,11 @@ a plist. This plist can contain :system-releases or :system-files."))
satisfy the version spec (if any) and including every system release per
satisfying release."
(when-let*
((project-name (requirement/name req))
((project-name (requirement-name req))
(source (find-requirement-source req nil))
(project (source-project source project-name))
(releases (project-releases project))
(applicable-releases (remove-if-not (rcurry #'release-satisfies-version-spec-p (requirement/version-spec req))
(applicable-releases (remove-if-not (rcurry #'release-satisfies-version-spec-p (requirement-version-spec req))
releases)))
(mapcar (lambda (x)
(list x :system-releases (release-system-releases x)))
......@@ -177,12 +177,12 @@ satisfying release."
(defmethod resolve-requirement ((req system-requirement) node)
"A system requirement is resolved by any release that provides the system."
(when-let*
((system-name (requirement/name req))
((system-name (requirement-name req))
(source (find-requirement-source req))
(system (source-system source system-name)))
(let* ((system-releases (system-system-releases system))
(applicable-system-releases (remove-if-not (rcurry #'system-release-satisfies-version-spec-p
(requirement/version-spec req))
(requirement-version-spec req))
system-releases)))
(unless system-releases
(error "No releases for ~S" system-name))
......@@ -193,12 +193,12 @@ satisfying release."
(defmethod resolve-requirement ((req vcs-project-requirement) node)
(declare (ignore node))
(let* ((project-name (requirement/name req))
(systems (requirement/systems req))
(system-files (requirement/system-files req))
(branch (requirement/branch req))
(commit (requirement/commit req))
(tag (requirement/tag req))
(let* ((project-name (requirement-name req))
(systems (requirement-systems req))
(system-files (requirement-system-files req))
(branch (requirement-branch req))
(commit (requirement-commit req))
(tag (requirement-tag req))
(source (find-requirement-source req nil))
(vcs-project (source-project source project-name nil))
(vcs-release (project-vcs-release vcs-project
......
......@@ -57,7 +57,7 @@
(log:trace "When groveling, found ~A is unsatisfied" missing-req)
(if-let ((candidate-file
(and (typep missing-req 'system-requirement)
(find (asdf:primary-system-name (requirement/name missing-req))
(find (asdf:primary-system-name (requirement-name missing-req))
(node-system-files-pending-groveling new-search-node)
:key (compose #'system-file-primary-system-name #'car)
:test #'equal))))
......@@ -101,7 +101,7 @@
(let ((reqs (system-release-requirements sr)))
;; Mark the reason for the new reqs
(mapc (lambda (r)
(setf (requirement/why r) sr))
(setf (requirement-why r) sr))
reqs)
;; Add the deps we just computed.
(node-add-unresolved-reqs! new-search-node reqs)))
......@@ -130,12 +130,12 @@
(node-add-resolution! new-node release system-releases nil unresolved-req)
;; And push its requirements, unless the requirement says to not
;; include deps.
(unless (requirement/no-deps-p unresolved-req)
(unless (requirement-no-deps-p unresolved-req)
(dolist (sr system-releases)
(let ((new-reqs (system-release-requirements sr)))
;; Mark the reason for the new reqs
(mapc (lambda (r)
(setf (requirement/why r) sr))
(setf (requirement-why r) sr))
new-reqs)
(node-add-unresolved-reqs! new-node new-reqs))))
(values new-node (not (null resolutions))))))))
......@@ -221,7 +221,7 @@ observed in package-inferred-systems that are groveled after a refactoring
leaves some dead files around."
(and (typep req 'system-requirement)
(null (find-requirement-source req nil))
(node-find-system-if-active node (asdf:primary-system-name (requirement/name req)))))
(node-find-system-if-active node (asdf:primary-system-name (requirement-name req)))))
(defun cleanup-search-node! (node)
"Returns two values. The first is the search node with all satisfied
......
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