Overview
| Comment: | rundir and links fix |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
346409ed1e1291dcc9d8dfc5ac79ac48 |
| User & Date: | matt on 2012-04-01 22:20:18 |
| Other Links: | manifest | tags |
Context
|
2012-04-01
| ||
| 23:29 | Updated copyrights check-in: 0a116daff3 user: mrwellan tags: trunk | |
| 23:14 | Pass debug params to execute tests Closed-Leaf check-in: b73650afa1 user: mrwellan tags: pass-debug-to-test-execute | |
| 22:23 | Experimentatal fixes Closed-Leaf check-in: 9dd8efddb8 user: mrwellan tags: experimental-fixes | |
| 22:20 | rundir and links fix check-in: 346409ed1e user: matt tags: trunk | |
|
2012-03-31
| ||
| 18:38 | Cleaned up ignores and added minimal example to docs check-in: ca3478ee5c user: matt tags: trunk | |
Changes
Modified launch.scm from [2790622feb] to [290ef6c47a].
| ︙ | ︙ | |||
377 378 379 380 381 382 383 384 385 |
(map car disks)))
(if best
best
(begin
(debug:print 0 "ERROR: No valid disks found in megatest.config. Please add some to your [disks] section")
(exit 1)))))
(define (create-work-area db run-id test-path disk-path testname itemdat)
(let* ((run-info (db:get-run-info db run-id))
| > > > > > > > > > > > > > > > | < | > | < > | | | > | | | 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 |
(map car disks)))
(if best
best
(begin
(debug:print 0 "ERROR: No valid disks found in megatest.config. Please add some to your [disks] section")
(exit 1)))))
;; Desired directory structure:
;;
;; <linkdir> - <target> - <testname> -.
;; |
;; v
;; <rundir> - <target> - <testname> -|- <itempath(s)>
;;
;; dir stored in test is:
;;
;; <linkdir> - <target> - <testname> [ - <itempath> ]
;;
;; All log file links should be stored relative to the top of link path
;;
;; <target> - <testname> [ - <itempath> ]
;;
(define (create-work-area db run-id test-path disk-path testname itemdat)
(let* ((run-info (db:get-run-info db run-id))
(item-path (item-list->path itemdat))
(runname (db:get-value-by-header (db:get-row run-info)
(db:get-header run-info)
"runname"))
(key-vals (rdb:get-key-vals db run-id))
(target (string-intersperse key-vals "/"))
;; nb// if itempath is not "" then it is prefixed with "/"
(dfullp (conc disk-path "/" target "/" runname "/" testname (if (equal? item-path "") "/" "") item-path))
;; ensure this exists first as links to subtests must be created there
(toptest-path (conc disk-path "/" target "/" runname "/" testname))
(linktree (let ((rd (config-lookup *configdat* "setup" "linktree")))
(if rd rd (conc *toppath* "/runs"))))
(lnkpath (conc linktree "/" target "/" runname item-path)))
(if (not (file-exists? linktree))
(begin
(debug:print 0 "WARNING: linktree did not exist! Creating it now at " linktree)
(create-directory linktree #t))) ;; (system (conc "mkdir -p " linktree))))
;; since this is an iterated test this is as good a place as any to
;; update the toptest record with its location rundir
(if (not (equal? item-path ""))
(db:test-set-rundir! db run-id testname "" toptest-path))
(debug:print 2 "Setting up test run area")
(debug:print 2 " - creating run area in " dfullp)
(create-directory dfullp #t) ;; (system (conc "mkdir -p " dfullp))
(debug:print 2 " - creating link from " dfullp "/" testname " to " lnkpath)
(create-directory lnkpath #t) ;; (system (conc "mkdir -p " lnkpath))
;; I suspect this section was deleting test directories under some
;; wierd sitations? This doesn't make sense - reenabling the rm -f
(let ((testlink (conc lnkpath "/" testname)))
(if (and (file-exists? testlink)
(or (regular-file? testlink)
|
| ︙ | ︙ |