@@ -16,11 +16,11 @@
 ;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;  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