Commit 7f9e7c54 authored by Eric Timmons's avatar Eric Timmons
Browse files

Make ref work with VCS constraints

parent 65c3ca39
......@@ -724,6 +724,14 @@ in place with the same name. Return the new requirement if it was modified."
(write-char #\Space stream)
(pprint-newline :miser stream)
(prin1 (requirement-tag req) stream))
;; Ref
(when (requirement-ref req)
(write-char #\Space stream)
(pprint-newline :fill stream)
(prin1 :ref stream)
(write-char #\Space stream)
(pprint-newline :miser stream)
(prin1 (requirement-ref req) stream))
;; Source
(when (requirement-source req)
(write-char #\Space stream)
......@@ -215,16 +215,16 @@ optionally changing into the local dir for ~repo~."
(zerop (nth-value 2 (git-rev-parse ref-name :repo repo :ignore-error-status t))))))))
(defmethod ensure-ref-present-locally! ((repo git-repo) ref)
"Given a repo and a reference (either a commit, branch, or tag), ensure that
"Given a repo and a reference (either a commit, branch, tag, or ref), ensure that
ref is present locally, fetching or cloning the repo as necessary."
(destructuring-bind (ref-type ref-name) ref
(declare (ignore ref-name))
(let ((local-dir (git-repo-local-dir repo)))
((uiop:probe-file* local-dir)
;; Repo is present, need to fetch if the ref is not present or the ref
;; is a branch.
(when (and (or (eql ref-type :branch)
(starts-with-subseq "refs/heads/" ref-name)
(not (ref-present-p repo ref)))
(with-retries (:max 10 :sleep 5)
......@@ -206,6 +206,7 @@ satisfying release."
(let* ((project-name (requirement-name req))
(systems (requirement-systems req))
(system-files (requirement-system-files req))
(ref (requirement-ref req))
(branch (requirement-branch req))
(commit (requirement-commit req))
(tag (requirement-tag req))
......@@ -214,7 +215,8 @@ satisfying release."
(vcs-release (project-vcs-release vcs-project
:tag tag
:commit commit
:branch branch))
:branch branch
:ref ref))
(release-system-files (release-system-files vcs-release)))
(assert (null system-files))
;; If the systems are defined, we only need to grovel the files in which
......@@ -275,11 +275,12 @@
(setf (slot-value project slot-name)
(defmethod project-vcs-release ((project clpi-project) &key commit branch tag)
(defmethod project-vcs-release ((project clpi-project) &key commit branch tag ref)
(let* ((ref (cond
(commit `(:commit ,commit))
(branch `(:branch ,branch))
(tag `(:tag ,tag))))
(tag `(:tag ,tag))
(ref `(:ref ,ref))))
(release (ensure-gethash ref (clpi-project-vcs-release-ht project)
(make-vcs-release (project-source project) project ref
:local-release-class 'clpi-vcs-local-release
......@@ -252,10 +252,10 @@ project."))
(defgeneric project-source (project)
(:documentation "The source that provides the project."))
(defgeneric project-vcs-release (project &key commit branch tag)
(defgeneric project-vcs-release (project &key commit branch tag ref)
(:documentation "Return a release of this project, taken from its repo.")
(:method :before (project &key commit branch tag)
(assert (xor commit branch tag))))
(:method :before (project &key commit branch tag ref)
(assert (xor commit branch tag ref))))
......@@ -180,11 +180,12 @@ local override when requesting a VCS release.")
(defmethod project-releases ((project vcs-project))
(hash-table-values (vcs-project-releases-by-spec project)))
(defmethod project-vcs-release ((project vcs-project) &key commit branch tag)
(defmethod project-vcs-release ((project vcs-project) &key commit branch tag ref)
(let* ((ref (cond
(commit `(:commit ,commit))
(branch `(:branch ,branch))
(tag `(:tag ,tag))))
(tag `(:tag ,tag))
(ref `(:ref ,ref))))
(release (ensure-gethash ref (vcs-project-releases-by-spec project)
(make-vcs-release (project-source project) project ref))))
(unless commit
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