Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -1102,11 +1102,11 @@ (mutex-unlock! *incoming-mutex*) (if *cache-on* (debug:print 6 "INFO: *cache-on* is " *cache-on* ", skipping cache write") (db:write-cached-data))) -(define (cdb:tests-register-test db run-id test-name item-path #!key (force-write #f)) +(define (cdb:tests-register-test run-id test-name item-path #!key (force-write #f)) (let ((item-paths (if (equal? item-path "") (list item-path) (list item-path "")))) (debug:print 4 "INFO: Adding " run-id ", " test-name "/" item-path " for setting pass/fail counts to the queue") (mutex-lock! *incoming-mutex*) @@ -1694,19 +1694,19 @@ (port (vector-ref *runremote* 1))) ((rpc:procedure 'cdb:pass-fail-counts host port) test-id fail-count pass-count)) (cdb:pass-fail-counts test-id fail-count pass-count))) ;; currently forces a flush of the queue -(define (rdb:tests-register-test db run-id test-name item-path) +(define (rdb:tests-register-test run-id test-name item-path) (if *runremote* (let ((host (vector-ref *runremote* 0)) (port (vector-ref *runremote* 1))) - ((rpc:procedure 'cdb:tests-register-test host port) db run-id test-name item-path force-write: #t)) - (cdb:tests-register-test db run-id test-name item-path force-write: #t))) + ((rpc:procedure 'cdb:tests-register-test host port) run-id test-name item-path force-write: #t)) + (cdb:tests-register-test run-id test-name item-path force-write: #t))) (define (rdb:flush-queue) (if *runremote* (let ((host (vector-ref *runremote* 0)) (port (vector-ref *runremote* 1))) ((rpc:procedure 'cdb:flush-queue host port))) (cdb:flush-queue))) Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -355,11 +355,12 @@ (let* ((host:port (db:get-var db "SERVER")) ;; this doen't support multiple servers BUG!!!! (th2 (server:start db (args:get-arg "-server"))) (th3 (make-thread (lambda () (server:keep-running db host:port))))) (thread-start! th3) - (thread-join! th3)) + (thread-join! th3) + (set! *didsomethings* #t)) (debug:print 0 "ERROR: Failed to setup for megatest")))) ;;====================================================================== ;; full run ;;====================================================================== Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -402,11 +402,13 @@ (debug:print 1 "INFO: Skipping " (tests:testqueue-get-testname test-record) " " item-path " as it doesn't match " item-patts) (thread-sleep! *global-delta*) (if (not (null? tal)) (loop (car tal)(cdr tal) reruns))) ((not (hash-table-ref/default test-registery (runs:make-full-test-name test-name item-path) #f)) - (open-run-close db:tests-register-test #f run-id test-name item-path) + ;; (open-run-close db:tests-register-test #f run-id test-name item-path) + (rdb:tests-register-test run-id test-name item-path) + (rdb:flush-queue) (hash-table-set! test-registery (runs:make-full-test-name test-name item-path) #t) (thread-sleep! *global-delta*) (loop (car newtal)(cdr newtal) reruns)) ((not have-resources) ;; simply try again after waiting a second (thread-sleep! (+ 1 *global-delta*)) @@ -614,11 +616,13 @@ ;; (set! test-id (open-run-close db:get-test-id db run-id test-name item-path)) (if (not test-id) (begin (debug:print 2 "WARN: Test not pre-created? test-name=" test-name ", item-path=" item-path ", run-id=" run-id) - (open-run-close db:tests-register-test #f run-id test-name item-path) + ;; (open-run-close db:tests-register-test #f run-id test-name item-path) + (rdb:tests-register-test run-id test-name item-path) + (rdb:flush-queue) (set! test-id (open-run-close db:get-test-id db run-id test-name item-path)))) (debug:print 4 "INFO: test-id=" test-id ", run-id=" run-id ", test-name=" test-name ", item-path=\"" item-path "\"") (set! testdat (open-run-close db:get-test-info-by-id db test-id)))) (set! test-id (db:test-get-id testdat)) (change-directory test-path) @@ -679,11 +683,13 @@ (if (> (- (current-seconds)(+ (db:test-get-event_time testdat) (db:test-get-run_duration testdat))) 600) ;; i.e. no update for more than 600 seconds (begin (debug:print 0 "WARNING: Test " test-name " appears to be dead. Forcing it to state INCOMPLETE and status STUCK/DEAD") - (tests:test-set-status! test-id "INCOMPLETE" "STUCK/DEAD" "Test is stuck or dead" #f)) + (tests:test-set-status! test-id "INCOMPLETE" "STUCK/DEAD" "Test is stuck or dead" #f) + ;; (rdb:flush-queue) + ) (debug:print 2 "NOTE: " test-name " is already running"))) (else (debug:print 0 "ERROR: Failed to launch test " new-test-name ". Unrecognised state " (test:get-state testdat))))))) ;;====================================================================== ;; END OF NEW STUFF @@ -823,13 +829,14 @@ (begin (debug:print 0 "Failed to setup, exiting") (exit 1))) (if (args:get-arg "-server") (open-run-close server:start db (args:get-arg "-server")) - (if (not (or (args:get-arg "-runall") ;; runall and runtests are allowed to be servers - (args:get-arg "-runtests"))) - (server:client-setup))) + ;;(if (not (or (args:get-arg "-runall") ;; runall and runtests are allowed to be servers + ;; (args:get-arg "-runtests"))) + (server:client-setup)) + ;; ) (set! keys (open-run-close db:get-keys db)) ;; have enough to process -target or -reqtarg here (if (args:get-arg "-reqtarg") (let* ((runconfigf (conc *toppath* "/runconfigs.config")) ;; DO NOT EVALUATE ALL (runconfig (read-config runconfigf #f #f environ-patt: #f))) Index: utils/installall.sh ================================================================== --- utils/installall.sh +++ utils/installall.sh @@ -58,13 +58,14 @@ if [[ $PREFIX == "" ]]; then PREFIX=$PWD/inst fi export PATH=$PREFIX/bin:$PATH +export LIBPATH=$PREFIX/lib$ADDITIONAL_LIBPATH +export LD_LIBRARY_PATH=$LIBPATH echo "export PATH=$PREFIX/bin:\$PATH" > setup-chicken4x.sh -export LD_LIBRARY_PATH=$PREFIX/lib -echo "export LD_LIBRARY_PATH=$PREFIX/lib" >> setup-chicken4x.sh +echo "export LD_LIBRARY_PATH=$LD_LIBRARY_PATH" >> setup-chicken4x.sh echo PATH=$PATH echo LD_LIBRARY_PATH=$LD_LIBRARY_PATH if ! [[ -e $PREFIX/bin/csi ]]; then @@ -89,12 +90,10 @@ 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-$SQLITE3_VERSION.tar.gz ]]; then wget http://www.sqlite.org/sqlite-autoconf-$SQLITE3_VERSION.tar.gz @@ -146,14 +145,13 @@ make make install cd $BUILDHOME -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 CSCLIBS=`echo $LD_LIBRARY_PATH | sed 's/:/ -L/g'` +CSC_OPTIONS="-I$PREFIX/include -L$CSCLIBS" chicken-install $PROX -D no-library-checks iup +CSC_OPTIONS="-I$PREFIX/include -L$CSCLIBS" chicken-install $PROX -D no-library-checks canvas-draw # export CD_REL=d704525ebe1c6d08 # if ! [[ -e Canvas_Draw-$CD_REL.zip ]]; then # wget http://www.kiatoa.com/matt/iup/Canvas_Draw-$CD_REL.zip # fi