high: Always release job template on errors.

* drmaa/v1/high.scm (lower-job-template): Release job template on any error.

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