Megatest

Check-in [c13726326c]
Login
Overview
Comment:Cherrypicked 5ea7
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65-junit-xml
Files: files | file ages | folders
SHA1: c13726326ce034fbedb36a634179fc1f685ef076
User & Date: pjhatwal on 2020-05-27 14:13:34
Other Links: branch diff | manifest | tags
Context
2020-05-27
14:22
Cherrypicked 451c check-in: 1b0d4f257e user: pjhatwal tags: v1.65-junit-xml
14:13
Cherrypicked 5ea7 check-in: c13726326c user: pjhatwal tags: v1.65-junit-xml
13:11
Cherrypicked 76d6 check-in: ad2000389b user: pjhatwal tags: v1.65-junit-xml
Changes

Modified runs.scm from [d2d22e6ef3] to [f120939904].

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

(define doc 
  '(*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"))

		(xml-dir		(if (and junit-test-reporter (equal? junit-test-reporter "yes" ))


						(conc (getenv "MT_LINKTREE") "/" (getenv "MT_TARGET") "/" (getenv "MT_RUNNAME"))
						#f))
		(xml-path		(if xml-dir
						(conc xml-dir "/junit-test-reporter.xml")

						#f))

		(xml-ts-name		(if xml-dir
						(conc (string-translate (getenv "MT_TARGET") "/" ".") "." (getenv "MT_RUNNAME"))
						#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
                      (debug:print 0 *default-log-port* (conc "*********************************************\n Running junit-test-reporter at " xml-path"\n *****************************************"))
				((sxml-modify!  `("testsuite" insert-into (@ (name ,xml-ts-name) (tests ,tests-count)))) doc)
				(map (lambda (test)





					(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))

						(test-status	(vector-ref test 4)))
                                       ;(print test)

                                      (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 "what to use?") (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 "what to use?") (type "error")))))) doc))

					((member test-state (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))))))
			test-data)






			(with-output-to-file xml-path      (lambda ()

				(print (sxml-serializer#serialize-sxml doc  ns-prefixes: (list (cons 'gnm "http://foo"))))))))))



	 
     
;; 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")))







>
|
>
|
>
>
|
|
|
<
>
|
>
|
|
|
>
|
|
|
|
|
|
|
|
|
|
|
|
|
<
|
|
>
>
>
>
>
|
|
|
|
>
|
<
>
|
|
|
|
|
|
>
>
>
>
>
>
>
|
|
|
>
|
>
>
>
|
>
>
|
>
|
|
>
>
>
>
>
>
|
>
|
|
>
>







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

(define doc 
  '(*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
      (if runname
	  (let* ((linktree (common:get-linktree)) ;; (if toppath (configf:lookup *configdat* "setup" "linktree")))