Megatest

	$(INSTALL) $< $@
	chmod a+x $@

$(PREFIX)/bin/mt-new-to-old.sh : utils/mt-new-to-old.sh
	$(INSTALL) $< $@
	chmod a+x $@

$(PREFIX)/bin/convert-db.sh : utils/convert-db.sh
	$(INSTALL) $< $@
	chmod a+x $@

deploytarg/nbfake : utils/nbfake
	$(INSTALL) $< $@
	chmod a+x $@

deploytarg/viewscreen : utils/viewscreen
	$(INSTALL) $< $@

	$(INSTALL) lib/libxcb-xlib.so.0 $(PREFIX)/bin/.$(ARCHSTR)/lib/libxcb-xlib.so.0; \
        fi

install : $(PREFIX)/bin/.$(ARCHSTR) $(PREFIX)/bin/.$(ARCHSTR)/mtest $(PREFIX)/bin/megatest \
          $(PREFIX)/bin/.$(ARCHSTR)/dboard $(PREFIX)/bin/dashboard $(HELPERS) $(PREFIX)/bin/nbfake \
	  $(PREFIX)/bin/nbfind $(PREFIX)/bin/mtrunner $(PREFIX)/bin/viewscreen $(PREFIX)/bin/mt_xterm \
          $(PREFIX)/bin/mt-old-to-new.sh $(PREFIX)/bin/mt-new-to-old.sh \
          $(PREFIX)/bin/convert-db.sh $(PREFIX)/bin/convert-db.sh \
	  $(PREFIX)/share/docs/megatest_manual.html $(PREFIX)/bin/remrun \
	  $(PREFIX)/share/docs/megatest_manual.html $(PREFIX)/bin/remrun $(PREFIX)/bin/mtutil \
	  $(PREFIX)/share/db/mt-pg.sql \
          $(PREFIX)/share/js/jquery-3.1.0.slim.min.js \
          $(PREFIX)/bin/.$(ARCHSTR)/lib/libpangox-1.0.so \
          $(PREFIX)/bin/.$(ARCHSTR)/lib/libpangox-1.0.so.0 \
          $(PREFIX)/bin/.$(ARCHSTR)/lib/libxcb-xlib.so.0 $(PREFIX)/bin/serialize-env

(use posix-extras pathname-expand files)


(import commonmod
	debugprint
	rmtmod
	(prefix mtargs args:))
	
(define (remove-server-files directory-path)
  (let ((files (glob (string-append directory-path "/server*"))))
    (for-each delete-file* files)))
(include "common_records.scm")

(define (remove-files filespec)
  (let ((files (glob filespec)))
    (for-each delete-file* files)))

(define (stop-the-train)
  (thread-start! (make-thread (lambda ()
				(let loop ()
				  (if (and *toppath*
					   (file-exists? (conc *toppath*"/stop-the-train")))
				      (let* ((msg (conc "ERROR: found file "*toppath*"/stop-the-train, exiting immediately")))
					;; yes, print to current-output-port AND *default-log-port*, annoying but necessary I think
					(print msg)
                                        (remove-server-files (conc *toppath* "/logs"))
					(debug:print 0 *default-log-port* msg)
                                        (remove-files (conc *toppath* "/logs/server*"))
                                        (remove-files (conc *toppath* "/.servinfo/*"))
                                        (remove-files (conc *toppath* "/.mtdb/*lock"))
					(exit 1)))
				  (thread-sleep! 5)
				  (loop))))))

    (for-each
     (lambda (logprodat)
       (match logprodat
	      ((name content)
	       (debug:print-info 2 *default-log-port* "Creating logpro file "(current-directory)"/"name".logpro")
	       (with-output-to-file (conc name".logpro")
		 (lambda ()
		   (print content)
		   ;; (change-file-mode name (bitwise-ior perm/irwxg perm/irwxu))
		   )))
	      (else
	       (debug:print-info 0 "Invalid logpro definiton found in [logpro] section of testconfig. \"" logprodat "\""))))
     logpros)))

