Megatest

Check-in [49f93afd9b]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Make rpc vs. normal calls more consistent
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | rpc-db-access
Files: files | file ages | folders
SHA1: 49f93afd9b9fac24c66b89fb6862eca0f5700be4
User & Date: mrwellan on 2012-10-08 18:17:44
Other Links: branch diff | manifest | tags
Context
2012-10-08
18:53
Force cache off for now check-in: 07dd812d1e user: matt tags: rpc-db-access
18:17
Make rpc vs. normal calls more consistent check-in: 49f93afd9b user: mrwellan tags: rpc-db-access
15:53
tweaked-installall.sh check-in: 71b201eb77 user: mrwellan tags: rpc-db-access
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified db.scm from [378f0551a1] to [8b953ea457].

︙
1100
1101
1102
1103
1104
1105
1106
1107

1108
1109
1110
1111
1112
1113
1114

1100
1101
1102
1103
1104
1105
1106

1107
1108
1109
1110
1111
1112
1113
1114








-
+








				      (list fail-count pass-count test-id))
			      *incoming-data*))
  (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*)
    (set! *last-db-access* (current-seconds))
    (set! *incoming-data* (cons (vector 'register-test
︙
1692
1693
1694
1695
1696
1697
1698
1699

1700
1701
1702
1703
1704


1705
1706
1707
1708
1709
1710
1711
1712

1692
1693
1694
1695
1696
1697
1698

1699
1700
1701
1702


1703
1704
1705
1706
1707
1708
1709
1710
1711
1712








-
+



-
-
+
+









  (if *runremote*
      (let ((host (vector-ref *runremote* 0))
	    (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)))

Modified megatest.scm from [a442c44f02] to [93098233a8].

︙
353
354
355
356
357
358
359
360


361
362
363
364
365
366
367

353
354
355
356
357
358
359

360
361
362
363
364
365
366
367
368








-
+
+








      (debug:print 0 "INFO: Starting the standalone server")
      (if db 
	  (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
;;======================================================================

;; get lock in db for full run for this directory
︙

Modified runs.scm from [260a499583] to [0beb742b48].

︙
400
401
402
403
404
405
406
407



408
409
410
411
412
413
414

400
401
402
403
404
405
406

407
408
409
410
411
412
413
414
415
416








-
+
+
+








		  ;; else the run is stuck, temporarily or permanently
		  ;; but should check if it is due to lack of resources vs. prerequisites
		  (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*))
		  (debug:print 1 "INFO: no resources to run new tests, waiting ...")
		  ;; could have done hed tal here but doing car/cdr of newtal to rotate tests
︙
612
613
614
615
616
617
618
619



620
621
622
623
624
625
626

614
615
616
617
618
619
620

621
622
623
624
625
626
627
628
629
630








-
+
+
+








	    ;;
	    ;; NB// for the above line. I want the test to be registered long before this routine gets called!
	    ;;
	    (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)
      (case (if force ;; (args:get-arg "-force")
		'NOT_STARTED
︙
677
678
679
680
681
682
683
684



685
686
687
688
689
690
691

681
682
683
684
685
686
687

688
689
690
691
692
693
694
695
696
697








-
+
+
+








	 (debug:print 1 "NOTE: " new-test-name " is already running or was explictly killed, use -force to launch it."))
	((LAUNCHED REMOTEHOSTSTART RUNNING)  
	 (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
;;======================================================================
︙
821
822
823
824
825
826
827
828
829
830




831
832
833
834
835
836
837

827
828
829
830
831
832
833



834
835
836
837
838
839
840
841
842
843
844








-
-
-
+
+
+
+








	    (keys #f))
	(if (not (setup-for-run))
	    (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))) 
	      (if (hash-table-ref/default runconfig (args:get-arg "-reqtarg") #f)
		  (keys:target-set-args keys (args:get-arg "-reqtarg") args:arg-hash)
︙

Modified utils/installall.sh from [fe7152b76e] to [84cb446680].

︙
56
57
58
59
60
61
62
63
64
65




66
67
68
69
70
71
72

56
57
58
59
60
61
62



63
64
65
66
67
68
69
70
71
72
73








-
-
-
+
+
+
+









BUILDHOME=$PWD
if [[ $PREFIX == "" ]]; then
   PREFIX=$PWD/inst
fi

export PATH=$PREFIX/bin:$PATH
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
export LIBPATH=$PREFIX/lib$ADDITIONAL_LIBPATH
export LD_LIBRARY_PATH=$LIBPATH
echo "export PATH=$PREFIX/bin:\$PATH" > 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
    tar xfvz chicken-${CHICKEN_VERSION}.tar.gz
    cd chicken-${CHICKEN_VERSION}
︙
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102

88
89
90
91
92
93
94


95
96
97
98
99
100
101








-
-








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-$SQLITE3_VERSION.tar.gz ]]; then
    wget http://www.sqlite.org/sqlite-autoconf-$SQLITE3_VERSION.tar.gz
fi
︙
144
145
146
147
148
149
150
151
152
153
154



155
156
157
158
159
160
161
162
163
164
165
166
167

143
144
145
146
147
148
149




150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165








-
-
-
-
+
+
+














cd ffcall
./configure --prefix=$PREFIX --enable-shared
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
# 
# unzip -o Canvas_Draw-$CD_REL.zip
# 
# cd "Canvas Draw-$CD_REL/chicken"
# CSC_OPTIONS="-I$PREFIX/include -L$LIBPATH" chicken-install $PROX -D no-library-checks

echo You may need to add $LD_LIBRARY_PATH to your LD_LIBRARY_PATH variable, a setup-chicken4x.sh 
echo file can be found in the current directory which should work for setting up to run chicken4x

This page was generated in about 0.116s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00