Megatest

Check-in [346409ed1e]
Login
Overview
Comment:rundir and links fix
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 346409ed1e1291dcc9d8dfc5ac79ac486e8b1b44
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
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
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 (let ((ip (item-list->path itemdat)))
	 (item-path (item-list->path itemdat))
		      (if (equal? ip "") "" (conc "/" ip))))
	 (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))
	 (key-str  (string-intersperse key-vals "/"))
	 (dfullp   (conc disk-path "/" key-str "/" runname "/" testname
	 (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))
			 item-path))
	 (toptest-path (conc disk-path "/" key-str "/" runname "/" testname))
	 ;; 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 "/" key-str "/" runname item-path)))
	 (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)
	  (system (conc "mkdir -p " 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)
    (system  (conc "mkdir -p " dfullp))
    (create-directory dfullp #t) ;; (system  (conc "mkdir -p " dfullp))
    (debug:print 2 " - creating link from " dfullp "/" testname " to " lnkpath)
    (system  (conc "mkdir -p " 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)