Overview
Comment: | Removed JOIN from -test-paths query |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.55 |
Files: | files | file ages | folders |
SHA1: |
be4c49d8e4b0fd91a9ddd313737b91cc |
User & Date: | matt on 2013-08-12 23:53:49 |
Other Links: | branch diff | manifest | tags |
Context
2013-08-15
| ||
17:55 | Added check to catch case of slow test registration, however it really shouldn't be happening... check-in: 2a9374aae1 user: mrwellan tags: v1.55 | |
2013-08-12
| ||
23:53 | Removed JOIN from -test-paths query check-in: be4c49d8e4 user: matt tags: v1.55 | |
01:18 | Added missing finalize for lock-queue check-in: 8d21f434ab user: matt tags: v1.55 | |
Changes
Modified db.scm from [3f7c697afc] to [0b796ed87c].
︙ | ︙ | |||
358 359 360 361 362 363 364 | (begin (sqlite3:execute db "CREATE TABLE IF NOT EXISTS log (id INTEGER PRIMARY KEY,event_time TIMESTAMP DEFAULT (strftime('%s','now')),logline TEXT,pwd TEXT,cmdline TEXT,pid INTEGER);") (sqlite3:execute db (conc "PRAGMA synchronous = 0;")))) db)) (define (db:log-local-event . loglst) (let ((logline (apply conc loglst))) | | | | | 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 | (begin (sqlite3:execute db "CREATE TABLE IF NOT EXISTS log (id INTEGER PRIMARY KEY,event_time TIMESTAMP DEFAULT (strftime('%s','now')),logline TEXT,pwd TEXT,cmdline TEXT,pid INTEGER);") (sqlite3:execute db (conc "PRAGMA synchronous = 0;")))) db)) (define (db:log-local-event . loglst) (let ((logline (apply conc loglst))) ;; (pwd (current-directory)) ;; (cmdline (string-intersperse (argv) " ")) ;; (pid (current-process-id))) (db:log-event logline))) (define (db:log-event logline) (let ((db (open-logging-db))) (sqlite3:execute db "INSERT INTO log (logline,pwd,cmdline,pid) VALUES (?,?,?,?);" logline (current-directory) |
︙ | ︙ | |||
501 502 503 504 505 506 507 | (debug:print-info 0 "Records count after clean: " tot)) count-stmt))) (map sqlite3:finalize! statements) (sqlite3:finalize! count-stmt) (sqlite3:execute db "VACUUM;"))) ;; (define (db:report-junk-records db) | | | 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 | (debug:print-info 0 "Records count after clean: " tot)) count-stmt))) (map sqlite3:finalize! statements) (sqlite3:finalize! count-stmt) (sqlite3:execute db "VACUUM;"))) ;; (define (db:report-junk-records db) ;;====================================================================== ;; meta get and set vars ;;====================================================================== ;; returns number if string->number is successful, string otherwise ;; also updates *global-delta* |
︙ | ︙ | |||
636 637 638 639 640 641 642 | (debug:print 3 "keys: " keys " allvals: " allvals " keyvals: " keyvals " key=?str is " key=?str) (debug:print 2 "NOTE: using target " (string-intersperse (map cadr keyvals) "/") " for this run") (if (and runname (null? (filter (lambda (x)(not x)) keyvals))) ;; there must be a better way to "apply and" (let ((res #f)) (apply sqlite3:execute db (conc "INSERT OR IGNORE INTO runs (runname,state,status,owner,event_time" comma keystr ") VALUES (?,?,?,?,strftime('%s','now')" comma valslots ");") allvals) (apply sqlite3:for-each-row | | | | | | | | | 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 | (debug:print 3 "keys: " keys " allvals: " allvals " keyvals: " keyvals " key=?str is " key=?str) (debug:print 2 "NOTE: using target " (string-intersperse (map cadr keyvals) "/") " for this run") (if (and runname (null? (filter (lambda (x)(not x)) keyvals))) ;; there must be a better way to "apply and" (let ((res #f)) (apply sqlite3:execute db (conc "INSERT OR IGNORE INTO runs (runname,state,status,owner,event_time" comma keystr ") VALUES (?,?,?,?,strftime('%s','now')" comma valslots ");") allvals) (apply sqlite3:for-each-row (lambda (id) (set! res id)) db (let ((qry (conc "SELECT id FROM runs WHERE (runname=? " andstr key=?str ");"))) ;(debug:print 4 "qry: " qry) qry) qryvals) (sqlite3:execute db "UPDATE runs SET state=?,status=?,event_time=strftime('%s','now') WHERE id=?;" state status res) res) (begin (debug:print 0 "ERROR: Called without all necessary keys") #f)))) |
︙ | ︙ | |||
738 739 740 741 742 743 744 | (sqlite3:for-each-row (lambda (runname state count) (let* ((stateparts (string-split state "|")) (newstate (conc (car stateparts) "\n" (cadr stateparts)))) (hash-table-set! totals newstate (+ (hash-table-ref/default totals newstate 0) count)) (set! res (cons (list runname newstate count) res)))) db | | | 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 | (sqlite3:for-each-row (lambda (runname state count) (let* ((stateparts (string-split state "|")) (newstate (conc (car stateparts) "\n" (cadr stateparts)))) (hash-table-set! totals newstate (+ (hash-table-ref/default totals newstate 0) count)) (set! res (cons (list runname newstate count) res)))) db "SELECT runname,t.state||'|'||t.status AS s,count(t.id) FROM runs AS r INNER JOIN tests AS t ON r.id=t.run_id GROUP BY s,runname ORDER BY r.event_time,s DESC;" ) ;; (set! res (reverse res)) (for-each (lambda (state) (set! res (cons (list "Totals" state (hash-table-ref totals state)) res))) (sort (hash-table-keys totals) string>=)) res)) ;; db:get-runs-by-patt |
︙ | ︙ | |||
789 790 791 792 793 794 795 | runnamepatt) (vector header res))) ;; use (get-value-by-header (db:get-header runinfo)(db:get-row runinfo)) (define (db:get-run-info db run-id) ;;(if (hash-table-ref/default *run-info-cache* run-id #f) ;; (hash-table-ref *run-info-cache* run-id) | | | | | | | | | | | | | | | | | | | 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 | runnamepatt) (vector header res))) ;; use (get-value-by-header (db:get-header runinfo)(db:get-row runinfo)) (define (db:get-run-info db run-id) ;;(if (hash-table-ref/default *run-info-cache* run-id #f) ;; (hash-table-ref *run-info-cache* run-id) (let* ((res #f) (keys (db:get-keys db)) (remfields (list "id" "runname" "state" "status" "owner" "event_time")) (header (append keys remfields)) (keystr (conc (keys->keystr keys) "," (string-intersperse remfields ",")))) (debug:print-info 11 "db:get-run-info run-id: " run-id " header: " header " keystr: " keystr) (sqlite3:for-each-row (lambda (a . x) (set! res (apply vector a x))) db (conc "SELECT " keystr " FROM runs WHERE id=? AND state != 'deleted';") run-id) (debug:print-info 11 "db:get-run-info run-id: " run-id " header: " header " keystr: " keystr) (let ((finalres (vector header res))) ;; (hash-table-set! *run-info-cache* run-id finalres) finalres))) (define (db:set-comment-for-run db run-id comment) (debug:print-info 11 "db:set-comment-for-run START run-id: " run-id " comment: " comment) (sqlite3:execute db "UPDATE runs SET comment=? WHERE id=?;" comment run-id) (debug:print-info 11 "db:set-comment-for-run END run-id: " run-id " comment: " comment)) ;; does not (obviously!) removed dependent data. But why not!!? |
︙ | ︙ | |||
865 866 867 868 869 870 871 | db qry run-id))) keys) (debug:print-info 11 "db:get-key-val-pairs END keys: " keys " run-id: " run-id) (reverse res))) ;; get key vals for a given run-id (define (db:get-key-vals db run-id) | | | | | | | | | | | | | | | | | | 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 | db qry run-id))) keys) (debug:print-info 11 "db:get-key-val-pairs END keys: " keys " run-id: " run-id) (reverse res))) ;; get key vals for a given run-id (define (db:get-key-vals db run-id) (let ((mykeyvals (hash-table-ref/default *keyvals* run-id #f))) (if mykeyvals mykeyvals (let* ((keys (db:get-keys db)) (res '())) (debug:print-info 11 "db:get-key-vals START keys: " keys " run-id: " run-id) (for-each (lambda (key) (let ((qry (conc "SELECT " key " FROM runs WHERE id=?;"))) ;; (debug:print 0 "qry: " qry) (sqlite3:for-each-row (lambda (key-val) (set! res (cons key-val res))) db qry run-id))) keys) (debug:print-info 11 "db:get-key-vals END keys: " keys " run-id: " run-id) (let ((final-res (reverse res))) (hash-table-set! *keyvals* run-id final-res) final-res))))) ;; The target is keyval1/keyval2..., cached in *target* as it is used often (define (db:get-target db run-id) (let ((mytarg (hash-table-ref/default *target* run-id #f))) (if mytarg mytarg (let* ((keyvals (db:get-key-vals db run-id)) (thekey (string-intersperse (map (lambda (x)(if x x "-na-")) keyvals) "/"))) (hash-table-set! *target* run-id thekey) thekey)))) ;;====================================================================== ;; T E S T S ;;====================================================================== |
︙ | ︙ | |||
928 929 930 931 932 933 934 | (conc " status " (if not-in " NOT IN ('" " IN ('") (string-intersperse statuses "','") "')"))) (states-statuses-qry | | | | | | | | | | | 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 | (conc " status " (if not-in " NOT IN ('" " IN ('") (string-intersperse statuses "','") "')"))) (states-statuses-qry (cond ((and states-qry statuses-qry) (conc " AND ( " states-qry " AND " statuses-qry " ) ")) (states-qry (conc " AND " states-qry)) (statuses-qry (conc " AND " statuses-qry)) (else ""))) (tests-match-qry (tests:match->sqlqry testpatt)) (qry (conc "SELECT " qryvals " FROM tests WHERE run_id=? AND state != 'DELETED' " states-statuses-qry (if tests-match-qry (conc " AND (" tests-match-qry ") ") "") (case sort-by ((rundir) " ORDER BY length(rundir) DESC ") ((event_time) " ORDER BY event_time ASC ") (else (if (string? sort-by) (conc " ORDER BY " sort-by) ""))) (if limit (conc " LIMIT " limit) "") (if offset (conc " OFFSET " offset) "") ";" ))) (debug:print-info 8 "db:get-tests-for-run qry=" qry) (sqlite3:for-each-row (lambda (a . b) ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment) (set! res (cons (apply vector a b) res))) ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment) res))) db qry run-id |
︙ | ︙ | |||
975 976 977 978 979 980 981 | ;; ;; 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 ;; run-ids is a list of run-ids or a single number or #f for all runs (define (db:get-tests-for-runs db run-ids testpatt states statuses | | | | | 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 | ;; ;; 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 ;; run-ids is a list of run-ids or a single number or #f for all runs (define (db:get-tests-for-runs db run-ids testpatt states statuses #!key (not-in #t) (sort-by #f) (qryvals "id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment")) ;; 'rundir 'event_time (debug:print-info 11 "db:get-tests-for-run START run-ids=" run-ids ", testpatt=" testpatt ", states=" states ", statuses=" statuses ", not-in=" not-in ", sort-by=" sort-by) (let* ((res '()) ;; if states or statuses are null then assume match all when not-in is false (states-qry (if (null? states) #f (conc " state " (if not-in "NOT" "") |
︙ | ︙ | |||
1010 1011 1012 1013 1014 1015 1016 | (if states-qry (conc " AND " states-qry) "") (if statuses-qry (conc " AND " statuses-qry) "") (if tests-match-qry (conc " AND (" tests-match-qry ") ") "") (case sort-by ((rundir) " ORDER BY length(rundir) DESC;") ((event_time) " ORDER BY event_time ASC;") (else ";")) | | | 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 | (if states-qry (conc " AND " states-qry) "") (if statuses-qry (conc " AND " statuses-qry) "") (if tests-match-qry (conc " AND (" tests-match-qry ") ") "") (case sort-by ((rundir) " ORDER BY length(rundir) DESC;") ((event_time) " ORDER BY event_time ASC;") (else ";")) ))) (debug:print-info 8 "db:get-tests-for-run qry=" qry) (sqlite3:for-each-row (lambda (a . b) ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment) (set! res (cons (apply vector a b) res))) ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment) res))) db qry ) |
︙ | ︙ | |||
1277 1278 1279 1280 1281 1282 1283 | res))) (define (db:get-test-info db run-id testname item-path) (db:get-test-info-by-id db (db:get-test-id db run-id testname item-path))) (define (db:test-set-comment db test-id comment) (sqlite3:execute | | | 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 | res))) (define (db:get-test-info db run-id testname item-path) (db:get-test-info-by-id db (db:get-test-id db run-id testname item-path))) (define (db:test-set-comment db test-id comment) (sqlite3:execute db "UPDATE tests SET comment=? WHERE id=?;" comment test-id)) (define (cdb:test-set-rundir! serverdat run-id test-name item-path rundir) (cdb:client-call serverdat 'test-set-rundir #t *default-numtries* rundir run-id test-name item-path)) (define (cdb:test-set-rundir-by-test-id serverdat test-id rundir) |
︙ | ︙ | |||
1315 1316 1317 1318 1319 1320 1321 | ;; MUST BE CALLED local! (define (db:test-get-paths-matching db keynames target fnamepatt #!key (res '())) ;; BUG: Move the values derived from args to parameters and push to megatest.scm (let* ((testpatt (if (args:get-arg "-testpatt")(args:get-arg "-testpatt") "%")) (statepatt (if (args:get-arg ":state") (args:get-arg ":state") "%")) (statuspatt (if (args:get-arg ":status") (args:get-arg ":status") "%")) (runname (if (args:get-arg ":runname") (args:get-arg ":runname") "%")) | | | 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 | ;; MUST BE CALLED local! (define (db:test-get-paths-matching db keynames target fnamepatt #!key (res '())) ;; BUG: Move the values derived from args to parameters and push to megatest.scm (let* ((testpatt (if (args:get-arg "-testpatt")(args:get-arg "-testpatt") "%")) (statepatt (if (args:get-arg ":state") (args:get-arg ":state") "%")) (statuspatt (if (args:get-arg ":status") (args:get-arg ":status") "%")) (runname (if (args:get-arg ":runname") (args:get-arg ":runname") "%")) (paths-from-db (cdb:remote-run db:test-get-paths-matching-keynames-target-new db keynames target res testpatt: testpatt statepatt: statepatt statuspatt: statuspatt runname: runname))) (if fnamepatt (apply append (map (lambda (p) |
︙ | ︙ | |||
1346 1347 1348 1349 1350 1351 1352 | (string-split target "/")) " AND ")) (testqry (tests:match->sqlqry testpatt)) (qrystr (conc "SELECT t.rundir FROM tests AS t INNER JOIN runs AS r ON t.run_id=r.id WHERE " keystr " AND r.runname LIKE '" runname "' AND " testqry " AND t.state LIKE '" statepatt "' AND t.status LIKE '" statuspatt "' ORDER BY t.event_time ASC;"))) | < > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 | (string-split target "/")) " AND ")) (testqry (tests:match->sqlqry testpatt)) (qrystr (conc "SELECT t.rundir FROM tests AS t INNER JOIN runs AS r ON t.run_id=r.id WHERE " keystr " AND r.runname LIKE '" runname "' AND " testqry " AND t.state LIKE '" statepatt "' AND t.status LIKE '" statuspatt "' ORDER BY t.event_time ASC;"))) (sqlite3:for-each-row (lambda (p) (set! res (cons p res))) db qrystr) res)) (define (db:test-get-paths-matching-keynames-target-new db keynames target res #!key (testpatt "%") (statepatt "%") (statuspatt "%") (runname "%")) (let* ((row-ids '()) (keystr (string-intersperse (map (lambda (key val) (conc key " like '" val "'")) keynames (string-split target "/")) " AND ")) (testqry (tests:match->sqlqry testpatt)) (runsqry (sqlite3:prepare db (conc "SELECT id FROM runs WHERE " keystr " AND runname LIKE '" runname "';"))) (tstsqry (sqlite3:prepare db (conc "SELECT rundir FROM tests WHERE run_id=? AND " testqry " AND state LIKE '" statepatt "' AND status LIKE '" statuspatt "' ORDER BY event_time ASC;")))) (sqlite3:for-each-row (lambda (rid) (set! row-ids (cons rid row-ids))) runsqry) (for-each (lambda (rid) (sqlite3:for-each-row (lambda (p) (set! res (cons p res))) tstsqry rid)) row-ids) (sqlite3:finalize! tstsqry) (sqlite3:finalize! runsqry) res)) ;; look through tests from matching runs for a file (define (db:test-get-first-path-matching db keynames target fname) ;; [refpaths] is the section where references to other megatest databases are stored (let ((mt-paths (configf:get-section "refpaths")) (res (db:test-get-paths-matching db keynames target fname))) (let loop ((pathdat (if (null? paths) #f (car mt-paths))) |
︙ | ︙ | |||
1392 1393 1394 1395 1396 1397 1398 | (base64:base64-encode (with-output-to-string (lambda ()(serialize obj)))) #t)) ((zmq)(with-output-to-string (lambda ()(serialize obj)))) (else obj))) (define (db:string->obj msg) (case *transport-type* | | | | | | | | | | | | | | 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 | (base64:base64-encode (with-output-to-string (lambda ()(serialize obj)))) #t)) ((zmq)(with-output-to-string (lambda ()(serialize obj)))) (else obj))) (define (db:string->obj msg) (case *transport-type* ((fs) msg) ((http) (if (string? msg) (with-input-from-string (base64:base64-decode (string-substitute (regexp "_") "=" msg #t)) (lambda ()(deserialize))) (vector #f #f #f))) ;; crude reply for when things go awry ((zmq)(with-input-from-string msg (lambda ()(deserialize)))) (else msg))) (define (cdb:use-non-blocking-mode proc) (set! *client-non-blocking-mode* #t) (let ((res (proc))) (set! *client-non-blocking-mode* #f) res)) ;; params = 'target cached remparams ;; ;; make-vector-record cdb packet client-sig qtype immediate query-sig params qtime ;; ;; cdb:client-call is the unified interface to all the transports. It dispatches the ;; query to a server routine (e.g. server:client-send-recieve) that ;; transports the data to the server where it is passed to db:process-queue-item |
︙ | ︙ | |||
1469 1470 1471 1472 1473 1474 1475 | ;; we will need to process "all" messages here some day (receive-message* sub-socket) ;; now get the actual message (let ((myres (db:string->obj (receive-message* sub-socket)))) (if (equal? query-sig (vector-ref myres 1)) (set! res (vector-ref myres 2)) (loop))))))) | | | | | | | | | | | | | | | | | | 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 | ;; we will need to process "all" messages here some day (receive-message* sub-socket) ;; now get the actual message (let ((myres (db:string->obj (receive-message* sub-socket)))) (if (equal? query-sig (vector-ref myres 1)) (set! res (vector-ref myres 2)) (loop))))))) ;; (timeout (lambda () ;; (let loop ((n numretries)) ;; (thread-sleep! 15) ;; (if (not res) ;; (if (> numretries 0) ;; (begin ;; (debug:print 2 "WARNING: no reply to query " params ", trying resend") ;; (debug:print-info 11 "re-sending message") ;; (send-message push-socket zdat) ;; (debug:print-info 11 "message re-sent") ;; (loop (- n 1))) ;; ;; (apply cdb:client-call *runremote* qtype immediate (- numretries 1) params)) ;; (begin ;; (debug:print 0 "ERROR: cdb:client-call timed out " params ", exiting.") ;; (exit 5)))))))) (debug:print-info 11 "Starting threads") (let ((th1 (make-thread send-receive "send receive")) ;; (th2 (make-thread timeout "timeout")) ) (thread-start! th1) ;; (thread-start! th2) (thread-join! th1) (debug:print-info 11 "cdb:client-call returning res=" res) res)))))) (define (cdb:set-verbosity serverdat val) (cdb:client-call serverdat 'set-verbosity #f *default-numtries* val)) (define (cdb:login serverdat keyval signature) (cdb:client-call serverdat 'login #t *default-numtries* keyval megatest-version signature)) (define (cdb:logout serverdat keyval signature) |
︙ | ︙ | |||
1584 1585 1586 1587 1588 1589 1590 | '(delete-tests-in-state "DELETE FROM tests WHERE state=? AND run_id=?;") '(tests:test-set-toplog "UPDATE tests SET final_logf=? WHERE run_id=? AND testname=? AND item_path='';") '(update-cpuload-diskfree "UPDATE tests SET cpuload=?,diskfree=? WHERE id=?;") '(update-run-duration "UPDATE tests SET run_duration=? WHERE id=?;") '(update-uname-host "UPDATE tests SET uname=?,host=? WHERE id=?;") '(update-test-state "UPDATE tests SET state=? WHERE state=? AND run_id=? AND testname=? AND NOT (item_path='' AND testname IN (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));") '(update-test-status "UPDATE tests SET status=? WHERE status like ? AND run_id=? AND testname=? AND NOT (item_path='' AND testname IN (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));") | | | | | 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 | '(delete-tests-in-state "DELETE FROM tests WHERE state=? AND run_id=?;") '(tests:test-set-toplog "UPDATE tests SET final_logf=? WHERE run_id=? AND testname=? AND item_path='';") '(update-cpuload-diskfree "UPDATE tests SET cpuload=?,diskfree=? WHERE id=?;") '(update-run-duration "UPDATE tests SET run_duration=? WHERE id=?;") '(update-uname-host "UPDATE tests SET uname=?,host=? WHERE id=?;") '(update-test-state "UPDATE tests SET state=? WHERE state=? AND run_id=? AND testname=? AND NOT (item_path='' AND testname IN (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));") '(update-test-status "UPDATE tests SET status=? WHERE status like ? AND run_id=? AND testname=? AND NOT (item_path='' AND testname IN (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));") )) ;; do not run these as part of the transaction (define db:special-queries '(rollup-tests-pass-fail db:roll-up-pass-fail-counts login immediate flush sync set-verbosity killserver )) ;; not used, intended to indicate to run in calling process |
︙ | ︙ | |||
1613 1614 1615 1616 1617 1618 1619 | (set! *server:last-write-flush* (current-milliseconds)) (set! *incoming-writes* '()) (mutex-unlock! *incoming-mutex*) (if (> (length data) 0) ;; Process if we have data (begin (debug:print-info 7 "Writing cached data " data) | | | 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 | (set! *server:last-write-flush* (current-milliseconds)) (set! *incoming-writes* '()) (mutex-unlock! *incoming-mutex*) (if (> (length data) 0) ;; Process if we have data (begin (debug:print-info 7 "Writing cached data " data) ;; Prepare the needed sql statements ;; (for-each (lambda (request-item) (let ((stmt-key (vector-ref request-item 0)) (query (vector-ref request-item 1))) (hash-table-set! queries stmt-key (sqlite3:prepare db query)))) data) |
︙ | ︙ | |||
1705 1706 1707 1708 1709 1710 1711 | (< (current-seconds) timeout)) (begin (thread-sleep! 0.01) (loop)))) (set! *number-of-writes* (+ *number-of-writes* 1)) (set! *writes-total-delay* (+ *writes-total-delay* (- (current-milliseconds) start-time))) got-it)) | | | 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 | (< (current-seconds) timeout)) (begin (thread-sleep! 0.01) (loop)))) (set! *number-of-writes* (+ *number-of-writes* 1)) (set! *writes-total-delay* (+ *writes-total-delay* (- (current-milliseconds) start-time))) got-it)) (define (db:process-queue-item db item) (let* ((stmt-key (cdb:packet-get-qtype item)) (qry-sig (cdb:packet-get-query-sig item)) (return-address (cdb:packet-get-client-sig item)) (params (cdb:packet-get-params item)) (query (let ((q (alist-ref stmt-key db:queries))) (if q (car q) #f)))) |
︙ | ︙ | |||
1809 1810 1811 1812 1813 1814 1815 | (sqlite3:execute db "UPDATE tests SET fail_count=(SELECT count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND status IN ('FAIL','CHECK')), pass_count=(SELECT count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND status IN ('PASS','WARN','WAIVED')) WHERE run_id=? AND testname=? AND item_path='';" run-id test-name run-id test-name run-id test-name) | | | 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 | (sqlite3:execute db "UPDATE tests SET fail_count=(SELECT count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND status IN ('FAIL','CHECK')), pass_count=(SELECT count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND status IN ('PASS','WARN','WAIVED')) WHERE run_id=? AND testname=? AND item_path='';" run-id test-name run-id test-name run-id test-name) ;; (thread-sleep! 0.1) ;; give other processes a chance here, no, better to be done ASAP? (if (equal? status "RUNNING") ;; running takes priority over all other states, force the test state to RUNNING (sqlite3:execute db "UPDATE tests SET state=? WHERE run_id=? AND testname=? AND item_path='';" "RUNNING" run-id test-name) (sqlite3:execute db "UPDATE tests SET state=CASE WHEN (SELECT count(id) FROM tests |
︙ | ︙ | |||
1983 1984 1985 1986 1987 1988 1989 | ;; (thread-sleep! 1) ;; play nice with the queue by ensuring the rollup is at least 10ms later than the set ;; if the test is not FAIL then set status based on the fail and pass counts. (cdb:test-rollup-test_data-pass-fail *runremote* test-id) ;; (sqlite3:execute ;; db ;;; NOTE: Should this be WARN,FAIL? A WARN is not a FAIL????? BUG FIXME ;; "UPDATE tests | | | | | | | | | 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 | ;; (thread-sleep! 1) ;; play nice with the queue by ensuring the rollup is at least 10ms later than the set ;; if the test is not FAIL then set status based on the fail and pass counts. (cdb:test-rollup-test_data-pass-fail *runremote* test-id) ;; (sqlite3:execute ;; db ;;; NOTE: Should this be WARN,FAIL? A WARN is not a FAIL????? BUG FIXME ;; "UPDATE tests ;; SET status=CASE WHEN (SELECT fail_count FROM tests WHERE id=?) > 0 ;; THEN 'FAIL' ;; WHEN (SELECT pass_count FROM tests WHERE id=?) > 0 AND ;; (SELECT status FROM tests WHERE id=?) NOT IN ('WARN','FAIL') ;; THEN 'PASS' ;; ELSE status ;; END WHERE id=?;" ;; test-id test-id test-id test-id) )))) (define (db:get-prev-tol-for-test db test-id category variable) ;; Finish me? (values #f #f #f)) |
︙ | ︙ | |||
2232 2233 2234 2235 2236 2237 2238 | (if (and (equal? item-path "") (or is-completed is-running));; this is the parent, set it to run if completed or running (set! parent-waiton-met #t))) ;; normal checking of parent items, any parent or parent item not ok blocks running ((and is-completed (or is-ok (eq? mode 'toplevel)) ;; toplevel does not block on FAIL | | | | | 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 | (if (and (equal? item-path "") (or is-completed is-running));; this is the parent, set it to run if completed or running (set! parent-waiton-met #t))) ;; normal checking of parent items, any parent or parent item not ok blocks running ((and is-completed (or is-ok (eq? mode 'toplevel)) ;; toplevel does not block on FAIL (and is-ok (eq? mode 'itemmatch))) ;; itemmatch blocks on not ok (set! item-waiton-met #t))))) tests) ;; both requirements, parent and item-waiton must be met to NOT add item to ;; prereq's not met list (if (not (or parent-waiton-met item-waiton-met)) (set! result (append (if (null? tests) (list waitontest-name) tests) result))) ;; if the test is not found then clearly the waiton is not met... ;; (if (not ever-seen)(set! result (cons waitontest-name result))))) (if (not ever-seen) (set! result (append (if (null? tests)(list waitontest-name) tests) result))))) waitons) |
︙ | ︙ |
Modified tests/Makefile from [602052bbdd] to [801e8f7cee].
︙ | ︙ | |||
126 127 128 129 130 131 132 133 134 135 136 137 138 139 | (cd fullrun;$(MEGATEST) -runtests priority_10_waiton_1 -target $$targ :runname $(RUNNAME) &); done for sys in ubuntu suse redhat debian;do \ for fs in afs nfs zfs; do \ for dpath in none tmp; do \ (cd fullrun;$(MEGATEST) -runtests priority_10_waiton_1 -target $$sys/$$fs/$$dpath :runname $(RUNNAME) &);\ done;done;done minsetup : cd ..;make && make install mkdir -p mintest/runs mintest/links cd mintest;megatest -stop-server 0 cd mintest;megatest -server - -debug $(DEBUG) > server.log 2> server.log & sleep 3 cd mintest;dashboard -rows 20 & | > > > | 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 | (cd fullrun;$(MEGATEST) -runtests priority_10_waiton_1 -target $$targ :runname $(RUNNAME) &); done for sys in ubuntu suse redhat debian;do \ for fs in afs nfs zfs; do \ for dpath in none tmp; do \ (cd fullrun;$(MEGATEST) -runtests priority_10_waiton_1 -target $$sys/$$fs/$$dpath :runname $(RUNNAME) &);\ done;done;done test11 : cd fullrun;time (for a in 1 2 3 4 5 6 7 8 9 10 1 2 3 4 5 6 7 8 9 10 1 2 3 4 5 6 7 8 9 10 1 2 3 4 5 6 7 8 9 10 ;do (megatest -test-paths -target %/%/% > /dev/null ) & done; wait; ) minsetup : cd ..;make && make install mkdir -p mintest/runs mintest/links cd mintest;megatest -stop-server 0 cd mintest;megatest -server - -debug $(DEBUG) > server.log 2> server.log & sleep 3 cd mintest;dashboard -rows 20 & |
︙ | ︙ |