;; read testconfig and create .logpro and script files
;;    - use #f for tconfigreg to re-read the testconfigs from disk
;;
(define (launch:extract-scripts-logpro  test-dir test-name item-path tconfigreg-in)
  (let* ((tconfigreg      (or tconfigreg-in
			      (tests:get-all)))
	 (tconfig-fname   (conc test-dir "/.testconfig"))
	 (tconfig-tmpfile (conc tconfig-fname ".tmp"))
	 (tconfig         (tests:get-testconfig test-name item-path tconfigreg #t force-create: #t)) ;; 'return-procs)))
	 (scripts         (configf:get-section tconfig "scripts"))
	 (logpros         (configf:get-section tconfig "logpro")))
    ;; create .testconfig file
    (configf:write-alist tconfig tconfig-tmpfile)
    (file-move tconfig-tmpfile tconfig-fname #t)
    (delete-file* ".final-status")
    
    ;; extract scripts from testconfig and write them to files in test run dir
    (for-each
     (lambda (scriptdat)
       (match scriptdat
	      ((name content)
	       (debug:print-info 2 *default-log-port* "Creating script "(current-directory)"/"name)
	       (with-output-to-file name
		 (lambda ()
		   (print content)))
	       (change-file-mode name (bitwise-ior perm/irwxg perm/irwxu)))
	      (else
	       (debug:print-info 0 "Invalid script definiton found in [scripts] section of testconfig. \"" scriptdat "\""))))
     scripts)

    ;; extract logpro from testconfig and write them to files in test run dir
    (for-each
     (lambda (logprodat)
       (match logprodat
	      ((name content)
	       (debug:print-info 2 *default-log-port* "Creating logpro file "(current-directory)"/"name)
	       (with-output-to-file name
		 (lambda ()
		   (print content)
		   ;; (change-file-mode name (bitwise-ior perm/irwxg perm/irwxu))
		   )))
	      (else
	       (debug:print-info 0 "Invalid logpro definiton found in [logpro] section of testconfig. \"" logprodat "\""))))
     logpros)))

;; load the ~/.megatestrc file, put (use trace)(trace-call-sites #t)(trace function-you-want-to-trace) in this file
;;
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.megatestrc")))
  (if (common:file-exists? debugcontrolf)
    (begin
      ;; for some reason, debug:print does not work here. Had to use print.
      (with-output-to-port (current-error-port)
	(lambda ()
	  (print (conc "WARNING: loading " debugcontrolf))))
      (load debugcontrolf)
    )
  )
)

;; usage logging, careful with this, it is not designed to deal with all real world challenges!
;;

  -mark-incompletes       : find and mark incomplete tests
  -ping run-id|host:port  : ping server, exit with 0 if found
  -debug N|N,M,O...       : enable debug 0-N or N and M and O ...
  -debug-noprop N|M,M,O...: enable debug but do not propagate to subprocesses via MT_DEBUG
  -config fname           : override the megatest.config file with fname
  -append-config fname    : append fname to the megatest.config file
  -import-sexpr fname     : import a sexpr file (use -list-runs % -dumpmode sexpr to create)

  -regen-testfiles        : regenerate scripts and logpro files from testconfig, run in test context
  
Utilities
  -env2file fname         : write the environment to fname.csh and fname.sh
  -envcap a               : save current variables labeled as context 'a' in file envdat.db
  -envdelta a-b           : output enviroment delta from context a to context b to -o fname
                            set the output mode with -dumpmode csh, bash or ini

	   (let* ((db       #f)
		  ;; DO NOT run remote
		  (paths    (tests:test-get-paths-matching keys target (args:get-arg "-test-files"))))
	     (for-each (lambda (path)
			 (print path))
		       paths))))))

;;======================================================================
;; Utils for test areas
;;======================================================================

