Index: launch.scm ================================================================== --- launch.scm +++ launch.scm @@ -473,32 +473,58 @@ ;; to the iteration. use pathname-directory to trim the path by one ;; level (if (not not-iterated) ;; i.e. iterated (let ((iterated-parent (pathname-directory (conc lnkpath "/" item-path)))) (debug:print-info 2 "Creating iterated parent " iterated-parent) - (create-directory iterated-parent #t))) + (handle-exceptions + exn + (begin + (debug:print 0 "ERROR: Failed to create directory " iterated-parent ((condition-property-accessor 'exn 'message) exn) ", exiting") + (exit 1)) + (create-directory iterated-parent #t)))) - (if (symbolic-link? lnkpath) (delete-file lnkpath)) + (if (symbolic-link? lnkpath) + (handle-exceptions + exn + (begin + (debug:print 0 "ERROR: Failed to remove symlink " lnkpath ((condition-property-accessor 'exn 'message) exn) ", exiting") + (exit 1)) + (delete-file lnkpath))) + (if (not (or (file-exists? lnkpath) (symbolic-link? lnkpath))) - (create-symbolic-link toptest-path lnkpath)) + (handle-exceptions + exn + (begin + (debug:print 0 "ERROR: Failed to create symlink " lnkpath ((condition-property-accessor 'exn 'message) exn) ", exiting") + (exit 1)) + (create-symbolic-link toptest-path lnkpath))) ;; The toptest path has been created, the link to the test in the linktree has ;; been created. Now, if this is an iterated test the real test dir must be created (if (not not-iterated) ;; 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)) + (handle-exceptions + exn + (begin + (debug:print 0 "ERROR: Failed to create directory " test-path ((condition-property-accessor 'exn 'message) exn) ", exiting") + (exit 1)) + (create-directory test-path #t)) (debug:print 2 " - creating link from: " test-path "\n" " to: " lnktarget) - ;; (create-directory lnkpath #t) ;; (system (conc "mkdir -p " lnkpath)) ;; If there is already a symlink delete it and recreate it. - (if (symbolic-link? lnktarget) (delete-file lnktarget)) - (if (not (file-exists? lnktarget)) (create-symbolic-link test-path lnktarget)))) + (handle-exceptions + exn + (begin + (debug:print 0 "ERROR: Failed to re-create link " linktarget ((condition-property-accessor 'exn 'message) exn) ", exiting") + (exit)) + (if (symbolic-link? lnktarget) (delete-file 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))) @@ -507,11 +533,19 @@ ;; (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 (debug:debug-mode 1) "" "q") " " test-src-path "/ " test-path "/")) + (let* ((ovrcmd (let ((cmd (config-lookup *configdat* "setup" "testcopycmd"))) + (if cmd + ;; substitute the TEST_SRC_PATH and TEST_TARG_PATH + (string-substitute "TEST_TARG_PATH" test-path + (string-substitute "TEST_SRC_PATH" test-src-path cmd)) + #f))) + (cmd (if ovrcmd + ovrcmd + (conc "rsync -av" (if (debug:debug-mode 1) "" "q") " " test-src-path "/ " test-path "/"))) (status (system cmd))) (if (not (eq? status 0)) (debug:print 2 "ERROR: problem with running \"" cmd "\""))) (list lnkpathf lnkpath )) (list #f #f)))) Index: mkdeploy/megatest.config ================================================================== --- mkdeploy/megatest.config +++ mkdeploy/megatest.config @@ -23,6 +23,8 @@ # put env-override last so definitions in site.config by default # are added as env-override variables # [env-override] + +# if the file site.config exists it will be used [include site.config] Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -817,15 +817,21 @@ (debug:print 0 "WARNING: directory " real-dir " does not exist") (debug:print 0 "WARNING: no real directory corrosponding to link " run-dir ", nothing done"))) (if (symbolic-link? run-dir) (begin (debug:print-info 1 "Removing symlink " run-dir) - (delete-file run-dir)) + (handle-exceptions + exn + (debug:print 0 "ERROR: Failed to remove symlink " run-dir ((condition-property-accessor 'exn 'message) exn) ", attempting to continue") + (delete-file run-dir))) (if (directory? run-dir) (if (> (directory-fold (lambda (f x)(+ 1 x)) 0 run-dir) 0) (debug:print 0 "WARNING: refusing to remove " run-dir " as it is not empty") - (delete-directory run-dir)) ;; it should be empty by here BUG BUG, add error catch + (handle-exceptions + exn + (debug:print 0 "ERROR: Failed to remove directory " run-dir ((condition-property-accessor 'exn 'message) exn) ", attempting to continue") + (delete-directory run-dir))) (if run-dir (debug:print 0 "WARNING: not removing " run-dir " as it either doesn't exist or is not a symlink") (debug:print 0 "NOTE: the run dir for this test is undefined. Test may have already been deleted.")) ))) ((set-state-status) Index: tests/fullrun/megatest.config ================================================================== --- tests/fullrun/megatest.config +++ tests/fullrun/megatest.config @@ -9,10 +9,21 @@ area1 /tmp/oldarea/megatest [include #{getenv MT_RUN_AREA_HOME}/config/mt_include_1.config] [setup] + +# It is possible (but not recommended) to override the rsync command used +# to populate the test directories. For test development the following +# example can be useful +# +testcopycmd cp --remove-destination -rsv TEST_SRC_PATH/. TEST_TARG_PATH/. + +# or for hard links + +# testcopycmd cp --remove-destination -rlv TEST_SRC_PATH/ TEST_TARG_PATH/ + # FULL or 2, NORMAL or 1, OFF or 0 synchronous OFF # Throttle roughly scales the db access milliseconds to seconds delay throttle 0.2 # Max retries allows megatest to re-check that a tests status has changed