Megatest

Check-in [76a411e422]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Partial implementation of threaded remote db calls
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | threaded-db-calls
Files: files | file ages | folders
SHA1: 76a411e4226a88916c384fdae9f79748c087b1f2
User & Date: mrwellan on 2013-04-26 18:05:48
Other Links: branch diff | manifest | tags
Context
2013-04-27
00:16
threaded-db-calls working check-in: fb4ad2ea7e user: matt tags: threaded-db-calls
2013-04-26
18:05
Partial implementation of threaded remote db calls check-in: 76a411e422 user: mrwellan tags: threaded-db-calls
2013-04-25
17:17
Turned off zmq for now (missed one use statement) check-in: c56c1a4a3e user: mrwellan tags: v1.54
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified db.scm from [f8730e944b] to [3229f18e05].

︙
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727

699
700
701
702
703
704
705















706
707
708
709
710
711
712








-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








	  (hash-table-set! *target* run-id thekey)
	  thekey))))

;;======================================================================
;;  T E S T S
;;======================================================================

(define (db:tests-register-test db run-id test-name item-path)
  (debug:print-info 11 "db:tests-register-test START db=" db ", run-id=" run-id ", test-name=" test-name ", item-path=\"" item-path "\"")
  (let ((item-paths (if (equal? item-path "")
			(list item-path)
			(list item-path ""))))
    (for-each 
     (lambda (pth)
       (sqlite3:execute db "INSERT OR IGNORE INTO tests (run_id,testname,event_time,item_path,state,status) VALUES (?,?,strftime('%s','now'),?,'NOT_STARTED','n/a');" 
			run-id 
			test-name
			pth))
     item-paths)
  (debug:print-info 11 "db:tests-register-test END db=" db ", run-id=" run-id ", test-name=" test-name ", item-path=\"" item-path "\"")
    #f))

;; states and statuses are lists, turn them into ("PASS","FAIL"...) and use NOT IN
;; i.e. these lists define what to NOT show.
;; states and statuses are required to be lists, empty is ok
;; not-in #t = above behaviour, #f = must match
(define (db:get-tests-for-run db run-id testpatt states statuses 
			      #!key (not-in #t)
			      (sort-by #f) ;; 'rundir 'event_time
︙
1267
1268
1269
1270
1271
1272
1273

1274


1275
1276
1277
1278
1279
1280
1281

1252
1253
1254
1255
1256
1257
1258
1259

1260
1261
1262
1263
1264
1265
1266
1267
1268








+
-
+
+








(define (cdb:pass-fail-counts serverdat test-id fail-count pass-count)
  (cdb:client-call serverdat 'pass-fail-counts #t *default-numtries* fail-count pass-count test-id))

(define (cdb:tests-register-test serverdat run-id test-name item-path)
  (let ((item-paths (if (equal? item-path "")
			(list item-path)
			(list item-path ""))))
    (for-each (lambda (pth)
    (cdb:client-call serverdat 'register-test #t *default-numtries* run-id test-name item-path)))
		(cdb:client-call serverdat 'register-test #t *default-numtries* run-id test-name pth))
	      item-paths)))

(define (cdb:flush-queue serverdat)
  (cdb:client-call serverdat 'flush #f *default-numtries*))

(define (cdb:kill-server serverdat)
  (cdb:client-call serverdat 'killserver #t *default-numtries*))
︙
1301
1302
1303
1304
1305
1306
1307




1308
1309
1310
1311
1312
1313
1314

1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305








+
+
+
+








       (if (directory? path)
	   (debug:print 2 "Found path: " path)
	   (debug:print 2 "No such path: " path)))
     db
     "SELECT rundir,final_logf FROM tests WHERE run_id=? AND testname=? AND item_path='';"
     run-id test-name)
    res))

;;======================================================================
;; A G R E G A T E D   T R A N S A C T I O N   D B   W R I T E S 
;;======================================================================

(define db:queries 
  (list '(register-test          "INSERT OR IGNORE INTO tests (run_id,testname,event_time,item_path,state,status) VALUES (?,?,strftime('%s','now'),?,'NOT_STARTED','n/a');")
	'(state-status           "UPDATE tests SET state=?,status=? WHERE id=?;")
	'(state-status-msg       "UPDATE tests SET state=?,status=?,comment=? WHERE id=?;")
	'(pass-fail-counts       "UPDATE tests SET fail_count=?,pass_count=? WHERE id=?;")
	;; test_data-pf-rollup is used to set a tests PASS/FAIL based on the pass/fail info from the steps
︙

Modified megatest.scm from [c9058ed68c] to [5c2d1bb47e].

︙
29
30
31
32
33
34
35
36
37
38





39
40
41
42
43
44
45

29
30
31
32
33
34
35



36
37
38
39
40
41
42
43
44
45
46
47








-
-
-
+
+
+
+
+








(define *db* #f) ;; this is only for the repl, do not use in general!!!!

(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
(include "megatest-fossil-hash.scm")

;; (use trace dot-locking)
;; (trace
;;  cdb:client-call
(use trace dot-locking)
(trace
 cdb:tests-register-test
 cdb:client-call
)
;;  cdb:remote-run
;;  cdb:test-set-status-state
;;  change-directory
;;  db:process-queue-item
;;  db:test-get-logfile-info
;;  db:teststep-set-status!
;;  nice-path
︙

Modified runs.scm from [f136285a97] to [3512dace32].

︙
362
363
364
365
366
367
368

369
370
371
372
373
374
375

362
363
364
365
366
367
368
369
370
371
372
373
374
375
376








+








;; test-records is a hash table testname:item_path => vector < testname testconfig waitons priority items-info ... >
(define (runs:run-tests-queue run-id runname test-records keyvallst flags test-patts)
    ;; At this point the list of parent tests is expanded 
    ;; NB// Should expand items here and then insert into the run queue.
  (debug:print 5 "test-records: " test-records ", keyvallst: " keyvallst " flags: " (hash-table->alist flags))
  (let ((sorted-test-names (tests:sort-by-priority-and-waiton test-records))
	(test-registery    (make-hash-table))
	(registery-mutex   (make-mutex))
	(num-retries        0)
	(max-retries       (config-lookup *configdat* "setup" "maxretries")))
    (set! max-retries (if (and max-retries (string->number max-retries))(string->number max-retries) 100))
    (if (not (null? sorted-test-names))
	(let loop ((hed         (car sorted-test-names))
		   (tal         (cdr sorted-test-names))
		   (reruns      '()))
︙
433
434
435
436
437
438
439


440
441





442
443






444
445







446
447
448
449
450
451
452

434
435
436
437
438
439
440
441
442


443
444
445
446
447

448
449
450
451
452
453
454


455
456
457
458
459
460
461
462
463
464
465
466
467
468








+
+
-
-
+
+
+
+
+
-

+
+
+
+
+
+
-
-
+
+
+
+
+
+
+








		 ((not (tests:match test-patts (tests:testqueue-get-testname test-record) item-path)) ;; This test/itempath is not to be run
		  ;; else the run is stuck, temporarily or permanently
		  ;; but should check if it is due to lack of resources vs. prerequisites
		  (debug:print-info 1 "Skipping " (tests:testqueue-get-testname test-record) " " item-path " as it doesn't match " test-patts)
		  ;; (thread-sleep! *global-delta*)
		  (if (not (null? tal))
		      (loop (car tal)(cdr tal) reruns)))
		 ;; Registery has been started for this test but has not yet completed
		 ;; this should be rare, the case where there are only a couple of tests and the db is slow
		 ( ;; (and
		  (not (hash-table-ref/default test-registery (runs:make-full-test-name test-name item-path) #f))
		 ;; delay a short while and continue
		 ((eq? (hash-table-ref/default test-registery (runs:make-full-test-name test-name item-path) #f) 'start)
		  (thread-sleep! 0.01)
		  (loop (car newtal)(cdr newtal) reruns))
		 ((not (hash-table-ref/default test-registery (runs:make-full-test-name test-name item-path) #f))
		      ;; (and max-concurrent-jobs (> (- max-concurrent-jobs num-running) 5)))
		  (debug:print-info 4 "Pre-registering test " test-name "/" item-path " to create placeholder" )
		  ;; NEED TO THREADIFY THIS
		  ;; (let ((th (make-thread (lambda ()
		  ;;       		   (print "Got here! AA")
		  ;;       		   (mutex-lock! registery-mutex)
		  ;;       		   (hash-table-set! test-registery (runs:make-full-test-name test-name item-path) 'start)
		  ;;       		   (mutex-unlock! registery-mutex)
		  (open-run-close db:tests-register-test #f run-id test-name item-path)
		  (hash-table-set! test-registery (runs:make-full-test-name test-name item-path) #t)
		         		   (cdb:tests-register-test #f run-id test-name item-path)
		  ;;       		   (print "Got here! AB")
		  ;;       		   (mutex-lock! registery-mutex)
		         		   (hash-table-set! test-registery (runs:make-full-test-name test-name item-path) 'done)
		  ;;       		   (mutex-unlock! registery-mutex))
		  ;;       		 (conc test-name "/" item-path))))
		  ;;   (thread-start! th))
		  ;; (thread-sleep! *global-delta*)
(runs:shrink-can-run-more-tests-delay)
		  (loop (car newtal)(cdr newtal) reruns))
		 ((not have-resources) ;; simply try again after waiting a second
		  (debug:print-info 1 "no resources to run new tests, waiting ...")
		  ;; (thread-sleep! (+ 2 *global-delta*))
		  ;; could have done hed tal here but doing car/cdr of newtal to rotate tests
︙
665
666
667
668
669
670
671
672

673
674
675
676
677
678
679

681
682
683
684
685
686
687

688
689
690
691
692
693
694
695








-
+








	    ;;
	    ;; 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)
		  (cdb:tests-register-test #f run-id test-name item-path)
		  (set! test-id (open-run-close db:get-test-id db run-id test-name item-path))))
	    (debug:print-info 4 "test-id=" test-id ", run-id=" run-id ", test-name=" test-name ", item-path=\"" item-path "\"")
	    (set! testdat (cdb:get-test-info-by-id *runremote* test-id))))
      (set! test-id (db:test-get-id testdat))
      (change-directory test-path)
      (case (if force ;; (args:get-arg "-force")
		'NOT_STARTED
︙

Modified tests/fdktestqa/testqa/tests/bigrun/step1.sh from [8c4fcc7255] to [38294e0788]. 

1

2





3

1
2

3
4
5
6
7
8


+
-
+
+
+
+
+


#!/bin/sh
if [ $NUMBER -lt 200 ];then 
sleep 10
   sleep $NUMBER
else
   sleep 200
fi

exit 0

Modified tests/fdktestqa/testqa/tests/bigrun/testconfig from [25b4432948] to [e67df4dda2]. 

1
2
3
4
5
6
7
8
9
10
11
12

13
14
15
16
17
18
19

1
2
3
4
5
6
7
8
9
10
11

12
13
14
15
16
17
18
19












-
+








# Add additional steps here. Format is "stepname script"
[ezsteps]
step1 step1.sh

# Test requirements are specified here
[requirements]
# waiton setup
priority 0

# Iteration for your tests are controlled by the items section
[items]
NUMBER #{scheme (string-intersperse (map number->string (sort (let loop ((a 0)(res '()))(if (< a 120)(loop (+ a 1)(cons a res)) res)) >)) " ")}
NUMBER #{scheme (string-intersperse (map number->string (sort (let loop ((a 0)(res '()))(if (< a 300)(loop (+ a 1)(cons a res)) res)) >)) " ")}

# test_meta is a section for storing additional data on your test
[test_meta]
author matt
owner  matt
description An example test
tags tagone,tagtwo
︙

Modified tests/fdktestqa/testqa/tests/bigrun2/testconfig from [e796f325ee] to [c56d7b9b7c]. 

1
2
3
4
5
6
7
8
9
10
11
12
13
14

15
16
17
18
19
20
21

1
2
3
4
5
6
7
8
9
10
11
12
13

14
15
16
17
18
19
20
21














-
+








# Add additional steps here. Format is "stepname script"
[ezsteps]
step1 step1.sh

# Test requirements are specified here
[requirements]
waiton bigrun
priority 0
mode itemmatch


# Iteration for your tests are controlled by the items section
[items]
NUMBER #{scheme (string-intersperse (map number->string (sort (let loop ((a 0)(res '()))(if (< a 120)(loop (+ a 1)(cons a res)) res)) >)) " ")}
NUMBER #{scheme (string-intersperse (map number->string (sort (let loop ((a 0)(res '()))(if (< a 300)(loop (+ a 1)(cons a res)) res)) >)) " ")}

# test_meta is a section for storing additional data on your test
[test_meta]
author matt
owner  matt
description An example test
tags tagone,tagtwo
︙

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