Megatest

;; GLOBALS
;;======================================================================

;; Gotta have a global? Stash it in the *global* hash table.
;;
(define *global* (make-hash-table))

(define (tcmt:print tdat)
(define (tcmt:print tdat flush-mode)
  (let* ((comment  (if (testdat-comment tdat)
		       (conc " message='" (testdat-comment tdat))
		       ""))
	 (details  (if (testdat-details tdat)
		       (conc " details='" (testdat-details tdat))
		       ""))
	 (flowid   (conc " flowId='" (testdat-flowid   tdat) "'"))
	 (duration (conc " duration='" (* 1e3 (testdat-duration tdat)) "'"))
	 (tcname   (conc " name='" (testdat-tctname  tdat) "'")))
    (case (string->symbol (testdat-overall tdat)) ;; (testdat-tc-type tdat)
	 (tcname   (conc " name='" (testdat-tctname  tdat) "'"))
	 (state    (string->symbol (testdat-state tdat)))
	 (status   (string->symbol (testdat-status tdat)))
	 (overall  (case state
		     ((RUNNING)   state)
		     ((COMPLETED) state)
		     (else 'UNK))))
    (case overall
      ((RUNNING)      (print "##teamcity[testStarted "  tcname flowid "]"))
      ((COMPLETED)
       (if (member (testdat-status tdat) '("PASS" "WARN" "SKIP" "WAIVED"))
       (if (member status '(PASS WARN SKIP WAIVED))
	   (print "##teamcity[testFinished " tcname flowid comment details duration "]")
	   (print "##teamcity[testFailed "   tcname flowid comment details "]")))
      (else
      ((ignore)        #f)
      (else            (print "ERROR: tc-type \"" (testdat-tc-type tdat) "\" not recognised for " tcname)))
       (if flush-mode
	   (print "##teamcity[testFailed "   tcname flowid comment details "]"))))
    ;; (print "ERROR: tc-type \"" (testdat-tc-type tdat) "\" not recognised for " tcname)))
    (flush-output)))

;; ;; returns values: flag newlst
;; (define (remove-duplicate-completed  tdats)
;;   (let* ((flag       #f)
;;          (state      (testdat-state      tdat))
;;          (status     (testdat-status     tdat))

         data
         'tqueue
         (let loop ((hed (car tqueue)) ;; by this point all duplicates by state COMPLETED are removed
                    (tal (cdr tqueue))
                    (rem '()))
           (if (> print-time (testdat-event-time hed)) ;; event happened over 15 seconds ago
               (begin
                 (tcmt:print hed)
                 (tcmt:print hed flush-mode)
                 (if (null? tqueue)
                     rem ;; return rem to be processed in the future
                     (loop (car tal)(cdr tal) rem)))
               (if (null? tal)
                   (cons hed rem) ;; return rem + hed for future processing
                   (loop (car tal)(cdr tal)(cons hed rem)))))))))

;;;;;;;       ((UNK)       ) ;; do nothing
;;;;;;;       ((RUNNING)   (print "##teamcity[testStarted name='" tctname "' flowId='" flowid "']"))
;;;;;;;       ((PASS SKIP WARN WAIVED) (print "##teamcity[testFinished name='" tctname "' duration='" (* 1e3 duration) "'" cmtstr details " flowId='" flowid "']"))
;;;;;;;       (else
;;;;;;; 	(print "##teamcity[testFailed name='" tctname "' " cmtstr details " flowId='" flowid "']")))
;;;;;;;     (flush-output)

(trace rmt:get-tests-for-run)
;; (trace rmt:get-tests-for-run)

(define (update-queue-since data run-ids last-update tsname target runname flowid flush) ;; 
  (let ((now   (current-seconds)))
;; (handle-exceptions
;; 	exn
;; 	(begin (print-call-chain) (print "Error message: " ((condition-property-accessor 'exn 'message) exn)))
      (for-each

				   (conc *toppath* "/lt/" target "/" runname "/" testname (if (equal? itempath "") "/" (conc "/" itempath "/")) logfile)
				   #f))
		     ;; (prev-tdat (hash-table-ref/default data tname #f)) 
		     (tdat      (let ((new (make-testdat)))
				  (testdat-flowid-set!     new flowid)
				  (testdat-tctname-set!    new tctname)
				  (testdat-tname-set!      new tname)
				  (testdat-state-set!      new state)
				  (testdat-status-set!     new status)
				  (testdat-comment-set!    new cmtstr)
				  (testdat-details-set!    new details)
				  (testdat-duration-set!   new duration)
				  (testdat-event-time-set! new (current-seconds))
				  (testdat-overall-set!    new newstat)
				  (hash-table-set! data tname new)
				  new)))

                     (process-queue testdats 15 #f)))
               (thread-sleep! 3)
	       (loop))
	     (begin
	       ;; (print "TCMT: pidres=" pidres " exittype=" exittype " exitstatus=" exitstatus " run-ids=" run-ids)
	       (print "TCMT: processing any tests that did not formally complete.")
	       (update-queue-since testdats run-ids 0 tsname target runname flowid #t) ;; call in flush mode
               (process-queue data 0 #t)
               (process-queue testdats 0 #t)
	       (print "TCMT: All done.")
	       ))))))
;;;;; )

;; (trace print-changes-since)

;; (if (not (eq? pidres 0))	  ;; (not exitstatus))

(cd ../..;make install) && RN=tcmt_m;megatest -remove-runs -target ubuntu/nfs/none -runname tcmt_m -testpatt %;tcmt -run -target ubuntu/nfs/none -runname tcmt_m -testpatt % -rerun-clean 2>&1 | grep teamcity