matlab equivalent of unwind_protect in R2008a

[David Bateman]

Seems matlab finally introduce the equivalent of unwind_protect in
R2008a with the onCleanup function. The example they give is like

function changeDirectorySafely(fileName)
currentDir = pwd;
c = onCleanup(@()cd(currentDir));

functionThatMayError;
end % c executes cd(currentDir) here

and they state that the cd(currentDir) is executed even if the function
creates an error. This is implemented in the new object class
definitions, where the destructors for "c" are always called when c is
destroyed. The stupid thing about this is that

function changeDirectorySafely(fileName)
currentDir = pwd;
onCleanup(@()cd(currentDir));

functionThatMayError;
end % c executes cd(currentDir) here

will not do the same as the above as "ans" is destroyed immediately and
so the cleanup code is executed early.. I don't believe there are
destructors in the Octave object classes which are compatible with
Matlab v7.5 and earlier, and so we can't yet do it this way. However,
with a bit of manipulation of the unwind_protect stack we can get the
same behavior.

We have to be careful of cases like

function changeDirectorySafely(fileName, cleanup)
currentDir = pwd;
if (cleanup)
  c = onCleanup(@()cd(currentDir));
end

functionThatMayError;
end % c executes cd(currentDir) here

as the cleanup will only happen if the "cleanup" variable is true, and
this is no longer the same structure as a traditional unwind_protect
block. So we can't use directly the unwind_protect code in the parser.
However, something like the attached seems to implement the same
behavior. The only thing it won't do the same is something like

function changeDirectorySafely(fileName)
currentDir = pwd;
c = onCleanup(@()cd(currentDir));

functionThatMayError;

clear c; % c executes cd(currentDir) here

functionThatWontError;
end

as the cleanup occurs when c is cleared. Do we care? Is the attached
function useful? Do you John prefer to implement the classdef code with
the destructors and really do this function in a matlab compatible manner?

Regards
David

-- 
David Bateman                                address@hidden
Motorola Labs - Paris                        +33 1 69 35 48 04 (Ph) 
Parc Les Algorithmes, Commune de St Aubin    +33 6 72 01 06 33 (Mob) 
91193 Gif-Sur-Yvette FRANCE                  +33 1 69 35 77 01 (Fax) 

The information contained in this communication has been classified as: 

[x] General Business Information 
[ ] Motorola Internal Use Only 
[ ] Motorola Confidential Proprietary

# HG changeset patch
# User David Bateman <address@hidden>
# Date 1205769380 -3600
# Node ID fcdf7f1a30089079968798196b94a4ccaae65a77
# Parent  0b6e68b31ad5a3b1ebec81748d1ce5da0e5bc072
Add onCleanup function

diff --git a/src/ChangeLog b/src/ChangeLog
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,4 +1,6 @@ 2008-03-17  David Bateman  <address@hidden
 2008-03-17  David Bateman  <address@hidden>
+
+       * DLD-FUNCTIONS/onCleanup.cc:: unwind_protect matlab style.
 
        * DLD-FUNCTIONS/minmax.cc: chop trailing singletons. 64-bit
        indexing fix.
