Megatest

Changes On Branch a5e90cd11826ca72
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Hide Diff Patch Side-by-Side Diff

Changes In Branch v1.64-tcintegration Through [a5e90cd118] Excluding Merge-Ins

This is equivalent to a diff from 3a8e2b2276 to a5e90cd118

2017-08-06
23:57
Refactoring for delayed output mostly done. Bugs remain. check-in: 790604d640 user: matt tags: v1.64-tcintegration
2017-08-04
18:15
Refactored and ready for new mechanism check-in: a5e90cd118 user: mrwellan tags: v1.64-tcintegration
00:05
Fixed possible memory growth problem where used dbstructs were not being pushed back on the stack check-in: 6cd5eb771a user: matt tags: v1.64
2017-08-03
23:02
Enforced full sync every hour check-in: 3dffe8fa8a user: matt tags: v1.64-bad-full-sync-fix
22:26
Updated with latest changes from v1.64 check-in: 5a8ae7b6c4 user: matt tags: v1.64-areas-dashboard
17:51
Partially implemented teamcity support changes as requested. WIP. check-in: 264909ff3b user: mrwellan tags: v1.64-tcintegration
16:15
Remove the added-on local access support in dashboard, rely instead on rmt built-in support. Improved the refresh button behavior. Added DEAD to statuses to clear in -rerun-clean. check-in: 3a8e2b2276 user: mrwellan tags: v1.64
2017-07-31
14:23
Bump version to v1.6428 check-in: 7cdeaee37d user: mrwellan tags: v1.64

Modified tcmt.scm from [3e1895cf52] to [e3a7746dd2].

︙
11
12
13
14
15
16
17
18

19
20
21
22
23
24
25

11
12
13
14
15
16
17

18
19
20
21
22
23
24
25








-
+








;;
;; Wrapper to enable running Megatest flows under teamcity
;;
;;  1. Run the megatest process and pass it all the needed parameters
;;  2. Every five seconds check for state/status changes and print the info
;;

(use srfi-1 posix srfi-69 srfi-18 regex)
(use srfi-1 posix srfi-69 srfi-18 regex defstruct)

(declare (uses margs))
(declare (uses rmt))
(declare (uses common))
(declare (uses megatest-version))

(include "megatest-fossil-hash.scm")
︙
33
34
35
36
37
38
39



























40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61




62
63
64
65
66
67





68
69
70
71
72
73
74
75

76
77
78
79
80




81
82
83
84









85




86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103


104
105
106
107
108
109
110

33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84




85
86
87
88
89





90
91
92
93
94

95
96
97
98
99
100

101
102




103
104
105
106
107



108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137


138
139
140
141
142
143
144
145
146








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


















-
-
-
-
+
+
+
+

-
-
-
-
-
+
+
+
+
+
-






-
+

-
-
-
-
+
+
+
+

-
-
-
+
+
+
+
+
+
+
+
+

+
+
+
+
















