Megatest

Changes On Branch 451c9aa4ba3bc606
Login

Changes In Branch v1.64-newview-junit-xml-reporter Through [451c9aa4ba] Excluding Merge-Ins

This is equivalent to a diff from eeb358089d to 451c9aa4ba

2020-05-26
19:19
added mechanisum to avoid two test trying to genrate xml file at same time check-in: e1a379fb2d user: pjhatwal tags: v1.64-newview-junit-xml-reporter
2020-05-22
18:14
updates to add comments in xml check-in: 451c9aa4ba user: pjhatwal tags: v1.64-newview-junit-xml-reporter
2020-05-21
14:10
added intial functionality for junit xml genration check-in: 76d6afd28a user: pjhatwal tags: v1.64-newview-junit-xml-reporter
2020-05-20
17:33
Create new branch named "v1.64-newview-junit-xml-reporter" check-in: 455693626c user: pjhatwal tags: v1.64-newview-junit-xml-reporter
2020-04-13
06:05
Added more needed functions to commonmod in prep for multi-area support in newview check-in: ccab6e04af user: matt tags: v1.65-newview
2020-04-12
23:51
Added auto gen area name check-in: eeb358089d user: matt tags: v1.65-newview
23:10
Moved some functions into commonmod check-in: e9a528680b user: matt tags: v1.65-newview

Modified launch.scm from [6b5c8d69de] to [10187a3242].

901
902
903
904
905
906
907

908
909
910
911
912
913
914
           (running-cnt (rmt:get-count-tests-running-for-run-id run-id))
           (all-test-launched (rmt:get-var (conc "lunch-complete-" run-id)))
           (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)

 
     (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) 
        	  (debug:print 0 *default-log-port* "There are " running-cnt " tests running." ))







>







901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
           (running-cnt (rmt:get-count-tests-running-for-run-id run-id))
           (all-test-launched (rmt:get-var (conc "lunch-complete-" run-id)))
           (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) 
        	  (debug:print 0 *default-log-port* "There are " running-cnt " tests running." ))

Modified runs.scm from [e3f5a06ce2] to [954456c4c1].

14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
;; 
;;     You should have received a copy of the GNU General Public License
;;     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)

(declare (unit runs))
(declare (uses db))
(declare (uses common))
(declare (uses items))
(declare (uses runconfig))
(declare (uses tests))







|







14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
;; 
;;     You should have received a copy of the GNU General Public License
;;     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 sxml-serializer sxml-modifications)

(declare (unit runs))
(declare (uses db))
(declare (uses common))
(declare (uses items))
(declare (uses runconfig))
(declare (uses tests))
2675
2676
2677
2678
2679
2680
2681
2682


























































































2683
2684
2685
2686
2687
2688
2689
	    (sqlite3:execute 
	     db 
	     (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)))
	 


























































































     
;; clean cache files
(define (runs:clean-cache target runname toppath)
  (if target
      (if runname
	  (let* ((linktree (common:get-linktree)) ;; (if toppath (configf:lookup *configdat* "setup" "linktree")))
		 (runtop   (conc linktree "/" target "/" runname))







|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
	    (sqlite3:execute 
	     db 
	     (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*	((doc			doc-template)
	 (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))
	 (xml-path		(if xml-dir
				    (conc xml-dir "/" (common:get-signature xml-ts-name) ".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))
			 (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))
			 ;; (debug:print 0 *default-log-port* "tail:" (length tail))
			 (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)
			    (if (null? tail)
				(set! fail-cnt (+ fail-cnt 1))
				(loop (car tail) (cdr tail) (+ fail-cnt 1) error-cnt))) 
			   ((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)
			    (if (null? tail)
				(set! error-cnt (+ error-cnt 1))
				(loop (car tail) (cdr tail)  fail-cnt (+ error-cnt 1))))
			   ((member test-status (list "SKIP"))
			    ((sxml-modify! `("testsuite" insert-into (testcase (@ (name ,tc-name)) (skipped (@ (type "skipped")))))) doc))
			   (else 
			    ((sxml-modify! `("testsuite" insert-into (testcase (@ (name ,tc-name)) (failure (@ (message ,exc-msg) (type "error")))))) doc)
			    (debug:print 0 *default-log-port* (conc "What do I do with State " test-state " Status " test-status))
			    (if (null? tail)
				(set! error-cnt (+ error-cnt 1)))
		    (loop (car tail) (cdr tail)  fail-cnt (+ error-cnt 1)))))
	      (if (null? tail)
		  (begin
		    (debug:print 0 *default-log-port* "modify attrib error=" error-cnt " fail= " fail-cnt) 
		    ((sxml-modify! `("testsuite" insert-into (@ (name ,xml-ts-name) (tests ,tests-count) (errors ,error-cnt) (failures ,fail-cnt)))) doc)

		    (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)))
		     (debug:print 0 *default-log-port* "creating xml at " xml-path)
		     (debug:print 0 *default-log-port* (length tail))
		     (if (not (file-exists? xml-dir)) 
			 (create-directory xml-dir #t))
		     (with-output-to-file xml-path
		       (lambda ()
			 (print (sxml-serializer#serialize-sxml doc  ns-prefixes: (list (cons 'gnm "http://foo"))))))))
		  (loop (car tail) (cdr tail)  fail-cnt error-cnt)))))
	)))
     
;; clean cache files
(define (runs:clean-cache target runname toppath)
  (if target
      (if runname
	  (let* ((linktree (common:get-linktree)) ;; (if toppath (configf:lookup *configdat* "setup" "linktree")))
		 (runtop   (conc linktree "/" target "/" runname))