Megatest

Check-in [a692915fb3]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:More complete handling of Megatest states and statuses for teamcity. Moved emergency patches to sub directory. Fixed issue in Makefile that prevented tcmt from being built.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.64
Files: files | file ages | folders
SHA1: a692915fb36b1f34dabf71452af63e04c91be209
User & Date: matt on 2017-07-31 00:17:34
Other Links: branch diff | manifest | tags
Context
2017-07-31
14:23
Bump version to v1.6428 check-in: 7cdeaee37d user: mrwellan tags: v1.64
08:19
Merged v1.64 into v1.65 check-in: 69ed787cf9 user: matt tags: v1.65
00:17
More complete handling of Megatest states and statuses for teamcity. Moved emergency patches to sub directory. Fixed issue in Makefile that prevented tcmt from being built. check-in: a692915fb3 user: matt tags: v1.64
2017-07-27
19:40
added protection against stuck in launched issue in ticket 220546342 check-in: 9fb029e72c user: bjbarcla tags: v1.64
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified Makefile from [b8928ba93e] to [01ab7d1240].

︙
232
233
234
235
236
237
238
239
240



241
242
243
244
245
246
247

232
233
234
235
236
237
238


239
240
241
242
243
244
245
246
247
248








-
-
+
+
+








	utils/mk_wrapper $(PREFIX) dboard $(PREFIX)/bin/dashboard
	chmod a+x $(PREFIX)/bin/dashboard
	$(INSTALL) dboard $(PREFIX)/bin/.$(ARCHSTR)/dboard

install : $(PREFIX)/bin/.$(ARCHSTR) $(PREFIX)/bin/.$(ARCHSTR)/mtest $(PREFIX)/bin/megatest \
          $(PREFIX)/bin/.$(ARCHSTR)/dboard $(PREFIX)/bin/dashboard $(HELPERS) $(PREFIX)/bin/nbfake \
	  $(PREFIX)/bin/nbfind $(PREFIX)/bin/loadrunner $(PREFIX)/bin/viewscreen $(PREFIX)/bin/mt_xterm \
	  $(PREFIX)/share/docs/megatest_manual.html $(PREFIX)/bin/remrun $(PREFIX)/bin/mtutil
#          $(PREFIX)/share/db/mt-pg.sql $(PREFIX)/bin/.$(ARCHSTR)/ndboard  $(PREFIX)/bin/tcmt
	  $(PREFIX)/share/docs/megatest_manual.html $(PREFIX)/bin/remrun $(PREFIX)/bin/mtutil \
	  $(PREFIX)/bin/tcmt $(PREFIX)/share/db/mt-pg.sql
#         $(PREFIX)/bin/.$(ARCHSTR)/ndboard

# $(PREFIX)/bin/newdashboard

$(PREFIX)/bin/.$(ARCHSTR) : 
	mkdir -p $(PREFIX)/bin/.$(ARCHSTR)
	mkdir -p $(PREFIX)/bin/.$(ARCHSTR)/lib
︙

cgisetup/cgi-bin/models became a symlink with target [39c07627cc].

cgisetup/cgi-bin/pages became a symlink with target [e2b5ed002d].

Name change from emergency-patch-1.scm to emergency-patches/emergency-patch-1.scm.

︙

Name change from emergency-patch-2.scm to emergency-patches/emergency-patch-2.scm.

︙

Name change from emergency-patch-3.scm to emergency-patches/emergency-patch-3.scm.

︙

Modified server.scm from [0b4350005b] to [cebb70c145].

︙
243
244
245
246
247
248
249
250

251
252
253
254
255
256
257

243
244
245
246
247
248
249

250
251
252
253
254
255
256
257








