Megatest

minimt.scm at [7bfbd68003]
Login

File minimt/minimt.scm artifact 9a5af2fd8b part of check-in 7bfbd68003


;;  Copyright 2006-2017, Matthew Welland.
;; 
;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
;;
(use posix)

(include "db.scm")

;; define following in setup.scm
;;    *remotehost*  => host for "tests"
;;    *homehost*    => host for servers
;;    *homepath*    => directory from which to run
;;    *numtests*    => how many tests to simulate for each run
;;    *numruns*     => how many runs to simulate
;;    
(include "setup.scm")

(include "direct.scm") ;; direct db calls

;; RUN A TEST
(define (run-test dbconn run-id test-name)
  (rmt:create-test dbconn run-id test-name)
  (let ((test-id (rmt:get-test-id dbconn run-id test-name)))
    (rmt:test-set-state-status dbconn test-id "LAUNCHED" "na")
    (thread-sleep! *launchdelay*)
    (rmt:test-set-state-status dbconn test-id "RUNNING" "na")
    (let loop ((step-num 0))
      (let ((step-name (conc "step" step-num)))
       (rmt:create-step dbconn test-id step-name)
       (let ((step-id (get-step-id dbconn test-id step-name)))
	 (rmt:step-set-state-status dbconn step-id "START" -1)
	 (thread-sleep! *stepdelay*)
	 (rmt:step-set-state-status dbconn step-id "END" 0)
	 (print"   STEP: " step-name " done.")))
      (if (< step-num *numsteps*)
	  (loop (+ step-num 1))))
    ;; we will do a large but bogus read to simulate the logic in Megatest
    (rmt:test-get-tests dbconn `(,run-id) "%")
    (rmt:test-set-state-status dbconn test-id "COMPLETED" (if (> (random 10) 2) "PASS" "FAIL"))
    (print "TEST: " test-name " done.")
    (print "Stats:")
    (print-stats *stats*)
    test-id))

;; RUN A RUN
(define (run-run dbconn target run-name num-tests)
  (rmt:create-run dbconn target run-name)
  (let ((run-id (rmt:get-run-id dbconn target run-name)))
    (let loop ((test-num 0))
      (system (conc "NBFAKE_LOG=test-" test-num "-run-id-" run-id ".log NBFAKE_HOST=" *remotehost* " nbfake minimt runtest " run-id " test-" test-num))
      (if (< test-num num-tests)
	  (loop (+ test-num 1))))))

;; Do what is asked
(let ((args (cdr (argv))))
  (if (< (length args) 1)
      (print
       "Usage: minimt [options]" "
  runtest run-id testname
  runrun  target runname")
      (let ((cmd    (car args))
	    (dbconn (rmt:open-create-db *homepath* "mt.db" init-db)))
	(thread-sleep! 0.5) ;; be sure the db is written out to disk? Should really not be needed.
	(change-directory *homepath*)
	(case (string->symbol cmd)
	  ((runtest)
	   (let ((run-id    (string->number (cadr args)))
		 (test-name (caddr args)))
	     (print "Launching test " test-name " for run-id " run-id)
	     (run-test dbconn run-id test-name)))
	  ((runrun)
	   (let ((target   (cadr args))
		 (run-name (caddr args)))
	     (run-run dbconn target run-name *numtests*)
	     (print "Use: sqlite3 runtest/mt.db 'select max(end_time)-min(start_time) from tests;' to see the total run time")
	     ))
	  ((runall)
	   (for-each
	    (lambda (target)
	      (let loop ((run-num 0))
		(thread-sleep! *rundelay*)
		(system (conc "NBFAKE_LOG=run-" target "-" run-num ".log nbfake minimt runrun " target " run-" run-num))
		(if (< run-num *numruns*)
		    (loop (+ run-num 1)))))
	    *targets*))
	  ((server)
	   (start-server dbconn))
	  (else
	   (print "Command: " cmd " not recognised. Run without params to see help.")))
	(close-database (dbconn-dat-dbh dbconn)))))