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 | (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" |
︙ | ︙ | |||
614 615 616 617 618 619 620 621 622 623 624 625 626 627 | (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 "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 | > | 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 | (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) |