Megatest

Check-in [75c8dc4713]
Login
Overview
Comment:Competed initial implementation of testrundat
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | test-specific-db
Files: files | file ages | folders
SHA1: 75c8dc47137e160cd65155cf2f46f607d3a2efac
User & Date: matt on 2012-09-18 02:49:15
Other Links: branch diff | manifest | tags
Context
2012-09-18
17:31
Partially broken implementation of steps data move to testrundat check-in: baf93f49cf user: mrwellan tags: test-specific-db
02:49
Competed initial implementation of testrundat check-in: 75c8dc4713 user: matt tags: test-specific-db
2012-09-17
18:02
Partial implementation of testrundat check-in: a8e4d577bc user: mrwellan tags: test-specific-db
Changes

Modified db.scm from [22790e3566] to [7749e22ea8].

1138
1139
1140
1141
1142
1143
1144
1145

1146
1147
1148
1149
1150
1151
1152
1138
1139
1140
1141
1142
1143
1144

1145
1146
1147
1148
1149
1150
1151
1152







-
+







    (mutex-lock! *incoming-mutex*)
    (set! *incoming-data* (cons (vector 'step-status
					(current-seconds)
					;; FIXME - this should not update the logfile unless it is specified.
					(list test-id teststep-name state-in status-in (current-seconds) (if comment comment "") (if logfile logfile "")))
				*incoming-data*))
    (mutex-unlock! *incoming-mutex*)
    (if (not *cache-on*)(db:write-cached-data db))
    ;; (if (not *cache-on*)(db:write-cached-data db))
    #t))

;;======================================================================
;; Extract ods file from the db
;;======================================================================

;; runspatt is a comma delimited list of run patterns

Modified launch.scm from [4bec83887e] to [95108f25d5].

268
269
270
271
272
273
274
275

276
277
278
279
280
281
282
268
269
270
271
272
273
274

275
276
277
278
279
280
281
282







-
+







					    ;; (tmpfree  (get-df "/tmp")))
				     (begin
				       ;; (if (not (args:get-arg "-server"))
				       ;;	   (server:client-setup db))
				       ;; (if (not cpuload)  (begin (debug:print 0 "WARNING: CPULOAD not found.")  (set! cpuload "n/a")))
				       ;; (if (not diskfree) (begin (debug:print 0 "WARNING: DISKFREE not found.") (set! diskfree "n/a")))
				       (set! kill-job? (test-get-kill-request db run-id test-name itemdat))
				       (test-set-meta-info db tdb run-id testname itemdat minutes: minutes)
				       (test-set-meta-info db tdb run-id test-name itemdat minutes: minutes)
				       ;; (rdb:test-update-meta-info db test-id minutes cpuload diskfree tmpfree)
				       (if kill-job? 
					   (begin
					     (mutex-lock! m)
					     (let* ((pid (vector-ref exit-info 0)))
					       (if (number? pid)
						   (begin

Modified runs.scm from [25e65a825b] to [735502950d].

335
336
337
338
339
340
341


342

343
344
345
346
347
348
349
335
336
337
338
339
340
341
342
343

344
345
346
347
348
349
350
351







+
+
-
+







	      (let* ((have-resources  (runs:can-run-more-tests db test-record)) ;; look at the test jobgroup and tot jobs running
		     (prereqs-not-met (db:get-prereqs-not-met db run-id waitons item-path mode: testmode))
		     (fails           (calc-fails prereqs-not-met))
		     (non-completed   (calc-not-completed prereqs-not-met)))
		(debug:print 8 "INFO: have-resources: " have-resources " prereqs-not-met: " 
			     (string-intersperse 
			      (map (lambda (t)
				     (if (string? t)
					 (conc " WARNING: t is a string=" t )
				     (conc (db:test-get-state t)"/"(db:test-get-status t)))
					 (conc (db:test-get-state t)"/"(db:test-get-status t))))
				   prereqs-not-met) ", ") " fails: " fails)
		;; Don't know at this time if the test have been launched at some time in the past
		;; i.e. is this a re-launch?
		(cond
		 ((and have-resources
		       (or (null? prereqs-not-met)
			   (and (eq? testmode 'toplevel)

Modified tests.scm from [4b23cdd7f6] to [e990011da7].

408
409
410
411
412
413
414
415

416
417
418
419
420
421
422
423
424
425
426
427
428
429

430
431





432
433
434
435
436
437
438
408
409
410
411
412
413
414

415
416
417
418

419
420
421
422
423
424
425
426
427
428
429


430
431
432
433
434
435
436
437
438
439
440
441







-
+



-










+
-
-
+
+
+
+
+







    (sqlite3:for-each-row
     (lambda (count)
       (set! res count))
     tdb
     "SELECT count(id) FROM test_rundat;")
    res))

(define (test-set-meta-info db tdb run-id testname itemdat)
(define (test-set-meta-info db tdb run-id testname itemdat #!key (minutes #f))
  (let* ((num-records (test:tdb-get-rundat-count tdb))
	 (item-path   (item-list->path itemdat))
	 (cpuload  (get-cpu-load))
	 ;; (hostname (get-host-name))
	 (diskfree (get-df (current-directory))))
    (if (eq? (modulo num-records 10) 0) ;; every ten records update central
	(begin
	  (sqlite3:execute db "UPDATE tests SET cpuload=?,diskfree=? WHERE run_id=? AND testname=? AND item_path=?;"
			   cpuload
			   diskfree
			   run-id
			   testname
			   item-path)
	  (if (eq? num-records 0)
	      (begin
	      (sqlite3:execute db "UPDATE tests SET uname=?,hostname=? WHERE run_id=? AND testname=? AND item_path=?;"
			       (get-uname "-srvpio") (get-host-name) run-id testname item-path))))
		(sqlite3:execute db "UPDATE tests SET uname=?,host=? WHERE run_id=? AND testname=? AND item_path=?;"
		  	             (get-uname "-srvpio") (get-host-name) run-id testname item-path)
                (if minutes 
                    (sqlite3:execute db "UPDATE tests SET minutes=? WHERE run_id=? AND testname=? AND item_path=?;"
                                        minutes run-id testname item-path))))))
    (sqlite3:execute tdb "INSERT INTO test_rundat (cpuload,diskfree) VALUES (?,?);"
		     cpuload diskfree)))
	  

;;======================================================================
;; A R C H I V I N G
;;======================================================================