Megatest

Check-in [79c34d7700]
Login
Overview
Comment:Added proper cleanup after removing a run. test dirs and run dir are removed if empty
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 79c34d7700c73fd5b306a337e1bfb44303678d9c
User & Date: matt on 2011-05-11 07:59:20
Other Links: manifest | tags
Context
2011-05-11
13:32
Added blanking out the comment on reseting a test check-in: 5411a1be29 user: mrwellan tags: trunk
07:59
Added proper cleanup after removing a run. test dirs and run dir are removed if empty check-in: 79c34d7700 user: matt tags: trunk
01:24
Bumped version to 1.04 check-in: 28b7497853 user: matt tags: trunk
Changes

Modified runs.scm from [40e5373888] to [32dfecc25c].

355
356
357
358
359
360
361
362




363
364
365
366
367
368
369
370
371
372
373
374
375
376

377
378
379
380
381
382
383
384
385

386
387




388
389
390
391




392
393





394

395

			    (hash-table-delete! *waiting-queue* testname)))
		      (if (not db)
			  (sqlite3:finalize! ldb))))
		  waiting-test-names)
	(sleep 10) ;; no point in rushing things at this stage?
	(loop (hash-table-keys *waiting-queue*)))))))

  




;; Remove runs
;; fields are passing in through 
(define (runs:remove-runs db runnamepatt testpatt itempatt)
  (let* ((keys        (db-get-keys db))
	 (rundat      (runs:get-runs-by-patt db keys runnamepatt))
	 (header      (vector-ref rundat 0))
	 (runs        (vector-ref rundat 1)))
    (print "Header: " header)
    (for-each
     (lambda (run)
       (let ((runkey (string-intersperse (map (lambda (k)
						(db-get-value-by-header run header (vector-ref k 0))) keys) "/")))
	 (let* ((run-id (db-get-value-by-header run header "id") )
		(tests  (db-get-tests-for-run db (db-get-value-by-header run header "id") testpatt itempatt)))

	   (if (not (null? tests))
	       (begin
		 (print "Removing tests for run: " runkey " " (db-get-value-by-header run header "runname"))
		 (for-each
		  (lambda (test)
		    (print "  " (db:test-get-testname test) " id: " (db:test-get-id test) " " (db:test-get-item-path test))
		    (db:delete-test-records db (db:test-get-id test))
		    (if (> (string-length (db:test-get-rundir test)) 5) ;; bad heuristic but should prevent /tmp /home etc.
			(let ((fullpath (db:test-get-rundir test))) ;; "/" (db:test-get-item-path test))))

			  (print "rm -rf " fullpath)
			  (system (conc "rm -rf " fullpath)))))




		  tests)
		 (let ((remtests (db-get-tests-for-run db (db-get-value-by-header run header "id"))))
		   (if (null? remtests) ;; no more tests remaining
		       (begin




			 (print "Removing run: " runkey " " (db-get-value-by-header run header "runname"))
			 (db:delete-run db run-id))))





		 )))))

     runs)))








|
>
>
>
>













|
>









>

|
>
>
>
>
|
|
|
<
>
>
>
>
|
|
>
>
>
>
>
|
>

>
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400

401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
			    (hash-table-delete! *waiting-queue* testname)))
		      (if (not db)
			  (sqlite3:finalize! ldb))))
		  waiting-test-names)
	(sleep 10) ;; no point in rushing things at this stage?
	(loop (hash-table-keys *waiting-queue*)))))))

(define (get-dir-up-one dir) 
  (let ((dparts  (string-split dir "/")))
    (conc "/" (string-intersperse 
	       (take dparts (- (length dparts) 1))
	       "/"))))
;; Remove runs
;; fields are passing in through 
(define (runs:remove-runs db runnamepatt testpatt itempatt)
  (let* ((keys        (db-get-keys db))
	 (rundat      (runs:get-runs-by-patt db keys runnamepatt))
	 (header      (vector-ref rundat 0))
	 (runs        (vector-ref rundat 1)))
    (print "Header: " header)
    (for-each
     (lambda (run)
       (let ((runkey (string-intersperse (map (lambda (k)
						(db-get-value-by-header run header (vector-ref k 0))) keys) "/")))
	 (let* ((run-id (db-get-value-by-header run header "id") )
		(tests  (db-get-tests-for-run db (db-get-value-by-header run header "id") testpatt itempatt))
		(lasttpath #f))
	   (if (not (null? tests))
	       (begin
		 (print "Removing tests for run: " runkey " " (db-get-value-by-header run header "runname"))
		 (for-each
		  (lambda (test)
		    (print "  " (db:test-get-testname test) " id: " (db:test-get-id test) " " (db:test-get-item-path test))
		    (db:delete-test-records db (db:test-get-id test))
		    (if (> (string-length (db:test-get-rundir test)) 5) ;; bad heuristic but should prevent /tmp /home etc.
			(let ((fullpath (db:test-get-rundir test))) ;; "/" (db:test-get-item-path test))))
			  (set! lasttpath fullpath)
			  (print "rm -rf " fullpath)
			  (system (conc "rm -rf " fullpath))
			  (let ((cmd (conc "rmdir -p " (get-dir-up-one fullpath))))
			    (print cmd)
			    (system cmd))
			  )))
		  tests)))
	   (let ((remtests (db-get-tests-for-run db (db-get-value-by-header run header "id"))))
	     (if (null? remtests) ;; no more tests remaining

		 (let* ((dparts  (string-split lasttpath "/"))
			(runpath (conc "/" (string-intersperse 
					    (take dparts (- (length dparts) 1))
					    "/"))))
		   (print "Removing run: " runkey " " (db-get-value-by-header run header "runname"))
		   (db:delete-run db run-id)
		   ;; need to figure out the path to the run dir and remove it if empty
		;;    (if (null? (glob (conc runpath "/*")))
		;;        (begin
		;; 	 (print "Removing run dir " runpath)
		;; 	 (system (conc "rmdir -p " runpath))))
		   )))
		 )))
     runs)))

Modified tests/Makefile from [fa62ae4881] to [4c07feade7].

9
10
11
12
13
14
15






test :
	cd ../;make test
	make runall

dashboard :
	cd ../;make dashboard
	../dashboard &













>
>
>
>
>
>
9
10
11
12
13
14
15
16
17
18
19
20
21
test :
	cd ../;make test
	make runall

dashboard :
	cd ../;make dashboard
	../dashboard &

remove :
	(cd ../;make);../megatest -remove-runs :runname %3  -testpatt % -itempatt % :sysname % :fsname % :datapath %

runforever :
	while(ls); do runname=`date +%F-%R:%S`;/home/matt/data/megatest/megatest -runall :sysname ubuntu :fsname nfs :datapath none :runname $$runname;/home/matt/data/megatest/megatest -runall :sysname ubuntu :fsname nfs :datapath none :runname $$runname;/home/matt/data/megatest/megatest -runall :sysname ubuntu :fsname nfs :datapath none :runname $$runname;done