@@ -274,11 +274,11 @@ (lambda (pid) (handle-exceptions exn (begin (debug:print-info 0 *default-log-port* "Unable to kill process with pid " pid ", possibly already killed.") - (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))) + (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn)) (debug:print 0 *default-log-port* "WARNING: Request received to kill job " pid) ;; " (attempt # " kill-tries ")") (debug:print-info 0 *default-log-port* "Signal mask=" (signal-mask)) ;; (if (process:alive? pid) ;; (begin (map (lambda (pid-num) @@ -286,13 +286,15 @@ (process:get-sub-pids pid)) (thread-sleep! 5) ;; (if (process:process-alive? pid) (map (lambda (pid-num) (handle-exceptions - exn - #f - (process-signal pid-num signal/kill))) + exn + (begin + (debug:print 0 *default-log-port* " .... had trouble sending kill to " pid-num ", exn=" exn) + #f) + (process-signal pid-num signal/kill))) (process:get-sub-pids pid)))) ;; (debug:print-info 0 *default-log-port* "not killing process " pid " as it is not alive")))) pids) ;; BB: question to Matt -- does the tests:test-state-status! encompass rollup to toplevel? If not, should it? (tests:test-set-status! run-id test-id "KILLED" "KILLED" (conc (args:get-arg "-m")" "kill-reason) #f)) ;; BB ADDED kill-reason -- confirm OK with Matt @@ -1039,18 +1041,18 @@ (begin (handle-exceptions exn (begin (debug:print-error 0 *default-log-port* "Something went wrong when trying to create linktree dir at " linktree) - (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn)) + (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn) (exit 1)) (create-directory linktree #t)))) (handle-exceptions exn (begin (debug:print-error 0 *default-log-port* "Something went wrong when trying to create link to linktree at " *toppath*) - (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))) + (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn)) (let ((tlink (conc *toppath* "/lt"))) (if (not (common:file-exists? tlink)) (create-symbolic-link linktree tlink))))) (begin (debug:print-error 0 *default-log-port* "linktree not defined in [setup] section of megatest.config") @@ -1111,11 +1113,15 @@ ;;(exit 1) (if (null? disks) (cons 1 (conc *toppath* "/runs")) (let ((paths (sort disks (lambda (x y) (> (string-length (cadr x)) (string-length (cadr y))))))) (let loop ((head (car paths)) (tail (cdr paths))) - (let ((result (handle-exceptions exn #f (create-directory (cadr head) #t)))) + (let ((result (handle-exceptions exn + (begin + (debug:print 0 *default-log-port* "failed to create dir " (cadr head) ", exn=" exn) + #f) + (create-directory (cadr head) #t)))) (if result result (if (null? tail) (cons 1 (conc *toppath* "/runs")) (loop (car tail) (cdr tail))))))))))) @@ -1207,11 +1213,11 @@ (let ((success (if (and (not (common:directory-exists? lnkbase)) (not (common:file-exists? lnkbase))) (handle-exceptions exn (begin - (debug:print-error 0 *default-log-port* "Problem creating linktree base at " lnkbase) + (debug:print-error 0 *default-log-port* "Problem creating linktree base at " lnkbase ", exn=" exn) (print-error-message exn (current-error-port)) #t) (create-directory lnkbase #t) #f)))) (if (and (not success)(> done 0)) @@ -1230,28 +1236,31 @@ (let ((iterated-parent (pathname-directory (conc lnkpath "/" item-path)))) (debug:print-info 2 *default-log-port* "Creating iterated parent " iterated-parent) (handle-exceptions exn (begin - (debug:print-error 0 *default-log-port* " Failed to create directory " iterated-parent ((condition-property-accessor 'exn 'message) exn) ", continuing but link tree may be corrupted") + (debug:print-error 0 *default-log-port* " Failed to create directory " iterated-parent ((condition-property-accessor 'exn 'message) exn) + ", continuing but link tree may be corrupted, exn=" exn) #;(exit 1)) (create-directory iterated-parent #t)))) (if (symbolic-link? lnkpath) (handle-exceptions exn (begin - (debug:print-error 0 *default-log-port* " Failed to remove symlink " lnkpath ((condition-property-accessor 'exn 'message) exn) ", continuing but link tree may be corrupted.") + (debug:print-error 0 *default-log-port* " Failed to remove symlink " lnkpath ((condition-property-accessor 'exn 'message) exn) + ", continuing but link tree may be corrupted. exn=" exn) #;(exit 1)) (delete-file lnkpath))) (if (not (or (common:file-exists? lnkpath) (symbolic-link? lnkpath))) (handle-exceptions exn (begin - (debug:print-error 0 *default-log-port* " Failed to create symlink " lnkpath ((condition-property-accessor 'exn 'message) exn) ", continuing but link tree may be corrupted.") + (debug:print-error 0 *default-log-port* " Failed to create symlink " lnkpath ((condition-property-accessor 'exn 'message) exn) + ", continuing but link tree may be corrupted. exn=" exn) #;(exit 1)) (create-symbolic-link toptest-path lnkpath))) ;; NB - This was not working right - some top tests are not getting the path set!!! ;; @@ -1278,12 +1287,14 @@ (if (or (not curr-test-path) (not (directory-exists? toptest-path))) (begin (debug:print-info 2 *default-log-port* "Creating " toptest-path " and link " lnkpath) (handle-exceptions - exn - #f ;; don't care to catch and deal with errors here for now. + exn + (begin + (debug:print 0 *default-log-port* "failed to create directory " toptest-path ", exn=" exn) + #f) (create-directory toptest-path #t)) (hash-table-set! *toptest-paths* testname toptest-path))))) ;; 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 @@ -1292,11 +1303,12 @@ (debug:print 2 *default-log-port* "Setting up sub test run area") (debug:print 2 *default-log-port* " - creating run area in " test-path) (handle-exceptions exn (begin - (debug:print-error 0 *default-log-port* " Failed to create directory " test-path ((condition-property-accessor 'exn 'message) exn) ", exiting") + (debug:print-error 0 *default-log-port* " Failed to create directory " test-path ((condition-property-accessor 'exn 'message) exn) + ", exiting, exn=" exn) (exit 1)) (create-directory test-path #t)) (debug:print 2 *default-log-port* " - creating link from: " test-path "\n" " to: " lnktarget) @@ -1303,11 +1315,11 @@ ;; If there is already a symlink delete it and recreate it. (handle-exceptions exn (begin - (debug:print-error 0 *default-log-port* " Failed to re-create link " lnktarget ((condition-property-accessor 'exn 'message) exn) ", exiting") + (debug:print-error 0 *default-log-port* " Failed to re-create link " lnktarget ((condition-property-accessor 'exn 'message) exn) ", exiting, exn=" exn) (exit)) (if (symbolic-link? lnktarget) (delete-file lnktarget)) (if (not (common:file-exists? lnktarget)) (create-symbolic-link test-path lnktarget))))) (if (not (directory? test-path))