Megatest

Diff
Login

Differences From Artifact [e08e69ab7f]:

To Artifact [9f39af124e]:


905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
	       (testpatt (if (args:get-arg "-testpatt") 
			     (args:get-arg "-testpatt") 
			     "%"))
	       (keys     (db:get-keys dbstruct))
	       ;; (runsdat  (db:get-runs dbstruct runpatt #f #f '()))
	       (runsdat  (db:get-runs-by-patt dbstruct keys (or runpatt "%") (common:args-get-target)
					 #f #f))
		;; (cdb:remote-run db:get-runs #f runpatt #f #f '()))
	       (runs     (db:get-rows runsdat))
	       (header   (db:get-header runsdat))
	       (db-targets (args:get-arg "-list-db-targets"))
	       (seen     (make-hash-table))
	       (dmode    (let ((d (args:get-arg "-dumpmode")))
			   (if d (string->symbol d) #f)))
	       (data     (make-hash-table)))







<







905
906
907
908
909
910
911

912
913
914
915
916
917
918
	       (testpatt (if (args:get-arg "-testpatt") 
			     (args:get-arg "-testpatt") 
			     "%"))
	       (keys     (db:get-keys dbstruct))
	       ;; (runsdat  (db:get-runs dbstruct runpatt #f #f '()))
	       (runsdat  (db:get-runs-by-patt dbstruct keys (or runpatt "%") (common:args-get-target)
					 #f #f))

	       (runs     (db:get-rows runsdat))
	       (header   (db:get-header runsdat))
	       (db-targets (args:get-arg "-list-db-targets"))
	       (seen     (make-hash-table))
	       (dmode    (let ((d (args:get-arg "-dumpmode")))
			   (if d (string->symbol d) #f)))
	       (data     (make-hash-table)))
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
	  (if (args:get-arg "-runstep")(debug:print-info 1 "Running -runstep, first change to directory " work-area))
	  (change-directory work-area)
	  ;; can setup as client for server mode now
	  ;; (client:setup)

	  (if (args:get-arg "-load-test-data")
	      ;; has sub commands that are rdb:
	      ;; DO NOT put this one into either cdb:remote-run or open-run-close
	      (tdb:load-test-data run-id test-id))
	  (if (args:get-arg "-setlog")
	      (let ((logfname (args:get-arg "-setlog")))
		(rmt:test-set-log! run-id test-id logfname)))
	  (if (args:get-arg "-set-toplog")
	      ;; DO NOT run remote
	      (tests:test-set-toplog! run-id test-name (args:get-arg "-set-toplog")))







|







1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
	  (if (args:get-arg "-runstep")(debug:print-info 1 "Running -runstep, first change to directory " work-area))
	  (change-directory work-area)
	  ;; can setup as client for server mode now
	  ;; (client:setup)

	  (if (args:get-arg "-load-test-data")
	      ;; has sub commands that are rdb:
	      ;; DO NOT put this one into either rmt: or open-run-close
	      (tdb:load-test-data run-id test-id))
	  (if (args:get-arg "-setlog")
	      (let ((logfname (args:get-arg "-setlog")))
		(rmt:test-set-log! run-id test-id logfname)))
	  (if (args:get-arg "-set-toplog")
	      ;; DO NOT run remote
	      (tests:test-set-toplog! run-id test-name (args:get-arg "-set-toplog")))
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
        (args:get-arg "-show-keys"))
    (let ((db #f)
	  (keys #f))
      (if (not (launch:setup-for-run *area-dat*))
	  (begin
	    (debug:print 0 "Failed to setup, exiting")
	    (exit 1)))
      (set! keys (cdb:remote-run db:get-keys db))
      (debug:print 1 "Keys: " (string-intersperse keys ", "))
      (if (sqlite3:database? db)(sqlite3:finalize! db))
      (set! *didsomething* #t)))

(if (args:get-arg "-gui")
    (begin
      (debug:print 0 "Look at the dashboard for now")







|







1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
        (args:get-arg "-show-keys"))
    (let ((db #f)
	  (keys #f))
      (if (not (launch:setup-for-run *area-dat*))
	  (begin
	    (debug:print 0 "Failed to setup, exiting")
	    (exit 1)))
      (set! keys (rmt:get-keys)) ;;  db))
      (debug:print 1 "Keys: " (string-intersperse keys ", "))
      (if (sqlite3:database? db)(sqlite3:finalize! db))
      (set! *didsomething* #t)))

(if (args:get-arg "-gui")
    (begin
      (debug:print 0 "Look at the dashboard for now")
1470
1471
1472
1473
1474
1475
1476

1477
1478
1479
1480
1481
1482
1483
	    (set! *client-non-blocking-mode* #t)
	    (import extras) ;; might not be needed
	    ;; (import csi)
	    (import readline)
            (use-legacy-bindings)
	    (import apropos)
	    ;; (import (prefix sqlite3 sqlite3:)) ;; doesn't work ...

	    (gnu-history-install-file-manager
	     (let ((d (string-append
		       (or (get-environment-variable "HOME") ".") "/.megatest")))
	       (if (not (file-exists? d))
		   (create-directory d #t))
	       d))
	    (current-input-port (make-gnu-readline-port "megatest> "))







>







1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
	    (set! *client-non-blocking-mode* #t)
	    (import extras) ;; might not be needed
	    ;; (import csi)
	    (import readline)
            (use-legacy-bindings)
	    (import apropos)
	    ;; (import (prefix sqlite3 sqlite3:)) ;; doesn't work ...
	    (include "readline-fix.scm")
	    (gnu-history-install-file-manager
	     (let ((d (string-append
		       (or (get-environment-variable "HOME") ".") "/.megatest")))
	       (if (not (file-exists? d))
		   (create-directory d #t))
	       d))
	    (current-input-port (make-gnu-readline-port "megatest> "))