-
-
+
+








		    "-runname"
		    )
		 `("-tc-repl"
		   )
		 args:arg-hash
		 0))

(defstruct testdat
  (tc-type #f)
  (state   #f)
  (status  #f)
  (overall #f)
  flowid
  tctname
  event_time
  details
  comment
  duration)

(define (tcmt:print tdat)
  (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 (testdat-tc-type tdat)
      ((test-start)    (print "##teamcity[testStarted "  tctname flowid "]"))
      ((test-end)      (print "##teamcity[testFinished " tctname flowid comment details duration "]"))
      ((test-failed)   (print "##teamcity[testFailed "   tctname flowid comment details "]")))))

;; ##teamcity[testStarted name='suite.testName']
;; ##teamcity[testStdOut name='suite.testName' out='text']
;; ##teamcity[testStdErr name='suite.testName' out='error text']
;; ##teamcity[testFailed name='suite.testName' message='failure message' details='message and stack trace']
;; ##teamcity[testFinished name='suite.testName' duration='50']
;; 
;; flush; #f, normal call. #t, last call, print out something for NOT_STARTED, etc.
;;
(define (print-changes-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
      (lambda (run-id)
	(let* ((tests (rmt:get-tests-for-run run-id "%" '() '() #f #f #f #f #f #f last-update #f)))
	  ;; (print "DEBUG: got tests=" tests)
	  (for-each
	   (lambda (testdat)
	     (let* ((testn    (db:test-get-fullname     testdat))
		    (testname (db:test-get-testname     testdat))
		    (itempath (db:test-get-item-path    testdat))
	   (lambda (test-rec)
	     (let* ((testn    (db:test-get-fullname     test-rec))
		    (testname (db:test-get-testname     test-rec))
		    (itempath (db:test-get-item-path    test-rec))
		    (tctname  (if (string=? itempath "") testname (conc testname "." (string-translate itempath "/" "."))))
		    (state    (db:test-get-state        testdat))
		    (status   (db:test-get-status       testdat))
		    (duration (or (any->number (db:test-get-run_duration testdat)) 0))
		    (comment  (db:test-get-comment      testdat))
		    (logfile  (db:test-get-final_logf   testdat))
		    (state    (db:test-get-state        test-rec))
		    (status   (db:test-get-status       test-rec))
		    (duration (or (any->number (db:test-get-run_duration test-rec)) 0))
		    (comment  (db:test-get-comment      test-rec))
		    (logfile  (db:test-get-final_logf   test-rec))
		    (prevstat (hash-table-ref/default data testn #f))
		    (newstat  (cond
			       ((equal? state "RUNNING")   "RUNNING")
			       ((equal? state "COMPLETED") status)
			       (flush   (conc state "/" status))
			       (else "UNK")))
		    (cmtstr   (if (and (not flush) comment)
				  (conc " message='" comment "' ")
				  comment
				  (if flush
				      (conc "message='Test ended in state/status=" state "/" status  (if  (string-match "^\\s*$" comment)
													  ", no Megatest comment found.' "
													  (conc ", Megatest comment='" comment "' "))) ;; special case, we are handling stragglers
				      " ")))
				      (conc "Test ended in state/status=" state "/" status  (if  (string-match "^\\s*$" comment)
                                                                                                 ", no Megatest comment found."
                                                                                                 (conc ", Megatest comment=\"" comment "\""))) ;; special case, we are handling stragglers
				      #f)))
		    (details  (if (string-match ".*html$" logfile)
				  (conc " details='" *toppath* "/lt/" target "/" runname "/" testname (if (equal? itempath "") "/" (conc "/" itempath "/")) logfile "' ")
				  "")))
		    
				  (conc *toppath* "/lt/" target "/" runname "/" testname (if (equal? itempath "") "/" (conc "/" itempath "/")) logfile)
				  #f))
                    (tdat     (hash-table-ref/default data testn
                                                      (let ((new (make-testdat)))
                                                        (testdat-flowid-set!   new flowid)
                                                        (testdat-tctname-set!  new tctname)
                                                        (testdat-event_time-set! new (current-seconds))
                                                        (hash-table-set! data testn new))))
                    (prevstat (testdat-overall tdat)))
	       ;; (print "DEBUG: testn=" testn " state=" state " status=" status " prevstat=" prevstat " newstat=" newstat)
               (cond
                ((and (not (testdat-state tdat))  ;; first time through
                      (equal? state "COMPLETED")) ;; 

	       (if (or (not prevstat)
		       (not (equal? prevstat newstat)))
		   (begin
		     (case (string->symbol newstat)
		       ((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)
		     (hash-table-set! data testn newstat)))))
	   tests)))
      run-ids))
    now))

(define (monitor pid)
  (let* ((run-ids #f)
	 (testdat (make-hash-table))
  (let* ((run-ids '())
	 (testdats (make-hash-table))  ;; each entry is a list of testdat structs
	 (keys    #f)
	 (last-update 0)
	 (target  (or (args:get-arg "-target")
		      (args:get-arg "-reqtarg")))
	 (runname (args:get-arg "-runname"))
	 (tsname  #f)
	 (flowid  (conc target "/" runname)))
︙
138
139
140
141
142
143
144
145

146
147
148
149
150
151

152
153
154
155
156
157
158

174
175
176
177
178
179
180

181
182
183
184
185
186

187
188
189
190
191
192
193
194








-
+





-
+








				       (db:get-value-by-header row header "id"))
				     rows)))
	       (set! run-ids run-ids-in)))
	 ;; (print "TCMT: pidres=" pidres " exittype=" exittype " exitstatus=" exitstatus " run-ids=" run-ids)
	 (if (eq? pidres 0)
	     (begin
	       (if keys
		   (set! last-update (print-changes-since testdat run-ids last-update tsname target runname flowid #f)))
		   (set! last-update (print-changes-since testdats run-ids last-update tsname target runname flowid #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.")
	       (print-changes-since testdat run-ids 0 tsname target runname flowid #t) ;; call in flush mode
	       (print-changes-since testdats run-ids 0 tsname target runname flowid #t) ;; call in flush mode
	       (print "TCMT: All done.")
	       )))))))

;; (if (not (eq? pidres 0))	  ;; (not exitstatus))
;; 	  (begin
;; 	    (thread-sleep! 3)
;; 	    (loop))
︙

This page was generated in about 0.136s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00