Overview
Comment: | Refactor complete. test4 and test5 pass 100% |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | refactor |
Files: | files | file ages | folders |
SHA1: |
47a5bbab30037887a234d1c8082fc53d |
User & Date: | matt on 2013-05-07 00:16:52 |
Other Links: | branch diff | manifest | tags |
Context
2016-09-06
| ||
15:08 | Create new branch named "v1.61-db-refactor-shoeb" Closed-Leaf check-in: 8cd60c3c3d user: srehman tags: v1.61-db-refactor-shoeb | |
2013-05-07
| ||
10:29 | Merged refactor back to development check-in: b4ff873dcd user: mrwellan tags: dev | |
00:16 | Refactor complete. test4 and test5 pass 100% Closed-Leaf check-in: 47a5bbab30 user: matt tags: refactor | |
2013-05-06
| ||
21:35 | Merged v1.54 to refactor branch check-in: 70547e2c4d user: matt tags: refactor | |
Changes
Modified db.scm from [c52b9c39c5] to [afa3cc378f].
︙ | |||
564 565 566 567 568 569 570 | 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 | - - - + + + + - - + + - + | (if (null? patts) '("") patts)) comparator))) ;; register a test run with the db |
︙ |
Modified launch.scm from [2728d72d90] to [4b56b7ca38].
︙ | |||
89 90 91 92 93 94 95 | 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 | - + | (change-directory top-path) (debug:print 2 "Exectuing " test-name " (id: " test-id ") on " (get-host-name)) ;; Setup the *runremote* global var (if *runremote* (debug:print 2 "ERROR: I'm not expecting *runremote* to be set at this time")) ;; (set! *runremote* runremote) (set! *transport-type* (string->symbol transport)) (set! keys (cdb:remote-run db:get-keys #f)) |
︙ | |||
124 125 126 127 128 129 130 | 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 | - + | ;; Can setup as client for server mode now ;; (client:setup) (change-directory *toppath*) (set-megatest-env-vars run-id) ;; these may be needed by the launching process (change-directory work-area) |
︙ | |||
404 405 406 407 408 409 410 | 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 | - + - + | ;; ;; <linkdir> - <target> - <testname> [ - <itempath> ] ;; ;; All log file links should be stored relative to the top of link path ;; ;; <target> - <testname> [ - <itempath> ] ;; |
︙ | |||
552 553 554 555 556 557 558 | 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 | - + | ;; 1. look though disks list for disk with most space ;; 2. create run dir on disk, path name is meaningful ;; 3. create link from run dir to megatest runs area ;; 4. remotely run the test on allocated host ;; - could be ssh to host from hosts table (update regularly with load) ;; - could be netbatch ;; (launch-test db (cadr status) test-conf)) |
︙ | |||
593 594 595 596 597 598 599 | 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 | - + - + | (diskpath #f) (cmdparms #f) (fullcmd #f) ;; (define a (with-output-to-string (lambda ()(write x)))) (mt-bindir-path #f) (item-path (item-list->path itemdat)) ;; (test-id (cdb:remote-run db:get-test-id #f run-id test-name item-path)) (testinfo (cdb:get-test-info-by-id *runremote* test-id)) |
︙ |
Modified megatest.scm from [1216238a60] to [30afa78c63].
︙ | |||
28 29 30 31 32 33 34 35 36 37 38 39 40 41 | 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 | + | (declare (uses daemon)) (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 "run_records.scm") (include "megatest-fossil-hash.scm") (let ((debugcontrolf (conc (get-environment-variable "HOME") "/.megatestrc"))) (if (file-exists? debugcontrolf) (load debugcontrolf))) |
︙ | |||
440 441 442 443 444 445 446 | 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 | - + | ;;====================================================================== ;; Remove old run(s) ;;====================================================================== ;; since several actions can be specified on the command line the removal ;; is done first (define (operate-on action) |
︙ |
Modified run-tests-queue-classic.scm from [ad152828d9] to [e6bbd11139].
1 2 | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | - + - | ;; test-records is a hash table testname:item_path => vector < testname testconfig waitons priority items-info ... > |
︙ | |||
130 131 132 133 134 135 136 | 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 | - + | (thread-sleep! 1) ;; (+ 2 *global-delta*)) ;; could have done hed tal here but doing car/cdr of newtal to rotate tests (loop (car newtal)(cdr newtal) reruns)) ((and have-resources (or (null? prereqs-not-met) (and (eq? testmode 'toplevel) (null? non-completed)))) |
︙ |
Modified runconfig.scm from [c0fb7afcc7] to [d34fbbfa1d].
1 2 3 4 5 6 7 8 9 10 11 12 | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 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 | - - - - - + + - - + - - - - - - - + + + + + + - - - + + + | ;;====================================================================== ;; read a config file, loading only the section pertinent ;; to this run field1val/field2val/field3val ... ;;====================================================================== (use format directory-utils) (declare (unit runconfig)) (declare (uses common)) (include "common_records.scm") |
︙ | |||
57 58 59 60 61 62 63 | 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 | - - + + - + + - + | (for-each (lambda (fullkey) (debug:print 2 (format #f "~20a ~a\n" fullkey (hash-table-ref/default whatfound fullkey 0)))) sections) (debug:print 2 "---") (set! *already-seen-runconfig-info* #t))) finaldat)) |
Modified runs.scm from [d694e00b35] to [3e021e4c4c].
︙ | |||
130 131 132 133 134 135 136 | 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 | - + + | (configf:get-section runconfig section))) (list "default" target)) (vector target runname testpatt keys keyvals envdat mconfig runconfig serverdat transport db toppath run-id))) (define (set-megatest-env-vars run-id #!key (inkeys #f)(inrunname #f)(inkeyvals #f)) (let* ((target (or (args:get-arg "-reqtarg") |
︙ | |||
221 222 223 224 225 226 227 | 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 | - + - - + | ;; FIXME: error out if /patt specified ;; (define (runs:run-tests target runname test-patts user flags) ;; test-names (common:clear-caches) ;; clear all caches (let* ((db #f) (keys (keys:config-get-fields *configdat*)) (keyvals (keys:target->keyval keys target)) |
︙ | |||
323 324 325 326 327 328 329 | 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 | - + | (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" |
︙ | |||
346 347 348 349 350 351 352 | 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 | - - + + | (if (not (null? required-tests)) (debug:print-info 1 "Adding " required-tests " to the run queue")) ;; NOTE: these are all parent tests, items are not expanded yet. (debug:print-info 4 "test-records=" (hash-table->alist test-records)) (let ((reglen (any->number (configf:lookup *configdat* "setup" "runqueue")))) (if reglen |
︙ | |||
402 403 404 405 406 407 408 | 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 | - + | '() reg))) (include "run-tests-queue-classic.scm") (include "run-tests-queue-new.scm") ;; parent-test is there as a placeholder for when parent-tests can be run as a setup step |
︙ | |||
508 509 510 511 512 513 514 | 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 | - + | (if (not parent-test) (debug:print 1 "NOTE: Not starting test " new-test-name " as it is state \"" (test:get-state testdat) "\" and status \"" (test:get-status testdat) "\", use -rerun \"" (test:get-status testdat) "\" or -force to override")) ;; NOTE: No longer be checking prerequisites here! Will never get here unless prereqs are ;; already met. ;; This would be a great place to do the process-fork |
︙ | |||
779 780 781 782 783 784 785 | 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 | - + | (runs:update-test_meta test-name test-conf))) test-names))) ;; This could probably be refactored into one complex query ... (define (runs:rollup-run keys runname user keyvals) (debug:print 4 "runs:rollup-run, keys: " keys " :runname " runname " user: " user) (let* ((db #f) |
︙ |
Modified tests.scm from [c40619bb57] to [b1e14ea02f].
︙ | |||
105 106 107 108 109 110 111 | 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 | - - + + | (loop (car tal)(cdr tal)(cons qry res))))))) #f)) ;; get the previous record for when this test was run where all keys match but runname ;; returns #f if no such test found, returns a single test record if found (define (test:get-previous-test-run-record db run-id test-name item-path) (let* ((keys (cdb:remote-run db:get-keys #f)) |
︙ |
Modified tests/tests.scm from [27bfdc97b2] to [03f9f60209].
︙ | |||
175 176 177 178 179 180 181 | 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 | - - - - - - - + + + + + + + - - + + | (define remargs (args:get-args '("bar" "foo" ":runname" "bob" ":SYSTEM" "ubuntu" ":RELEASE" "v1.2" ":datapath" "blah/foo" "nada") (list ":runname" ":state" ":status") (list "-h") args:arg-hash 0)) |
︙ | |||
270 271 272 273 274 275 276 | 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 | - + | (test #f "ubuntu" (car (keys:target-set-args keys (args:get-arg "-target") args:arg-hash))) (define rinfo #f) (test "get-run-info" #f (vector? (vector-ref (let ((rinf (cdb:remote-run db:get-run-info #f 1))) (set! rinfo rinf) rinf) 0))) |
︙ |