Changes In Branch runcontrol Through [efa1af53d5] Excluding Merge-Ins
This is equivalent to a diff from d187e07c8b to efa1af53d5
2013-04-22
| ||
16:38 | Fixed issue with server record not reflecting actual server when have port collisions. check-in: 99ca17a0cc user: mrwellan tags: development, v1.5415 | |
01:25 | Draw test/task boxes in rows to keep compact interface check-in: df77e9f1bd user: matt tags: runcontrol | |
00:59 | Display of tests on canvas partially implemented check-in: efa1af53d5 user: matt tags: runcontrol | |
2013-04-21
| ||
01:24 | Target selector done check-in: 5a56443663 user: matt tags: runcontrol | |
2013-04-19
| ||
00:33 | Starting on dashboard run control panel check-in: b504d0edc5 user: matt tags: runcontrol | |
2013-04-17
| ||
15:28 | Converted test steps to matrix, added browsing of log check-in: d187e07c8b user: mrwellan tags: development, v1.5414 | |
08:51 | bumped version check-in: f8584f2d62 user: icfadm tags: development, v1.5413 | |
Modified common.scm from [3109b21887] to [7f9cf64fe3].
︙ | |||
140 141 142 143 144 145 146 147 148 149 150 151 152 153 | 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 | + + + + + + + + + + + + + + + + + + + + + + + + + + | #f #t))) string<?)) ;; '(print (string-intersperse (map cadr (hash-table-ref/default (read-config "megatest.config" \#f \#t) "disks" '"'"'("none" ""))) "\n"))' (define (common:get-disks) (hash-table-ref/default (read-config "megatest.config" #f #t) "disks" '("none" ""))) ;;====================================================================== ;; M I S C L I S T S ;;====================================================================== ;; items in lista are matched value and position in listb ;; return the remaining items in listb or #f ;; (define (common:list-is-sublist lista listb) (if (null? lista) listb ;; all items in listb are "remaining" (if (> (length lista)(length listb)) #f (let loop ((heda (car lista)) (tala (cdr lista)) (hedb (car listb)) (talb (cdr listb))) (if (equal? heda hedb) (if (null? tala) ;; we are done talb (loop (car tala) (cdr tala) (car talb) (cdr talb))) #f))))) ;;====================================================================== ;; System stuff ;;====================================================================== ;; return a nice clean pathname made absolute (define (nice-path dir) |
︙ |
Modified dashboard-tests.scm from [b247a10977] to [3e5475f076].
︙ | |||
473 474 475 476 477 478 479 | 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 | - + + + | (db:test-data-get-units x) (db:test-data-get-type x) (db:test-data-get-comment x))) (open-run-close db:read-test-data #f test-id "%"))) "\n"))) (if (not (equal? currval newval)) (iup:attribute-set! test-data "VALUE" newval ))))) ;; "TITLE" newval))))) |
︙ |
Modified dashboard.scm from [f8c5b58774] to [3061b16302].
︙ | |||
10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 | 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 | + + | ;;====================================================================== (use format) (require-library iup) (import (prefix iup iup:)) (use canvas-draw) (import canvas-draw-iup) (use sqlite3 srfi-1 posix regex regex-case srfi-69) (import (prefix sqlite3 sqlite3:)) (use trace) (declare (uses common)) (declare (uses margs)) (declare (uses keys)) (declare (uses items)) (declare (uses db)) (declare (uses configf)) |
︙ | |||
420 421 422 423 424 425 426 | 422 423 424 425 426 427 428 429 430 431 432 433 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 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 | - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + | (define (update-search x val) ;; (print "Setting search for " x " to " val) (hash-table-set! *searchpatts* x val)) (define (mark-for-update) (set! *last-db-update-time* 0) |
︙ | |||
600 601 602 603 604 605 606 | 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 | + - - - - - - - - - - + + + + + + + + + + + + + + + | (hash-table-set! *buttondat* button-key (vector 0 "100 100 100" button-key #f #f)) (vector-set! testvec testnum butn) (loop runnum (+ testnum 1) testvec (cons butn res)))))) ;; now assemble the hdrlst and bdylst and kick off the dialog (iup:show (iup:dialog #:title "Megatest dashboard" (let ((tabs (iup:tabs |
︙ |
Modified db.scm from [a540e1036f] to [6e6a12b542].
︙ | |||
504 505 506 507 508 509 510 511 512 513 514 515 516 517 | 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 | + | (set! res (cons (vector key keytype) res))) db "SELECT fieldname,fieldtype FROM keys ORDER BY id DESC;") (set! *db-keys* res) (debug:print-info 11 "db:get-keys END (cache miss)") res))) ;; (define (db:get-value-by-header row header field) (debug:print-info 4 "db:get-value-by-header row: " row " header: " header " field: " field) (if (null? header) #f (let loop ((hed (car header)) (tal (cdr header)) (n 0)) (if (equal? hed field) |
︙ | |||
580 581 582 583 584 585 586 587 588 589 590 591 592 593 | 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 | + + + + + + + + + + + + + + + + + + + + + | (lambda (a . x) (set! res (cons (apply vector a x) res))) db qrystr ) (debug:print-info 11 "db:get-runs END qrystr: " qrystr " keypatts: " keypatts " offset: " offset " limit: " count) (vector header res))) ;; Get all targets from the db ;; (define (db:get-targets db) (let* ((res '()) (keys (db:get-keys db)) (header (map key:get-fieldname keys)) (keystr (keys->keystr keys)) (qrystr (conc "SELECT " keystr " FROM runs;")) (seen (make-hash-table))) (sqlite3:for-each-row (lambda (a . x) (let ((targ (cons a x))) (if (not (hash-table-ref/default seen targ #f)) (begin (hash-table-set! seen targ #t) (set! res (cons (apply vector targ) res)))))) db qrystr) (debug:print-info 11 "db:get-targets END qrystr: " qrystr ) (vector header res))) ;; just get count of runs (define (db:get-num-runs db runpatt) (let ((numruns 0)) (debug:print-info 11 "db:get-num-runs START " runpatt) (sqlite3:for-each-row (lambda (count) |
︙ |
Modified docs/manual/megatest_manual.txt from [db93d807cc] to [6b638a28bf].
1 2 3 4 5 6 7 | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | - - - - - - - - - - - - - - - - - | The Megatest Users Manual ========================= Matt Welland <matt@kiatoa.com> v1.0, April 2012 :doctype: book |
︙ |
Modified margs.scm from [282b6e3581] to [5bb81571cb].
︙ | |||
15 16 17 18 19 20 21 | 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 | - - + + - + + | (define (args:get-arg arg . default) (if (null? default) (hash-table-ref/default args:arg-hash arg #f) (hash-table-ref/default args:arg-hash arg (car default)))) (define (args:get-arg-from ht arg . default) (if (null? default) |
︙ |
Modified runs.scm from [f136285a97] to [0d071f8e6c].
︙ | |||
975 976 977 978 979 980 981 | 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 | - + | (begin (print "Updating " test-name " " fld " to " val) (open-run-close db:testmeta-update-field db test-name fld val))))) '(("author" 2)("owner" 3)("description" 4)("reviewed" 5)("tags" 9))))) ;; Update test_meta for all tests (define (runs:update-all-test_meta db) |
︙ |
Modified tests.scm from [45344ee04b] to [628e641bd0].
︙ | |||
24 25 26 27 28 29 30 | 24 25 26 27 28 29 30 31 32 33 34 35 36 37 | - - - - - - - - - - | (include "common_records.scm") (include "key_records.scm") (include "db_records.scm") (include "run_records.scm") (include "test_records.scm") |
︙ | |||
427 428 429 430 431 432 433 | 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 | + + + - - - + + + + + + - - + + - - - + + - | (release-dot-lock outputfilename))) (close-output-port oup) (change-directory orig-dir) ;; NB// tests:test-set-toplog! is remote internal... (tests:test-set-toplog! db run-id test-name outputfilename) ))))) ;;====================================================================== ;; Gather data from test/task specifications ;;====================================================================== |
︙ | |||
528 529 530 531 532 533 534 535 536 537 538 539 540 541 | 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 | + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + | (member (db:test-get-state wtdat) '("INCOMPETE"))) (set! keep-test #f)))) ;; no point in running this one again waitons)))) (if keep-test (set! runnables (cons testkeyname runnables))))) testkeynames) runnables)) ;;====================================================================== ;; refactoring this block into tests:get-full-data from line 263 of runs.scm ;;====================================================================== ;; hed is the test name ;; test-records is a hash of test-name => test record (define (tests:get-full-data test-names test-records required-tests) (if (not (null? test-names)) (let loop ((hed (car test-names)) (tal (cdr test-names))) ;; 'return-procs tells the config reader to prep running system but return a proc (debug:print-info 4 "hed=" hed " at top of loop") (let* ((config (tests:get-testconfig hed 'return-procs)) (waitons (let ((instr (if config (config-lookup config "requirements" "waiton") (begin ;; No config means this is a non-existant test (debug:print 0 "ERROR: non-existent required test \"" hed "\"") (if db (sqlite3:finalize! db)) (exit 1))))) (debug:print-info 8 "waitons string is " instr) (string-split (cond ((procedure? instr) (let ((res (instr))) (debug:print-info 8 "waiton procedure results in string " res " for test " hed) res)) ((string? instr) instr) (else ;; NOTE: This is actually the case of *no* waitons! ;; (debug:print 0 "ERROR: something went wrong in processing waitons for test " hed) "")))))) (debug:print-info 8 "waitons: " waitons) ;; check for hed in waitons => this would be circular, remove it and issue an ;; error (if (member hed waitons) (begin (debug:print 0 "ERROR: test " hed " has listed itself as a waiton, please correct this!") (set! waitons (filter (lambda (x)(not (equal? x hed))) waitons)))) ;; (items (items:get-items-from-config config))) (if (not (hash-table-ref/default test-records hed #f)) (hash-table-set! test-records hed (vector hed ;; 0 config ;; 1 waitons ;; 2 (config-lookup config "requirements" "priority") ;; priority 3 (let ((items (hash-table-ref/default config "items" #f)) ;; items 4 (itemstable (hash-table-ref/default config "itemstable" #f))) ;; if either items or items table is a proc return it so test running ;; process can know to call items:get-items-from-config ;; if either is a list and none is a proc go ahead and call get-items ;; otherwise return #f - this is not an iterated test (cond ((procedure? items) (debug:print-info 4 "items is a procedure, will calc later") items) ;; calc later ((procedure? itemstable) (debug:print-info 4 "itemstable is a procedure, will calc later") itemstable) ;; calc later ((filter (lambda (x) (let ((val (car x))) (if (procedure? val) val #f))) (append (if (list? items) items '()) (if (list? itemstable) itemstable '()))) 'have-procedure) ((or (list? items)(list? itemstable)) ;; calc now (debug:print-info 4 "items and itemstable are lists, calc now\n" " items: " items " itemstable: " itemstable) (items:get-items-from-config config)) (else #f))) ;; not iterated #f ;; itemsdat 5 #f ;; spare - used for item-path ))) (for-each (lambda (waiton) (if (and waiton (not (member waiton test-names))) (begin (set! required-tests (cons waiton required-tests)) (set! test-names (cons waiton test-names))))) ;; was an append, now a cons waitons) (let ((remtests (delete-duplicates (append waitons tal)))) (if (not (null? remtests)) (loop (car remtests)(cdr remtests)))))))) ;;====================================================================== ;; test steps ;;====================================================================== ;; teststep-set-status! used to be here |
︙ |