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 | folders | 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)