Note 1: This road-map continues to evolve and subject to change without notice.
Index: launch.scm
==================================================================
--- launch.scm
+++ launch.scm
@@ -911,11 +911,11 @@
(current-state (rmt:get-run-state run-id))
(current-status (rmt:get-run-status run-id)))
;;get-vars run-id to query metadata table to check if all completed. if all-test-launched = yes then only not-completed-cnt = 0 means everyting is completed if no entry found in the table do nothing
(debug:print 0 *default-log-port* "rollup run state/status")
(rmt:set-state-status-and-roll-up-run run-id current-state current-status)
-
+ (runs:update-junit-test-reporter-xml run-id)
(cond
((and all-test-launched (eq? not-completed-cnt 0) (equal? all-test-launched "yes" ))
(debug:print 0 *default-log-port* "look for post hook.")
(runs:run-post-hook run-id))
((> running-cnt 3)
Index: runs.scm
==================================================================
--- runs.scm
+++ runs.scm
@@ -16,11 +16,11 @@
;; along with Megatest. If not, see .
;; strftime('%m/%d/%Y %H:%M:%S','now','localtime')
(use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 (srfi 18)
- posix-extras directory-utils pathname-expand typed-records format)
+ posix-extras directory-utils pathname-expand typed-records format sxml-serializer sxml-modifications)
(declare (unit runs))
(declare (uses db))
(declare (uses common))
(declare (uses items))
@@ -2699,10 +2699,100 @@
(conc "INSERT OR REPLACE INTO test_data (test_id,category,variable,value,expected,tol,units,comment) "
"SELECT " (db:test-get-id new-testdat) ",category,variable,value,expected,tol,units,comment FROM test_data WHERE test_id=?;")
(db:test-get-id testdat))))
))
prev-tests)))
+
+(define doc-template
+ '(*TOP*
+ (*PI* xml "version='1.0'")
+ (testsuite)))
+
+(define (runs:update-junit-test-reporter-xml run-id)
+ (let* (
+ (junit-test-reporter (configf:lookup *configdat* "runs" "junit-test-reporter-xml"))
+ (junit-test-report-dir (configf:lookup *configdat* "runs" "junit-test-report-dir"))
+ (xml-dir (if (and junit-test-reporter (equal? junit-test-reporter "yes" ))
+ (if junit-test-report-dir
+ junit-test-report-dir
+ (conc (getenv "MT_LINKTREE") "/" (getenv "MT_TARGET") "/" (getenv "MT_RUNNAME")))
+ #f))
+ (xml-ts-name (if xml-dir
+ (conc (getenv "MT_TESTSUITENAME")"."(string-translate (getenv "MT_TARGET") "/" ".") "." (getenv "MT_RUNNAME"))
+ #f))
+ (keyname (common:get-signature xml-ts-name))
+ (xml-path (if xml-dir
+ (conc xml-dir "/" keyname ".xml")
+ #f))
+
+ (test-data (if xml-dir
+ (rmt:get-tests-for-run run-id "%" '() '() ;; run-id testpatt states statuses
+ #f #f ;; offset limit
+ #f ;; not-in
+ #f ;; sort-by
+ #f ;; sort-order
+ #f ;; get full data (not 'shortlist)
+ 0 ;; (runs:gendat-inc-results-last-update *runs:general-data*) ;; last update time
+ #f)
+ '()))
+ (tests-count (if xml-dir (length test-data) #f)))
+ (if (and junit-test-reporter (equal? junit-test-reporter "yes" ))
+ (begin
+ ;((sxml-modify! `("testsuite" insert-into (@ (name ,xml-ts-name) (tests ,tests-count)))) doc)
+
+ (let loop ((test (car test-data))
+ (tail (cdr test-data))
+ (doc doc-template)
+ (fail-cnt 0)
+ (error-cnt 0))
+ (let* ((test-name (vector-ref test 2))
+ (test-itempath (vector-ref test 11))
+ (tc-name (conc test-name (if (and test-itempath (not (equal? test-itempath ""))) (conc "." (string-translate test-itempath "/" "." )) "")))
+ (test-state (vector-ref test 3))
+ (comment (vector-ref test 14))
+ (test-status (vector-ref test 4))
+ (exc-msg (conc "No bucket for State " test-state " Status " test-status))
+ (new-doc (cond
+ ((member test-state (list "LAUNCHED" "REMOTEHOSTSTART" "RUNNING" ))
+ ((sxml-modify `("testsuite" insert-into (testcase (@ (name ,tc-name)) (inProgress (@ (type "inProgress")))))) doc))
+ ((member test-status (list "PASS" "WARN" "WAIVED"))
+ ((sxml-modify `("testsuite" insert-into (testcase (@ (name ,tc-name))))) doc))
+ ((member test-status (list "FAIL" "CHECK"))
+ ((sxml-modify `("testsuite" insert-into (testcase (@ (name ,tc-name)) (failure (@ (message ,comment) (type "failure")))))) doc))
+ ((member test-status (list "DEAD" "KILLED" "ABORT" "PREQ_FAIL" "PREQ_DISCARDED"))
+ ((sxml-modify `("testsuite" insert-into (testcase (@ (name ,tc-name)) (failure (@ (message ,comment) (type "error")))))) doc))
+ ((member test-status (list "SKIP"))
+ ((sxml-modify `("testsuite" insert-into (testcase (@ (name ,tc-name)) (skipped (@ (type "skipped")))))) doc))
+ (else
+ (debug:print 0 *default-log-port* (conc "What do I do with State " test-state " Status " test-status))
+ ((sxml-modify `("testsuite" insert-into (testcase (@ (name ,tc-name)) (failure (@ (message ,exc-msg) (type "error")))))) doc))))
+ (new-error-cnt (if (member test-status (list "DEAD" "KILLED" "ABORT" "PREQ_FAIL" "PREQ_DISCARDED"))
+ (+ error-cnt 1)
+ error-cnt))
+ (new-fail-cnt (if (member test-status (list "FAIL" "CHECK"))
+ (+ fail-cnt 1)
+ fail-cnt)))
+ (if (null? tail)
+ (let* ((final-doc ((sxml-modify `("testsuite" insert-into (@ (name ,xml-ts-name) (tests ,tests-count) (errors ,error-cnt) (failures ,fail-cnt)))) new-doc)))
+ (debug:print 0 *default-log-port* "modify attrib error=" error-cnt " fail= " fail-cnt)
+ (handle-exceptions
+ exn
+ (let* ((msg ((condition-property-accessor 'exn 'message) exn)))
+ (debug:print 0 *default-log-port* (conc "WARNING: Failed to update file" xml-path". Message:" msg)))
+
+ (if (not (file-exists? xml-dir))
+ (create-directory xml-dir #t))
+ (if (not (rmt:no-sync-get/default keyname #f))
+ (begin
+ (rmt:no-sync-set keyname "on")
+ (debug:print 0 *default-log-port* "creating xml at " xml-path)
+ (with-output-to-file xml-path
+ (lambda ()
+ (print (sxml-serializer#serialize-sxml final-doc ns-prefixes: (list (cons 'gnm "http://foo"))))))
+ (rmt:no-sync-del! keyname))
+ (debug:print 0 *default-log-port* "Could not get the lock. Skip writing the xml file."))))
+ (loop (car tail) (cdr tail) new-doc new-fail-cnt new-error-cnt))))))))
;; clean cache files
(define (runs:clean-cache target runname toppath)
(if target
+