From 2faa691ea7e4a26ecccd21217587c81ba7805f97 Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Thu, 20 Jul 2017 22:23:00 -0700 Subject: [PATCH] devops: changes should be #f initially. Use empty tag message. --- src/devops/devops.scm | 62 +++++++++++++++++++++---------------------- 1 file changed, 30 insertions(+), 32 deletions(-) diff --git a/src/devops/devops.scm b/src/devops/devops.scm index d91b52df5..02f45aa79 100644 --- a/src/devops/devops.scm +++ b/src/devops/devops.scm @@ -35,7 +35,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define (core-status dirt) (let* ((version (core-version)) - (lint (core-lint version (core-changes) dirt))) + (lint (core-lint version (or (core-changes) '()) dirt))) (if (not (null? lint)) (begin (log "# "(project-name)" "(version-string version)":\n") @@ -116,7 +116,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define (released-version-lint version released changes) (cond ((eq? #f released) (list "First release!")) - ((and (not (null? changes)) + ((and (pair? changes) (not (version>? version released))) (list "Version is out-of-date.")) (else @@ -178,21 +178,24 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define (core-changes) (let ((start-hash (released-hash (project-name)))) - (append-map! - (lambda (hash) - (let* ((lines (shell-lines "git log --oneline --name-status -1 "hash)) - (files (filter (let ((excludes (plugin-dir-prefixes))) - (lambda (line) - (let* ((i (string-find-next-char line #\tab)) - (name (substring line (fix:1+ i)))) - (not (any (lambda (exclude) - (string-prefix? exclude name)) - excludes))))) - (cdr lines)))) - (if (null? files) - '() - (cons (car lines) files)))) - (shell-lines "git log --format=%H "start-hash"..HEAD")))) + (and start-hash + (append-map! + (lambda (hash) + (let* ((lines + (shell-lines "git log --oneline --name-status -1 "hash)) + (files + (filter (let ((excludes (plugin-dir-prefixes))) + (lambda (line) + (let* ((i (string-find-next-char line #\tab)) + (name (substring line (fix:1+ i)))) + (not (any (lambda (exclude) + (string-prefix? exclude name)) + excludes))))) + (cdr lines)))) + (if (null? files) + '() + (cons (car lines) files)))) + (shell-lines "git log --format=%H "start-hash"..HEAD"))))) #;(define (core-changed-files) (let ((hash (released-hash (project-name)))) @@ -241,10 +244,9 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define (plugin-changes plugin) (let ((hash (released-hash (plugin-package plugin)))) - (if hash - (shell-lines "git log --oneline --name-status "hash".." - " -- "(plugin-directory plugin)"/") - '()))) + (and hash + (shell-lines "git log --oneline --name-status "hash".." + " -- "(plugin-directory plugin)"/")))) #;(define (plugin-changed-files plugin) (let ((hash (released-hash (plugin-package plugin)))) @@ -259,7 +261,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define (devops:release #!optional plugin) (let ((dirt (shell-lines "git status --porcelain --untracked-files=no"))) (cond ((default-object? plugin) - (release-core dirt #f)) + (release-core (core-version) (core-changes) dirt #f)) ((or (equal? "snapshot" plugin) (eq? 'snapshot plugin)) (snapshot-core dirt) @@ -269,7 +271,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (let* ((name (string plugin)) (p (find (lambda (p) (string=? name (plugin-name p))) (plugins)))) - (release-plugin p dirt #f))) + (release-plugin p (plugin-version p) (plugin-changes p) dirt #f))) (else (error "Plugin must be a string or symbol."))))) @@ -289,10 +291,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (if snap? (run "git archive --prefix="project"/ HEAD" " | ( cd devops/"pkgvers" && tar xf - )") - (let ((hash (car (shell-lines "git log --format=%H -1 HEAD"))) - (datime - (universal-time->local-time-string (get-universal-time)))) - (run "git tag -s -m \""datime" "hash"\" "pkgvers) + (begin + (run "git tag -s -m \"\" "pkgvers) (run "git archive --prefix="project"/ "pkgvers " | ( cd devops/"pkgvers" && tar xf - )"))) (run "cd devops/"pkgvers" && "project"/dist/make-src-files standard") @@ -321,10 +321,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (if snap? (run "git archive --prefix="pkgvers"/ HEAD -- "dir " | ( cd devops && tar xf - )") - (let ((hash (car (shell-lines "git log --format=%H -1 HEAD"))) - (datime - (universal-time->local-time-string (get-universal-time)))) - (run "git tag -s -m \""datime" "hash"\" "pkgvers) + (begin + (run "git tag -s -m \"\" "pkgvers) (run "git archive --prefix="pkgvers"/ "pkgvers" -- "dir " | ( cd devops && tar xf - )"))) (run "cd devops/"pkgvers"/"dir" && ./autogen.sh") @@ -364,7 +362,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (error "version has not incremented:" version))))) (define (snapshot-plugin plugin dirt) - (let* ((changes (plugin-changes plugin)) + (let* ((changes (or (plugin-changes plugin) '())) (version (plugin-version plugin)) (released (released-version (plugin-package plugin))) (vers (version-string version)) -- 2.25.1