Overview
| Comment: | pgdb test-step sync completed |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.65 |
| Files: | files | file ages | folders |
| SHA1: |
2f03232e1d7998dd77f1e118585ba2e1 |
| User & Date: | pjhatwal on 2017-09-01 15:50:32 |
| Other Links: | branch diff | manifest | tags |
Context
|
2017-09-06
| ||
| 11:47 | Minor tidy up check-in: a1dbd06515 user: mrwellan tags: v1.65 | |
|
2017-09-01
| ||
| 15:50 | pgdb test-step sync completed check-in: 2f03232e1d user: pjhatwal tags: v1.65 | |
|
2017-08-29
| ||
| 12:04 | Merged in missing viewscreen fix check-in: a5ed8f0caa user: mrwellan tags: v1.65 | |
Changes
Modified Makefile from [8bd7c1c18c] to [c704f0ab66].
| ︙ | ︙ | |||
48 49 50 51 52 53 54 | dboard : $(OFILES) $(GOFILES) dashboard.scm csc $(CSCOPTS) $(OFILES) dashboard.scm $(GOFILES) -o dboard ndboard : newdashboard.scm $(OFILES) $(GOFILES) csc $(CSCOPTS) $(OFILES) $(GOFILES) newdashboard.scm -o ndboard | | | 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 | dboard : $(OFILES) $(GOFILES) dashboard.scm csc $(CSCOPTS) $(OFILES) dashboard.scm $(GOFILES) -o dboard ndboard : newdashboard.scm $(OFILES) $(GOFILES) csc $(CSCOPTS) $(OFILES) $(GOFILES) newdashboard.scm -o ndboard mtut: $(OFILES) megatest-fossil-hash.scm mtut.scm csc $(CSCOPTS) $(OFILES) mtut.scm -o mtut TCMTOBJS = \ api.o \ archive.o \ cgisetup/models/pgdb.o \ client.o \ |
| ︙ | ︙ | |||
144 145 146 147 148 149 150 151 152 153 154 155 156 157 | $(PREFIX)/bin/newdashboard : $(PREFIX)/bin/.$(ARCHSTR)/ndboard utils/mk_wrapper utils/mk_wrapper $(PREFIX) ndboard $(PREFIX)/bin/newdashboard chmod a+x $(PREFIX)/bin/newdashboard $(PREFIX)/bin/.$(ARCHSTR)/mtut : mtut $(INSTALL) mtut $(PREFIX)/bin/.$(ARCHSTR)/mtut $(PREFIX)/bin/mtutil : $(PREFIX)/bin/.$(ARCHSTR)/mtut utils/mk_wrapper utils/mk_wrapper $(PREFIX) mtut $(PREFIX)/bin/mtutil chmod a+x $(PREFIX)/bin/mtutil $(PREFIX)/bin/.$(ARCHSTR)/tcmt : tcmt $(INSTALL) tcmt $(PREFIX)/bin/.$(ARCHSTR)/tcmt | > > > | 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 | $(PREFIX)/bin/newdashboard : $(PREFIX)/bin/.$(ARCHSTR)/ndboard utils/mk_wrapper utils/mk_wrapper $(PREFIX) ndboard $(PREFIX)/bin/newdashboard chmod a+x $(PREFIX)/bin/newdashboard $(PREFIX)/bin/.$(ARCHSTR)/mtut : mtut $(INSTALL) mtut $(PREFIX)/bin/.$(ARCHSTR)/mtut install-mtut : mtut $(INSTALL) mtut $(PREFIX)/bin/mtut $(PREFIX)/bin/mtutil : $(PREFIX)/bin/.$(ARCHSTR)/mtut utils/mk_wrapper utils/mk_wrapper $(PREFIX) mtut $(PREFIX)/bin/mtutil chmod a+x $(PREFIX)/bin/mtutil $(PREFIX)/bin/.$(ARCHSTR)/tcmt : tcmt $(INSTALL) tcmt $(PREFIX)/bin/.$(ARCHSTR)/tcmt |
| ︙ | ︙ |
Modified api.scm from [c4438e36a1] to [107a3485b1].
| ︙ | ︙ | |||
275 276 277 278 279 280 281 282 283 284 285 286 287 288 |
((get-main-run-stats) (apply db:get-main-run-stats dbstruct params))
((get-var) (apply db:get-var dbstruct params))
((get-run-stats) (apply db:get-run-stats dbstruct params))
;; STEPS
((get-steps-data) (apply db:get-steps-data dbstruct params))
((get-steps-for-test) (apply db:get-steps-for-test dbstruct params))
;; TEST DATA
((read-test-data) (apply db:read-test-data dbstruct params))
((read-test-data*) (apply db:read-test-data* dbstruct params))
;; MISC
((get-latest-host-load) (apply db:get-latest-host-load dbstruct params))
| > | 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 |
((get-main-run-stats) (apply db:get-main-run-stats dbstruct params))
((get-var) (apply db:get-var dbstruct params))
((get-run-stats) (apply db:get-run-stats dbstruct params))
;; STEPS
((get-steps-data) (apply db:get-steps-data dbstruct params))
((get-steps-for-test) (apply db:get-steps-for-test dbstruct params))
((get-steps-info-by-id) (apply db:get-steps-info-by-id dbstruct params))
;; TEST DATA
((read-test-data) (apply db:read-test-data dbstruct params))
((read-test-data*) (apply db:read-test-data* dbstruct params))
;; MISC
((get-latest-host-load) (apply db:get-latest-host-load dbstruct params))
|
| ︙ | ︙ |
Modified cgisetup/models/pgdb.scm from [2f88fa03e8] to [5842dfc33d].
| ︙ | ︙ | |||
126 127 128 129 130 131 132 133 134 135 136 137 138 139 |
;;
(define (pgdb:insert-run dbh ttype-id target run-name state status owner event-time comment fail-count pass-count)
(dbi:exec
dbh
"INSERT INTO runs (ttype_id,target,run_name,state,status,owner,event_time,comment,fail_count,pass_count)
VALUES (?,?,?,?,?,?,?,?,?,?);"
ttype-id target run-name state status owner event-time comment fail-count pass-count))
;;======================================================================
;; T E S T S
;;======================================================================
;; given run-id, test_name and item_path return test-id
;;
| > > > > > > > > > > > > > > > > > > > > > > > > > > | 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 |
;;
(define (pgdb:insert-run dbh ttype-id target run-name state status owner event-time comment fail-count pass-count)
(dbi:exec
dbh
"INSERT INTO runs (ttype_id,target,run_name,state,status,owner,event_time,comment,fail_count,pass_count)
VALUES (?,?,?,?,?,?,?,?,?,?);"
ttype-id target run-name state status owner event-time comment fail-count pass-count))
;;======================================================================
;; T E S T - S T E P S
;;======================================================================
(define (pgdb:get-test-step-id dbh test-id stepname)
(dbi:get-one
dbh
"SELECT id FROM test_steps WHERE test_id=? AND stepname=? ;"
test-id stepname))
(define (pgdb:insert-test-step dbh test-id stepname state status event_time comment logfile)
(dbi:exec
dbh
"INSERT INTO test_steps (test_id,stepname,state,status,event_time,logfile,comment)
VALUES (?,?,?,?,?,?,?);"
test-id stepname state status event_time logfile comment))
(define (pgdb:update-test-step dbh step-id test-id stepname state status event_time comment logfile)
(dbi:exec
dbh
"UPDATE test_steps SET
test_id=?,stepname=?,state=?,status=?,event_time=?,logfile=?,comment=?
WHERE id=?;"
test-id stepname state status event_time logfile comment step-id))
;;======================================================================
;; T E S T S
;;======================================================================
;; given run-id, test_name and item_path return test-id
;;
|
| ︙ | ︙ |
Modified db.scm from [144a083df6] to [1b0ddebb0a].
| ︙ | ︙ | |||
3103 3104 3105 3106 3107 3108 3109 3110 3111 3112 3113 3114 3115 3116 |
(sqlite3:for-each-row
(lambda (id test-id stepname state status event-time logfile comment)
(set! res (cons (vector id test-id stepname state status event-time (if (string? logfile) logfile "") comment) res)))
db
"SELECT id,test_id,stepname,state,status,event_time,logfile,comment FROM test_steps WHERE status != 'DELETED' AND test_id=? ORDER BY id ASC;" ;; event_time DESC,id ASC;
test-id)
(reverse res)))))
(define (db:get-steps-data dbstruct run-id test-id)
(db:with-db
dbstruct
run-id
#f
(lambda (db)
| > > > > > > > > > > > > > > > | 3103 3104 3105 3106 3107 3108 3109 3110 3111 3112 3113 3114 3115 3116 3117 3118 3119 3120 3121 3122 3123 3124 3125 3126 3127 3128 3129 3130 3131 |
(sqlite3:for-each-row
(lambda (id test-id stepname state status event-time logfile comment)
(set! res (cons (vector id test-id stepname state status event-time (if (string? logfile) logfile "") comment) res)))
db
"SELECT id,test_id,stepname,state,status,event_time,logfile,comment FROM test_steps WHERE status != 'DELETED' AND test_id=? ORDER BY id ASC;" ;; event_time DESC,id ASC;
test-id)
(reverse res)))))
(define (db:get-steps-info-by-id dbstruct test-step-id)
(db:with-db
dbstruct
#f
#f
(lambda (db)
(let* ((res (vector #f #f #f #f #f #f #f #f)))
(sqlite3:for-each-row
(lambda (id test-id stepname state status event-time logfile comment)
(set! res (vector id test-id stepname state status event-time (if (string? logfile) logfile "") comment)))
db
"SELECT id,test_id,stepname,state,status,event_time,logfile,comment FROM test_steps WHERE status != 'DELETED' AND id=? ORDER BY id ASC;" ;; event_time DESC,id ASC;
test-step-id)
res))))
(define (db:get-steps-data dbstruct run-id test-id)
(db:with-db
dbstruct
run-id
#f
(lambda (db)
|
| ︙ | ︙ |
Modified rmt.scm from [07c2956559] to [41b3cde9e8].
| ︙ | ︙ | |||
812 813 814 815 816 817 818 819 820 821 822 823 824 825 |
(debug:print 3 *default-log-port* "WARNING: Invalid " (if status "status" "state")
" value \"" (if status state-in status-in) "\", update your validvalues section in megatest.config"))
(rmt:send-receive 'teststep-set-status! run-id (list run-id test-id teststep-name state-in status-in comment logfile))))
(define (rmt:get-steps-for-test run-id test-id)
(rmt:send-receive 'get-steps-for-test run-id (list run-id test-id)))
;;======================================================================
;; T E S T D A T A
;;======================================================================
(define (rmt:read-test-data run-id test-id categorypatt #!key (work-area #f))
(rmt:send-receive 'read-test-data run-id (list run-id test-id categorypatt)))
(define (rmt:read-test-data* run-id test-id categorypatt varpatt #!key (work-area #f))
| > > > | 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 |
(debug:print 3 *default-log-port* "WARNING: Invalid " (if status "status" "state")
" value \"" (if status state-in status-in) "\", update your validvalues section in megatest.config"))
(rmt:send-receive 'teststep-set-status! run-id (list run-id test-id teststep-name state-in status-in comment logfile))))
(define (rmt:get-steps-for-test run-id test-id)
(rmt:send-receive 'get-steps-for-test run-id (list run-id test-id)))
(define (rmt:get-steps-info-by-id test-step-id)
(rmt:send-receive 'get-steps-info-by-id #f (list test-step-id)))
;;======================================================================
;; T E S T D A T A
;;======================================================================
(define (rmt:read-test-data run-id test-id categorypatt #!key (work-area #f))
(rmt:send-receive 'read-test-data run-id (list run-id test-id categorypatt)))
(define (rmt:read-test-data* run-id test-id categorypatt varpatt #!key (work-area #f))
|
| ︙ | ︙ |
Modified tasks.scm from [5b8b7eec05] to [ce51b9306d].
| ︙ | ︙ | |||
646 647 648 649 650 651 652 | (args:get-arg "-contour")))) (keytarg (if (or (args:get-arg "-prepend-contour") (args:get-arg "-prefix-target")) (conc "MT_CONTOUR/MT_AREA/" (string-intersperse (rmt:get-keys) "/")) (string-intersperse (rmt:get-keys) "/"))) ;; e.g. version/iteration/platform (target (if (or (args:get-arg "-prepend-contour") (args:get-arg "-prefix-target")) (conc (or (args:get-arg "-prefix-target") (conc contour "/" (common:get-area-name) "/")) (rmt:get-target run-id)) (rmt:get-target run-id))) ;; e.g. v1.63/a3e1/ubuntu (spec-id (pgdb:get-ttype dbh keytarg)) (new-run-id (pgdb:get-run-id dbh spec-id target run-name)) | < < < < | < > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 |
(args:get-arg "-contour"))))
(keytarg (if (or (args:get-arg "-prepend-contour") (args:get-arg "-prefix-target"))
(conc "MT_CONTOUR/MT_AREA/" (string-intersperse (rmt:get-keys) "/")) (string-intersperse (rmt:get-keys) "/"))) ;; e.g. version/iteration/platform
(target (if (or (args:get-arg "-prepend-contour") (args:get-arg "-prefix-target"))
(conc (or (args:get-arg "-prefix-target") (conc contour "/" (common:get-area-name) "/")) (rmt:get-target run-id)) (rmt:get-target run-id))) ;; e.g. v1.63/a3e1/ubuntu
(spec-id (pgdb:get-ttype dbh keytarg))
(new-run-id (pgdb:get-run-id dbh spec-id target run-name))
;; (area-id (db:get-value-by-header row header "area_id)"))
)
(if new-run-id
(begin ;; let ((run-record (pgdb:get-run-info dbh new-run-id))
(hash-table-set! runs-ht run-id new-run-id)
;; ensure key fields are up to date
(pgdb:refresh-run-info
dbh
new-run-id
state status owner event-time comment fail-count pass-count)
new-run-id)
(if (handle-exceptions
exn
(begin (print-call-chain)
(print ((condition-property-accessor 'exn 'message) exn))
#f)
(pgdb:insert-run
dbh
spec-id target run-name state status owner event-time comment fail-count pass-count)) ;; area-id))
(tasks:run-id->mtpg-run-id dbh cached-info run-id)
#f))))))
(define (tasks:sync-test-steps dbh cached-info test-step-ids)
(let ((test-ht (hash-table-ref cached-info 'tests))
(step-ht (hash-table-ref cached-info 'steps)))
(for-each
(lambda (test-step-id)
(let* ((test-step-info (rmt:get-steps-info-by-id test-step-id))
(step-id (tdb:step-get-id test-step-info))
(test-id (tdb:step-get-test_id test-step-info))
(stepname (tdb:step-get-stepname test-step-info))
(state (tdb:step-get-state test-step-info))
(status (tdb:step-get-status test-step-info))
(event_time (tdb:step-get-event_time test-step-info))
(comment (tdb:step-get-comment test-step-info))
(logfile (tdb:step-get-logfile test-step-info))
(pgdb-test-id (hash-table-ref/default test-ht test-id #f))
(pgdb-step-id (if pgdb-test-id
(pgdb:get-test-step-id dbh pgdb-test-id stepname)
#f)))
(if step-id
(begin
(if pgdb-test-id
(begin
(if pgdb-step-id
(begin
(print "Updating existing test-step with test-id: " test-id " and step-id " step-id)
(pgdb:update-test-step dbh pgdb-step-id pgdb-test-id stepname state status event_time comment logfile))
(begin
(print "Updating existing test-step with test-id: " test-id " and step-id " step-id)
(pgdb:insert-test-step dbh pgdb-test-id stepname state status event_time comment logfile )
(set! pgdb-step-id (pgdb:get-test-step-id dbh pgdb-test-id stepname))))
(hash-table-set! step-ht step-id pgdb-step-id )
(print test-step-info " test-step-id: " test-step-id " pgdb-test-id: " pgdb-test-id))
(print "Error: Test not cashed")))
(print "Error: Could not get test step info for step id " test-step-id )))) ;; this is a wierd senario need to debug
test-step-ids)))
(define (tasks:sync-tests-data dbh cached-info test-ids)
(let ((test-ht (hash-table-ref cached-info 'tests)))
(for-each
(lambda (test-id)
(let* ((test-info (rmt:get-test-info-by-id #f test-id))
(run-id (db:test-get-run_id test-info)) ;; look these up in db_records.scm
|
| ︙ | ︙ | |||
708 709 710 711 712 713 714 |
;; "id" "run_id" "testname" "state" "status" "event_time"
;; "host" "cpuload" "diskfree" "uname" "rundir" "item_path"
;; "run_duration" "final_logf" "comment" "shortdir" "attemptnum" "archived"
(if pgdb-run-id
(begin
(if pgdb-test-id ;; have a record
(begin ;; let ((key-name (conc run-id "/" test-name "/" item-path)))
| < > > > | > > | < | | | > | > | 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 |
;; "id" "run_id" "testname" "state" "status" "event_time"
;; "host" "cpuload" "diskfree" "uname" "rundir" "item_path"
;; "run_duration" "final_logf" "comment" "shortdir" "attemptnum" "archived"
(if pgdb-run-id
(begin
(if pgdb-test-id ;; have a record
(begin ;; let ((key-name (conc run-id "/" test-name "/" item-path)))
(print "Updating existing test with run-id: " run-id " and test-id: " test-id)
(pgdb:update-test dbh pgdb-test-id pgdb-run-id test-name item-path state status host cpuload diskfree uname run-dir log-file run-duration comment event-time archived))
(begin
(print "Inserting test with run-id: " run-id " and test-id: " test-id)
(pgdb:insert-test dbh pgdb-run-id test-name item-path state status host cpuload diskfree uname run-dir log-file run-duration comment event-time archived)
(set! pgdb-test-id (pgdb:get-test-id dbh pgdb-run-id test-name item-path))))
(hash-table-set! test-ht test-id pgdb-test-id))
(print "WARNING: Skipping run with run-id:" run-id ". This run was created after privious sync and removed before this sync."))))
test-ids)))
;; get runs changed since last sync
;; (define (tasks:sync-test-data dbh cached-info area-info)
;; (let* ((
(define (tasks:sync-to-postgres configdat dest)
(let* ((dbh (pgdb:open configdat dbname: dest))
(area-info (pgdb:get-area-by-path dbh *toppath*))
(cached-info (make-hash-table))
(start (current-seconds)))
(for-each (lambda (dtype)
(hash-table-set! cached-info dtype (make-hash-table)))
'(runs targets tests steps))
(hash-table-set! cached-info 'start start) ;; when done we'll set sync times to this
(if area-info
(let* ((last-sync-time (vector-ref area-info 3))
(changed (rmt:get-changed-record-ids last-sync-time))
(run-ids (alist-ref 'runs changed))
(test-ids (alist-ref 'tests changed))
(test-step-ids (alist-ref 'test_steps changed))
(test-data-ids (alist-ref 'test_data changed))
(run-stat-ids (alist-ref 'run_stats changed)))
;(print "area-info: " area-info)
(if (not (null? test-ids))
(begin
(print "Syncing " (length test-step-ids) " changed tests")
(tasks:sync-tests-data dbh cached-info test-ids)
(tasks:sync-test-steps dbh cached-info test-step-ids)))
;(pgdb:write-sync-time dbh area-info start)
)
(if (tasks:set-area dbh configdat)
(tasks:sync-to-postgres configdat dest)
(begin
(debug:print 0 *default-log-port* "ERROR: unable to create an area record")
#f)))))
|