Overview
Comment: | Cleaned up archiving |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.60 | v1.6019 |
Files: | files | file ages | folders |
SHA1: |
26c7e70d1ccc6b3f651e6dd5798b15fc |
User & Date: | mrwellan on 2015-07-07 15:07:53 |
Other Links: | branch diff | manifest | tags |
Context
2015-07-07
| ||
18:23 | fixed typo check-in: 59532cc2c4 user: mrwellan tags: v1.60 | |
15:07 | Cleaned up archiving check-in: 26c7e70d1c user: mrwellan tags: v1.60, v1.6019 | |
10:21 | regenerated the manual check-in: 96290df545 user: mrwellan tags: v1.60 | |
Changes
Modified archive.scm from [bf539ba83a] to [340ad26128].
︙ | ︙ | |||
229 230 231 232 233 234 235 | (archive-block-id (db:test-get-archived test-dat)) (archive-block-info (rmt:test-get-archive-block-info archive-block-id)) (archive-path (if (vector? archive-block-info) (vector-ref archive-block-info 2) ;; look in db.scm for test-get-archive-block-info for the vector record info #f)) ;; no archive found? (archive-internal-path (conc (common:get-testsuite-name) "-" run-id "/latest/" test-partial-path))) | | > > > > | > | 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 | (archive-block-id (db:test-get-archived test-dat)) (archive-block-info (rmt:test-get-archive-block-info archive-block-id)) (archive-path (if (vector? archive-block-info) (vector-ref archive-block-info 2) ;; look in db.scm for test-get-archive-block-info for the vector record info #f)) ;; no archive found? (archive-internal-path (conc (common:get-testsuite-name) "-" run-id "/latest/" test-partial-path))) ;; some sanity checks, move an existing path out of the way ;; (if (and prev-test-physical-path (file-exists? prev-test-physical-path)) ;; what to do? abort or clean up or link it in? (let ((base (pathname-directory prev-test-physical-path)) (dirn (pathname-file prev-test-physical-path)) (newn (conc base "/." dirn))) (debug:print 0 "ERROR: the old directory " prev-test-physical-path ", still exists! Moving it to " newn) (file-move prev-test-physical-path newn))) (if archive-path ;; no point in proceeding if there is no actual archive (begin ;; CREATE WORK AREA ;; test-src-path == #f ==> don't copy in data from tests directory ;; itemdat == string ==> use directly (create-work-area run-id run-name keyvals test-id #f best-disk test-name item-path) ;; #!key (remtries 2)) |
︙ | ︙ | |||
257 258 259 260 261 262 263 | (db:test-get-rundir new-test-dat) (begin (debug:print 0 "ERROR: unable to get data for run-id=" run-id ", test-id=" test-id) (exit 1)))) ;; new-test-path won't work - must use best-disk instead? Nope, new-test-path but tack on /.. (bup-restore-params (list "-d" archive-path "restore" "-C" (conc new-test-path "/..") archive-internal-path))) (debug:print-info 0 "Restoring archived data to " new-test-physical-path " from archive in " archive-path " ... " archive-internal-path) | | > | 262 263 264 265 266 267 268 269 270 271 272 273 | (db:test-get-rundir new-test-dat) (begin (debug:print 0 "ERROR: unable to get data for run-id=" run-id ", test-id=" test-id) (exit 1)))) ;; new-test-path won't work - must use best-disk instead? Nope, new-test-path but tack on /.. (bup-restore-params (list "-d" archive-path "restore" "-C" (conc new-test-path "/..") archive-internal-path))) (debug:print-info 0 "Restoring archived data to " new-test-physical-path " from archive in " archive-path " ... " archive-internal-path) (run-n-wait bup-exe params: bup-restore-params print-cmd: #f) (mt:test-set-state-status-by-id run-id test-id "COMPLETED" #f #f))) (debug:print 0 "ERROR: No archive path in the record for run-id=" run-id " test-id=" test-id)))) (filter vector? tests)))) |
Modified dashboard-tests.scm from [89fa6fa483] to [981b21b733].
︙ | ︙ | |||
555 556 557 558 559 560 561 | (conc "megatest -target " keystring " -runname " runname " -set-state-status KILLREQ,n/a -testpatt %/% " " -state RUNNING")))) (run-test (lambda (x) (iup:attribute-set! command-text-box "VALUE" (conc "megatest -target " keystring " -runname " runname | | | 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 | (conc "megatest -target " keystring " -runname " runname " -set-state-status KILLREQ,n/a -testpatt %/% " " -state RUNNING")))) (run-test (lambda (x) (iup:attribute-set! command-text-box "VALUE" (conc "megatest -target " keystring " -runname " runname " -run -testpatt " (conc testname "/" (if (equal? item-path "") "%" item-path)) )))) (remove-test (lambda (x) (iup:attribute-set! command-text-box "VALUE" (conc "megatest -remove-runs -target " keystring " -runname " runname |
︙ | ︙ | |||
587 588 589 590 591 592 593 | (remove-test (lambda (x) (iup:attribute-set! command-text-box "VALUE" (conc "megatest -remove-runs -target " keystring " -runname " runname " -testpatt " (conc testname "/" (if (equal? item-path "") "%" item-path)) | | > > > > > > > | | | | | | > | 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 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 | (remove-test (lambda (x) (iup:attribute-set! command-text-box "VALUE" (conc "megatest -remove-runs -target " keystring " -runname " runname " -testpatt " (conc testname "/" (if (equal? item-path "") "%" item-path)) " -v")))) (archive-test (lambda (x) (iup:attribute-set! command-text-box "VALUE" (conc "megatest -target " keystring " -runname " runname " -archive save-remove -testpatt " (conc testname "/" (if (equal? item-path "") "%" item-path)) ))))) (cond ((not testdat)(begin (print "ERROR: bad test info for " test-id)(exit 1))) ((not rundat)(begin (print "ERROR: found test info but there is a problem with the run info for " run-id)(exit 1))) (else ;; (test-set-status! db run-id test-name state status itemdat) (set! self ; (iup:dialog #:close_cb (lambda (a)(exit)) ; #:expand "YES" #:title testfullname (iup:vbox ; #:expand "YES" ;; The run and test info (iup:hbox ; #:expand "YES" (run-info-panel dbstruct keydat testdat runname) (test-info-panel testdat store-label widgets) (test-meta-panel testmeta store-meta)) (host-info-panel testdat store-label) ;; The controls (iup:frame #:title "Actions" (iup:vbox (iup:hbox (iup:button "View Log" #:action viewlog #:size "80x") (iup:button "Start Xterm" #:action xterm #:size "80x") (iup:button "Run Test" #:action run-test #:size "80x") (iup:button "Clean Test" #:action remove-test #:size "80x") (iup:button "CleanRunExecute!" #:action clean-run-execute #:size "80x") (iup:button "Kill All Jobs" #:action kill-jobs #:size "80x") (iup:button "Archive Test" #:action archive-test #:size "80x") (iup:button "Close" #:action (lambda (x)(exit)) #:size "80x")) (apply iup:hbox (list command-text-box command-launch-button)))) (set-fields-panel dbstruct run-id test-id testdat) (let ((tabs (iup:tabs |
︙ | ︙ |
Modified megatest-version.scm from [a98e35a9bb] to [b37c417062].
1 2 3 4 5 | ;; Always use two or four digit decimal ;; 1.01, 1.02...1.10,1.11,1,1101 ... 1.99,2.00.. (declare (unit megatest-version)) | | | 1 2 3 4 5 6 7 | ;; Always use two or four digit decimal ;; 1.01, 1.02...1.10,1.11,1,1101 ... 1.99,2.00.. (declare (unit megatest-version)) (define megatest-version 1.6019) |