From: Matt Birkholz Date: Fri, 21 Jul 2017 05:01:17 +0000 (-0700) Subject: devops: Use regsexps, more parsed versions. X-Git-Tag: mit-scheme-pucked-9.2.12~102 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=6324ee1aa8d7b91e19288818d6556e8fac46dfc1;p=mit-scheme.git devops: Use regsexps, more parsed versions. --- diff --git a/src/devops/devops.scm b/src/devops/devops.scm index 9c5c3aa99..d91b52df5 100644 --- a/src/devops/devops.scm +++ b/src/devops/devops.scm @@ -38,7 +38,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (lint (core-lint version (core-changes) dirt))) (if (not (null? lint)) (begin - (log "# "(project-name)" "version":\n") + (log "# "(project-name)" "(version-string version)":\n") (write-lint lint))))) (define (plugin-status plugin dirt) @@ -47,7 +47,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (lint (plugin-lint plugin version changes dirt))) (if (not (null? lint)) (begin - (log "# "(plugin-name plugin)" "version":\n") + (log "# "(plugin-name plugin)" "(version-string version)":\n") (write-lint lint))))) (define (write-lint lint) @@ -83,15 +83,21 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (plugin-lint-hook plugin version changes dirt) '())))) +(define debian-changelog-version-pattern + (compile-regsexp '(seq (* (any-char)) + #\space #\( + (group version (+ (char-not-in #\)))) + #\)))) + (define (debian-version dir) (let* ((changelog (string dir"/debian/changelog")) (line (and (file-exists? changelog) (file-first-line changelog))) - (regs (and line - (re-string-match ".* +(\\([^)]+\\))" line)))) - (if regs - (re-match-extract line regs 1) - (error "could not find Debian version:" line)))) + (match (and line + (regsexp-match-string debian-changelog-version-pattern + line)))) + (and match + (->version (match-extract match 'version))))) (define (debian-version-lint version dversion) (append @@ -102,15 +108,16 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (list "Debian version not found.") '()) (if (and version dversion - (not (string=? version dversion))) - (list (string "Debian version ("dversion") does not match.")) + (not (version=? version dversion))) + (list (string "Debian version ("(version-string dversion)")" + " does not match.")) '()))) -(define (released-version-lint version-string released changed) +(define (released-version-lint version released changes) (cond ((eq? #f released) (list "First release!")) - ((and (not (null? changed)) - (not (version>? (->version version-string) released))) + ((and (not (null? changes)) + (not (version>? version released))) (list "Version is out-of-date.")) (else '()))) @@ -143,18 +150,23 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (string=? dir (substring line 3 dir-end)) (char=? #\/ (string-ref line dir-end))))) -(load-option 'regular-expression) +(define core-version-pattern + (compile-regsexp '(seq (* (any-char)) + "ubsystem-identification! \"Release\"" + " '(" + (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)) - (patt ".*ubsystem-identification! \"Release\" '(\\([0-9 ]+\\))") - (regs (and (string? line) - (re-string-match patt line)))) - (if regs - (string-replace (re-match-extract line regs 1) #\space #\.) + (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)))))))) @@ -203,6 +215,12 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (and last-tag (car (shell-lines "git log --format=%H -1 "last-tag))))) +(define plugin-version-pattern + (compile-regsexp '(seq (* (char-in whitespace)) + #\[ + (group version (+ (alt #\. (char-in numeric)))) + #\]))) + (define (plugin-version plugin) (call-with-input-file (string (plugin-directory plugin)"/configure.ac") (lambda (in) @@ -211,11 +229,11 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (if (and (string? line) (string-prefix? "AC_INIT" line)) (let* ((line (read-line in)) - (regs (and (string? line) - (re-string-match "[ \t]*[[]\\([0-9.]+\\)[]]" - line)))) - (if regs - (re-match-extract line regs 1) + (match (and (string? line) + (regsexp-match-string plugin-version-pattern + line)))) + (if match + (->version (match-extract match 'version)) (error "no plugin version:" (plugin-name plugin)))) (if (eof-object? line) (error "no AC_INIT:" (plugin-name plugin)) @@ -258,9 +276,9 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define (release-core version changes dirt snap?) (if (and (null? changes) (not snap?)) (error "no unreleased commits")) - (let* ((version (core-version)) - (project (project-name)) - (pkgvers (string project"-"version)) + (let* ((project (project-name)) + (vers (version-string version)) + (pkgvers (string project"-"vers)) (logfile (string "devops/"pkgvers"-src.log"))) (log "# "pkgvers":\n") (write-lint (core-lint version changes dirt)) @@ -282,16 +300,17 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (run "rm -rf devops/"pkgvers) (run "cd devops/ && tar xzf "pkgvers".tar.gz") (run "cd devops/ && dpkg-source --build "pkgvers) - (run "chmod 444 devops/"project"_"version".dsc") - (run "chmod 444 devops/"project"_"version".tar.xz") + (run "chmod 444 devops/"project"_"vers".dsc") + (run "chmod 444 devops/"project"_"vers".tar.xz") (run "rm -rf devops/"pkgvers))) (delete-file logfile))) (define (release-plugin plugin version changes dirt snap?) (if (and (null? changes) (not snap?)) (error "no unreleased commits")) - (let* ((pkg (plugin-package plugin)) - (pkgvers (string pkg"-"version)) + (let* ((vers (version-string version)) + (pkg (plugin-package plugin)) + (pkgvers (string pkg"-"vers)) (logfile (string "devops/"pkgvers"-src.log")) (dir (plugin-directory plugin))) (log "# "pkgvers":\n") @@ -316,8 +335,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (run "rm -rf devops/"pkgvers) (run "cd devops/ && tar xzf "pkgvers".tar.gz") (run "cd devops/ && dpkg-source --build "pkgvers) - (run "chmod 444 devops/"pkg"_"version".dsc") - (run "chmod 444 devops/"pkg"_"version".tar.xz") + (run "chmod 444 devops/"pkg"_"vers".dsc") + (run "chmod 444 devops/"pkg"_"vers".tar.xz") (run "rm -rf devops/"pkgvers))) (delete-file logfile))) @@ -325,17 +344,16 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (let* ((changes (or (core-changes) '())) (version (core-version)) (released (released-version (project-name))) - (new (->version version)) - (source-filename - (string "devops/"(project-name)"-"version".tar.gz"))) + (vers (version-string version)) + (source-filename (string "devops/"(project-name)"-"vers".tar.gz"))) (define (found) (log "# "source-filename":\nAlready done.\n")) (cond ((and (null? changes) - (version=? new released)) + (version=? version released)) (if (file-exists? source-filename) (found) (release-core version changes dirt #t))) ((and (pair? changes) - (version>? new released)) + (version>? version released)) ;; Clobber! (release-core version changes dirt #t)) ((null? changes) @@ -349,17 +367,17 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (let* ((changes (plugin-changes plugin)) (version (plugin-version plugin)) (released (released-version (plugin-package plugin))) - (new (->version version)) - (source-filename - (string "devops/"(plugin-package plugin)"-"version".tar.gz"))) + (vers (version-string version)) + (source-filename (string "devops/" + (plugin-package plugin)"-"vers".tar.gz"))) (define (found) (log "# "source-filename":\nAlready done.\n")) (cond ((and (null? changes) - (version=? new released)) + (version=? version released)) (if (file-exists? source-filename) (found) (release-plugin plugin version changes dirt #t))) ((and (pair? changes) - (version>? new released)) + (version>? version released)) ;; Clobber! (release-plugin plugin version changes dirt #t)) ((null? changes)