Index: Makefile
==================================================================
--- Makefile
+++ Makefile
@@ -27,11 +27,11 @@
SHELL=/bin/bash
PREFIX=$(PWD)
CSCOPTS=
INSTALL=install
SRCFILES = common.scm items.scm launch.scm ods.scm runconfig.scm \
- server.scm configf.scm db.scm keys.scm margs.scm \
+ server.scm configf.scm db.scm keys.scm \
process.scm runs.scm tasks.scm tests.scm genexample.scm \
tdb.scm mt.scm \
ezsteps.scm rmt.scm api.scm \
subrun.scm archive.scm env.scm \
diff-report.scm cgisetup/models/pgdb.scm
ADDED attic/margs.scm
Index: attic/margs.scm
==================================================================
--- /dev/null
+++ attic/margs.scm
@@ -0,0 +1,103 @@
+;; 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 .
+
+
+(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))))
+
+;; get an arg as a number
+(define (args:get-arg-number arg . default)
+ (let* ((val-str (args:get-arg arg))
+ (val (if val-str (string->number val-str) #f)))
+ (if val
+ val
+ (if (null? default)
+ #f
+ default))))
+
+(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:remove-arg-from-ht arg)
+ (hash-table-delete! args:arg-hash arg)
+)
+
+(define (args:usage . args)
+ (if (> (length args) 0)
+ (apply print "ERROR: " args))
+ (if (string? help)
+ (print help)
+ (print "Usage: " (car (argv)) " ... "))
+ (exit 0))
+
+(define (args:any-defined? . args)
+ (not (null? (filter (lambda (x) x)
+ (map args:get-arg args)))))
+
+;; ;; 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)))
DELETED margs.scm
Index: margs.scm
==================================================================
--- margs.scm
+++ /dev/null
@@ -1,103 +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 .
-
-
-(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))))
-
-;; get an arg as a number
-(define (args:get-arg-number arg . default)
- (let* ((val-str (args:get-arg arg))
- (val (if val-str (string->number val-str) #f)))
- (if val
- val
- (if (null? default)
- #f
- default))))
-
-(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:remove-arg-from-ht arg)
- (hash-table-delete! args:arg-hash arg)
-)
-
-(define (args:usage . args)
- (if (> (length args) 0)
- (apply print "ERROR: " args))
- (if (string? help)
- (print help)
- (print "Usage: " (car (argv)) " ... "))
- (exit 0))
-
-(define (args:any-defined? . args)
- (not (null? (filter (lambda (x) x)
- (map args:get-arg args)))))
-
-;; ;; 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: mtut.scm
==================================================================
--- mtut.scm
+++ mtut.scm
@@ -16,17 +16,17 @@
;; along with Megatest. If not, see .
;;
;
(declare (uses common))
(declare (uses mtargs))
+(declare (uses mtargs.import))
(declare (uses debugprint))
(declare (uses debugprint.import))
(declare (uses configf))
;; (declare (uses rmt))
(declare (uses commonmod))
(declare (uses commonmod.import))
-(declare (uses mtargs.import))
(import debugprint)
; (include "common.scm")
(include "megatest-version.scm")