Megatest

Check-in [8995de4ee1]
Login
Overview
Comment:Added fname to calls for get test path
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 8995de4ee199ac88a13673d2592f9bb10252b95c
User & Date: mrwellan on 2012-04-23 15:19:37
Other Links: manifest | tags
Context
2012-04-24
21:59
Added another raw test to to simpletest check-in: a7ab704e37 user: matt tags: trunk, patch-point
2012-04-23
15:19
Added fname to calls for get test path check-in: 8995de4ee1 user: mrwellan tags: trunk
11:07
Merged extend-test-get-path into trunk check-in: 8b3179d059 user: mrwellan tags: trunk
Changes

Modified db.scm from [92d14b406b] to [685f5a2010].

1382
1383
1384
1385
1386
1387
1388
1389

1390
1391
1392
1393
1394


1395
1396
1382
1383
1384
1385
1386
1387
1388

1389
1390
1391
1392


1393
1394
1395
1396







-
+



-
-
+
+


(define (rdb:test-data-rollup db test-id status)
    (if *runremote*
      (let ((host (vector-ref *runremote* 0))
	    (port (vector-ref *runremote* 1)))
	((rpc:procedure 'rdb:test-data-rollup host port) test-id status))
      (db:test-data-rollup db test-id status)))

(define (rdb:test-get-paths-matching db keynames target)
(define (rdb:test-get-paths-matching db keynames target fname)
   (if *runremote*
       (let ((host (vector-ref *runremote* 0))
	     (port (vector-ref *runremote* 1)))
	 ((rpc:procedure 'rdb:test-get-paths-matching host port) keynames target))
       (db:test-get-paths-matching db keynames target)))
	 ((rpc:procedure 'rdb:test-get-paths-matching host port) keynames target fname))
       (db:test-get-paths-matching db keynames target fname)))

 

Modified megatest.scm from [4e1718db76] to [232eaca49e].

479
480
481
482
483
484
485
486

487
488
489
490
491
492
493
494
495
496
497

498
499
500
501
502
503
504
479
480
481
482
483
484
485

486
487
488
489
490
491
492
493
494
495
496

497
498
499
500
501
502
503
504







-
+










-
+







		(exit 1)))
	  (set! db (open-db))    
	  (if (not (args:get-arg "-server"))
	      (server:client-setup db))
	  (let* ((itempatt (args:get-arg "-itempatt"))
		 (keys     (rdb:get-keys db))
		 (keynames (map key:get-fieldname keys))
		 (paths    (rdb:test-get-paths-matching db keynames target)))
		 (paths    (rdb:test-get-paths-matching db keynames target (args:get-arg "-test-path"))))
	    (set! *didsomething* #t)
	    (for-each (lambda (path)
			(print path))
		      paths)))
	;; else do a general-run-call
	(general-run-call 
	 "-test-path"
	 "Get paths to test"
	 (lambda (db target runname keys keynames keyvallst)
	   (let* ((itempatt (args:get-arg "-itempatt"))
		  (paths    (rdb:test-get-paths-matching db keynames target)))
		  (paths    (rdb:test-get-paths-matching db keynames target (args:get-arg "-test-path"))))
	     (for-each (lambda (path)
			 (print path))
		       paths))))))

;;======================================================================
;; Archive tests
;;======================================================================