-
+








				   (> (length rec) 2))
			      (let ((start-time (list-ref rec 3))
				    (mod-time   (list-ref rec 0)))
				;; (print "start-time: " start-time " mod-time: " mod-time)
				(and start-time mod-time
				     (> (- now start-time) 0)    ;; been running at least 0 seconds
				     (< (- now mod-time)   16)   ;; still alive - file touched in last 16 seconds
				     (< (- now start-time) 
				     (< (- now start-time)       
					(+ (- (string->number (or (configf:lookup *configdat* "server" "runtime") "3600"))
					      180)
					   (random 360))) ;; under one hour running time +/- 180
				     ))
			      #f))
			srvlst)
		(lambda (a b)
︙
442
443
444
445
446
447
448
449

450
451
452
453
454
455
456

442
443
444
445
446
447
448

449
450
451
452
453
454
455
456








-
+








	#f)))

;; timeout is hms string: 1h 5m 3s, default is 1 minute
;;
(define (server:expiration-timeout)
  (let ((tmo (configf:lookup *configdat* "server" "timeout")))
    (if (and (string? tmo)
	     (common:hms-string->seconds tmo))
	     (common:hms-string->seconds tmo)) ;; BUG: hms-string->seconds is broken, if given "10" returns 0. Also, it doesn't belong in this logic unless the string->number is changed below
        (* 3600 (string->number tmo))
	60)))

;; moving this here as it needs access to db and cannot be in common.
;;
(define (server:writable-watchdog dbstruct)
  (thread-sleep! 0.05) ;; delay for startup
︙

Modified tcmt.scm from [06a53b1301] to [3e1895cf52].

︙
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

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








-
-
+
+
+




















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

+
+
+
+
-
+










-
-
+
+

-
+







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





-
+









;; ##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']
;; 

(define (print-changes-since data run-ids last-update tsname target runname)
;; 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))
		    (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))
		    (prevstat (hash-table-ref/default data testn #f))
		    (newstat  (if (equal? state "RUNNING")
				  "RUNNING"
				  (if (equal? state "COMPLETED")
				      status
				      "UNK")))
		    (cmtstr   (if comment
		    (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 "' ")
				  (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
				  " "))
				      " ")))
		    (details  (if (string-match ".*html$" logfile)
				  (conc " details='" *toppath* "/lt/" target "/" runname "/" testname (if (equal? itempath "") "/" (conc "/" itempath "/")) logfile "' ")
				  "")))
		    
	       ;; (print "DEBUG: testn=" testn " state=" state " status=" status " prevstat=" prevstat " newstat=" newstat)
	       (if (or (not prevstat)
		       (not (equal? prevstat newstat)))
		   (begin
		     (case (string->symbol newstat)
		       ((UNK)       ) ;; do nothing
		       ((RUNNING)   (print "##teamcity[testStarted name='" tctname "']"))
		       ((PASS SKIP WARN WAIVED) (print "##teamcity[testFinished name='" tctname "' duration='" (* 1e3 duration) "'" cmtstr details " ]"))
		       ((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 " ]")))
			(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))
	(keys    #f)
	(last-update 0)
	(target  (or (args:get-arg "-target")
		     (args:get-arg "-reqtarg")))
	(runname (args:get-arg "-runname"))
	(tsname  #f))
  (let* ((run-ids #f)
	 (testdat (make-hash-table))
	 (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)))
    (if (and target runname)
	(begin
	  (launch:setup)
	  (set! keys (rmt:get-keys))))
    (set! tsname  (common:get-testsuite-name))
    (print "TCMT: for testsuite=" tsname " found runname=" runname ", target=" target ", keys=" keys " and successfully ran launch:setup.")
    (print "TCMT: for testsuite=" tsname " found runname=" runname ", target=" target ", keys=" keys " and successfully ran launch:setup. Using " flowid " as the flowId.")
    (let loop ()
      (handle-exceptions
       exn
       ;; (print "Process done.")
       (begin (print-call-chain) (print "Error message: " ((condition-property-accessor 'exn 'message) exn)))
       (let-values (((pidres exittype exitstatus)
		     (process-wait pid #t)))
︙
129
130
131
132
133
134
135
136
137
138
139


140
141
142
143


144
145
146
147
148
149
150

135
136
137
138
139
140
141


142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158








-
-


+
+




+
+








		    (header (db:get-header runs))
		    (rows   (db:get-rows   runs))
		    (run-ids-in (map (lambda (row)
				       (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 keys
	     (set! last-update (print-changes-since testdat run-ids last-update tsname target runname)))
	 (if (eq? pidres 0)
	     (begin
	       (if keys
		   (set! last-update (print-changes-since testdat 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 "TCMT: All done.")
	       )))))))

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

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