Megatest

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

 

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