359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
|
(pids (delete-duplicates (filter number? (list pid1 pid2)))))
(if (not (null? pids))
(begin
(for-each
(lambda (pid)
(handle-exceptions
exn
(debug:print-info 0 "Unable to kill process with pid " pid ", possibly already killed.")
(debug:print 0 "WARNING: Request received to kill job " pid) ;; " (attempt # " kill-tries ")")
(process-signal pid signal/int)
(thread-sleep! 5)
(process-signal pid signal/kill)))
pids)
(tests:test-set-status! run-id test-id "KILLED" "KILLED" (args:get-arg "-m") #f))
(begin
(debug:print 0 "ERROR: Nothing to kill, pid1=" pid1 ", pid2=" pid2)
(tests:test-set-status! run-id test-id "KILLED" "FAILED TO KILL" (args:get-arg "-m") #f)
)))
(mutex-unlock! m)
|
>
|
>
>
>
|
|
>
|
|
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
|
(pids (delete-duplicates (filter number? (list pid1 pid2)))))
(if (not (null? pids))
(begin
(for-each
(lambda (pid)
(handle-exceptions
exn
(begin
(debug:print-info 0 "Unable to kill process with pid " pid ", possibly already killed.")
(debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn)))
(debug:print 0 "WARNING: Request received to kill job " pid) ;; " (attempt # " kill-tries ")")
(if (process:alive? pid)
(begin
(process-signal pid signal/int)
(thread-sleep! 5)
(if (process:process-alive? pid)
(process-signal pid signal/kill))))))
pids)
(tests:test-set-status! run-id test-id "KILLED" "KILLED" (args:get-arg "-m") #f))
(begin
(debug:print 0 "ERROR: Nothing to kill, pid1=" pid1 ", pid2=" pid2)
(tests:test-set-status! run-id test-id "KILLED" "FAILED TO KILL" (args:get-arg "-m") #f)
)))
(mutex-unlock! m)
|
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
|
(if linktree
(if (not (file-exists? linktree))
(begin
(handle-exceptions
exn
(begin
(debug:print 0 "ERROR: Something went wrong when trying to create linktree dir at " linktree)
(exit 1))
(create-directory linktree #t))))
(begin
(debug:print 0 "ERROR: linktree not defined in [setup] section of megatest.config")
(exit 1)))
(if linktree
(let ((dbdir (conc linktree "/.db")))
(handle-exceptions
exn
(debug:print 0 "ERROR: failed to create the " dbdir " area for your database files")
(if (not (directory-exists? dbdir))(create-directory dbdir)))
(setenv "MT_LINKTREE" linktree))
(begin
(debug:print 0 "ERROR: linktree is required in your megatest.config [setup] section")
(exit 1)))
(if (and *toppath*
(directory-exists? *toppath*))
|
>
>
|
>
|
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
|
(if linktree
(if (not (file-exists? linktree))
(begin
(handle-exceptions
exn
(begin
(debug:print 0 "ERROR: Something went wrong when trying to create linktree dir at " linktree)
(debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
(exit 1))
(create-directory linktree #t))))
(begin
(debug:print 0 "ERROR: linktree not defined in [setup] section of megatest.config")
(exit 1)))
(if linktree
(let ((dbdir (conc linktree "/.db")))
(handle-exceptions
exn
(begin
(debug:print 0 "ERROR: failed to create the " dbdir " area for your database files")
(debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn)))
(if (not (directory-exists? dbdir))(create-directory dbdir)))
(setenv "MT_LINKTREE" linktree))
(begin
(debug:print 0 "ERROR: linktree is required in your megatest.config [setup] section")
(exit 1)))
(if (and *toppath*
(directory-exists? *toppath*))
|