Megatest

Check-in [c661cee49c]
Login
Overview
Comment:Restructured runs dir and links
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: c661cee49cdca265df86d4e9128ea68a94f91108
User & Date: mrwellan on 2012-04-02 01:40:34
Other Links: manifest | tags
Context
2012-04-02
01:47
Added info print to help resolve links vs. run area check-in: e1b6d511c2 user: mrwellan tags: trunk
01:40
Restructured runs dir and links check-in: c661cee49c user: mrwellan tags: trunk
01:25
Restructured runs dir and links check-in: a8bf4e7e6f user: mrwellan tags: trunk
Changes

Modified launch.scm from [4c2421b45c] to [c5891929fb].

408
409
410
411
412
413
414
415


416
417
418
419
420
421
422
408
409
410
411
412
413
414

415
416
417
418
419
420
421
422
423







-
+
+







	 ;; nb// if itempath is not "" then it is prefixed with "/"
	 (toptest-path (conc disk-path "/" target "/" runname "/" testname))
	 (test-path    (conc toptest-path (if (equal? item-path "") "" "/") item-path))
	 ;; ensure this exists first as links to subtests must be created there
	 (linktree  (let ((rd (config-lookup *configdat* "setup" "linktree")))
		     (if rd rd (conc *toppath* "/runs"))))
	 (lnkbase  (conc linktree "/" target "/" runname))
	 (lnkpath  (conc lnkbase "/" testname))) ;; item-path)))
	 (lnkpath  (conc lnkbase "/" testname)) ;; item-path)))
	 (lnkpathf (conc lnkpath (if (equal? item-path "") "" "/") item-path)))
    (debug:print 2 "INFO:\n       lnkbase=" lnkbase "\n       lnkpath=" lnkpath "\n  toptest-path=" toptest-path "\n     test-path=" test-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))))
    ;; create the directory for the tests dir links, this is needed no matter what...
    (if (not (directory-exists? lnkbase))
454
455
456
457
458
459
460
461
462


463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479

480
481
482
483
484
485
486
455
456
457
458
459
460
461


462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479

480
481
482
483
484
485
486
487







-
-
+
+
















-
+







    (if (not (equal? item-path "")) ;; this is an iterated test
	(let ((lnktarget (conc lnkpath "/" item-path)))
	  (debug:print 2 "Setting up sub test run area")
	  (debug:print 2 " - creating run area in " test-path)
	  (create-directory test-path #t) ;; (system  (conc "mkdir -p " test-path))
	  (debug:print 2 " - creating link from " test-path " to " lnktarget)
	  ;; (create-directory lnkpath #t) ;; (system  (conc "mkdir -p " lnkpath))
	  
	  (create-symbolic-link test-path lnktarget)))
	  (if (not (file-exists? lnktarget))
	      (create-symbolic-link test-path lnktarget))))

    ;; I suspect this section was deleting test directories under some 
    ;; wierd sitations? This doesn't make sense - reenabling the rm -f 
    ;; I honestly don't remember *why* this chunk was needed...
    ;; (let ((testlink (conc lnkpath "/" testname)))
    ;;   (if (and (file-exists? testlink)
    ;;            (or (regular-file? testlink)
    ;;     	   (symbolic-link? testlink)))
    ;;       (system (conc "rm -f " testlink)))
    ;;   (system  (conc "ln -sf " test-path " " testlink)))
    (if (directory? test-path)
	(begin
	  (let* ((cmd    (conc "rsync -av" (if (> *verbosity* 1) "" "q") " " test-src-path "/ " test-path "/"))
		 (status (system cmd)))
	    (if (not (eq? status 0))
		(debug:print 2 "ERROR: problem with running \"" cmd "\"")))
	  (list test-path toptest-path))
	  (list lnkpathf lnkpath))
	(list #f #f))))

;; 1. look though disks list for disk with most space
;; 2. create run dir on disk, path name is meaningful
;; 3. create link from run dir to megatest runs area 
;; 4. remotely run the test on allocated host
;;    - could be ssh to host from hosts table (update regularly with load)