Megatest

Diff
Login

Differences From Artifact [88f6ab0431]:

To Artifact [b67c39dcab]:


1205
1206
1207
1208
1209
1210
1211

1212
1213
1214



1215
1216
1217
1218
1219
1220
1221
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"))
		       (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
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")))
	    (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)))