Overview
Comment: | Possible fix for collisions at test start (possibly with remove) |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.65 |
Files: | files | file ages | folders |
SHA1: |
57fdf136efcbda786125e07951d6f8a8 |
User & Date: | mrwellan on 2017-09-21 12:23:14 |
Other Links: | branch diff | manifest | tags |
Context
2017-09-22
| ||
13:43 | Added desktop pic check-in: d5ab33bd7c user: mrwellan tags: v1.65 | |
2017-09-21
| ||
12:23 | Possible fix for collisions at test start (possibly with remove) check-in: 57fdf136ef user: mrwellan tags: v1.65 | |
2017-09-20
| ||
21:59 | Compiled manual check-in: 1b76773ad4 user: matt tags: v1.65 | |
Changes
Modified launch.scm from [dd33d34146] to [224152075a].
︙ | ︙ | |||
451 452 453 454 455 456 457 | (if (substring-index "/" runscript) runscript ;; use unadultered if contains slashes (let ((fulln (conc work-area "/" runscript))) (if (and (common:file-exists? fulln) (file-execute-access? fulln)) fulln runscript))))) ;; assume it is on the path | < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 | (if (substring-index "/" runscript) runscript ;; use unadultered if contains slashes (let ((fulln (conc work-area "/" runscript))) (if (and (common:file-exists? fulln) (file-execute-access? fulln)) fulln runscript))))) ;; assume it is on the path (check-work-area (lambda () ;; NFS might not have propagated the directory meta data to the run host - give it time if needed (let loop ((count 0)) (if (or (common:directory-exists? work-area) (> count 10)) (change-directory work-area) (begin (debug:print 0 *default-log-port* "INFO: Not starting job yet - directory " work-area " not found") |
︙ | ︙ | |||
543 544 545 546 547 548 549 | (set! bad-files (cons fname bad-files))))) files) (if (not (null? bad-files)) (begin (debug:print 0 *default-log-port* "INFO: test data from " testpath " not copied properly or filesystem problems causing data to not be found. Re-running the copy command.") (debug:print 0 *default-log-port* "INFO: missing files from " work-area ": " (string-intersperse bad-files ", ")) (launch:test-copy testpath work-area)))) | < | > > > > > > > > > > > | > | 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 | (set! bad-files (cons fname bad-files))))) files) (if (not (null? bad-files)) (begin (debug:print 0 *default-log-port* "INFO: test data from " testpath " not copied properly or filesystem problems causing data to not be found. Re-running the copy command.") (debug:print 0 *default-log-port* "INFO: missing files from " work-area ": " (string-intersperse bad-files ", ")) (launch:test-copy testpath work-area)))) ;; one more time, change to the work-area directory (change-directory work-area))) ) ;; let* (if contour (setenv "MT_CONTOUR" contour)) ;; immediated set some key variables from CMDINFO data, yes, these will be set again below ... ;; (setenv "MT_TESTSUITENAME" areaname) (setenv "MT_RUN_AREA_HOME" top-path) (set! *toppath* top-path) (change-directory *toppath*) ;; temporarily switch to the run area home (setenv "MT_TEST_RUN_DIR" work-area) (launch:setup) ;; should be properly in the run area home now (set! tconfigreg (tests:get-all)) (let ((sighand (lambda (signum) ;; (signal-mask! signum) ;; to mask or not? seems to cause issues in exiting (if (eq? signum signal/stop) (debug:print-error 0 *default-log-port* "attempt to STOP process. Exiting.")) (set! *time-to-exit* #t) (print "Received signal " signum ", cleaning up before exit. Please wait...") |
︙ | ︙ | |||
612 613 614 615 616 617 618 619 620 621 622 623 624 625 | ;; one of these is defunct/redundant ... (if (not (launch:setup force-reread: #t)) (begin (debug:print 0 *default-log-port* "Failed to setup, exiting") ;; (sqlite3:finalize! db) ;; (sqlite3:finalize! tdb) (exit 1))) (change-directory *toppath*) ;; NOTE: Current order is to process runconfigs *before* setting the MT_ vars. This ;; seems non-ideal but could well break stuff ;; BUG? BUG? BUG? (let ((rconfig (full-runconfigs-read)) ;; (read-config (conc *toppath* "/runconfigs.config") #f #t sections: (list "default" target)))) | > > > > | 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 | ;; one of these is defunct/redundant ... (if (not (launch:setup force-reread: #t)) (begin (debug:print 0 *default-log-port* "Failed to setup, exiting") ;; (sqlite3:finalize! db) ;; (sqlite3:finalize! tdb) (exit 1))) ;; validate that the test run area is available (check-work-area) ;; still need to go back to run area home for next couple steps (change-directory *toppath*) ;; NOTE: Current order is to process runconfigs *before* setting the MT_ vars. This ;; seems non-ideal but could well break stuff ;; BUG? BUG? BUG? (let ((rconfig (full-runconfigs-read)) ;; (read-config (conc *toppath* "/runconfigs.config") #f #t sections: (list "default" target)))) |
︙ | ︙ | |||
644 645 646 647 648 649 650 651 652 653 654 655 656 657 | (if (or (common:file-exists? work-area) (> count 10)) (change-directory work-area) (begin (debug:print 0 *default-log-port* "INFO: Not starting job yet - directory " work-area " not found") (thread-sleep! 10) (loop (+ count 1))))) ;;(bb-check-path msg: "launch:execute post block 1.5") ;; (change-directory work-area) (set! keyvals (keys:target->keyval keys target)) ;; apply pre-overrides before other variables. The pre-override vars must not ;; clobbers things from the official sources such as megatest.config and runconfigs.config (if (string? set-vars) (let ((varpairs (string-split set-vars ","))) | > > > | 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 | (if (or (common:file-exists? work-area) (> count 10)) (change-directory work-area) (begin (debug:print 0 *default-log-port* "INFO: Not starting job yet - directory " work-area " not found") (thread-sleep! 10) (loop (+ count 1))))) ;; now we can switch to the work-area? (change-directory work-area) ;;(bb-check-path msg: "launch:execute post block 1.5") ;; (change-directory work-area) (set! keyvals (keys:target->keyval keys target)) ;; apply pre-overrides before other variables. The pre-override vars must not ;; clobbers things from the official sources such as megatest.config and runconfigs.config (if (string? set-vars) (let ((varpairs (string-split set-vars ","))) |
︙ | ︙ |