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
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 keyvallst runname keys keynames target)
(define (db:test-get-paths-matching db runname 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 

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