Check-in [c661cee49c]
Not logged in
Overview
SHA1 Hash:c661cee49cdca265df86d4e9128ea68a94f91108
Date: 2012-04-02 01:40:34
User: mrwellan
Comment:Restructured runs dir and links
Timelines: family | ancestors | descendants | both | trunk
Downloads: Tarball | ZIP archive
Other Links: files | file ages | manifest
Tags And Properties
Changes

Modified launch.scm from [4c2421b45c5b9076] to [c5891929fbdcac78].

408 408 ;; nb// if itempath is not "" then it is prefixed with "/" 409 409 (toptest-path (conc disk-path "/" target "/" runname "/" testname)) 410 410 (test-path (conc toptest-path (if (equal? item-path "") "" "/") item-path)) 411 411 ;; ensure this exists first as links to subtests must be created there 412 412 (linktree (let ((rd (config-lookup *configdat* "setup" "linktree"))) 413 413 (if rd rd (conc *toppath* "/runs")))) 414 414 (lnkbase (conc linktree "/" target "/" runname)) 415 - (lnkpath (conc lnkbase "/" testname))) ;; item-path))) 415 + (lnkpath (conc lnkbase "/" testname)) ;; item-path))) 416 + (lnkpathf (conc lnkpath (if (equal? item-path "") "" "/") item-path))) 416 417 (debug:print 2 "INFO:\n lnkbase=" lnkbase "\n lnkpath=" lnkpath "\n toptest-path=" toptest-path "\n test-path=" test-path) 417 418 (if (not (file-exists? linktree)) 418 419 (begin 419 420 (debug:print 0 "WARNING: linktree did not exist! Creating it now at " linktree) 420 421 (create-directory linktree #t))) ;; (system (conc "mkdir -p " linktree)))) 421 422 ;; create the directory for the tests dir links, this is needed no matter what... 422 423 (if (not (directory-exists? lnkbase)) ................................................................................ 454 455 (if (not (equal? item-path "")) ;; this is an iterated test 455 456 (let ((lnktarget (conc lnkpath "/" item-path))) 456 457 (debug:print 2 "Setting up sub test run area") 457 458 (debug:print 2 " - creating run area in " test-path) 458 459 (create-directory test-path #t) ;; (system (conc "mkdir -p " test-path)) 459 460 (debug:print 2 " - creating link from " test-path " to " lnktarget) 460 461 ;; (create-directory lnkpath #t) ;; (system (conc "mkdir -p " lnkpath)) 461 - 462 - (create-symbolic-link test-path lnktarget))) 462 + (if (not (file-exists? lnktarget)) 463 + (create-symbolic-link test-path lnktarget)))) 463 464 464 465 ;; I suspect this section was deleting test directories under some 465 466 ;; wierd sitations? This doesn't make sense - reenabling the rm -f 466 467 ;; I honestly don't remember *why* this chunk was needed... 467 468 ;; (let ((testlink (conc lnkpath "/" testname))) 468 469 ;; (if (and (file-exists? testlink) 469 470 ;; (or (regular-file? testlink) ................................................................................ 472 473 ;; (system (conc "ln -sf " test-path " " testlink))) 473 474 (if (directory? test-path) 474 475 (begin 475 476 (let* ((cmd (conc "rsync -av" (if (> *verbosity* 1) "" "q") " " test-src-path "/ " test-path "/")) 476 477 (status (system cmd))) 477 478 (if (not (eq? status 0)) 478 479 (debug:print 2 "ERROR: problem with running \"" cmd "\""))) 479 - (list test-path toptest-path)) 480 + (list lnkpathf lnkpath)) 480 481 (list #f #f)))) 481 482 482 483 ;; 1. look though disks list for disk with most space 483 484 ;; 2. create run dir on disk, path name is meaningful 484 485 ;; 3. create link from run dir to megatest runs area 485 486 ;; 4. remotely run the test on allocated host 486 487 ;; - could be ssh to host from hosts table (update regularly with load)