1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
|
(handle-exceptions
exn
(begin
(debug:print 0 "ERROR: Bad data in test record? " test)
(print "exn=" (condition->list exn))
(debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
(print-call-chain (current-error-port)))
(let* ((test-id (if (member "id" tests-spec)(get-value-by-fieldname test test-field-index "id" ) #f)) ;; (db:test-get-id test))
(testname (if (member "testname" tests-spec)(get-value-by-fieldname test test-field-index "testname" ) #f)) ;; (db:test-get-testname test))
(itempath (if (member "item_path" tests-spec)(get-value-by-fieldname test test-field-index "item_path" ) #f)) ;; (db:test-get-item-path test))
(comment (if (member "comment" tests-spec)(get-value-by-fieldname test test-field-index "comment" ) #f)) ;; (db:test-get-comment test))
(tstate (if (member "state" tests-spec)(get-value-by-fieldname test test-field-index "state" ) #f)) ;; (db:test-get-state test))
(tstatus (if (member "status" tests-spec)(get-value-by-fieldname test test-field-index "status" ) #f)) ;; (db:test-get-status test))
(event-time (if (member "event_time" tests-spec)(get-value-by-fieldname test test-field-index "event_time" ) #f)) ;; (db:test-get-event_time test))
(rundir (if (member "rundir" tests-spec)(get-value-by-fieldname test test-field-index "rundir" ) #f)) ;; (db:test-get-rundir test))
(final_logf (if (member "final_logf" tests-spec)(get-value-by-fieldname test test-field-index "final_logf" ) #f)) ;; (db:test-get-final_logf test))
(run_duration (if (member "run_duration" tests-spec)(get-value-by-fieldname test test-field-index "run_duration") #f)) ;; (db:test-get-run_duration test))
(fullname (conc testname
(if (equal? itempath "")
""
(conc "(" itempath ")")))))
(case dmode
((json ods)
(if tests-spec
|
|
|
|
|
|
|
|
|
|
|
|
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
|
(handle-exceptions
exn
(begin
(debug:print 0 "ERROR: Bad data in test record? " test)
(print "exn=" (condition->list exn))
(debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
(print-call-chain (current-error-port)))
(let* ((test-id (if (member "id" tests-spec)(get-value-by-fieldname test test-field-index "id" ) #f)) ;; (db:test-id test))
(testname (if (member "testname" tests-spec)(get-value-by-fieldname test test-field-index "testname" ) #f)) ;; (db:test-testname test))
(itempath (if (member "item_path" tests-spec)(get-value-by-fieldname test test-field-index "item_path" ) #f)) ;; (db:test-item-path test))
(comment (if (member "comment" tests-spec)(get-value-by-fieldname test test-field-index "comment" ) #f)) ;; (db:test-comment test))
(tstate (if (member "state" tests-spec)(get-value-by-fieldname test test-field-index "state" ) #f)) ;; (db:test-state test))
(tstatus (if (member "status" tests-spec)(get-value-by-fieldname test test-field-index "status" ) #f)) ;; (db:test-status test))
(event-time (if (member "event_time" tests-spec)(get-value-by-fieldname test test-field-index "event_time" ) #f)) ;; (db:test-event_time test))
(rundir (if (member "rundir" tests-spec)(get-value-by-fieldname test test-field-index "rundir" ) #f)) ;; (db:test-rundir test))
(final_logf (if (member "final_logf" tests-spec)(get-value-by-fieldname test test-field-index "final_logf" ) #f)) ;; (db:test-final_logf test))
(run_duration (if (member "run_duration" tests-spec)(get-value-by-fieldname test test-field-index "run_duration") #f)) ;; (db:test-run_duration test))
(fullname (conc testname
(if (equal? itempath "")
""
(conc "(" itempath ")")))))
(case dmode
((json ods)
(if tests-spec
|
1121
1122
1123
1124
1125
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
|
(else
(if (and tstate tstatus event-time)
(format #t
" Test: ~25a State: ~15a Status: ~15a Runtime: ~5@as Time: ~22a Host: ~10a\n"
(if fullname fullname "")
(if tstate tstate "")
(if tstatus tstatus "")
(get-value-by-fieldname test test-field-index "run_duration");;(if test (db:test-get-run_duration test) "")
(if event-time event-time "")
(get-value-by-fieldname test test-field-index "host")) ;;(if test (db:test-get-host test)) "")
(print " Test: " fullname
(if tstate (conc " State: " tstate) "")
(if tstatus (conc " Status: " tstatus) "")
(if (get-value-by-fieldname test test-field-index "run_duration")
(conc " Runtime: " (get-value-by-fieldname test test-field-index "run_duration"))
"")
(if event-time (conc " Time: " event-time) "")
(if (get-value-by-fieldname test test-field-index "host")
(conc " Host: " (get-value-by-fieldname test test-field-index "host"))
"")))
(if (not (or (equal? (get-value-by-fieldname test test-field-index "status") "PASS")
(equal? (get-value-by-fieldname test test-field-index "status") "WARN")
(equal? (get-value-by-fieldname test test-field-index "state") "NOT_STARTED")))
(begin
(print (if (get-value-by-fieldname test test-field-index "cpuload")
(conc " cpuload: " (get-value-by-fieldname test test-field-index "cpuload"))
"") ;; (db:test-get-cpuload test)
(if (get-value-by-fieldname test test-field-index "diskfree")
(conc "\n diskfree: " (get-value-by-fieldname test test-field-index "diskfree")) ;; (db:test-get-diskfree test)
"")
(if (get-value-by-fieldname test test-field-index "uname")
(conc "\n uname: " (get-value-by-fieldname test test-field-index "uname")) ;; (db:test-get-uname test)
"")
(if (get-value-by-fieldname test test-field-index "rundir")
(conc "\n rundir: " (get-value-by-fieldname test test-field-index "rundir")) ;; (db:test-get-rundir test)
"")
;; "\n rundir: " (get-value-by-fieldname test test-field-index "") ;; (sdb:qry 'getstr ;; (filedb:get-path *fdb*
;; (db:test-get-rundir test) ;; )
)
;; Each test
;; DO NOT remote run
(let ((steps (rmt:get-steps-for-test run-id (db:test-get-id test)))) ;; (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)
|
|
|
|
|
|
|
|
|
|
1121
1122
1123
1124
1125
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
|
(else
(if (and tstate tstatus event-time)
(format #t
" Test: ~25a State: ~15a Status: ~15a Runtime: ~5@as Time: ~22a Host: ~10a\n"
(if fullname fullname "")
(if tstate tstate "")
(if tstatus tstatus "")
(get-value-by-fieldname test test-field-index "run_duration");;(if test (db:test-run_duration test) "")
(if event-time event-time "")
(get-value-by-fieldname test test-field-index "host")) ;;(if test (db:test-host test)) "")
(print " Test: " fullname
(if tstate (conc " State: " tstate) "")
(if tstatus (conc " Status: " tstatus) "")
(if (get-value-by-fieldname test test-field-index "run_duration")
(conc " Runtime: " (get-value-by-fieldname test test-field-index "run_duration"))
"")
(if event-time (conc " Time: " event-time) "")
(if (get-value-by-fieldname test test-field-index "host")
(conc " Host: " (get-value-by-fieldname test test-field-index "host"))
"")))
(if (not (or (equal? (get-value-by-fieldname test test-field-index "status") "PASS")
(equal? (get-value-by-fieldname test test-field-index "status") "WARN")
(equal? (get-value-by-fieldname test test-field-index "state") "NOT_STARTED")))
(begin
(print (if (get-value-by-fieldname test test-field-index "cpuload")
(conc " cpuload: " (get-value-by-fieldname test test-field-index "cpuload"))
"") ;; (db:test-cpuload test)
(if (get-value-by-fieldname test test-field-index "diskfree")
(conc "\n diskfree: " (get-value-by-fieldname test test-field-index "diskfree")) ;; (db:test-diskfree test)
"")
(if (get-value-by-fieldname test test-field-index "uname")
(conc "\n uname: " (get-value-by-fieldname test test-field-index "uname")) ;; (db:test-uname test)
"")
(if (get-value-by-fieldname test test-field-index "rundir")
(conc "\n rundir: " (get-value-by-fieldname test test-field-index "rundir")) ;; (db:test-rundir test)
"")
;; "\n rundir: " (get-value-by-fieldname test test-field-index "") ;; (sdb:qry 'getstr ;; (filedb:get-path *fdb*
;; (db:test-rundir test) ;; )
)
;; Each test
;; DO NOT remote run
(let ((steps (rmt:get-steps-for-test run-id (db:test-id test)))) ;; (db:get-steps-for-test dbstruct run-id (db:test-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)
|