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
			    "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:get-run-status db run-id)
  (let ((res "n/a"))
    (sqlite3:for-each-row 
     (lambda (status)
       (set! res status))
     db 
     "SELECT status FROM runs WHERE id=?;" 
     run-id)
    res))

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







|
|
|
|
|

|




|







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 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 dbstruct run-id)
  (let ((res "n/a"))
    (sqlite3:for-each-row 
     (lambda (status)
       (set! res status))
     (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
    (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 
	  (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))







|
|







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

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








|







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

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








|
>







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 (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].