Megatest

Diff
Login

Differences From Artifact [2bf02a0d8b]:

To Artifact [d00ef9a849]:


344
345
346
347
348
349
350
351

352
353
354
355
356
357
358
;; Weird special calls that need to run *after* the server has started?
;;======================================================================

(if (args:get-arg "-list-targets")
    (let ((targets (common:get-runconfig-targets)))
      (print "Found "(length targets) " targets")
      (for-each (lambda (x)
		  (print "[" x "]"))

		targets)
      (set! *didsomething* #t)))

(if (args:get-arg "-show-runconfig")
    (begin
      (pp (hash-table->alist (open-run-close setup-env-defaults #f "runconfigs.config" #f #f change-env: #f)))
      (set! *didsomething* #t)))







|
>







344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
;; Weird special calls that need to run *after* the server has started?
;;======================================================================

(if (args:get-arg "-list-targets")
    (let ((targets (common:get-runconfig-targets)))
      (print "Found "(length targets) " targets")
      (for-each (lambda (x)
		  ;; (print "[" x "]"))
		  (print x))
		targets)
      (set! *didsomething* #t)))

(if (args:get-arg "-show-runconfig")
    (begin
      (pp (hash-table->alist (open-run-close setup-env-defaults #f "runconfigs.config" #f #f change-env: #f)))
      (set! *didsomething* #t)))
424
425
426
427
428
429
430
431

432
433
434
435
436
437
438
	     (let ((targetstr (string-intersperse (map (lambda (x)
							 (db:get-value-by-header run header x))
						       keynames) "/")))
	       (if db-targets
		   (if (not (hash-table-ref/default seen targetstr #f))
		       (begin
			 (hash-table-set! seen targetstr #t)
			 (print "[" targetstr "]"))))

	       (if (not db-targets)
		   (let* ((run-id (open-run-close db:get-value-by-header run header "id"))
			  (tests  (open-run-close db:get-tests-for-run db run-id testpatt '() '())))
		     (debug:print 1 "Run: " targetstr " status: " (db:get-value-by-header run header "state")
				  " run-id: " run-id ", number tests: " (length tests))
		     (for-each 
		      (lambda (test)







|
>







425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
	     (let ((targetstr (string-intersperse (map (lambda (x)
							 (db:get-value-by-header run header x))
						       keynames) "/")))
	       (if db-targets
		   (if (not (hash-table-ref/default seen targetstr #f))
		       (begin
			 (hash-table-set! seen targetstr #t)
			 ;; (print "[" targetstr "]"))))
			 (print targetstr))))
	       (if (not db-targets)
		   (let* ((run-id (open-run-close db:get-value-by-header run header "id"))
			  (tests  (open-run-close db:get-tests-for-run db run-id testpatt '() '())))
		     (debug:print 1 "Run: " targetstr " status: " (db:get-value-by-header run header "state")
				  " run-id: " run-id ", number tests: " (length tests))
		     (for-each 
		      (lambda (test)
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
(if (args:get-arg "-repl")
    (let* ((toppath (setup-for-run))
	   (db      (if toppath (open-db) #f)))
      (if db
	  (begin
	    (set! *db* db)
	    (set! *client-non-blocking-mode* #t)
	    ;; (server:client-setup)
	    (import readline)
	    (import apropos)
	    (gnu-history-install-file-manager
	     (string-append
	      (or (get-environment-variable "HOME") ".") "/.megatest_history"))
	    (current-input-port (make-gnu-readline-port "megatest> "))
	    (repl))







|







907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
(if (args:get-arg "-repl")
    (let* ((toppath (setup-for-run))
	   (db      (if toppath (open-db) #f)))
      (if db
	  (begin
	    (set! *db* db)
	    (set! *client-non-blocking-mode* #t)
	    (server:client-setup)
	    (import readline)
	    (import apropos)
	    (gnu-history-install-file-manager
	     (string-append
	      (or (get-environment-variable "HOME") ".") "/.megatest_history"))
	    (current-input-port (make-gnu-readline-port "megatest> "))
	    (repl))