summaryrefslogtreecommitdiff
path: root/drmaa/v1/high.scm
diff options
context:
space:
mode:
Diffstat (limited to 'drmaa/v1/high.scm')
-rw-r--r--drmaa/v1/high.scm54
1 files changed, 30 insertions, 24 deletions
diff --git a/drmaa/v1/high.scm b/drmaa/v1/high.scm
index d93922b..9c7ff63 100644
--- a/drmaa/v1/high.scm
+++ b/drmaa/v1/high.scm
@@ -294,29 +294,34 @@
(define-method (lower-job-template (instance <job-template>))
(define klass (class-of instance))
- (define t (low:allocate-job-template!))
- ;; Validate slots
- (for-each
- (lambda (slot)
- (let* ((options (slot-definition-options slot))
- (keyword (slot-definition-init-keyword slot))
- (drmaa (and=> (memq #:drmaa-name options) cadr))
- (transform (or (and=> (memq #:transform options) cadr)
- identity))
- (slot-name (slot-definition-name slot)))
- (when (slot-bound? instance slot-name)
- (let* ((value (slot-ref instance slot-name))
- (transformed (transform value)))
- (cond
- ;; Empty lists and #false are not valid values to set.
- ((or (null? transformed) (not transformed))
- #true)
- ((pair? transformed)
- (apply low:set-vector-attribute! t drmaa transformed))
- (else
- (low:set-attribute! t drmaa transformed)))))))
- (class-slots klass))
- t)
+ (define t #false)
+ (catch #true
+ (lambda ()
+ (set! t (low:allocate-job-template!))
+ (for-each
+ (lambda (slot)
+ (let* ((options (slot-definition-options slot))
+ (keyword (slot-definition-init-keyword slot))
+ (drmaa (and=> (memq #:drmaa-name options) cadr))
+ (transform (or (and=> (memq #:transform options) cadr)
+ identity))
+ (slot-name (slot-definition-name slot)))
+ (when (slot-bound? instance slot-name)
+ (let* ((value (slot-ref instance slot-name))
+ (transformed (transform value)))
+ (cond
+ ;; Empty lists and #false are not valid values to set.
+ ((or (null? transformed) (not transformed))
+ #true)
+ ((pair? transformed)
+ (apply low:set-vector-attribute! t drmaa transformed))
+ (else
+ (low:set-attribute! t drmaa transformed)))))))
+ (class-slots klass))
+ t)
+ (lambda (key . args)
+ (low:delete-job-template! t)
+ (apply throw key args))))
(define-syntax-rule (with-drmaa-session body ...)
(dynamic-wind
@@ -332,7 +337,8 @@
(lambda ()
(proc template))
(lambda ()
- (low:delete-job-template! template)))))
+ (when template
+ (low:delete-job-template! template))))))
(define-method (run-job (template <job-template>))
"Submit a single job with the attributes defined in the job