From 0b606ee0ec4ccc5e15d1465e00e0d0516a4224a9 Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Thu, 28 Dec 2017 12:36:57 -0700 Subject: [PATCH] devops: A parameter (plugin name) for devops:status, and filenames in the lint messages, to make it easy to find the offender. --- src/devops/build.texi | 10 +++-- src/devops/devops.scm | 85 ++++++++++++++++++++++++++----------------- 2 files changed, 58 insertions(+), 37 deletions(-) diff --git a/src/devops/build.texi b/src/devops/build.texi index e18edb944..530452d1a 100644 --- a/src/devops/build.texi +++ b/src/devops/build.texi @@ -116,10 +116,13 @@ tested. The developer also needs to know if the core has been changed since its last release, which plugins have changed, and what files changed. -@deffn Procedure devops:status +@deffn Procedure devops:status [plugin] Write a status report listing the commits to be released and warning of unclean files, lint, or other possible trouble. The current working directory should be the top of the git repository. +If @var{plugin} is not provided the statuses of all plugins (and core) +are reported, else @var{plugin} should be a symbol or string---the +name of a plugin. @end deffn With the status report well considered, the developer will create @@ -129,8 +132,9 @@ is in use, the tag is pushed and the source is uploaded. @deffn Procedure devops:release [plugin] Warn of unclean files, lint, or other possible trouble, but tag @var{plugin} (or core) regardless and build a source distribution. If -@var{plugin} is @code{"snapshot"} create source distributions, but not -git tags, for all changed plugins (or core). +@var{plugin} is not provided the core is released. If name is +``snapshot'' source distributions are created for all changed plugins +(or core) but no git tags. @end deffn @node Build Process diff --git a/src/devops/devops.scm b/src/devops/devops.scm index 7b8269978..3c7662dd4 100644 --- a/src/devops/devops.scm +++ b/src/devops/devops.scm @@ -27,19 +27,24 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define (devops:main) (let* ((cmdl (command-line)) (arg1 (and (pair? cmdl) (car cmdl)))) - (cond ((equal? arg1 "status") (devops:status)) + (cond ((equal? arg1 "status") (apply devops:status (cdr cmdl))) ((equal? arg1 "release") (apply devops:release (cdr cmdl))) ((equal? arg1 "build") (apply devops:build (cdr cmdl))) (else (error "Unknown developer operation:" cmdl))))) -(define (devops:status) - (let ((dirt (shell-lines "git status --porcelain --untracked-files=no"))) +(define (devops:status #!optional name) + (if (default-object? name) + (status) + (plugin-status (->plugin name) (dirt)))) + +(define (dirt) + (shell-lines "git status --porcelain --untracked-files=no")) + +(define (status) + (let ((dirt (dirt))) (if (file-exists? "src/runtime/version.scm") (core-status dirt)) - (let ((ps (plugins))) - (if (pair? ps) - (for-each (lambda (p) (plugin-status p dirt)) ps) - (log "No plugins defined.\n"))))) + (for-each (lambda (p) (plugin-status p dirt)) plugin-list))) (define (core-status dirt) (let* ((version (core-version)) @@ -70,8 +75,10 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define (core-lint version changes dirt) (let ((dirt (core-dirt dirt))) (append - (debian-version-lint version (debian-version ".")) - (released-version-lint version (released-version (project-name)) changes) + (debian-version-lint version "src/runtime/version.scm" + (debian-version ".") "debian/changelog") + (released-version-lint version (released-version (project-name)) + changes "src/runtime/version.scm") (if core-lint-hook (core-lint-hook version changes dirt) '()) @@ -83,10 +90,12 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (pkg (plugin-package plugin)) (dir (plugin-directory plugin))) (append - (debian-version-lint version (debian-version dir)) + (debian-version-lint version (string dir"/configure.ac") + (debian-version dir) (string dir"/debian/changelog")) (news-version-lint plugin version) (subsystem-version-lint plugin version) - (released-version-lint version (released-version pkg) changes) + (released-version-lint version (released-version pkg) changes + (string (plugin-directory plugin)"/configure.ac")) (if plugin-lint-hook (plugin-lint-hook plugin version changes dirt) '()) @@ -109,17 +118,18 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (and match (->version (match-extract match 'version))))) -(define (debian-version-lint version dversion) +(define (debian-version-lint version filename dversion dfilename) (append (if (not version) - (list "Package version not found.") + (list (string filename": Warning: package version not found.")) '()) (if (not dversion) - (list "Debian version not found.") + (list (string dfilename": Warning: Debian version not found.")) '()) (if (and version dversion (not (version=? version dversion))) - (list (string "Debian version ("(version-string dversion)")" + (list (string dfilename": Warning: Debian version" + " ("(version-string dversion)")" " does not match.")) '()))) @@ -128,31 +138,34 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (if nvers (if (string=? nvers (version-string version)) '() - (list (string "NEWS version ("nvers") does not match."))) - (list "NEWS version not found.")))) + (list (string (plugin-directory plugin)"/NEWS:" + " Warning: version ("nvers") does not match."))) + (list (string (plugin-directory plugin)"/NEWS:" + " Warning: version not found."))))) (define (subsystem-version-lint plugin version) (let ((svers (read-subsystem-version plugin))) (if svers (if (version=? svers version) '() - (list (string "Subsystem version "svers" does not match.") - (string " (See "(plugin-directory plugin)"/make.scm.)"))) - (list "Subsystem version not found." - (string " (See "(plugin-directory plugin)"/make.scm.)"))))) + (list (string (plugin-directory plugin)"/make.scm:" + " Warning: subsystem version "svers + " does not match."))) + (list (string (plugin-directory plugin)"/make.scm:" + " Warning: subsystem version not found."))))) -(define (released-version-lint version released changes) +(define (released-version-lint version released changes filename) (cond ((eq? #f released) (list "First release!")) ((and (pair? changes) (not (version>? version released))) - (list "Version is out-of-date.")) + (list (string filename": Warning: version is out-of-date."))) (else '()))) (define (dirt-lint dirt) (if (pair? dirt) - (cons "Uncommitted files:" dirt) + (cons "Warning: uncommitted files:" dirt) '())) (define (changes-lint changes) @@ -162,7 +175,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define (core-dirt dirt) (filter (lambda (line) - (not (any (lambda (plugin) (plugin-dirt? plugin line)) (plugins)))) + (not (any (lambda (plugin) (plugin-dirt? plugin line)) + plugin-list))) dirt)) (define (plugin-dirt plugin dirt) @@ -293,7 +307,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. #;(define (core-changed-files) (let ((hash (released-hash (project-name)))) (and hash - (let ((excluded-dirs (map plugin-directory (plugins)))) + (let ((excluded-dirs (map plugin-directory plugin-list))) (filter (lambda (filename) (not (any (lambda (excluded-dir) @@ -302,7 +316,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (shell-lines "git diff --name-only "hash)))))) (define (plugin-dir-prefixes) - (map (lambda (p) (string-append (plugin-directory p) "/")) (plugins))) + (map (lambda (p) (string-append (plugin-directory p) "/")) + plugin-list)) (define (released-hash name) (let* ((tags (sorted-tags name)) @@ -338,7 +353,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define (plugin-changes plugin) (let ((hash (released-hash (plugin-package plugin)))) (and hash - (shell-lines "git log --oneline --name-status "hash".." + (shell-lines "git log --no-merges --oneline --name-status "hash".." " -- "(plugin-directory plugin)"/")))) #;(define (plugin-changed-files plugin) @@ -359,11 +374,9 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (eq? 'snapshot plugin)) (snapshot-core dirt) (for-each (lambda (p) (snapshot-plugin p dirt)) - (plugins))) + plugin-list)) ((or (string? plugin) (symbol? plugin)) - (let* ((name (string plugin)) - (p (find (lambda (p) (string=? name (plugin-name p))) - (plugins)))) + (let ((p (->plugin plugin))) (release-plugin p (plugin-version p) (plugin-changes p) dirt #f))) (else (error "Plugin must be a string or symbol."))))) @@ -731,10 +744,14 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (list (make-plugin name directory)))) unspecific) -(define (plugins) (list-copy plugin-list)) - (define plugin-list '()) +(define (->plugin name) + (let ((n (string name))) + (or (find (lambda (p) (string=? n (plugin-name p))) + plugin-list) + (error "no such plugin:" name)))) + (define-record-type (make-plugin name directory) plugin? -- 2.25.1