Overview
| Comment: | Fixed issue with run event_time being reset when test was rerun |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.55 |
| Files: | files | file ages | folders |
| SHA1: |
aaa8f2a3d5189dee65798079f2091294 |
| User & Date: | mrwellan on 2013-09-09 10:12:07 |
| Other Links: | branch diff | manifest | tags |
Context
|
2013-09-09
| ||
| 16:41 | partially borked change to better deal with run queue idiosyncracies check-in: fa1ff570f2 user: mrwellan tags: v1.55 | |
| 10:12 | Fixed issue with run event_time being reset when test was rerun check-in: aaa8f2a3d5 user: mrwellan tags: v1.55 | |
|
2013-09-05
| ||
| 17:36 | First pass on revtag tool check-in: 67a802fc2e user: mrwellan tags: v1.55 | |
Changes
Modified db.scm from [ac3c20aa1a] to [3d88d89e84].
| ︙ | ︙ | |||
643 644 645 646 647 648 649 | (lambda (id) (set! res id)) db (let ((qry (conc "SELECT id FROM runs WHERE (runname=? " andstr key=?str ");"))) ;(debug:print 4 "qry: " qry) qry) qryvals) | | | 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 |
(lambda (id)
(set! res id))
db
(let ((qry (conc "SELECT id FROM runs WHERE (runname=? " andstr key=?str ");")))
;(debug:print 4 "qry: " qry)
qry)
qryvals)
(sqlite3:execute db "UPDATE runs SET state=?,status=?,event_time=strftime('%s','now') WHERE id=? AND state='deleted';" state status res)
res)
(begin
(debug:print 0 "ERROR: Called without all necessary keys")
#f))))
;; replace header and keystr with a call to runs:get-std-run-fields
|
| ︙ | ︙ |
Modified utils/revtagfsl.scm from [b7c322220b] to [48b6acfe19].
| ︙ | ︙ | |||
29 30 31 32 33 34 35 |
(conc "fossil json timeline checkin --limit " limit))))
(with-input-from-pipe cmd json-read)))
(define mt (vector->list (revtag:get-timeline fname 10000)))
(define tl (map vector->list (cdr (assoc "timeline" (vector->list (cdr (assoc "payload" mt)))))))
| < < < < < | | < | < < | | | < > > > > > > > > > > > > < | | < < | | < < < < < | 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 |
(conc "fossil json timeline checkin --limit " limit))))
(with-input-from-pipe cmd json-read)))
(define mt (vector->list (revtag:get-timeline fname 10000)))
(define tl (map vector->list (cdr (assoc "timeline" (vector->list (cdr (assoc "payload" mt)))))))
(define tagged (make-hash-table))
(define usedtags (make-hash-table))
(for-each (lambda (node)
(let* ((uuid (cdr (assoc "uuid" node)))
(tags-dat (assoc "tags" node))
(tags (if tags-dat (cdr tags-dat) '())))
(for-each (lambda (tag)
(hash-table-set! usedtags tag #t))
tags)))
tl)
(define ord-tl (sort tl (lambda (a b)(let ((ta (cdr (assoc "timestamp" a)))(tb (cdr (assoc "timestamp" b))))(< ta tb)))))
(define (make-tag branch)
(let* ((nextnum (+ 1 (hash-table-ref/default tagged branch 0))))
(hash-table-set! tagged branch nextnum)
(conc branch "-r" nextnum)))
(define (get-next-revtag branch)
(let loop ((tag (make-tag branch)))
(if (hash-table-ref/default usedtags tag #f)
(loop (make-tag branch))
tag)))
(print "branch, uuid, newtag")
(let loop ((hed (car ord-tl))
(tal (cdr ord-tl)))
(let* ((tags (let ((t (assoc "tags" hed)))
(if t (cdr t) '())))
(uuid (cdr (assoc "uuid" hed)))
(branch (if (null? tags) "nobranch" (car tags)))
(tagpatt (regexp (conc "^" branch "-r\\d+$")))
(currtag (filter (lambda (x)(string-match tagpatt x)) tags)))
(if (and (not (equal? branch "nobranch"))
(null? currtag))
(let ((newtag (get-next-revtag branch)))
(print branch ", " uuid ", " newtag)
(system (conc "fossil tag add \"" newtag "\" " uuid " -R " fname)) ;; ?--raw? ?--propagate? TAGNAME CHECK-IN ?VALUE?
(hash-table-set! usedtags currtag #t)))
(if (not (null? tal))
(loop (car tal)(cdr tal)))))
|