(if (args:get-arg "-regen-testfiles")
    (if (getenv "MT_TEST_RUN_DIR")
	(begin
	  (launch:setup)
	  (change-directory (getenv "MT_TEST_RUN_DIR"))
	  (let* ((testname (getenv "MT_TEST_NAME"))
		 (itempath (getenv "MT_ITEMPATH")))
	    (launch:extract-scripts-logpro (getenv "MT_TEST_RUN_DIR") testname itempath #f))
	  (set! *didsomething* #t))
	(debug:print 0 *default-log-port* "ERROR: Must run -regen-testfiles in a test environment (i.e. test xterm from dashboard)")))
		 	  
;;======================================================================
;; Utils for test areas
;;======================================================================

(if (args:get-arg "-regen-testfiles")
    (if (getenv "MT_TEST_RUN_DIR")
	(begin

;;     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/>.
;;

(require-extension (srfi 18) extras tcp s11n)

(declare (unit portlogger))
(declare (uses debugprint))
(declare (uses dbmod))

(module portlogger
*

(define (rmt:find-and-mark-incomplete run-id ovr-deadtime)
  (let* ((cfg-deadtime             (configf:lookup-number *configdat* "setup" "deadtime"))
	 (test-stats-update-period (configf:lookup-number *configdat* "setup" "test-stats-update-period")))
   (rmt:find-and-mark-incomplete-engine run-id ovr-deadtime cfg-deadtime test-stats-update-period)
   ;;call end of eud of run detection for posthook
   (launch:end-of-run-check run-id)))

;; orphaned from cherrypick merge
;;         (debug:print 0 *default-log-port* "Inserting " (length tests-data) " tests in run " runname)

    (if (not (null? required-tests))
	(debug:print-info 1 *default-log-port* "Adding \"" (string-intersperse required-tests " ") "\" to the run queue"))
    ;; NOTE: these are all parent tests, items are not expanded yet.
    (debug:print-info 4 *default-log-port* "test-records=" (hash-table->alist test-records))
    (let ((reglen (configf:lookup *configdat* "setup" "runqueue")))
      (if (> (length (hash-table-keys test-records)) 0)
	  (let* ()









	    (runs:run-tests-queue run-id runname test-records keyvals flags test-patts required-tests
				  (any->number reglen) all-tests-registry)

	    (if (> run-count 0) ;; handle reruns
		(begin
		  (if (not (hash-table-ref/default flags "-preclean" #f))
		      (hash-table-set! flags "-preclean" #t))
		  (if (not (hash-table-ref/default flags "-rerun" #f))
		      (hash-table-set! flags "-rerun" "ABORT,STUCK/DEAD,n/a,ZERO_ITEMS"))
                  (runs:run-tests target runname test-patts user flags run-count: (- run-count 1)))
                 (launch:end-of-run-check run-id)))
	  (debug:print-info 0 *default-log-port* "No tests to run")))
    (debug:print-info 4 *default-log-port* "All done by here")
    ;; TODO: try putting post hook call here
      
    ;  (debug:print-info 2 *default-log-port* " run-count " run-count)
    ;  (runs:run-post-hook run-id))
    ;  (debug:print-info 2 *default-log-port* "Not calling post hook runcount = " run-count ))   

		      (if (eq? nth-try 'removed) ;; removed is removed - drop it NOW
			  (if (null? tal)
			      #f ;; yes, really
			      (list (car tal)(cdr tal) reg reruns))
			  (begin
			    (if (runs:lownoise (conc "FAILED prerequisites or other issue" hed) 60)
				(debug:print 0 *default-log-port* "WARNING: test " hed " has FAILED prerequisites or other issue. Internal state >" nth-try "< will be overridden and we'll retry."))
			    (let* ((test-id      (rmt:get-test-id run-id testname item-path))
				   (test-info    (rmt:get-testinfo-state-status run-id test-id)) ;; we need *current* info
				   (status       (db:test-status test-info)))
			      (if (equal? status "KEEP_TRYING")
				  (mt:test-set-state-status-by-testname-unless-completed run-id test-name item-path "COMPLETED" "PREQ_FAIL" #f)
				  (mt:test-set-state-status-by-testname run-id test-name item-path "NOT_STARTED" "KEEP_TRYING" #f)))
			    (hash-table-set! test-registry hed 'removed) ;; was 0
                            (if (not (and (null? reg) (null? tal)))
                                (runs:loop-values tal reg reglen regfull reruns)
                                #f))))
		     (else
		      (if (runs:lownoise (conc "FAILED prerequitests and we tried" hed) 60)
			  (debug:print 0 *default-log-port* "WARNING: test " hed " has FAILED prerequitests and we've tried at least 10 times to run it. Giving up now."))

		      (with-output-to-file start-flag (lambda () (print server-key)))
		      (thread-sleep! 0.25)
		      (set! new-server-key (with-input-from-file start-flag (lambda () (read-line))))
		      (equal? server-key new-server-key)))
	       #t
               ;; If either of the above conditions is not true, print a "Gating server start" message, wait <idle-time> + 1, then call this function recursively. 
	       (begin
		 (debug:print-info 2 *default-log-port* "Gating server start, last start: "
				   (seconds->time-string fmodtime) ", time since last start: " delta ", required idletime: " idletime ", gating reason:" (if old-enough "another job started a server" "too soon to start another server"))
		 
		 (thread-sleep! ( + 1 idletime))
		 (server:wait-for-server-start-last-flag areapath)))))))

;; oldest server alive determines host then choose random of youngest
;; five servers on that host

#!/bin/bash

if [ -z "megatest.config" ]; then
    echo "The file 'megatest.config' does not exist. This must be run in a megatest area."
    exit 1
fi
if [ -d ".mtdb" ]; then
    echo "The .mtdb directory already exists. Will not do the conversion"
    exit 1
fi
if [ -d ".megatest" ]; then
    echo "Found a .megatest directory. Will convert from megatest 1.70 to 1.71/1.80 format"
    /p/foundry/env/pkgs/megatest/1.70/16/bin/megatest -list-runs % -dumpmode sexpr > data.sexpr
else 
    if [ -f "megatest.db" ]; then
        echo "Found megatest.db. Will convert from megatest 1.65 to 1.71/1.80 format"
        /p/foundry/env/pkgs/megatest/1.65/92/bin/megatest -list-runs % -dumpmode sexpr > data.sexpr
    else
        echo "Did not find .megatest or megatest.db. Cannot do the conversion"
        exit 1
    fi
fi
which megatest
megatest -import-sexpr data.sexpr