Megatest

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

;;  megatest.scm mofiles/autoload.o mofiles/dbi.o mofiles/ducttape-lib.o
;;  mofiles/pkts.o mofiles/stml2.o mofiles/cookie.o mofiles/mutils.o
;;  mofiles/mtargs.o

;; (include "mutils/mutils.scm")
;; (include "autoload/autoload.scm")
;; (include "dbi/dbi.scm")
;; (include "stml2/cookie.scm")
;; (include "stml2/stml2.scm")
;; (include "pkts/pkts.scm")
;; (include "csv-xml/csv-xml.scm")
;; (include "ducttape/ducttape-lib.scm")
;; (include "hostinfo/hostinfo.scm")
;; (include "adjutant.scm")

(declare (uses autoload))
(declare (uses dbi))
(declare (uses pkts))
(declare (uses stml2))
(declare (uses cookie))
(declare (uses csv-xml))
(declare (uses hostinfo))

;; fake out readline usage of toplevel-command
(define (toplevel-command . a) #f)
(define setenv set-environment-variable!)
(define unsetenv unset-environment-variable!)

(define *db* #f) ;; this is only for the repl, do not use in general!!!!

;; (include "common_records.scm")
;; (include "key_records.scm")
;; (include "db_records.scm")
;; (include "run_records.scm")
;; (include "test_records.scm")

(include "common.scm")
;; (include "margs.scm")
(include "db.scm")
(include "server.scm")
(include "tests.scm")
(include "genexample.scm")
(include "tdb.scm")
(include "env.scm")
(include "diff-report.scm")

     					    (printf "Sending signal/term to ~A\n" pid)
     					    (process-signal pid signal/term))))))
     		       (process:children #f))
     		      (original-exit exit-code)))))
     
     ;; for some switches always print the command to stderr
     ;;
     (if (args:any? "-run" "-runall" "-remove-runs" "-set-state-status" "-kill-runs" "-kill-rerun")
         (debug:print 0 *default-log-port* (string-intersperse (argv) " ")))
     
     ;; some switches imply homehost. Exit here if not on homehost
     ;;
     (let ((homehost-required  (list "-cleanup-db" "-server")))
       (if (apply args:any? homehost-required)
           (if (not (common:on-homehost?))
     	  (for-each
     	   (lambda (switch)
     	     (if (args:get-arg switch)
     		 (begin
     		   (debug:print 0 *default-log-port* "ERROR: you must be on the homehost to run with " switch
     				", you can move homehost by removing the .homehost file but this will disrupt any runs in progress.")

     				     (display (conc "target: " targetstr " "))
     				     (display (conc field-name ": " (db:get-value-by-header run header (conc field-name)) " "))))
     			       runs-spec)
     			      (newline)))))
     		       
     		     (for-each 
     		      (lambda (test)
     		      	(common:debug-handle-exceptions #f
     			 exn
     			 (begin
     			   (debug:print-error 0 *default-log-port* "Bad data in test record? " test)
     			   (debug:print-error 5 *default-log-port* "exn=" (condition->list exn))
     			   (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
     			   (print-call-chain (current-error-port)))
     			 (let* ((test-id      (if (member "id"           tests-spec)(get-value-by-fieldname test test-field-index "id"          ) #f)) ;; (db:test-get-id         test))

              ((1)(exit 1))
              ((2)(exit 2))
              (else (exit 3)))))
     )

)

;; (main)
(print "Got here")