Index: common.scm ================================================================== --- common.scm +++ common.scm @@ -37,11 +37,11 @@ (define *already-seen-runconfig-info* #f) (define *waiting-queue* (make-hash-table)) (define *test-meta-updated* (make-hash-table)) (define *globalexitstatus* 0) ;; attempt to work around possible thread issues (define *passnum* 0) ;; when running track calls to run-tests or similar -(define *verbosity* 1) + (define *rpc:listener* #f) ;; if set up for server communication this will hold the tcp port (define *runremote* #f) ;; if set up for server communication this will hold (define *last-db-access* (current-seconds)) ;; update when db is accessed via server (define *max-cache-size* 0) (define *target* (make-hash-table)) ;; cache the target here; target is keyval1/keyval2/.../keyvalN @@ -52,10 +52,14 @@ (define *test-ids* (make-hash-table)) ;; cache run-id, testname, and item-path => test-id (define *test-info* (make-hash-table)) ;; cache the test info records, update the state, status, run_duration etc. from testdat.db (define *run-info-cache* (make-hash-table)) ;; run info is stable, no need to reget +;; Debugging stuff +(define *verbosity* 1) +(define *logging* #f) + (define (get-with-default val default) (let ((val (args:get-arg val))) (if val val default))) (define (assoc/default key lst . default) Index: common_records.scm ================================================================== --- common_records.scm +++ common_records.scm @@ -8,12 +8,15 @@ ;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ;; PURPOSE. ;;====================================================================== (define-inline (debug:print n . params) - (if (<= n *verbosity*) - (apply print params))) + (begin + (if (<= n *verbosity*) + (apply print params)) + (if *logging* + (apply db:log-event params)))) ;; if a value is printable (i.e. string or number) return the value ;; else return an empty string (define-inline (printable val) (if (or (number? val)(string? val)) val "")) Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -218,10 +218,14 @@ CONSTRAINT test_data_constraint UNIQUE (test_id,category,variable));") ;; Must do this *after* running patch db !! No more. (db:set-var db "MEGATEST_VERSION" megatest-version) )) +;;====================================================================== +;; T E S T S P E C I F I C D B +;;====================================================================== + ;; Create the sqlite db for the individual test(s) (define (open-test-db testpath) (if (and (directory? testpath) (file-read-access? testpath)) (let* ((dbpath (conc testpath "/testdat.db")) @@ -287,10 +291,35 @@ id INTEGER PRIMARY KEY, var TEXT, val TEXT, ackstate INTEGER DEFAULT 0, CONSTRAINT metadat_constraint UNIQUE (var));"))) + +;;====================================================================== +;; L O G G I N G D B +;;====================================================================== + +(define (open-logging-db) ;; (conc *toppath* "/megatest.db") (car *configinfo*))) + (let* ((dbpath (conc (if *toppath* (conc *toppath* "/") "") "logging.db")) ;; fname) + (dbexists (file-exists? dbpath)) + (db (sqlite3:open-database dbpath)) ;; (never-give-up-open-db dbpath)) + (handler (make-busy-timeout (if (args:get-arg "-override-timeout") + (string->number (args:get-arg "-override-timeout")) + 36000)))) ;; 136000))) + (sqlite3:set-busy-handler! db handler) + (if (not dbexists) + (begin + (sqlite3:execute db "CREATE TABLE IF NOT EXISTS log (id INTEGER PRIMARY KEY,event_time TIMESTAMP DEFAULT (strftime('%s','now')),logline TEXT);") + (sqlite3:execute db (conc "PRAGMA synchronous = 0;")))) + db)) + +(define (db:log-event . loglst) + (let ((db (open-logging-db)) + (logline (apply conc loglst))) + (sqlite3:execute db "INSERT INTO log (logline) VALUES (?);" logline) + (sqlite3:finalize! db) + logline)) ;;====================================================================== ;; TODO: ;; put deltas into an assoc list with version numbers ;; apply all from last to current Index: launch.scm ================================================================== --- launch.scm +++ launch.scm @@ -605,15 +605,15 @@ (list "MT_ITEM_INFO" (conc itemdat)) (list "MT_RUNNAME" runname) (list "MT_TARGET" mt_target) ) itemdat))) - (launch-results (apply cmd-run-proc-each-line + (launch-results (apply cmd-run-with-stderr->list ;; cmd-run-proc-each-line (if useshell (string-intersperse fullcmd " ") (car fullcmd)) - print + ;; conc (if useshell '() (cdr fullcmd))))) ;; launcher fullcmd)));; (apply cmd-run-proc-each-line launcher print fullcmd))) ;; (cmd-run->list fullcmd)) (with-output-to-file "mt_launch.log" (lambda () Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -96,10 +96,12 @@ -setvars VAR1=val1,VAR2=val2 : Add environment variables to a run NB// these are overwritten by values set in config files. -server -|hostname : start the server (reduces contention on megatest.db), use - to automatically figure out hostname -repl : start a repl (useful for extending megatest) + -debug N : increase verbosity to N. (try 10 for lots of noise) + -logging : turn on logging all debug output to logging.db Spreadsheet generation -extract-ods fname.ods : extract an open document spreadsheet from the database -pathmod path : insert path, i.e. path/runame/itempath/logfile.html will clear the field if no rundir/testname/itempath/logfile @@ -190,10 +192,11 @@ "-update-meta" "-gen-megatest-area" "-v" ;; verbose 2, more than normal (normal is 1) "-q" ;; quiet 0, errors/warnings only + "-logging" ) args:arg-hash 0)) (if (args:get-arg "-h") @@ -215,10 +218,12 @@ (if (not (number? *verbosity*)) (begin (print "ERROR: Invalid debug value " (args:get-arg "-debug")) (exit))) + +(if (args:get-arg "-logging")(set! *logging* #t)) ;;====================================================================== ;; Misc general calls ;;====================================================================== Index: process.scm ================================================================== --- process.scm +++ process.scm @@ -13,10 +13,41 @@ ;; Process convience utils ;;====================================================================== (declare (unit process)) (declare (uses common)) + +(define (conservative-read port) + (let loop ((res "")) + (if (not (eof-object? (peek-char port))) + (loop (conc res (read-char port))) + res))) + +(define (cmd-run-with-stderr->list cmd . params) + ;; (print "Called with cmd=" cmd ", proc=" proc ", params=" params) +;; (handle-exceptions +;; exn +;; (begin +;; (print "ERROR: Failed to run command: " cmd " " (string-intersperse params " ")) +;; (print " " ((condition-property-accessor 'exn 'message) exn)) +;; #f) + (let-values (((fh fho pid fhe) (if (null? params) + (process* cmd) + (process* cmd params)))) + (let loop ((curr (read-line fh)) + (result '())) + (let ((errstr (conservative-read fhe))) + (if (not (string=? errstr "")) + (set! result (append result (list errstr))))) + (if (not (eof-object? curr)) + (loop (read-line fh) + (append result (list curr))) + (begin + (close-input-port fh) + (close-input-port fhe) + (close-output-port fho) + result))))) ;; ) (define (cmd-run-proc-each-line cmd proc . params) ;; (print "Called with cmd=" cmd ", proc=" proc ", params=" params) (handle-exceptions exn @@ -24,17 +55,18 @@ (print "ERROR: Failed to run command: " cmd " " (string-intersperse params " ")) #f) (let-values (((fh fho pid) (if (null? params) (process cmd) (process cmd params)))) - (let loop ((curr (read-line fh)) + (let loop ((curr (read-line fh)) (result '())) (if (not (eof-object? curr)) (loop (read-line fh) (append result (list (proc curr)))) (begin (close-input-port fh) + (close-input-port fhe) (close-output-port fho) result)))))) (define (cmd-run-proc-each-line-alt cmd proc) (let* ((fh (open-input-pipe cmd)) Index: server.scm ================================================================== --- server.scm +++ server.scm @@ -53,10 +53,11 @@ hostn)) (ipaddrstr (if (string=? "-" hostn) (string-intersperse (map number->string (u8vector->list (hostname->ip hostname))) ".") #f)) (host:port (conc (if ipaddrstr ipaddrstr hostname) ":" (rpc:default-server-port)))) + (debug:print 0 "Server started on " host:port) (db:set-var db "SERVER" host:port) (set! *cache-on* #t) ;; can use this to run most anything at the remote (rpc:publish-procedure! @@ -136,11 +137,11 @@ (begin (debug:print 0 "INFO: Queue not flushed, waiting ...") (loop (+ n 1))))) ))) (thread-start! th1) - (debug:print 0 "Server started...") + ;; (debug:print 0 "Server started on port " (rpc:default-server-port) "...") (thread-start! th2) ;; (thread-join! th2) ;; return th2 for the calling process to do a join with th2 )))) ;; rpc:server))) @@ -149,33 +150,34 @@ ;; if none running or if > 20 seconds since ;; server last used then start shutdown (let loop ((count 0)) (thread-sleep! 20) ;; no need to do this very often (let ((numrunning (db:get-count-tests-running db))) - (if (or (not (> numrunning 0)) - (> *last-db-access* (+ (current-seconds) 60))) + (if (or (> numrunning 0) + (> (+ *last-db-access* 60)(current-seconds))) + (begin + (debug:print 0 "INFO: Server continuing, tests running: " numrunning ", seconds since last db access: " (- (current-seconds) *last-db-access*)) + (loop (+ 1 count))) (begin (debug:print 0 "INFO: Starting to shutdown the server side") ;; need to delete only *my* server entry (future use) (sqlite3:execute db "DELETE FROM metadat WHERE var='SERVER' AND val like ?;" host:port) (thread-sleep! 10) (debug:print 0 "INFO: Max cached queries was " *max-cache-size*) (debug:print 0 "INFO: Server shutdown complete. Exiting") - (exit)) - (debug:print 0 "INFO: Server continuing, tests running: " numrunning ", seconds since last db access: " (- (current-seconds) *last-db-access*)) - )) - (loop (+ 1 count)))) + ;; (exit))) + ))))) (define (server:find-free-port-and-open port) (handle-exceptions exn (begin (print "Failed to bind to port " (rpc:default-server-port) ", trying next port") (server:find-free-port-and-open (+ port 1))) (rpc:default-server-port port) - (tcp-read-timeout 120000) - (tcp-listen (rpc:default-server-port) ))) + (tcp-read-timeout 240000) + (tcp-listen (rpc:default-server-port) 10000))) (define (server:client-setup) (if *runremote* (begin (debug:print 0 "ERROR: Attempt to connect to server but already connected") @@ -199,12 +201,12 @@ ;; #f) (set! *runremote* #f)) (if (and (not (args:get-arg "-server")) ;; no point in the server using the server using the server ((rpc:procedure 'server:login host portn) *toppath*)) (begin - (debug:print 2 "INFO: Connected to " host ":" port) + (debug:print 2 "INFO: Logged in and connected to " host ":" port) (set! *runremote* (vector host portn))) (begin - (debug:print 2 "INFO: Failed to connect to " host ":" port) + (debug:print 2 "INFO: Failed to login or connect to " host ":" port) (set! *runremote* #f))))) (debug:print 2 "INFO: no server available"))))) Index: tests/Makefile ================================================================== --- tests/Makefile +++ tests/Makefile @@ -24,38 +24,39 @@ test3 : fullprep cd fullrun;$(MEGATEST) -runtests runfirst -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_b $(SERVER) -debug 10 test4 : fullprep cd fullrun;$(MEGATEST) $(SERVER) & - cd fullrun;sleep 5;$(MEGATEST) -debug $(DEBUG) -runall -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_b -m "This is a comment specific to a run" -v + cd fullrun;sleep 5;$(MEGATEST) -debug $(DEBUG) -runall -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_b -m "This is a comment specific to a run" -v -logging # NOTE: Only one instance can be a server test5 : fullprep cd fullrun;$(MEGATEST) $(SERVER) & - cd fullrun;sleep 10;$(MEGATEST) -runall -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_aa -debug $(DEBUG) > aa.log 2> aa.log & - cd fullrun;sleep 10;$(MEGATEST) -runall -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_ab -debug $(DEBUG) > ab.log 2> ab.log & - cd fullrun;sleep 10;$(MEGATEST) -runall -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_ac -debug $(DEBUG) > ac.log 2> ac.log & - cd fullrun;sleep 10;$(MEGATEST) -runall -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_ad -debug $(DEBUG) > ad.log 2> ad.log & -# cd fullrun;sleep 10;$(MEGATEST) -runall -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_ae -debug $(DEBUG) > ae.log 2> ae.log & -# cd fullrun;sleep 10;$(MEGATEST) -runall -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_af -debug $(DEBUG) > af.log 2> af.log & + cd fullrun;sleep 10;$(MEGATEST) -runall -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_aa -debug $(DEBUG) -logging > aa.log 2> aa.log & + cd fullrun;sleep 10;$(MEGATEST) -runall -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_ab -debug $(DEBUG) -logging > ab.log 2> ab.log & + cd fullrun;sleep 10;$(MEGATEST) -runall -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_ac -debug $(DEBUG) -logging > ac.log 2> ac.log & + cd fullrun;sleep 10;$(MEGATEST) -runall -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_ad -debug $(DEBUG) -logging > ad.log 2> ad.log & +# cd fullrun;sleep 10;$(MEGATEST) -runall -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_ae -debug $(DEBUG) -logging > ae.log 2> ae.log & +# cd fullrun;sleep 10;$(MEGATEST) -runall -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_af -debug $(DEBUG) -logging > af.log 2> af.log & test6: fullprep cd fullrun;$(MEGATEST) -runtests runfirst -itempatt %/1 -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_itempatt -v cd fullrun;$(MEGATEST) -runtests runfirst -itempatt %blahha% -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_itempatt -debug 10 cleanprep : ../*.scm Makefile */*.config # if [ -e fullrun/megatest.db ]; then sqlite3 fullrun/megatest.db "delete from metadat where var='SERVER';";fi mkdir -p /tmp/mt_runs /tmp/mt_links cd ..;make install + rm -f fullrun/logging.db touch cleanprep fullprep : cleanprep cd fullrun;$(MEGATEST) -remove-runs :runname $(RUNNAME)% -target %/%/% -testpatt % -itempatt % cd fullrun;$(BINPATH)/dboard -rows 15 & dashboard : cleanprep - cd fullrun && $(BINPATH)/dboard & + cd fullrun && $(BINPATH)/dashboard -rows 25 & remove : cd fullrun;$(MEGATEST) -remove-runs :runname $(RUN) -testpatt % -itempatt % :sysname % :fsname % :datapath % clean : Index: tests/fullrun/tests/priority_3/main.sh ================================================================== --- tests/fullrun/tests/priority_3/main.sh +++ tests/fullrun/tests/priority_3/main.sh @@ -4,7 +4,16 @@ for i in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17;do $MT_MEGATEST -step step$i :state start :status running -setlog results$i.html sleep 2 $MT_MEGATEST -step step$i :state end :status 0 done + +# get a previous test +export EZFAILPATH=`$MT_MEGATEST -test-files envfile.txt -target $MT_TARGET :runname $MT_RUNNAME -testpatt ez_fail` +if [[ -e $EZFAILPATH ]];then + echo All good! +else + echo NOT good! + exit 1 +fi exit 0 Index: tests/tests.scm ================================================================== --- tests/tests.scm +++ tests/tests.scm @@ -1,6 +1,7 @@ (require-extension test) +(require-extension regex) (define test-work-dir (current-directory)) ;; read in all the _record files (let ((files (glob "*_records.scm"))) @@ -7,10 +8,22 @@ (for-each (lambda (file) (print "Loading " file) (load file)) files)) + +;;====================================================================== +;; P R O C E S S E S +;;====================================================================== + +(test "cmd-run-with-stderr->list" '("No such file or directory") + (let ((reslst (cmd-run-with-stderr->list "ls" "/tmp/ihadbetternotexist"))) + (string-search (regexp "No such file or directory")(car reslst)))) + +;;====================================================================== +;; C O N F I G F I L E S +;;====================================================================== (define conffile #f) (test "Read a config" #t (hash-table? (read-config "test.config" #f #f))) (test "Read a config that doesn't exist" #t (hash-table? (read-config "nada.config" #f #f))) Index: utils/installall.sh ================================================================== --- utils/installall.sh +++ utils/installall.sh @@ -9,14 +9,23 @@ # implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR # PURPOSE. echo You may need to do the following first: echo sudo apt-get install libreadline-dev +echo sudo apt-get install libwebkitgtk-dev echo sudo apt-get install libmotif3 -OR- set KTYPE=26g4 -echo KTYPE can be 26 or 26g4 +echo KTYPE can be 26, 26g4, or 32 +echo KTYPE=$KTYPE echo You are using PREFIX=$PREFIX echo You are using proxy="$proxy" +echo +echo "Set additional_libpath to help find gtk or other libraries, don't forget a leading :" +echo ADDITIONAL_LIBPATH=$ADDITIONAL_LIBPATH +echo +echo To use previous IUP libraries set USEOLDIUP to yes +echo USEOLDIUP=$USEOLDIUP + echo Hit ^C now to do that # A nice way to run this script: # # script -c 'PREFIX=/tmp/delme ./installall.sh ' installall.log @@ -38,13 +47,13 @@ export KTYPE=26 else echo Using KTYPE=$KTYPE fi -export CHICKEN_VERSION=4.7.3 +export CHICKEN_VERSION=4.8.0 if ! [[ -e chicken-${CHICKEN_VERSION}.tar.gz ]]; then - wget http://code.call-cc.org/dev-snapshots/2011/08/17/chicken-${CHICKEN_VERSION}.tar.gz + wget http://code.call-cc.org/releases/${CHICKEN_VERSION}/chicken-${CHICKEN_VERSION}.tar.gz fi BUILDHOME=$PWD if [[ $PREFIX == "" ]]; then PREFIX=$PWD/inst @@ -64,40 +73,56 @@ make PLATFORM=linux PREFIX=$PREFIX make PLATFORM=linux PREFIX=$PREFIX install cd $BUILDHOME fi -for f in readline apropos base64 regex-literals format regex-case test coops trace csv dot-locking posix-utils directory-utils hostinfo; do - chicken-install $PROX $f +# Some eggs are quoted since they are reserved to Bash +for f in readline apropos base64 regex-literals format "regex-case" "test" coops trace csv dot-locking posix-utils posix-extras directory-utils hostinfo tcp rpc csv-xml fmt ; do + if ! [[ -e $PREFIX/lib/chicken/6/$f.so ]];then + chicken-install $PROX $f + else + echo Skipping install of egg $f as it is already installed + fi done cd $BUILDHOME for a in `ls */*.meta|cut -f1 -d/` ; do echo $a (cd $a;chicken-install) done +export LIBPATH=$PREFIX/lib$ADDITIONAL_LIBPATH +export LD_LIBRARY_PATH=$LIBPATH + +export SQLITE3_VERSION=3071401 echo Install sqlite3 -if ! [[ -e sqlite-autoconf-3070500.tar.gz ]]; then - wget http://www.sqlite.org/sqlite-autoconf-3070500.tar.gz +if ! [[ -e sqlite-autoconf-$SQLITE3_VERSION.tar.gz ]]; then + wget http://www.sqlite.org/sqlite-autoconf-$SQLITE3_VERSION.tar.gz fi if ! [[ -e $PREFIX/bin/sqlite3 ]] ; then - if [[ -e sqlite-autoconf-3070500.tar.gz ]]; then - tar xfz sqlite-autoconf-3070500.tar.gz - (cd sqlite-autoconf-3070500;./configure --prefix=$PREFIX;make;make install) + if [[ -e sqlite-autoconf-$SQLITE3_VERSION.tar.gz ]]; then + tar xfz sqlite-autoconf-$SQLITE3_VERSION.tar.gz + (cd sqlite-autoconf-$SQLITE3_VERSION;./configure --prefix=$PREFIX;make;make install) CSC_OPTIONS="-I$PREFIX/include -L$PREFIX/lib" chicken-install $PROX sqlite3 fi fi chicken-install $PROX sqlite3 if [[ `uname -a | grep x86_64` == "" ]]; then - export files="cd-5.4.1_Linux${KTYPE}_lib.tar.gz im-3.6.3_Linux${KTYPE}_lib.tar.gz iup-3.5_Linux${KTYPE}_lib.tar.gz" + export ARCHSIZE='' +else + export ARCHSIZE=64_ +fi + # export files="cd-5.4.1_Linux${KTYPE}_lib.tar.gz im-3.6.3_Linux${KTYPE}_lib.tar.gz iup-3.5_Linux${KTYPE}_lib.tar.gz" +if [[ x$USEOLDIUP == "x" ]];then + export files="cd-5.5.1_Linux${KTYPE}_${ARCHSIZE}lib.tar.gz im-3.8_Linux${KTYPE}_${ARCHSIZE}lib.tar.gz iup-3.6_Linux${KTYPE}_${ARCHSIZE}lib.tar.gz" else - export files="cd-5.4.1_Linux${KTYPE}_64_lib.tar.gz im-3.6.3_Linux${KTYPE}_64_lib.tar.gz iup-3.5_Linux${KTYPE}_64_lib.tar.gz" + echo WARNING: Using old IUP libraries + export files="cd-5.4.1_Linux${KTYPE}_${ARCHSIZE}lib.tar.gz im-3.6.3_Linux${KTYPE}_${ARCHSIZE}lib.tar.gz iup-3.5_Linux${KTYPE}_${ARCHSIZE}lib.tar.gz" fi mkdir $PREFIX/iuplib for a in `echo $files` ; do if ! [[ -e $a ]] ; then @@ -120,11 +145,11 @@ make make install cd $BUILDHOME -export LIBPATH=$PREFIX/lib +export LIBPATH=$PREFIX/lib$ADDITIONAL_LIBPATH export LD_LIBRARY_PATH=$LIBPATH CSC_OPTIONS="-I$PREFIX/include -L$LIBPATH" chicken-install $PROX -D no-library-checks iup CSC_OPTIONS="-I$PREFIX/include -L$LIBPATH" chicken-install $PROX -D no-library-checks canvas-draw # export CD_REL=d704525ebe1c6d08