1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
|
((and (not rerun)
(member (test:get-status testdat) '("FAIL" "n/a")))
(set! runflag #t))
(else (set! runflag #f)))
(debug:print 4 "RUNNING => runflag: " runflag " STATE: " (test:get-state testdat) " STATUS: " (test:get-status testdat))
(if (not runflag)
(if (not parent-test)
(debug:print 1 "NOTE: Not starting test " full-test-name " as it is state \"" (test:get-state testdat)
"\" and status \"" (test:get-status testdat) "\", use -rerun \"" (test:get-status testdat)
"\" or -force to override"))
;; NOTE: No longer be checking prerequisites here! Will never get here unless prereqs are
;; already met.
;; This would be a great place to do the process-fork
;;
(let ((skip-test #f)
(skip-check (configf:get-section test-conf "skip")))
(cond
|
>
|
|
|
|
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
|
((and (not rerun)
(member (test:get-status testdat) '("FAIL" "n/a")))
(set! runflag #t))
(else (set! runflag #f)))
(debug:print 4 "RUNNING => runflag: " runflag " STATE: " (test:get-state testdat) " STATUS: " (test:get-status testdat))
(if (not runflag)
(if (not parent-test)
(if (runs:lownoise (conc "not starting test" full-test-name) 60)
(debug:print 1 "NOTE: Not starting test " full-test-name " as it is state \"" (test:get-state testdat)
"\" and status \"" (test:get-status testdat) "\", use -rerun \"" (test:get-status testdat)
"\" or -force to override")))
;; NOTE: No longer be checking prerequisites here! Will never get here unless prereqs are
;; already met.
;; This would be a great place to do the process-fork
;;
(let ((skip-test #f)
(skip-check (configf:get-section test-conf "skip")))
(cond
|
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
|
(count (if (null? params) 1 (car params))))
(conc "/" (string-intersperse
(take dparts (- (length dparts) count))
"/"))))
(define (runs:recursive-delete-with-error-msg real-dir)
(if (> (system (conc "rm -rf " real-dir)) 0)
(debug:print 0 "ERROR: There was a problem removing " real-dir " with rm -f")))
(define (runs:safe-delete-test-dir real-dir)
;; first delete all sub-directories
(directory-fold
(lambda (f x)
(let ((fullname (conc real-dir "/" f)))
(if (directory? fullname)(runs:recursive-delete-with-error-msg fullname)))
|
>
>
>
>
|
|
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
|
(count (if (null? params) 1 (car params))))
(conc "/" (string-intersperse
(take dparts (- (length dparts) count))
"/"))))
(define (runs:recursive-delete-with-error-msg real-dir)
(if (> (system (conc "rm -rf " real-dir)) 0)
(begin
;; FAILED, possibly due to permissions, do chmod a+rwx then try one more time
(system (conc "chmod -R a+rwx " real-dir))
(if (> (system (conc "rm -rf " real-dir)) 0)
(debug:print 0 "ERROR: There was a problem removing " real-dir " with rm -f")))))
(define (runs:safe-delete-test-dir real-dir)
;; first delete all sub-directories
(directory-fold
(lambda (f x)
(let ((fullname (conc real-dir "/" f)))
(if (directory? fullname)(runs:recursive-delete-with-error-msg fullname)))
|