Megatest

Check-in [fb93dbd975]
Login
Overview
Comment:Fixed -get and -set run-status. Cleaned up junk messages when precleaning
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60 | v1.6001_beta2
Files: files | file ages | folders
SHA1: fb93dbd975e9b6979fb88acfbdf026e6c39be48c
User & Date: matt on 2014-09-29 23:33:09
Other Links: branch diff | manifest | tags
Context
2014-10-02
23:36
Fixes for: rollup when RUNNING or LAUNCHED, clearing and deleting test_steps check-in: b5d1478244 user: matt tags: v1.60
2014-09-29
23:33
Fixed -get and -set run-status. Cleaned up junk messages when precleaning check-in: fb93dbd975 user: matt tags: v1.60, v1.6001_beta2
17:52
Partial addition of allowing rerun on various and sundry test states. Partial fix of -set-run-state and -get-run-state check-in: 509b6a3d9c user: mrwellan tags: v1.60
Changes

Modified db.scm from [68e1a6e4da] to [3f339edf41].

1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232





1233
1234

1235
1236
1237
1238
1239

1240
1241
1242
1243
1244
1245
1246
1221
1222
1223
1224
1225
1226
1227





1228
1229
1230
1231
1232
1233

1234
1235
1236
1237
1238

1239
1240
1241
1242
1243
1244
1245
1246







-
-
-
-
-
+
+
+
+
+

-
+




-
+







			    "locked")))) ;; semi-failsafe
    (sqlite3:execute (db:get-db dbstruct #f) "UPDATE runs SET state=? WHERE id=?;" newlockval run-id)
    ;; (db:delay-if-busy)
    (sqlite3:execute (db:get-db dbstruct #f) "INSERT INTO access_log (user,accessed,args) VALUES(?,strftime('%s','now'),?);"
		     user (conc newlockval " " run-id))
    (debug:print-info 1 "" newlockval " run number " run-id)))

(define (db:set-run-status db run-id status msg)
  ;; (db:delay-if-busy)
  (if msg
      (sqlite3:execute db "UPDATE runs SET status=?,comment=? WHERE id=?;" status msg run-id)
      (sqlite3:execute db "UPDATE runs SET status=? WHERE id=?;" status run-id)))
(define (db:set-run-status dbstruct run-id status msg)
  (let ((db (db:get-db dbstruct #f)))
    (if msg
	(sqlite3:execute db "UPDATE runs SET status=?,comment=? WHERE id=?;" status msg run-id)
	(sqlite3:execute db "UPDATE runs SET status=? WHERE id=?;" status run-id))))

(define (db:get-run-status db run-id)
(define (db:get-run-status dbstruct run-id)
  (let ((res "n/a"))
    (sqlite3:for-each-row 
     (lambda (status)
       (set! res status))
     db 
     (db:get-db dbstruct #f)
     "SELECT status FROM runs WHERE id=?;" 
     run-id)
    res))

;;======================================================================
;; K E Y S
;;======================================================================

Modified launch.scm from [d2834f7a04] to [fecb9d2b18].

722
723
724
725
726
727
728
729
730


731
732
733
734
735
736
737
722
723
724
725
726
727
728


729
730
731
732
733
734
735
736
737







-
-
+
+







    (if hosts (set! hosts (string-split hosts)))
    ;; set the megatest to be called on the remote host
    (if (not remote-megatest)(set! remote-megatest local-megatest)) ;; "megatest"))
    (set! mt-bindir-path (pathname-directory remote-megatest))
    (if launcher (set! launcher (string-split launcher)))
    ;; set up the run work area for this test
    (if (and (args:get-arg "-preclean") ;; user has requested to preclean for this run
	     (not (equal? (db:test-get-rundir testinfo) "n/a"))) ;; n/a is a placeholder and thus not a read dir
	(begin 
	     (not (member (db:test-get-rundir testinfo)(list "n/a" "/tmp/badname")))) ;; n/a is a placeholder and thus not a read dir
	(begin
	  (debug:print-info 0 "attempting to preclean directory " (db:test-get-rundir testinfo) " for test " test-name "/" item-path)
	  (runs:remove-test-directory #f testinfo #t))) ;; remove data only, do not perturb the record
    (set! diskpath (get-best-disk *configdat*))
    (if diskpath
	(let ((dat  (create-work-area run-id run-info keyvals test-id test-path diskpath test-name itemdat)))
	  (set! work-area (car dat))
	  (set! toptest-work-area (cadr dat))

Modified rmt.scm from [fbc96af109] to [c7c01a03ee].

319
320
321
322
323
324
325
326

327
328
329
330
331
332
333
319
320
321
322
323
324
325

326
327
328
329
330
331
332
333







-
+







  (rmt:send-receive 'lock/unlock-run #f (list run-id lock unlock user)))

;; set/get status
(define (rmt:get-run-status run-id)
  (rmt:send-receive 'get-run-status #f (list run-id)))

(define (rmt:set-run-status run-id run-status #!key (msg #f))
  (rmt:send-receive 'set-run-status #f (list run-id msg)))
  (rmt:send-receive 'set-run-status #f (list run-id run-status msg)))

(define (rmt:update-run-event_time run-id)
  (rmt:send-receive 'update-run-event_time #f (list run-id)))

(define (rmt:get-runs-by-patt  keys runnamepatt targpatt offset limit)
  (rmt:send-receive 'get-runs-by-patt #f (list keys runnamepatt targpatt offset limit)))

Modified runs.scm from [a346794ad0] to [080b4283f7].

1531
1532
1533
1534
1535
1536
1537
1538


1539
1540
1541
1542
1543
1544
1545
1531
1532
1533
1534
1535
1536
1537

1538
1539
1540
1541
1542
1543
1544
1545
1546







-
+
+







	(if (directory? run-dir)
	    (if (> (directory-fold (lambda (f x)(+ 1 x)) 0 run-dir) 0)
		(debug:print 0 "WARNING: refusing to remove " run-dir " as it is not empty")
		(handle-exceptions
		 exn
		 (debug:print 0 "ERROR:  Failed to remove directory " run-dir ((condition-property-accessor 'exn 'message) exn) ", attempting to continue")
		 (delete-directory run-dir)))
	    (if run-dir
	    (if (and run-dir
		     (not (member run-dir (list "n/a" "/tmp/badname"))))
		(debug:print 0 "WARNING: not removing " run-dir " as it either doesn't exist or is not a symlink")
		(debug:print 0 "NOTE: the run dir for this test is undefined. Test may have already been deleted."))
	    ))
    ;; Only delete the records *after* removing the directory. If things fail we have a record 
    (if (not remove-data-only)
	(rmt:delete-test-records (db:test-get-run_id test) (db:test-get-id test)))))

tests/installall/config/megatest.config.dat became a regular file with contents [736a5da885].

tests/installall/config/runconfigs.config.dat became a regular file with contents [3b8f260acb].