DELETED margs.scm
Index: margs.scm
==================================================================
--- margs.scm
+++ /dev/null
@@ -1,88 +0,0 @@
-;; Copyright 2007-2010, 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/>.
-
-
-;; (declare (unit margs))
-;; (declare (uses common))
-
-(define args:arg-hash (make-hash-table))
-
-(define (args:get-arg arg . default)
-  (if (null? default)
-      (hash-table-ref/default args:arg-hash arg #f)
-      (hash-table-ref/default args:arg-hash arg (car default))))
-
-(define (args:any? . args)
-  (not (null? (filter (lambda (x) x)
-		      (map args:get-arg args)))))
-
-(define (args:get-arg-from ht arg . default)
-  (if (null? default)
-      (hash-table-ref/default ht arg #f)
-      (hash-table-ref/default ht arg (car default))))
-
-(define (args:usage . args)
-  (if (> (length args) 0)
-      (apply print "ERROR: " args))
-  (if (string? help)
-      (print help)
-      (print "Usage: " (car (argv)) " ... "))
-  (exit 0))
-
- ;; one-of args defined
-(define (args:any-defined? . param)
-  (let ((res #f))
-    (for-each 
-     (lambda (arg)
-       (if (args:get-arg arg)(set! res #t)))
-     param)
-    res))
-
-;; args: 
-(define (args:get-args args params switches arg-hash num-needed)
-  (let* ((numargs (length args))
-	 (adj-num-needed (if num-needed (+ num-needed 2) #f)))
-    (if (< numargs (if adj-num-needed adj-num-needed 2))
-	(if (>= num-needed 1)
-	    (args:usage "No arguments provided")
-	    '())
-	(let loop ((arg (cadr args))
-		   (tail (cddr args))
-		   (remargs '()))
-	  (cond 
-	   ((member arg params) ;; args with params
-	    (if (< (length tail) 1)
-		(args:usage "param given without argument " arg)
-		(let ((val     (car tail))
-		      (newtail (cdr tail)))
-		  (hash-table-set! arg-hash arg val)
-		  (if (null? newtail) remargs
-		      (loop (car newtail)(cdr newtail) remargs)))))
-	   ((member arg switches)         ;; args with no params (i.e. switches)
-	    (hash-table-set! arg-hash arg #t)
-	    (if (null? tail) remargs
-		(loop (car tail)(cdr tail) remargs)))
-	   (else
-	    (if (null? tail)(append remargs (list arg)) ;; return the non-used args
-		(loop (car tail)(cdr tail)(append remargs (list arg))))))))
-    ))
-
-(define (args:print-args remargs arg-hash)
-  (print "ARGS: " remargs)
-  (for-each (lambda (arg)
-	      (print "   " arg "   " (hash-table-ref/default arg-hash arg #f)))
-	    (hash-table-keys arg-hash)))

Index: megatest.scm
==================================================================
--- megatest.scm
+++ megatest.scm
@@ -14,25 +14,10 @@
 ;; 
 ;;     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))
@@ -165,18 +150,17 @@
 (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 "common_records.scm")
 ;; (include "key_records.scm")
-;; (include "db_records.scm")
-;; (include "run_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")
@@ -746,17 +730,17 @@
      		       (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")
+     (if (args:any-defined? "-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 (apply args:any-defined? homehost-required)
            (if (not (common:on-homehost?))
      	  (for-each
      	   (lambda (switch)
      	     (if (args:get-arg switch)
      		 (begin
@@ -1562,11 +1546,11 @@
      			       runs-spec)
      			      (newline)))))
      		       
      		     (for-each 
      		      (lambda (test)
-     		      	(common:debug-handle-exceptions #f
+     		      	(handle-exceptions
      			 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))
@@ -2630,7 +2614,7 @@
               (else (exit 3)))))
      )
 
 )
 
-;; (main)
-(print "Got here")
+(main)
+