Invoke finalizers if object initialization bails.

* struct.c (make_struct): Add unwind protection around
the initialization of the struct object, which calls
the partially initialized object's finalizers if
initialization is abandoned by a non-local exit.

* txr.1: Document the behavior, under make-struct and
the new macro.

2 files changed, 22 insertions, 0 deletions

diff --git a/struct.c b/struct.c
index 7162dc3e..7b8c2f72 100644
--- a/struct.c
+++ b/struct.c
@@ -339,6 +339,7 @@ val make_struct(val type, val plist, struct args *args)
     size_t size = offsetof(struct struct_inst, slot) + sizeof (val) * nslots;
     struct struct_inst *si = coerce(struct struct_inst *, chk_malloc(size));
     val sinst;
+    volatile val inited = nil;
 
     if (args_more(args, 0) && !st->boactor) {
       free(si);
@@ -357,6 +358,8 @@ val make_struct(val type, val plist, struct args *args)
 
     si->type = type;
 
+    uw_simple_catch_begin;
+
     call_initfun_chain(st, sinst);
 
     for (; plist; plist = cddr(plist))
@@ -369,6 +372,15 @@ val make_struct(val type, val plist, struct args *args)
       generic_funcall(st->boactor, args_copy);
     }
 
+    inited = t;
+
+    uw_unwind {
+      if (!inited)
+        gc_call_finalizers(sinst);
+    }
+
+    uw_catch_end;
+
     return sinst;
   }
 }
diff --git a/txr.1 b/txr.1
index 911eb2f8..b57f2391 100644
--- a/txr.1
+++ b/txr.1
@@ -18232,6 +18232,11 @@ overrides from the
 .code new
 macro, and lastly the "boa constructor" overrides.
 
+If any of the initializations abandon the evaluation of
+.code new
+by a non-local exit such as an exception throw, the object's
+finalizers, if any, are invoked.
+
 .coNP Macro @ qref
 .synb
 .mets (qref < object-form
@@ -18681,6 +18686,11 @@ is processed, if not empty, and finally, the
 .metn arg -s
 are processed, if present, and passed to the boa constructor.
 
+If any of the initializations abandon the evaluation of
+.code make-struct
+by a non-local exit such as an exception throw, the object's
+finalizers, if any, are invoked.
+
 .coNP Function @ copy-struct
 .synb
 .mets (copy-struct << struct-obj )