From a03b0f25dcd36631fafaaf284af815298d58a15b Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Thu, 25 Jan 2018 12:38:51 -0700 Subject: [PATCH] devops (get-core-version): search src/runtime/version.scm once --- src/devops/devops.scm | 50 ++++++++++++++++++++++--------------------- 1 file changed, 26 insertions(+), 24 deletions(-) diff --git a/src/devops/devops.scm b/src/devops/devops.scm index 8d64b31f5..9993800e1 100644 --- a/src/devops/devops.scm +++ b/src/devops/devops.scm @@ -41,14 +41,14 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (shell-lines "git status --porcelain --untracked-files=no")) (define (status) - (let ((dirt (dirt))) - (if (file-exists? "src/runtime/version.scm") - (core-status dirt)) + (let ((dirt (dirt)) + (version (get-core-version))) + (if version + (core-status version dirt)) (for-each (lambda (p) (plugin-status p dirt)) plugin-list))) -(define (core-status dirt) - (let* ((version (core-version)) - (lint (core-lint version (or (core-changes) '()) dirt))) +(define (core-status version dirt) + (let ((lint (core-lint version (or (get-core-changes) '()) dirt))) (if (not (null? lint)) (begin (log "\n# core "(version-string version)"\n") @@ -199,19 +199,22 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (group version (+ (alt #\space (char-in numeric)))) ")"))) -(define (core-version) - (call-with-input-file "src/runtime/version.scm" - (lambda (in) - (let loop () - (let* ((line (read-line in)) - (match (and (string? line) - (regsexp-match-string core-version-pattern line)))) - (if match - (map (lambda (s) (string->number s 10)) - (burst-string (match-extract match 'version) #\space #t)) - (if (eof-object? line) - (error "could not find core version") - (loop)))))))) +(define (get-core-version) + (and (file-exists? "src/runtime/version.scm") + (call-with-input-file "src/runtime/version.scm" + (lambda (in) + (let loop () + (let* ((line (read-line in)) + (match (and (string? line) + (regsexp-match-string core-version-pattern + line)))) + (if match + (map (lambda (s) (string->number s 10)) + (burst-string (match-extract match 'version) + #\space #t)) + (if (eof-object? line) + (error "could not find core version") + (loop))))))))) (define (make-news-pattern fullname) (compile-regsexp `(seq ,fullname @@ -283,7 +286,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (and (pair? tags) (caar tags)))) -(define (core-changes) +(define (get-core-changes) (let ((start-hash (released-hash (project-name)))) (and start-hash (append-map! @@ -371,7 +374,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 (core-version) (core-changes) dirt #f)) + (release-core (get-core-version) (get-core-changes) dirt #f)) ((or (equal? "snapshot" plugin) (eq? 'snapshot plugin)) (snapshot-core dirt) @@ -446,9 +449,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (run "rm -rf devops/"pkgvers))) (delete-file logfile))) -(define (snapshot-core dirt) - (let* ((changes (or (core-changes) '())) - (version (core-version)) +(define (snapshot-core version dirt) + (let* ((changes (or (get-core-changes) '())) (released (released-version (project-name))) (vers (version-string version)) (source-filename (string "devops/"(project-name)"-"vers".tar.gz"))) -- 2.25.1