Index: Makefile
==================================================================
--- Makefile
+++ Makefile
@@ -25,15 +25,17 @@
server.scm configf.scm db.scm keys.scm margs.scm \
process.scm runs.scm tasks.scm tests.scm genexample.scm \
http-transport.scm tdb.scm client.scm mt.scm \
ezsteps.scm lock-queue.scm rmt.scm api.scm \
subrun.scm portlogger.scm archive.scm env.scm \
- diff-report.scm cgisetup/models/pgdb.scm
+ diff-report.scm pgdb.scm
+
+# cgisetup/models/pgdb.scm
# module source files
MSRCFILES = dbmod.scm dbfile.scm debugprint.scm mtargs.scm commonmod.scm \
- ducttape-lib.scm pkts.scm dbi.scm
+ ducttape-lib.scm pkts.scm dbi.scm autoload.scm
# ftail.scm rmtmod.scm commonmod.scm removed
# MSRCFILES = ducttape-lib.scm pkts.scm stml2.scm cookie.scm mutils.scm \
# mtargs.scm commonmod.scm dbmod.scm adjutant.scm ulex.scm \
# rmtmod.scm apimod.scm
@@ -100,11 +102,11 @@
# include makefile.inc
TCMTOBJS = \
api.o \
archive.o \
- cgisetup/models/pgdb.o \
+ pgdb.o \
client.o \
common.o \
configf.o \
db.o \
env.o \
@@ -152,10 +154,11 @@
$(INSTALL) mt-pg.sql $(PREFIX)/share/db/mt-pg.sql
# Special dependencies for the includes
$(MOFILE) $(MOIMPFILES) $(MSRCFILES) : megatest-fossil-hash.scm
+mofiles/dbi.o : mofiles/autoload.o
mofiles/pkts.o : mofiles/dbi.o
mofiles/dbfile.o : mofiles/debugprint.o
mofiles/debugprint.o : mofiles/mtargs.o
common.o : mofiles/commonmod.o megatest-fossil-hash.scm
ADDED autoload.scm
Index: autoload.scm
==================================================================
--- /dev/null
+++ autoload.scm
@@ -0,0 +1,23 @@
+;;======================================================================
+;; Copyright 2019, 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 autoload))
+
+(include "autoload/autoload.scm")
ADDED autoload/autoload.egg
Index: autoload/autoload.egg
==================================================================
--- /dev/null
+++ autoload/autoload.egg
@@ -0,0 +1,5 @@
+((license "BSD")
+ (category lang-exts)
+ (author "Alex Shinn")
+ (synopsis "Load modules lazily")
+ (components (extension autoload)))
ADDED autoload/autoload.meta
Index: autoload/autoload.meta
==================================================================
--- /dev/null
+++ autoload/autoload.meta
@@ -0,0 +1,9 @@
+;;; autoload.meta -*- Hen -*-
+
+((egg "autoload.egg")
+ (synopsis "Load modules lazily")
+ (category lang-exts)
+ (license "BSD")
+ (author "Alex Shinn")
+ (doc-from-wiki)
+ (files "autoload.meta" "autoload.scm" "autoload.release-info" "autoload.setup"))
ADDED autoload/autoload.scm
Index: autoload/autoload.scm
==================================================================
--- /dev/null
+++ autoload/autoload.scm
@@ -0,0 +1,93 @@
+;;;; autoload.scm -- load modules lazily
+;;
+;; Copyright (c) 2005-2009 Alex Shinn
+;; All rights reserved.
+;;
+;; BSD-style license: http://www.debian.org/misc/bsd.license
+
+;; Provides an Emacs-style autoload facility which takes the basic form
+;;
+;; (autoload unit procedure-name ...)
+;;
+;; such that the first time procedure-name is called, it will perform a
+;; runtime require of 'unit and then apply the procedure from the newly
+;; loaded unit to the args it was passed. Subsequent calls to
+;; procedure-name will thereafter refer to the new procedure and will
+;; thus not incur any overhead.
+;;
+;; You may also specify an alias for the procedure, and a default
+;; procedure if the library can't be loaded:
+;;
+;; (autoload unit (name alias default) ...)
+;;
+;; In this case, although the procedure name from the unit is "name,"
+;; the form defines the autoload procedure as "alias."
+;;
+;; If the library can't be loaded then an error is signalled, unless
+;; default is given, in which case the values are passed to that.
+;;
+;; Examples:
+;;
+;; ;; load iconv procedures lazily
+;; (autoload iconv iconv iconv-open)
+;;
+;; ;; load some sqlite procedures lazily with "-" names
+;; (autoload sqlite (sqlite:open sqlite-open)
+;; (sqlite:execute sqlite-execute))
+;;
+;; ;; load md5 library, falling back on slower scheme version
+;; (autoload scheme-md5 (md5:digest scheme-md5:digest))
+;; (autoload md5 (md5:digest #f scheme-md5:digest))
+
+(module autoload (autoload)
+
+(import scheme (chicken base))
+
+(define-syntax autoload
+ (er-macro-transformer
+ (lambda (expr rename compare)
+ (let ((module (cadr expr))
+ (procs (cddr expr))
+ (_import (rename 'import))
+ (_define (rename 'define))
+ (_let (rename 'let))
+ (_set! (rename 'set!))
+ (_begin (rename 'begin))
+ (_apply (rename 'apply))
+ (_args (rename 'args))
+ (_tmp (rename 'tmp))
+ (_eval (rename 'eval))
+ (_condition-case (rename 'condition-case)))
+ `(,_begin
+ ,@(map
+ (lambda (x)
+ (let* ((x (if (pair? x) x (list x)))
+ (name (car x))
+ (full-name
+ (string->symbol
+ (string-append (symbol->string module) "#"
+ (symbol->string name))))
+ (alias (or (and (pair? (cdr x)) (cadr x)) name))
+ (default (and (pair? (cdr x)) (pair? (cddr x)) (caddr x))))
+ (if default
+ `(,_define (,alias . ,_args)
+ (,_let ((,_tmp (,_condition-case
+ (,_begin
+ (,_eval
+ (begin (require-library ,module)
+ #f))
+ (,_eval ',full-name))
+ (exn () ,default))))
+ (,_set! ,alias ,_tmp)
+ (,_apply ,_tmp ,_args)))
+ `(,_define (,alias . ,_args)
+ (,_let ((,_tmp (,_begin
+ (,_eval
+ (begin (require-library ,module)
+ #f))
+ (,_eval ',full-name))))
+ (,_set! ,alias ,_tmp)
+ (,_apply ,_tmp ,_args))))))
+ procs))))))
+
+)
ADDED autoload/autoload.setup
Index: autoload/autoload.setup
==================================================================
--- /dev/null
+++ autoload/autoload.setup
@@ -0,0 +1,7 @@
+
+(compile -s -O2 -j autoload autoload.scm)
+(compile -s -O2 autoload.import.scm)
+
+(install-extension
+ 'autoload '("autoload.so" "autoload.import.so")
+ '((version 3.0) (syntax)))
Index: cgisetup/models/pgdb.scm
==================================================================
--- cgisetup/models/pgdb.scm
+++ cgisetup/models/pgdb.scm
@@ -17,10 +17,11 @@
;; along with Megatest. If not, see .
;;======================================================================
;; (declare (unit pgdb))
+
;; (declare (uses configf))
;;
;; ;; I don't know how to mix compilation units and modules, so no module here.
;; ;;
;; ;; (module pgdb
Index: mtexec.scm
==================================================================
--- mtexec.scm
+++ mtexec.scm
@@ -20,14 +20,20 @@
;; (include "megatest-version.scm")
;; fake out readline usage of toplevel-command
(define (toplevel-command . a) #f)
-(use srfi-1 posix srfi-69 readline ;; regex regex-case srfi-69 apropos json http-client directory-utils rpc typed-records;; (srfi 18) extras)
- srfi-19 srfi-18 extras format pkts regex regex-case
- (prefix dbi dbi:)
- )
+(import
+ srfi-1
+ ;; posix
+ srfi-69
+ breadline ;; regex regex-case srfi-69 apropos json http-client directory-utils rpc typed-records;; (srfi 18) extras)
+ srfi-19 srfi-18
+ ;; extras format
+ pkts regex regex-case
+ (prefix dbi dbi:)
+ )
;; (declare (uses common))
(declare (uses margs))
(declare (uses configf))
;; (declare (uses rmt))
@@ -100,13 +106,13 @@
(exit)))
(if (or (args:get-arg "-repl")
(args:get-arg "-load"))
(begin
- (import extras) ;; might not be needed
+ ;; (import extras) ;; might not be needed
;; (import csi)
- (import readline)
+ (import breadline)
(import apropos)
;; (import (prefix sqlite3 sqlite3:)) ;; doesn't work ...
(install-history-file (get-environment-variable "HOME") ".mtutil_history") ;; [homedir] [filename] [nlines])
(current-input-port (make-readline-port "mtutil> "))
ADDED pgdb.scm
Index: pgdb.scm
==================================================================
--- /dev/null
+++ pgdb.scm
@@ -0,0 +1,23 @@
+;;======================================================================
+;; Copyright 2019, 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 pgdb))
+
+(include "cgisetup/models/pgdb.scm")
Index: pkts/pkts.scm
==================================================================
--- pkts/pkts.scm
+++ pkts/pkts.scm
@@ -164,12 +164,24 @@
make-report ;; make a .dot file
)
(import
- ;; chicken
+ chicken.base
+ chicken.condition
+ chicken.file
+ chicken.file.posix
+ chicken.io
+ chicken.port
+ chicken.process
+ chicken.process-context.posix
+ chicken.time
+ chicken.time.posix
+ chicken.sort
+ chicken.string
scheme
+
;; data-structures posix
srfi-1 regex srfi-13 srfi-69
;; ports extras)
crypt sha1 message-digest
(prefix dbi dbi:)
@@ -703,11 +715,11 @@
(cond
((not (file-exists? pktsdir))
(print "ERROR: packets directory " pktsdir " does not exist."))
((not (directory? pktsdir))
(print "ERROR: packets directory path " pktsdir " is not a directory."))
- ((not (file-read-access? pktsdir))
+ ((not (file-readable? pktsdir))
(print "ERROR: packets directory path " pktsdir " is not readable."))
(else
;; (print "INFO: Loading packets found in " pktsdir)
(let ((pkts (glob (conc pktsdir "/*.pkt"))))
(for-each
Index: tasks.scm
==================================================================
--- tasks.scm
+++ tasks.scm
@@ -16,19 +16,19 @@
;; along with Megatest. If not, see .
;;
;; strftime('%m/%d/%Y %H:%M:%S','now','localtime')
-(use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking format)
-(import (prefix sqlite3 sqlite3:))
-
(declare (unit tasks))
(declare (uses dbfile))
(declare (uses db))
(declare (uses rmt))
(declare (uses common))
(declare (uses pgdb))
+
+(use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking format)
+(import (prefix sqlite3 sqlite3:))
(import dbfile)
;; (import pgdb) ;; pgdb is a module
(include "task_records.scm")