Megatest

Check-in [502458b88d]
Login
Overview
Comment:Partial fix for test path retrival in test mode
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 502458b88d603b17376f7db68093e07878489dd9
User & Date: mrwellan on 2012-01-27 20:01:06
Other Links: manifest | tags
Context
2012-01-28
22:28
final tweaks on -test-paths check-in: 5e8a00a005 user: matt tags: trunk
2012-01-27
20:01
Partial fix for test path retrival in test mode check-in: 502458b88d user: mrwellan tags: trunk
2012-01-26
23:18
Added -test-paths query for getting paths to previous tests check-in: e6213e8dbb user: matt tags: trunk
Changes

Modified db.scm from [5aeed6583f] to [22f2e6b05a].

480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
(define (db:test-set-rundir! db run-id testname item-path rundir)
  (sqlite3:execute 
   db 
   "UPDATE tests SET rundir=? WHERE run_id=? AND testname=? AND item_path=?;"
   rundir run-id testname item-path))

;; Misc. test related queries
(define (db:test-get-paths-matching db keyvallst runname keys keynames target)
  ;; (print "keyvallst: " keyvallst ", runname: " runname)
  ;; (print "keys: " keys " keynames: " keynames)
  (let ((res '())
	(itempatt (if (args:get-arg "-itempatt")(args:get-arg "-itempatt") "%"))
	(testpatt (if (args:get-arg "-testpatt")(args:get-arg "-testpatt") "%"))
	(qrystr (string-intersperse 
		 (map (lambda (key val)
			(conc "r." key " like '" val "'"))
		      keynames 







|
<
<







480
481
482
483
484
485
486
487


488
489
490
491
492
493
494
(define (db:test-set-rundir! db run-id testname item-path rundir)
  (sqlite3:execute 
   db 
   "UPDATE tests SET rundir=? WHERE run_id=? AND testname=? AND item_path=?;"
   rundir run-id testname item-path))

;; Misc. test related queries
(define (db:test-get-paths-matching db runname keynames target)


  (let ((res '())
	(itempatt (if (args:get-arg "-itempatt")(args:get-arg "-itempatt") "%"))
	(testpatt (if (args:get-arg "-testpatt")(args:get-arg "-testpatt") "%"))
	(qrystr (string-intersperse 
		 (map (lambda (key val)
			(conc "r." key " like '" val "'"))
		      keynames 

Modified megatest.scm from [19704606e8] to [d661856f2a].

391
392
393
394
395
396
397

























398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
			user))))

;;======================================================================
;; Get paths to tests
;;======================================================================
;; run all tests are are Not COMPLETED and PASS or CHECK
(if (args:get-arg "-test-paths")

























    (general-run-call 
     "-test-paths"
     "Get paths to tests"
     (lambda (db target runname keys keynames keyvallst)
       (let* ((itempatt (args:get-arg "-itempatt"))
	      (paths    (db:test-get-paths-matching db keyvallst runname keys keynames target)))
	 (for-each (lambda (path)
		     (print path))
		   paths)))))

;;======================================================================
;; Extract a spreadsheet from the runs database
;;======================================================================

(if (args:get-arg "-extract-ods")
    (general-run-call







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
|
|
|
|
|
|
|







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
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
			user))))

;;======================================================================
;; Get paths to tests
;;======================================================================
;; run all tests are are Not COMPLETED and PASS or CHECK
(if (args:get-arg "-test-paths")
    ;; if we are in a test use the MT_CMDINFO data
    (if (getenv "MT_CMDINFO")
	(let* ((startingdir (current-directory))
	       (cmdinfo   (read (open-input-string (base64:base64-decode (getenv "MT_CMDINFO")))))
	       (testpath  (assoc/default 'testpath  cmdinfo))
	       (test-name (assoc/default 'test-name cmdinfo))
	       (runscript (assoc/default 'runscript cmdinfo))
	       (db-host   (assoc/default 'db-host   cmdinfo))
	       (run-id    (assoc/default 'run-id    cmdinfo))
	       (itemdat   (assoc/default 'itemdat   cmdinfo))
	       (db        #f)
	       (state     (args:get-arg ":state"))
	       (status    (args:get-arg ":status")))
	  (change-directory testpath)
	  (if (not (setup-for-run))
	      (begin
		(debug:print 0 "Failed to setup, giving up on -test-paths, exiting")
		(exit 1)))
	  (set! db (open-db))    
	  (let* ((itempatt (args:get-arg "-itempatt"))
		 (paths    (db:test-get-paths-matching db keyvallst runname keys keynames target)))
	    (for-each (lambda (path)
			(print path))
		      paths)))
	;; else do a general-run-call
	(general-run-call 
	 "-test-paths"
	 "Get paths to tests"
	 (lambda (db target runname keys keynames keyvallst)
	   (let* ((itempatt (args:get-arg "-itempatt"))
		  (paths    (db:test-get-paths-matching db keyvallst runname keys keynames target)))
	     (for-each (lambda (path)
			 (print path))
		       paths))))))

;;======================================================================
;; Extract a spreadsheet from the runs database
;;======================================================================

(if (args:get-arg "-extract-ods")
    (general-run-call