| ︙ | | |
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
|
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
|
-
+
-
+
-
+
-
+
|
;;======================================================================
;; NOTE: list-runs and list-db-targets operate on local db!!!
;;
(if (or (args:get-arg "-list-runs")
(args:get-arg "-list-db-targets"))
(if (setup-for-run)
(let* ((db (make-dbr:dbstruct path: *toppath* local: #t))
(let* ((dbstruct (make-dbr:dbstruct path: *toppath* local: #t))
(runpatt (args:get-arg "-list-runs"))
(testpatt (if (args:get-arg "-testpatt")
(args:get-arg "-testpatt")
"%"))
(runsdat (db:get-runs db runpatt #f #f '()))
(runsdat (db:get-runs dbstruct runpatt #f #f '()))
(runs (db:get-rows runsdat))
(header (db:get-header runsdat))
(keys (db:get-keys db))
(keys (db:get-keys dbstruct))
(db-targets (args:get-arg "-list-db-targets"))
(seen (make-hash-table)))
;; Each run
(for-each
(lambda (run)
(let ((targetstr (string-intersperse (map (lambda (x)
(db:get-value-by-header run header x))
keys) "/")))
(if db-targets
(if (not (hash-table-ref/default seen targetstr #f))
(begin
(hash-table-set! seen targetstr #t)
;; (print "[" targetstr "]"))))
(print targetstr))))
(if (not db-targets)
(let* ((run-id (db:get-value-by-header run header "id"))
(tests (db:get-tests-for-run db run-id testpatt '() '() #f #f #f 'testname 'asc #f)))
(tests (db:get-tests-for-run dbstruct run-id testpatt '() '() #f #f #f 'testname 'asc #f)))
(print "Run: " targetstr "/" (db:get-value-by-header run header "runname")
" status: " (db:get-value-by-header run header "state")
" run-id: " run-id ", number tests: " (length tests))
(for-each
(lambda (test)
(format #t
" Test: ~25a State: ~15a Status: ~15a Runtime: ~5@as Time: ~22a Host: ~10a\n"
|
| ︙ | | |
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
|
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
|
-
+
+
-
+
|
(print " cpuload: " (db:test-get-cpuload test)
"\n diskfree: " (db:test-get-diskfree test)
"\n uname: " (sdb:qry 'getstr (db:test-get-uname test))
"\n rundir: " (filedb:get-path *fdb* (db:test-get-rundir test))
)
;; Each test
;; DO NOT remote run
(let ((steps (db:get-steps-for-test db (db:test-get-id test))))
(let ((steps (db:get-steps-for-test dbstruct run-id (db:test-get-id test))))
(for-each
(lambda (step)
(format #t
" Step: ~20a State: ~10a Status: ~10a Time ~22a\n"
(tdb:step-get-stepname step)
(tdb:step-get-state step)
(tdb:step-get-status step)
(tdb:step-get-event_time step)))
steps)))))
tests)))))
runs)
(db:close-all dbstruct)
(set! *didsomething* #t))))
(set! *didsomething* #t))))
;;======================================================================
;; full run
;;======================================================================
;; get lock in db for full run for this directory
;; for all tests with deps
|
| ︙ | | |
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
|
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
|
-
+
-
+
-
+
-
+
-
-
+
+
|
;; (if (sqlite3:database? db)(sqlite3:finalize! db))
)
;; else do a general-run-call
(general-run-call
"-test-paths"
"Get paths to tests"
(lambda (target runname keys keyvals)
(let* ((db (make-dbr:dbstruct path: *toppath* local: #t))
(let* ((dbstruct (make-dbr:dbstruct path: *toppath* local: #t))
;; DO NOT run remote
(paths (db:test-get-paths-matching db keys target)))
(paths (db:test-get-paths-matching dbstruct keys target)))
(for-each (lambda (path)
(print path))
paths)
(sqlite3:finalize! db))))))
(db:close-all dbstruct))))))
;;======================================================================
;; Extract a spreadsheet from the runs database
;;======================================================================
(if (args:get-arg "-extract-ods")
(general-run-call
"-extract-ods"
"Make ods spreadsheet"
(lambda (target runname keys keyvals)
(let ((db (make-dbr:dbstruct path: *toppath* local: #t))
(let ((dbstruct (make-dbr:dbstruct path: *toppath* local: #t))
(outputfile (args:get-arg "-extract-ods"))
(runspatt (args:get-arg ":runname"))
(pathmod (args:get-arg "-pathmod")))
;; (keyvalalist (keys->alist keys "%")))
(debug:print 2 "Extract ods, outputfile: " outputfile " runspatt: " runspatt " keyvals: " keyvals)
(db:extract-ods-file db outputfile keyvals (if runspatt runspatt "%") pathmod)
(sqlite3:finalize! db)
(db:extract-ods-file dbstruct outputfile keyvals (if runspatt runspatt "%") pathmod)
(db:close-all dbstruct)
(set! *didsomething* #t)))))
;;======================================================================
;; execute the test
;; - gets called on remote host
;; - receives info from the -execute param
;; - passes info to steps via MT_CMDINFO env var (future is to use a dot file)
|
| ︙ | | |
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
|
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
|
-
-
+
+
-
+
-
+
+
+
+
-
+
-
+
+
|
;;======================================================================
;; Start a repl
;;======================================================================
(if (or (args:get-arg "-repl")
(args:get-arg "-load"))
(let* ((toppath (setup-for-run))
(db (if toppath (make-dbr:dbstruct path: toppath local: #t) #f)))
(if db
(dbstruct (if toppath (make-dbr:dbstruct path: toppath local: #t) #f)))
(if dbstruct
(begin
(set! *db* db)
(set! *db* dbstruct)
(set! *client-non-blocking-mode* #t)
(import readline)
(import apropos)
;; (import (prefix sqlite3 sqlite3:)) ;; doesn't work ...
(gnu-history-install-file-manager
(string-append
(or (get-environment-variable "HOME") ".") "/.megatest_history"))
(current-input-port (make-gnu-readline-port "megatest> "))
(if (args:get-arg "-repl")
(repl)
(load (args:get-arg "-load"))))
(load (args:get-arg "-load")))
(db:close-all dbstruct))
(exit))
(set! *didsomething* #t)))
;; Not converted to use dbstruct yet
;;
(if (args:get-arg "-convert-to-norm")
(let* ((toppath (setup-for-run))
(db (if toppath (make-dbr:dbstruct path: toppath local: #t))))
(dbstruct (if toppath (make-dbr:dbstruct path: toppath local: #t))))
(for-each
(lambda (field)
(let ((dat '()))
(debug:print-info 0 "Getting data for field " field)
(sqlite3:for-each-row
(lambda (id val)
(set! dat (cons (list id val) dat)))
db
(get-db db run-id)
(conc "SELECT id," field " FROM tests;"))
(debug:print-info 0 "found " (length dat) " items for field " field)
(let ((qry (sqlite3:prepare db (conc "UPDATE tests SET " field "=? WHERE id=?;"))))
(for-each
(lambda (item)
(let ((newval (sdb:qry 'getid (cadr item))))
(if (not (equal? newval (cadr item)))
(debug:print-info 0 "Converting " (cadr item) " to " newval " for test #" (car item)))
(sqlite3:execute qry newval (car item))))
dat)
(sqlite3:finalize! qry))))
(db:close-all dbstruct)
(list "uname" "rundir" "final_logf" "comment"))
(set! *didsomething* #t)))
;;======================================================================
;; Exit and clean up
;;======================================================================
|
| ︙ | | |