diff --git a/src/DLD-FUNCTIONS/onCleanup.cc b/src/DLD-FUNCTIONS/onCleanup.cc
new file mode 100644
--- /dev/null
+++ b/src/DLD-FUNCTIONS/onCleanup.cc
@@ -0,0 +1,152 @@
+/*
+
+Copyright (C) 2008 David Bateman
+
+This file is part of Octave.
+
+Octave is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation; either version 3 of the License, or (at your
+option) any later version.
+
+Octave is distributed in the hope that it will be useful, but WITHOUT
+ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with Octave; see the file COPYING.  If not, see
+<http://www.gnu.org/licenses/>.
+
+*/
+
+#ifdef HAVE_CONFIG_H
+#include <config.h>
+#endif
+
+#include "defun-dld.h"
+#include "error.h"
+#include "oct-obj.h"
+#include "unwind-prot.h"
+
+static void 
+cleanup_fcn (void * ptr)
+{
+  octave_value * val = FCN_PTR_CAST (octave_value *, ptr);
+  octave_function *fcn = val->function_value ();
+  octave_value_list args;
+
+  unwind_protect::begin_frame ("cleanup_fcn");
+  unwind_protect_int (error_state);
+  error_state = 0;
+  fcn->do_multi_index_op (0, args);
+  delete val;
+  unwind_protect::run_frame ("cleanup_fcn");
+}
+
+DEFUN_DLD (onCleanup, args, nargout,
+  "-*- texinfo -*-\n\
address@hidden {Built-in Function} {} onCleanup (@var{f})\n\
+Execute a function when exiting the current function, for both normal\n\
+and abnormal exit. This is similar to the @code{unwind_protect} block\n\
+in concept.\n\
address@hidden
address@hidden deftypefn")
+{
+  octave_value retval;
+
+  int nargin = args.length ();
+
+  if (nargin == 1)
+    {
+      // Search backwards in unwind protect stack for last user_fcn_eval tag
+      std::stack<unwind_elem> tmpstack;
+      unwind_elem el;
+      bool found = false;
+
+      while (1)
+       {
+         if (unwind_protect::elt_list.empty())
+           break;
+         else
+           {
+             el = unwind_protect::elt_list.top ();
+
+             if (el.tag () == "user_func_eval")
+               {
+                 found = true;
+                 break;
+               }
+
+             unwind_protect::elt_list.pop ();
+             tmpstack.push (el);
+           }
+       }
+
+      if (! found)
+       error ("onCleanup: must be called from a function");
+      else
+       {
+         
+         if (args(0).is_function_handle () || args(0).is_inline_function ())
+           {
+             octave_value *val = new octave_value ();
+             *val = args(0);
+             // FIXME handle should have no arguments!! Need a check
+             unwind_protect::elt_list.push (unwind_elem (cleanup_fcn, 
FCN_PTR_CAST (void *, val)));
+
+             // dummy return value
+             retval = 1.;
+           }
+         else
+           error ("onCleanup: argument must be an inline function or function 
handle");
+       }
+
+      while (! tmpstack.empty ())
+       {
+         unwind_protect::elt_list.push (tmpstack.top ());
+         tmpstack.pop ();
+       }
+    }
+  else
+    print_usage ();
+
+  return retval;
+}
+
+/*
+
+%!function cleanup_fcn1 (p)
+%! C = onCleanup (@() chdir(p));
+
+%!function cleanup_fcn2 (p)
+%! C = onCleanup (@() chdir(p));
+%! error();
+
+%!test
+%! tmpdir = tmpnam ();
+%! p = pwd ();
+%! unwind_protect
+%!   mkdir (tmpdir);
+%!   chdir (tmpdir);
+%!   cleanup_fcn1 (p);
+%! unwind_protect_cleanup
+%!   assert (pwd(), p);
+%!   chdir (p);
+%!   rmdir (tmpdir);
+%! end_unwind_protect
+
+%!test
+%! tmpdir = tmpnam ();
+%! p = pwd ();
+%! unwind_protect
+%!   mkdir (tmpdir);
+%!   chdir (tmpdir);
+%!   fail (cleanup_fcn1 (p));
+%! unwind_protect_cleanup
+%!   assert (pwd(), p);
+%!   chdir (p);
+%!   rmdir (tmpdir);
+%! end_unwind_protect
+
+ */
diff --git a/src/Makefile.in b/src/Makefile.in
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -68,8 +68,8 @@ DLD_XSRC := balance.cc besselj.cc betain
        expm.cc fft.cc fft2.cc fftn.cc fftw.cc filter.cc find.cc fsolve.cc \
        gammainc.cc gcd.cc getgrent.cc getpwent.cc getrusage.cc \
        givens.cc hess.cc hex2num.cc inv.cc kron.cc lsode.cc \
-       lu.cc luinc.cc matrix_type.cc md5sum.cc minmax.cc pinv.cc qr.cc \
-       quad.cc qz.cc rand.cc regexp.cc schur.cc sparse.cc \
+       lu.cc luinc.cc matrix_type.cc md5sum.cc minmax.cc onCleanup.cc \
+       pinv.cc qr.cc quad.cc qz.cc rand.cc regexp.cc schur.cc sparse.cc \
        spparms.cc sqrtm.cc svd.cc syl.cc symrcm.cc symbfact.cc \
        time.cc tsearch.cc typecast.cc \
        urlwrite.cc __contourc__.cc __delaunayn__.cc __dsearchn__.cc \