--- a/scripts/ChangeLog
+++ b/scripts/ChangeLog
@@ -1,5 +1,11 @@
 2005-12-14  David Bateman  <dbateman@free.fr>
 
+	* testfun/assert.m, testfun/fail.m, testfun/test.m, testfun/demo.m,
+	testfun/speed.m, testfun/example.m, Makefile.in: New files.
+
+	* Makefile.in (SUBDIRS): Include testfun.
+	* configure.in (AC_CONFIG_FILES): Include testfun/Makefile.
+
 	* miscellaneous/dir.m: Transpose sub-assignment for cleanness.
 
 	* general/__isequal__.m: Remove reference to getfield.

--- a/scripts/Makefile.in
+++ b/scripts/Makefile.in
@@ -32,7 +32,7 @@
 SUBDIRS = audio control deprecated elfun finance general image io \
 	linear-algebra miscellaneous optimization plot polynomial \
 	quaternion set signal sparse specfun special-matrix startup \
-	statistics strings time
+	statistics strings testfun time
 
 DISTSUBDIRS = $(SUBDIRS)
 

--- a/scripts/configure.in
+++ b/scripts/configure.in
@@ -40,5 +40,5 @@
 	  special-matrix/Makefile startup/Makefile statistics/Makefile \
 	  statistics/base/Makefile statistics/distributions/Makefile \
 	  statistics/models/Makefile statistics/tests/Makefile \
-	  strings/Makefile time/Makefile])
+	  strings/Makefile time/Makefile testfun/Makefile])
 AC_OUTPUT

new file mode 100644
--- /dev/null
+++ b/scripts/testfun/Makefile.in
@@ -0,0 +1,63 @@
+#
+# Makefile for octave's scripts/testfun directory
+#
+# John W. Eaton
+# jwe@bevo.che.wisc.edu
+# University of Wisconsin-Madison
+# Department of Chemical Engineering
+
+TOPDIR = ../..
+
+script_sub_dir = testfun
+
+srcdir = @srcdir@
+top_srcdir = @top_srcdir@
+VPATH = @srcdir@
+
+include $(TOPDIR)/Makeconf
+
+INSTALL = @INSTALL@
+INSTALL_PROGRAM = @INSTALL_PROGRAM@
+INSTALL_DATA = @INSTALL_DATA@
+
+SOURCES = *.m
+
+DISTFILES = Makefile.in $(SOURCES)
+
+FCN_FILES = $(wildcard $(srcdir)/*.m)
+FCN_FILES_NO_DIR = $(notdir $(FCN_FILES))
+
+all:
+.PHONY: all
+
+install install-strip:
+	$(do-script-install)
+.PHONY: install install-strip
+
+uninstall:
+	$(do-script-uninstall)
+.PHONY: uninstall
+
+clean:
+.PHONY: clean
+
+tags: $(SOURCES)
+	ctags $(SOURCES)
+
+TAGS: $(SOURCES)
+	etags $(SOURCES)
+
+mostlyclean: clean
+.PHONY: mostlyclean
+
+distclean: clean
+	rm -f Makefile
+.PHONY: distclean
+
+maintainer-clean: distclean
+	rm -f tags TAGS
+.PHONY: maintainer-clean
+
+dist:
+	ln $(DISTFILES) ../../`cat ../../.fname`/scripts/testfun
+.PHONY: dist

new file mode 100644
--- /dev/null
+++ b/scripts/testfun/assert.m
@@ -0,0 +1,262 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program 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 2 of the License, or
+## (at your option) any later version.
+##
+## This program 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 this program; if not, write to the Free Software
+## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+## 02110-1301  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} assert (@var{cond})
+## @deftypefnx {Function File} {} assert (@var{observed},@var{expected})
+## @deftypefnx {Function File} {} assert (@var{observed},@var{expected},@var{tol})
+##
+## Produces an error if the condition is not met. @code{assert} can be
+## called in three different ways.
+##
+## @table @code
+## @item assert (@var{cond})
+## Called with a single argument @var{cond}, @code{assert} produces an
+## error if @var{cond} is zero.
+##
+## @item assert (@var{observed}, @var{expected})
+## Produce an error if observed is not the same as expected. Note that 
+## observed and expected can be strings, scalars, vectors, matrices, 
+## lists or structures.
+##
+## @item assert(@var{observed}, @var{expected}, @var{tol})
+## Produce an error if relative error is less than tolerance. That is, 
+## @code{abs(@var{observed} - @var{expected}) > @var{tol} * @var{expected}}.  
+## Absolute error @code{abs(@var{observed} - @var{expected}) > abs(@var{tol})} 
+## will be used when tolerance is negative or when the expected value is zero.
+## @end table
+##
+## @end deftypefn
+## @seealso{test}
+
+## TODO: Output throttling: don't print out the entire 100x100 matrix,
+## TODO: but instead give a summary; don't print out the whole list, just
+## TODO: say what the first different element is, etc.  To do this, make
+## TODO: the message generation type specific.
+function assert(cond, expected, tol)
+
+  if (nargin < 1 || nargin > 3)
+    usage("assert (cond) or assert (v, expected_v [,tol])");
+  endif
+
+  if (nargin < 3)
+    tol = 0;
+  endif
+
+  if exist("argn") == 0, argn=" "; endif
+  in = deblank(argn(1,:));
+  for i=2:rows(argn)
+    in = [in, ",", deblank(argn(i,:))];
+  end
+  in = ["(",in,")"];
+
+  coda = "";
+  iserror = 0;
+  if (nargin == 1)
+    if (!isnumeric(cond) || !all(cond(:)))
+      error ("assert %s failed", in); # say which elements failed?
+    endif
+  
+  elseif (is_list(cond))
+    if (!is_list(expected) || length(cond) != length(expected))
+      iserror = 1;
+    else
+      try
+	for i=1:length(cond)
+	  assert(nth(cond,i),nth(expected,i));
+	endfor
+      catch
+	iserror = 1;
+      end
+    endif
+
+  elseif (ischar (expected))
+    iserror = (!ischar (cond) || !strcmp (cond, expected));
+
+  elseif (iscell(expected))
+    if (!iscell (cond) || any(size(cond)!=size(expected)))
+      iserror = 1;
+    else
+      try
+	for i=1:length(expected(:))
+	  assert(cond{i},expected{i},tol);
+	endfor
+      catch
+	iserror = 1;
+      end
+    endif
+
+  elseif (isstruct (expected))
+    if (!isstruct (cond) || any(size(cond) != size(expected)) || ...
+	rows(struct_elements(cond)) != rows(struct_elements(expected)))
+      iserror = 1;
+    else
+      try
+	empty=prod(size(cond))==0;
+	normal=prod(size(cond))==1;
+	for [v,k] = cond
+	  if !struct_contains(expected,k), error; endif
+	  if empty, v = cell(1,0); endif
+	  if normal, v = {v}; endif
+	  assert(v,{expected.(k)},tol);
+	endfor
+      catch
+	iserror = 1;
+      end
+    endif
+
+  elseif (isempty (expected))
+    iserror = (any (size (cond) != size (expected)));
+
+  elseif (any (size (cond) != size (expected)))
+    iserror = 1;
+    coda = "Dimensions don't match";
+
+  elseif tol==0 && !strcmp(typeinfo(cond),typeinfo(expected))
+    iserror = 1;
+    coda = ["Type ",typeinfo(cond)," != ",typeinfo(expected)];
+
+  else # numeric
+    A=cond(:); B=expected(:);
+    ## Check exceptional values
+    if any(isnan(A) != isnan(B))
+      iserror = 1;
+      coda = "NaNs don't match";
+    elseif any(isna(A) != isna(B))
+      iserror = 1;
+      coda = "NAs don't match";
+    elseif any(A(isinf(A)) != B(isinf(B)))
+      iserror = 1;
+      coda = "Infs don't match";
+    else
+      ## Check normal values
+      A = A(finite(A)); B=B(finite(B));
+      if tol == 0,
+        err = any(A != B);
+	errtype = "values do not match";
+      elseif tol >= 0,
+	err = max(abs(A-B));
+	errtype = "maximum absolute error %g exceeds tolerance %g";
+      else 
+	abserr = max(abs(A(B==0)));
+	A = A(B!=0); B = B(B!=0);
+	relerr = max(abs(A-B)./abs(B));
+	err = max([abserr;relerr]);
+	errtype = "maximum relative error %g exceeds tolerance %g";
+      endif
+      if err > abs(tol)
+	iserror = 1;
+	coda = sprintf(errtype,err,abs(tol));
+      endif
+    endif
+  endif
+
+  if (!iserror)
+    return;
+  endif
+
+  ## pretty print the "expected but got" info,
+  ## trimming leading and trailing "\n"
+  str = disp (expected);
+  idx = find(str!="\n");
+  if (!isempty(idx))
+    str = str(idx(1):idx(length(idx)));
+  endif
+  str2 = disp (cond);
+  idx = find(str2!="\n");
+  if (!isempty(idx))
+    str2 = str2(idx(1):idx(length(idx)));
+  endif
+  msg = ["assert ",in," expected\n", str, "\nbut got\n", str2];
+  if (!isempty(coda))
+    msg = [ msg, "\n", coda ];
+  endif
+  error("%s",msg);
+  ## disp(msg);
+  ## error("assertion failed");
+endfunction
+
+## empty
+%!assert([])
+%!assert(zeros(3,0),zeros(3,0))
+%!error assert(zeros(3,0),zeros(0,2))
+%!error assert(zeros(3,0),[])
+
+## conditions
+%!assert(isempty([]))
+%!assert(1)
+%!error assert(0)
+%!assert(ones(3,1))
+%!assert(ones(1,3))
+%!assert(ones(3,4))
+%!error assert([1,0,1])
+%!error assert([1;1;0])
+%!error assert([1,0;1,1])
+
+## vectors
+%!assert([1,2,3],[1,2,3]);
+%!assert([1;2;3],[1;2;3]);
+%!error assert([2;2;3],[1;2;3]);
+%!error assert([1,2,3],[1;2;3]);
+%!error assert([1,2],[1,2,3]);
+%!error assert([1;2;3],[1;2]);
+%!assert([1,2;3,4],[1,2;3,4]);
+%!error assert([1,4;3,4],[1,2;3,4])
+%!error assert([1,3;2,4;3,5],[1,2;3,4])
+
+## exceptional values
+%!assert([NaN, NA, Inf, -Inf, 1+eps, eps],[NaN, NA, Inf, -Inf, 1, 0],eps)
+%!error assert(NaN, 1)
+%!error assert(NA, 1)
+%!error assert(-Inf, Inf)
+
+## scalars
+%!error assert(3, [3,3; 3,3])
+%!error assert([3,3; 3,3], 3)
+%!assert(3, 3);
+%!assert(3+eps, 3, eps);
+%!assert(3, 3+eps, eps);
+%!error assert(3+2*eps, 3, eps);
+%!error assert(3, 3+2*eps, eps);
+
+%## must give a little space for floating point errors on relative
+%!assert(100+100*eps, 100, -2*eps); 
+%!assert(100, 100+100*eps, -2*eps);
+%!error assert(100+300*eps, 100, -2*eps); 
+%!error assert(100, 100+300*eps, -2*eps);
+%!error assert(3, [3,3]);
+%!error assert(3,4);
+
+## structures
+%!shared x,y
+%! x.a = 1; x.b=[2, 2];
+%! y.a = 1; y.b=[2, 2];
+%!assert (x,y)
+%!test y.b=3;
+%!error assert (x,y)
+%!error assert (3, x);
+%!error assert (x, 3);
+
+## check usage statements
+%!error assert
+%!error assert(1,2,3,4,5)
+
+## strings
+%!assert("dog","dog")
+%!error assert("dog","cat")
+%!error assert("dog",3);
+%!error assert(3,"dog");

new file mode 100644
--- /dev/null
+++ b/scripts/testfun/demo.m
@@ -0,0 +1,131 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program 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 2 of the License, or
+## (at your option) any later version.
+##
+## This program 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 this program; if not, write to the Free Software
+## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+## 02110-1301  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} demo ('@var{name}',@var{n})
+##
+## Runs any examples associated with the function '@var{name}'.  
+## Examples are stored in the script file, or in a file with the same 
+## name but no extension somewhere on your path.  To keep them separate 
+## from the usual script code, all lines are prefixed by @code{%!}. Each
+## example is introduced by the keyword 'demo' flush left to the prefix,
+## with no intervening spaces.  The remainder of the example can contain 
+## arbitrary octave code. For example:
+##
+## @example
+##    %!demo
+##    %! t=0:0.01:2*pi; x = sin(t);
+##    %! plot(t,x)
+##    %! %-------------------------------------------------
+##    %! % the figure window shows one cycle of a sine wave
+## @end example
+##
+## Note that the code is displayed before it is executed, so a simple
+## comment at the end suffices.  It is generally not necessary to use
+## disp or printf within the demo.
+##
+## Demos are run in a function environment with no access to external
+## variables. This means that all demos in your function must use
+## separate initialization code. Alternatively, you can combine your
+## demos into one huge demo, with the code:
+##
+## @example
+##    %! input("Press <enter> to continue: ","s");
+## @end example
+##
+## between the sections, but this is discouraged.  Other techniques
+## include using multiple plots by saying figure between each, or
+## using subplot to put multiple plots in the same window.
+##
+## Also, since demo evaluates inside a function context, you cannot
+## define new functions inside a demo.  Instead you will have to
+## use @code{eval(example('function',n))} to see them.  Because eval only
+## evaluates one line, or one statement if the statement crosses
+## multiple lines, you must wrap your demo in "if 1 <demo stuff> endif"
+## with the 'if' on the same line as 'demo'. For example,
+##
+## @example
+##   %!demo if 1
+##   %!  function y=f(x)
+##   %!    y=x;
+##   %!  endfunction
+##   %!  f(3)
+##   %! endif
+## @end example
+##
+## @end deftypefn
+## @seealso{test, example}
+
+## TODO: modify subplot so that gnuplot_has_multiplot == 0 causes it to
+## TODO: use the current figure window but pause if not plotting in the
+## TODO: first subplot.
+
+## PKG_ADD: mark_as_command demo
+
+function demo(name, n)
+
+  if (nargin < 1 || nargin > 2)
+    usage("demo('name')  or demo('name, n)");
+  endif
+
+  if (nargin < 2)
+    n = 0;
+  endif
+
+  [code, idx] = test (name, 'grabdemo');
+  if (length(idx) == 0)
+    warning(["demo not available for ", name]);
+    return;
+  elseif (n >= length(idx))
+    warning(sprintf("only %d demos available for %s", length(idx)-1, name));
+    return;
+  endif
+
+
+  if (n > 0)
+    doidx = n;
+  else
+    doidx = [ 1 : length(idx)-1 ];
+  endif
+  for i=1:length(doidx)
+    ## Pause between demos
+    if (i > 1)
+      input("Press <enter> to continue: ","s");
+    endif
+
+    ## Process each demo without failing
+    try
+      block = code( idx(doidx(i)) : idx(doidx(i)+1) -1 );
+      ## Use an environment without variables
+      eval(["function __demo__()\n", block, "\nendfunction"]);
+      ## Display the code that will be executed before executing it
+      printf("%s example %d:%s\n\n", name, doidx(i), block);
+      __demo__;
+    catch
+      ## Let the programmer know which demo failed.
+      printf("%s example %d: failed\n%s", name, doidx(i), __error_text__);
+    end_try_catch
+    clear __demo__;
+  endfor
+
+endfunction
+
+%!demo
+%! t=0:0.01:2*pi; x = sin(t);
+%! plot(t,x)
+%! %-------------------------------------------------
+%! % the figure window shows one cycle of a sine wave

new file mode 100644
--- /dev/null
+++ b/scripts/testfun/example.m
@@ -0,0 +1,95 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program 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 2 of the License, or
+## (at your option) any later version.
+##
+## This program 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 this program; if not, write to the Free Software
+## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+## 02110-1301  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} example ('@var{name}',@var{n})
+## @deftypefnx {Function File} {[@var{x}, @var{idx}] =} example ('@var{name}',@var{n})
+##
+##  Display the code for example @var{n} associated with the function 
+## '@var{name}', but do not run it. If @var{n} is not given, all examples 
+## are displayed.
+##
+## Called with output arguments, the examples are returned in the form of
+## a string @var{x}, with @var{idx} indicating the ending position of the 
+## various examples.
+##
+## See @code{demo} for a complete explanation.
+## @end deftypefn
+## @seealso{demo, test}
+
+## PKG_ADD: mark_as_command example
+
+function [code_r, idx_r] = example(name, n)
+
+  if (nargin < 1 || nargin > 2)
+    usage("example('name')  or example('name', n)");
+  endif
+  if (nargin < 2)
+    n = 0;
+  endif
+
+  [code, idx] = test (name, 'grabdemo');
+  if (nargout > 0)
+    if (n > 0)
+      if (n <= length(idx))
+      	code_r = code(idx(n) : idx(n+1)-1);
+      	idx_r = [1, length(code_r)+1];
+      else
+	code_r = "";
+	idx_r = [];
+      endif
+    else
+      code_r = code;
+      idx_r = idx;
+    endif
+  else
+    if (n > 0)
+      doidx = n;
+    else
+      doidx = [ 1:length(idx)-1 ];
+    endif
+    if (length(idx) == 0)
+      warning(["example not available for ", name]);
+    elseif (n >= length(idx))
+      warning(sprintf("only %d examples available for %s", length(idx)-1, name));
+      doidx = [];
+    endif
+
+    for i=1:length(doidx)
+      block = code( idx(doidx(i)) : idx(doidx(i)+1) -1 );
+      printf("%s example %d:%s\n\n", name, doidx(i), block);
+    endfor
+  endif
+
+endfunction
+
+%!## warning: don't modify the demos without modifying the tests!
+%!demo
+%! example('example');
+%!demo
+%! t=0:0.01:2*pi; x=sin(t);
+%! plot(t,x)
+
+%!assert (example('example',1), "\n example('example');");
+%!test
+%! [code, idx] = example('example');
+%! assert (code, ... 
+%!	   "\n example('example');\n t=0:0.01:2*pi; x=sin(t);\n plot(t,x)")
+%! assert (idx, [1, 22, 59]);
+
+%!error example;
+%!error example('example',3,5)

new file mode 100644
--- /dev/null
+++ b/scripts/testfun/fail.m
@@ -0,0 +1,107 @@
+## -*- texinfo -*-
+## @deftypefn {Function File} {} fail (@var{code},@var{pattern})
+## @deftypefnx {Function File} {} fail (@var{code},'warning',@var{pattern})
+##
+## Return true if @var{code} fails with an error message matching
+## @var{pattern}, otherwise produce an error. Note that @var{code}
+## is a string and if @var{code} runs successfully, the error produced is:
+##
+## @example
+##           expected error but got none  
+## @end example
+##
+## If the code fails with a different error, the message produced is:
+##
+## @example
+##           expected <pattern>
+##           but got <text of actual error>
+## @end example
+##
+## The angle brackets are not part of the output.
+##
+## Called with three arguments, the behavior is similar to 
+## @code{fail(@var{code}, @var{pattern})}, but produces an error if no 
+## warning is given during code execution or if the code fails.
+##
+## @end deftypefn
+
+## This program is public domain
+## Author: Paul Kienzle <pkienzle@users.sf.net>
+
+## PKG_ADD mark_as_command fail
+function ret=fail(code,pattern,warning_pattern)
+  if nargin < 1 || nargin > 3
+    usage("fail(code [, 'warning'] [, pattern])");
+  endif
+
+  ## sort out arguments
+  test_warning =  (nargin > 1 && strcmp(pattern,'warning'));
+  if nargin == 3
+    pattern = warning_pattern;
+  elseif nargin == 1 || (nargin==2 && test_warning)
+    pattern = "";
+  endif
+  if isempty(pattern), pattern = "."; endif  # match any nonempty message
+
+  ## allow assert(fail())
+  if nargout, ret=1; endif  
+
+  ## don't test failure if evalin doesn't exist
+  if !exist('evalin') || !exist('lastwarn'), return; endif
+
+  if test_warning
+    ## perform the warning test
+    lastwarn();  # clear old warnings
+    state = warning("query","quiet"); # make sure warnings are turned on
+    warning("on","quiet");
+    try
+      ## printf("lastwarn before %s: %s\n",code,lastwarn);
+      evalin("caller",sprintf("%s;",code));
+      ## printf("lastwarn after %s: %s\n",code,lastwarn);
+      err = lastwarn;  # retrieve new warnings
+      warning(state.state,"quiet");
+      if isempty(err), 
+        msg = sprintf("expected warning <%s> but got none", pattern); 
+      else
+        err([1:9,end]) = [];  # transform "warning: ...\n" to "..."
+        if !isempty(regexp(err,pattern,"once")), return; end
+        msg = sprintf("expected warning <%s>\nbut got <%s>", pattern,err);
+      endif
+    catch
+      warning(state.state,"quiet");
+      err = lasterr;
+      err([1:7,end]) = [];  # transform "error: ...\n", to "..."
+      msg = sprintf("expected warning <%s> but got error <%s>", pattern, err);
+    end
+      
+  else
+    ## perform the error test
+    try
+      evalin("caller",sprintf("%s;",code));
+      msg = sprintf("expected error <%s> but got none", pattern);
+    catch
+      err=lasterr;
+      if (strcmp(err(1:7),"error:"))
+         err([1:6,end]) = []; # transform "error: ...\n", to "..."
+      endif
+      if !isempty(regexp(err,pattern,"once")), return; end
+      msg = sprintf("expected error <%s>\nbut got <%s>",pattern,err);
+    end
+  endif
+
+  ## if we get here, then code didn't fail or error didn't match
+  error(msg);
+endfunction
+
+%!fail ('[1,2]*[2,3]','nonconformant')
+%!fail ("fail('[1,2]*[2;3]','nonconformant')","expected error <nonconformant> but got none")
+%!fail ("fail('[1,2]*[2,3]','usage:')","expected error <usage:>\nbut got.*nonconformant")
+%!fail ("warning('test warning')",'warning','test warning');
+
+%!# fail ("warning('next test')",'warning','next test');  ## only allowed one warning test?!?
+
+## Comment out the following tests if you don't want to see what
+## errors look like
+% !fail ('a*[2;3]', 'nonconformant')
+% !fail ('a*[2,3]', 'usage:')
+% !fail ("warning('warning failure')", 'warning', 'success')

new file mode 100644
--- /dev/null
+++ b/scripts/testfun/speed.m
@@ -0,0 +1,270 @@
+## Copyright (C) 2000-2001 Paul Kienzle
+##
+## This program 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 2 of the License, or
+## (at your option) any later version.
+##
+## This program 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 this program; if not, write to the Free Software
+## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+## 02110-1301  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} speed (@var{f}, @var{init}, @var{max_n}, @var{f2}, @var{tol}, @var{err})
+## @deftypefnx {Function File} {@var{r} =} speed (@dots{})
+##
+## Determine the execution time of an expression for various @var{n}.
+## The @var{n} are log-spaced from 1 to @var{max_n}.  For each @var{n},
+## an initialization expression is computed to create whatever data
+## are needed for the test. Called without output arguments the data
+## is presented graphically. Called with an output argument @var{r},
+## the speedup ratio is returned instead of displaying it graphically.
+##
+## @table @code
+## @item @var{f}
+## The expression to evaluate.
+##
+## @item @var{max_n}
+## The maximum test length to run. Default value is 100.
+##
+## @item @var{init}
+## Initialization expression for function argument values.  Use @var{k} 
+## for the test number and @var{n} for the size of the test.  This should
+## compute values for all variables listed in args.  Note that init will
+## be evaluated first for k=0, so things which are constant throughout
+## the test can be computed then. The default value is @code{@var{x} =
+## randn (@var{n}, 1);}.
+##
+## @item @var{f2}
+## An alternative expression to evaluate, so the speed of the two
+## can be compared. Default is @code{[]}.
+##
+## @item @var{tol}
+## If @var{tol} is @code{Inf}, then no comparison will be made between the
+## results of expression @var{f} and expression @var{f2}.  Otherwise,
+## expression @var{f} should produce a value @var{v} and expression @var{f2} 
+## should produce a value @var{v2}, and these shall be compared using 
+## @code{assert(@var{v},@var{v2},@var{tol},@var{err})}. The default is
+## @code{eps}.
+## @end table
+##
+## Some global variables are also referenced. Choose values suitable to
+## your machine and your work style.
+##
+## @table @code
+## @item speed_test_plot
+## If true, plot a nice speed comparison graph. Default is true.
+##
+## @item speed_test_numtests
+## Number of vector lengths to test. The default is 25.
+## @end table
+##
+## Some comments on the graphs.  The line on the speedup ratio graph 
+## should be larger than 1 if your function is faster.  The slope on
+## the runtime graph shows you the O(f) speed characteristics.  Where it
+## is flat, execution time is O(1).  Where it is sloping, execution time
+## is O(n^m), with steeper slopes for larger @var{n}.  Generally vectorizing
+## a function will not change the slope of the run-time graph, but it
+## will shift it relative to the original.
+##
+## A simple example is
+##
+## @example
+##   speed("strrep(s,x,y)", "s=blanks(n);x=' ';y='b';", 100)
+## @end example
+##
+## A more complex example, if you had an original version of @code{xcorr}
+## using for loops and another version using an FFT, you could compare the
+## run speed for various lags as follows, or for a fixed lag with varying
+## vector lengths as follows:
+##
+## @example
+##   speed("v=xcorr(x,n)", "x=rand(128,1);", 100, ...
+##         "v2=xcorr_orig(x,n)", 100*eps,'rel')
+##   speed("v=xcorr(x,15)", "x=rand(20+n,1);", 100, ...
+##         "v2=xcorr_orig(x,n)", 100*eps,'rel')
+## @end example
+##
+## Assuming one of the two versions is in @var{xcorr_orig}, this would
+## would compare their speed and their output values.  Note that the
+## FFT version is not exact, so we specify an acceptable tolerance on
+## the comparison @code{100*eps}, and the errors should be computed
+## relatively, as @code{abs((@var{x} - @var{y})./@var{y})} rather than 
+## absolutely as @code{abs(@var{x} - @var{y})}.
+##
+## Type @code{example('speed')} to see some real examples. Note for 
+## obscure reasons, you can't run examples 1 and 2 directly using 
+## @code{demo('speed')}. Instead use, @code{eval(example('speed',1))}
+## and @code{eval(example('speed',2))}.
+## @end deftypefn
+
+## TODO: consider two dimensional speedup surfaces for functions like kron.
+function __ratio_r = speed (__f1, __init, __max_n, __f2, __tol, __err)
+  if nargin < 1 || nargin > 6, 
+    usage("speed_test(f, init, max_n, f2, tol, err)");
+  endif
+  if nargin < 2 || isempty(__init), 
+    __init = "x = randn(n, 1);";
+  endif
+  if nargin < 3 || isempty(__max_n), __max_n = 100; endif
+  if nargin < 4, __f2 = []; endif
+  if nargin < 5 || isempty(__tol), __tol = eps; endif
+  if nargin < 6 || isempty(__err), __err = []; endif
+
+  global speed_test_plot = 1;
+  global speed_test_numtests = 25;
+
+  __test_n = uniq(round(logspace(0,log10(__max_n),speed_test_numtests)));
+  __torig = __tnew = zeros (size(__test_n)) ;
+
+  disp (["testing..........", __f1, "\ninit: ", __init]);
+
+  ## make sure the functions are freshly loaded by evaluating them at
+  ## test_n(1); firt have to initialize the args though.
+  n=1; k=0;
+  eval ([__init, ";"]);
+  if !isempty(__f2), eval ([__f2, ";"]); endif
+  eval ([__f1, ";"]);
+
+  ## run the tests
+  for k=1:length(__test_n)
+    if (k > 1)
+      n=__test_n(k);
+      eval ([__init, ";"]);
+    endif
+    
+    printf ("n%i=%i  ",k, n) ; fflush(1);
+
+    eval (["__t=time();", __f1, "; __v1=ans; __t = time()-__t;"]);
+    if (__t < 0.25)
+      eval (["__t2=time();", __f1, "; __t2 = time()-__t2;"]);
+      eval (["__t3=time();", __f1, "; __t3 = time()-__t3;"]);
+      __t = min([__t,__t2,__t3]);
+    endif
+    __tnew(k) = __t;
+
+    if !isempty(__f2)
+      eval (["__t=time();", __f2, "; __v2=ans; __t = time()-__t;"]);
+      if (__t < 0.25)
+      	eval (["__t2=time();", __f2, "; __t2 = time()-__t2;"]);
+      	eval (["__t3=time();", __f2, "; __t3 = time()-__t3;"]);
+      endif
+      __torig(k) = __t;
+      if !isinf(__tol)
+      	assert(__v1,__v2,__tol,__err);
+      endif
+    endif
+    
+  end
+  
+  if !isempty(__f2),
+				# Don't keep zero times
+    idx = find ( __tnew>sqrt(eps) &  __torig>sqrt(eps) ) ;
+    ratio = mean (__torig(idx) ./ __tnew(idx));
+    if (nargout == 1)
+      __ratio_r = ratio;
+    else
+      printf ("\nmean runtime ratio of %s / %s : %g\n", __f2, __f1, ratio);
+    endif
+  else
+    if (nargout == 1)
+      _ratio_r = mean(__tnew);
+    else
+      printf ("\nmean runtime: %g\n", mean(__tnew));
+    endif
+  endif
+
+  if (speed_test_plot && nargout == 0 && !isempty(__f2))
+
+    subplot(121);
+    xlabel("test length");
+    title (__f1);
+    ylabel("speedup ratio");
+    semilogx ( __test_n(idx), __torig(idx)./__tnew(idx) , 
+	      ["-*r;", strrep(__f1,";","."), "/", strrep(__f2,";","."), ";"],
+	       __test_n(idx), __tnew(idx)./__torig(idx) ,
+	      ["-*g;", strrep(__f2,";","."), "/", strrep(__f1,";","."), ";"]);
+    subplot (122);
+
+    ## convert best execution time to milliseconds.
+    __torig = 1000*__torig;
+    __tnew = 1000*__tnew;
+
+    ylabel ("best execution time (ms)");
+    title (["init: ", __init]);
+    loglog ( __test_n (idx), __tnew (idx), ["*-g;", strrep(__f1,";","."), ";" ], 
+	    __test_n (idx), __torig (idx), ["*-r;", strrep(__f2,";","."), ";"])
+    title (""); xlabel (""); ylabel (""); oneplot();
+  elseif (speed_test_plot && nargout == 0)
+    __tnew = 1000*__tnew;
+    xlabel("test length");
+    ylabel ("best execution time (ms)");
+    title ([__f1, "  init: ", __init]);
+    loglog ( __test_n, __tnew, "*-g;;");
+    title (""); xlabel (""); ylabel (""); oneplot();
+  endif
+  
+endfunction
+
+%!demo if 1
+%!  function x = build_orig(n)
+%!    ## extend the target vector on the fly
+%!    for i=0:n-1, x([1:10]+i*10) = 1:10; endfor
+%!  endfunction
+%!  function x = build(n)
+%!    ## preallocate the target vector
+%!    x = zeros(1, n*10);
+%!    try
+%!      if (prefer_column_vectors), x = x.'; endif
+%!    catch
+%!    end
+%!    for i=0:n-1, x([1:10]+i*10) = 1:10; endfor
+%!  endfunction
+%!
+%!  disp("-----------------------");
+%!  type build_orig;
+%!  disp("-----------------------");
+%!  type build;
+%!  disp("-----------------------");
+%!
+%!  disp("Preallocated vector test.\nThis takes a little while...");
+%!  speed('build', 'build_orig', 1000, 'v=n;');
+%!  clear build build_orig
+%!  disp("Note how much faster it is to pre-allocate a vector.");
+%!  disp("Notice the peak speedup ratio.");
+%!  clear build build_orig
+%! endif
+
+%!demo if 1
+%!  function x = build_orig(n)
+%!    for i=0:n-1, x([1:10]+i*10) = 1:10; endfor
+%!  endfunction
+%!  function x = build(n)
+%!    idx = [1:10]';
+%!    x = idx(:,ones(1,n));
+%!    x = reshape(x, 1, n*10);
+%!    try
+%!      if (prefer_column_vectors), x = x.'; endif
+%!    catch
+%!    end
+%!  endfunction
+%!
+%!  disp("-----------------------");
+%!  type build_orig;
+%!  disp("-----------------------");
+%!  type build;
+%!  disp("-----------------------");
+%!
+%!  disp("Vectorized test. This takes a little while...");
+%!  speed('build', 'build_orig', 1000, 'v=n;');
+%!  clear build build_orig
+%!  disp("-----------------------");
+%!  disp("This time, the for loop is done away with entirely.");
+%!  disp("Notice how much bigger the speedup is then in example 1.");
+%! endif

new file mode 100644
--- /dev/null
+++ b/scripts/testfun/test.m
@@ -0,0 +1,685 @@
+## Copyright (C) 2005 Paul Kienzle
+##
+## This program 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 2 of the License, or
+## (at your option) any later version.
+##
+## This program 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 this program; if not, write to the Free Software
+## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+## 02110-1301  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} test @var{name}
+## @deftypefnx {Function File} {} test @var{name} quiet|normal|verbose
+## @deftypefnx {Function File} {} test ('@var{name}', 'quiet|normal|verbose', @var{fid})
+## @deftypefnx {Function File} {} test ([], 'explain', @var{fid})
+## @deftypefnx {Function File} {@var{success} =} test (@dots{})
+## @deftypefnx {Function File} {[@var{n}, @var{max}] =} test (@dots{})
+## @deftypefnx {Function File} {[@var{code}, @var{idx}] =} test ('@var{name}','grabdemo')
+##
+## Perform tests from the first file in the loadpath matching @var{name}.
+## @code{test} can be called as a command or as a function. Called with 
+## a single argument @var{name}, the tests are run interactively and stop
+## after the first error is encountered.
+##
+## With a second argument the tests which are performed and the amount of
+## output is selected.
+##
+## @table @asis
+## @item 'quiet'
+##  Don't report all the tests as they happen, just the errors.
+##
+## @item 'normal'
+## Report all tests as they happen, but don't do tests which require 
+## user interaction.
+##
+## @item 'verbose'
+## Do tests which require user interaction.
+## @end table
+##
+## The argument @var{fid} can be used to allow batch processing. Errors
+## can be written to the already open file defined by @var{fid}, and 
+## hopefully when octave crashes this file will tell you what was happening
+## when it did. You can use @code{stdout} if you want to see the results as
+## they happen.  You can also give a file name rather than an @var{fid}, in
+## which case the contents of the file will be replaced with the log from 
+## the current test.
+##
+## Called with a single output argument @var{success}, @code{test} returns
+## true is all of the tests were successful. Called with two output arguments
+## @var{n} and @var{max}, the number of sucessful test and the total number
+## of tests in the file @var{name} are returned.
+##
+## If the second argument is the string 'grabdemo', the contents of the demo
+## blocks are extracted but not executed. Code for all code blocks is
+## concatented and returned as @var{code} with @var{idx} being a vector of
+## positions of the ends of the demo blocks.
+##
+## If the second argument is 'explain', then @var{name} is ignored and an
+## explanation of the line markers used is written to the file @var{fid}.
+##
+## @end deftypefn
+## @seealso{error, assert, fail, demo, example}
+
+## TODO: * Consider using keyword fail rather then error?  This allows us
+## TODO: to make a functional form of error blocks, which means we
+## TODO: can include them in test sections which means that we can use
+## TODO: octave flow control for both kinds of tests.
+
+## PKG_ADD: mark_as_command test
+
+function [__ret1, __ret2] = test (__name, __flag, __fid)
+  ## information from test will be introduced by "key" 
+  persistent __signal_fail =  "!!!!! ";
+  persistent __signal_empty = "????? ";
+  persistent __signal_block = "  ***** ";
+  persistent __signal_file =  ">>>>> ";
+
+  if (nargin < 2 || isempty(__flag))
+    __flag = "quiet";
+  endif
+  if (nargin < 3) 
+    __fid = []; 
+  endif
+  if (nargin < 1 || nargin > 3 ...
+      || (!ischar(__name) && !isempty(__name)) || !ischar(__flag))
+    usage("success = test('name', ['quiet'|'normal'|'verbose'], fid)");
+  endif
+  if (isempty(__name) && (nargin != 3 || !strcmp(__flag, "explain")))
+    usage("test([], 'explain', fid)");
+  endif
+  __batch = (!isempty(__fid));
+
+  ## decide if error messages should be collected
+  __close_fid = 0;
+  if (__batch)
+    if (ischar(__fid))
+      __fid = fopen(__fid, "wt");
+      if __fid < 0, error("could not open log file"); endif
+      __close_fid = 1;
+    endif
+    fprintf (__fid, "%sprocessing %s\n", __signal_file, __name);
+  else
+    __fid = stdout;
+  endif
+
+  if (strcmp(__flag, "normal"))
+    __grabdemo = 0;
+    __rundemo = 0;
+    __verbose = __batch;
+  elseif (strcmp(__flag, "quiet"))
+    __grabdemo = 0;
+    __rundemo = 0;
+    __verbose = 0;
+  elseif (strcmp(__flag, "verbose"))
+    __grabdemo = 0;
+    __rundemo = 1;
+    __verbose = 1;
+  elseif (strcmp(__flag, "grabdemo"))
+    __grabdemo = 1;
+    __rundemo = 0;
+    __verbose = 0;
+    __demo_code = "";
+    __demo_idx = 1;
+  elseif (strcmp(__flag, "explain"))
+    fprintf (__fid, "# %s new test file\n",__signal_file);
+    fprintf (__fid, "# %s no tests in file\n",__signal_empty);
+    fprintf (__fid, "# %s test had an unexpected result\n",__signal_fail);
+    fprintf (__fid, "# %s code for the test\n",__signal_block);
+    fprintf (__fid, "# Search for the unexpected results in the file\n");
+    fprintf (__fid, "# then page back to find the file name which caused it.\n");
+    fprintf (__fid, "# The result may be an unexpected failure (in which\n");
+    fprintf (__fid, "# case an error will be reported) or an unexpected\n");
+    fprintf (__fid, "# success (in which case no error will be reported).\n");
+    if (__close_fid) fclose(__fid); endif
+    return;
+  else
+    error("test unknown flag '%s'", __flag);
+  endif
+
+  ## locate the file to test
+  __file = file_in_loadpath (__name);
+  if (isempty (__file)) 
+    __file = file_in_loadpath ([__name, ".m"]);
+  endif
+  if (isempty (__file))
+    __file = file_in_loadpath ([__name, ".cc"]);
+  endif
+  if (isempty (__file))
+    if (__grabdemo)
+      __ret1 = "";
+      __ret2 = [];
+    else
+      fprintf(__fid, "%s%s does not exist in path\n", __signal_empty, __name);
+      if (nargout > 0) __ret1 = __ret2 = 0; endif
+    endif
+    if (__close_fid) fclose(__fid); endif
+    return;
+  endif
+
+  ## grab the test code from the file
+  __body = __extract_test_code (__file);
+
+  if (isempty (__body))
+    if (__grabdemo)
+      __ret1 = "";
+      __ret2 = [];
+    else
+      fprintf(__fid, "%s%s has no tests available\n", __signal_empty, __file);
+      if (nargout > 0) __ret1 = __ret2 = 0; endif
+    endif
+    if (__close_fid) fclose(__fid); endif
+    return;
+  else
+    ## add a dummy comment block to the end for ease of indexing
+    if (__body (length(__body)) == "\n")
+      __body = sprintf("\n%s#", __body); 
+    else
+      __body = sprintf("\n%s\n#", __body); 
+    endif
+  endif
+
+  ## chop it up into blocks for evaluation
+  __lineidx = find(__body == "\n");
+  __blockidx = __lineidx(find(!isspace(__body(__lineidx+1))))+1;
+
+  ## ready to start tests ... if in batch mode, tell us what is happening
+  if (__verbose)
+    disp ([ __signal_file, __file ]);
+  endif
+
+  ## assume all tests will pass
+  __all_success = 1;
+
+  ## process each block separately, initially with no shared variables
+  __tests = __successes = 0;
+  __shared = " ";
+  __shared_r = " ";
+  __clear = "";
+  for __i=1:length(__blockidx)-1
+
+    ## extract the block
+    __block = __body(__blockidx(__i):__blockidx(__i+1)-2);
+
+    ## let the user/logfile know what is happening
+    if (__verbose)
+      fprintf (__fid, "%s%s\n", __signal_block, __block);
+    endif
+
+    ## split __block into __type and __code
+    __idx = find(!isletter(__block));
+    if (isempty(__idx))
+      __type = __block;
+      __code = "";
+    else
+      __type = __block(1:__idx(1)-1);
+      __code = __block(__idx(1):length(__block));
+    endif
+
+    ## assume the block will succeed;
+    __success = 1;
+    __msg = [];
+
+    ## DEMO
+    ## If in __grabdemo mode, then don't process any other block type.
+    ## So that the other block types don't have to worry about
+    ## this __grabdemo mode, the demo block processor grabs all block
+    ## types and skips those which aren't demo blocks.
+    __isdemo = strcmp (__type, "demo");
+    if (__grabdemo || __isdemo)
+      __istest = 0;
+
+      if (__grabdemo && __isdemo)
+	if (isempty(__demo_code))
+	  __demo_code = __code;
+	  __demo_idx = [ 1, length(__demo_code)+1 ];
+	else
+	  __demo_code = strcat(__demo_code, __code);
+	  __demo_idx = [ __demo_idx, length(__demo_code)+1 ];
+	endif
+
+      elseif (__rundemo && __isdemo)
+      	try
+	  ## process the code in an environment without variables
+      	  eval(sprintf("function __test__()\n%s\nendfunction",__code));
+	  __test__;
+	  input("Press <enter> to continue: ","s");
+      	catch
+	  __success = 0;
+	  __msg = sprintf("%sdemo failed\n%s",  __signal_fail, __error_text__);
+      	end_try_catch
+      	clear __test__;
+
+      endif
+      __code = ""; # code already processed
+      
+    ## SHARED
+    elseif strcmp (__type, "shared")
+      __istest = 0;
+
+      ## separate initialization code from variables
+      __idx = find(__code == "\n");
+      if (isempty(__idx))
+	__vars = __code;
+	__code = "";
+      else
+      	__vars = __code (1:__idx(1)-1);
+      	__code = __code (__idx(1):length(__code));
+      endif
+      
+      ## strip comments off the variables
+      __idx = find(__vars=="%" | __vars == "#");
+      if (!isempty(__idx))
+	__vars = __vars(1:__idx(1)-1);
+      endif
+      
+      ## assign default values to variables
+      try
+	__vars = deblank(__vars);
+	if (!isempty(__vars))
+	  eval([strrep(__vars,",","=[];"), "=[];"]);
+	  __shared = __vars;
+	  __shared_r = ["[ ", __vars, "] = "];
+      	else
+	  __shared = " ";
+	  __shared_r = " ";
+      	endif
+      catch
+	__code = "";  # couldn't declare, so don't initialize
+	__success = 0;
+	__msg = sprintf("%sshared variable initialization failed\n", ...
+		        __signal_fail);
+      end_try_catch
+
+      ## clear shared function definitions
+      eval(__clear,""); __clear="";
+      
+      ## initialization code will be evaluated below
+    
+    ## FUNCTION
+    elseif strcmp (__type, "function")
+      __istest = 0;
+      persistent __fn = 0;
+      __name_position = function_name(__block);
+      if isempty(__name_position)
+        __success = 0;
+        __msg = sprintf("%stest failed: missing function name\n", ...
+			__signal_fail);
+      else
+        __name = __block(__name_position(1):__name_position(2));
+        __code = __block;
+        try
+          eval(__code); ## Define the function
+          __clear = sprintf("%sclear %s;\n",__clear,__name);
+        catch
+          __success = 0;
+          __msg = sprintf("%stest failed: syntax error\n%s", ...
+			  __signal_fail, __error_text__);
+        end_try_catch
+      endif
+      __code = "";
+      
+
+    ## ASSERT/FAIL
+    elseif strcmp (__type, "assert") || strcmp (__type, "fail")
+      __istest = 1;
+      __code = __block; # put the keyword back on the code
+      ## the code will be evaluated below as a test block
+      
+    ## ERROR/WARNING
+    elseif strcmp (__type, "error") || strcmp(__type, "warning")
+      __istest = 1;
+      __warning = strcmp(__type, "warning");
+      [__pattern, __code] = getpattern(__code);
+      try
+      	eval(sprintf("function __test__(%s)\n%s\nendfunction", ...
+		     __shared, __code));
+      catch
+      	__success = 0;
+      	__msg = sprintf("%stest failed: syntax error\n%s", ...
+			__signal_fail, __error_text__);
+      end_try_catch
+      
+      if (__success)
+        __success = 0;
+	__warnstate = warning("query","quiet");
+	warning("on","quiet");
+      	try
+ 	  eval(sprintf("__test__(%s);", __shared));
+	  __err = trimerr(lastwarn,"warning");
+          warning(__warnstate.state,"quiet");
+
+          if !__warning,
+       	    __msg = sprintf("%sexpected <%s> but got no error\n", ...
+ 			    __signal_fail, __pattern);
+          elseif isempty(__err)
+            __msg = sprintf("%sexpected <%s> but got no warning\n", ...
+			    __signal_fail,__pattern);
+          elseif isempty(regexp(__err,__pattern,"once"))
+            __msg = sprintf("%sexpected <%s> but got %s\n", ...
+ 			     __signal_fail, __pattern, __err);
+          else
+            __success = 1;
+          endif
+
+      	catch
+	  __err = trimerr(lasterr,"error");
+          warning(__warnstate.state,"quiet");
+          if __warning,
+            __msg = sprintf("%sexpected warning <%s> but got error %s\n", ...
+			    __signal_fail, __pattern, __err);
+	  elseif isempty(regexp(__err,__pattern,"once"))
+            __msg = sprintf("%sexpected <%s> but got %s\n", ...
+			    __signal_fail, __pattern, __err);
+          else
+	    __success = 1;
+          endif
+      	end_try_catch
+      	clear __test__;
+      endif
+      __code = ""; # code already processed
+      
+    ## TEST
+    elseif strcmp(__type, "test")
+      __istest = 1;
+      ## code will be evaluated below
+      
+    ## comment block
+    elseif strcmp (__block(1:1), "#")
+      __istest = 0;
+      __code = ""; # skip the code
+
+    else
+    ## unknown block
+      __istest = 1;
+      __success = 0;
+      __msg = sprintf("%sunknown test type!\n", __signal_fail);
+      __code = ""; # skip the code
+    endif
+
+    ## evaluate code for test, shared, and assert.
+    if (!isempty(__code))
+      try
+      	eval(sprintf("function %s__test__(%s)\n%s\nendfunction", ...
+	      __shared_r,__shared, __code));
+	eval(sprintf("%s__test__(%s);", __shared_r, __shared));
+      catch
+	__success = 0;
+	__msg = sprintf("%stest failed\n%s", __signal_fail, __error_text__);
+	if isempty(__error_text__), 
+	  error("empty error text, probably Ctrl-C --- aborting"); 
+	endif
+      end_try_catch
+      clear __test__;
+    endif
+    
+    ## All done.  Remember if we were successful and print any messages
+    if (!isempty(__msg))
+      ## make sure the user knows what caused the error
+      if (!__verbose)
+      	fprintf (__fid, "%s%s\n", __signal_block, __block);
+      endif
+      fputs (__fid, __msg);
+      ## show the variable context
+      if !strcmp(__type, "error") && !all(__shared==" ")
+	fputs(__fid, "shared variables ");
+	eval (sprintf("fdisp(__fid,bundle(%s));", __shared)); 
+      endif
+    endif
+    if (__success == 0)
+      __all_success = 0;
+      	## stop after one error if not in batch mode
+      if (!__batch)
+    	if (nargout > 0) __ret1 = __ret2 = 0; endif
+	if (__close_fid) fclose(__fid); endif
+      	return;
+      endif
+    endif
+    __tests += __istest;
+    __successes += __success*__istest;
+  endfor
+  eval(__clear,"");
+
+  if (nargout == 0)
+    printf("PASSES %d out of %d tests\n",__successes,__tests);
+  elseif (__grabdemo)
+    __ret1 = __demo_code;
+    __ret2 = __demo_idx;
+  elseif nargout == 1
+    __ret1 = __all_success; 
+  else
+    __ret1 = __successes;
+    __ret2 = __tests;
+  endif
+endfunction
+
+## create structure with fieldnames the name of the input variables
+function s = varstruct(varargin)
+  for i=1:nargin
+    s.(deblank(argn(i,:))) = varargin{i};
+  endfor
+endfunction
+
+## find [start,end] of fn in 'function [a,b] = fn'
+function pos = function_name(def)
+  pos = [];
+
+  ## Find the end of the name
+  right = min(find(def=='('));
+  if isempty(right), return; endif
+  right = max(find(def(1:right-1) != ' '));
+
+  ## Find the beginning of the name
+  left = max([find(def(1:right)==' '),find(def(1:right)=='=')]);
+  if isempty(left), return; endif
+  left++;
+
+  ## Return the end points of the name
+  pos = [left,right];
+endfunction
+
+## strip <pattern> from '<pattern> code'
+function [pattern,rest] = getpattern(str)
+  pattern = '.';
+  rest = str; 
+  str = trimleft(str);
+  if !isempty(str) && str(1) == '<'
+    close = index(str,'>');
+    if close,
+      pattern = str(2:close-1);
+      rest = str(close+1:end);
+    endif
+  endif
+endfunction
+
+## strip '.*prefix:' from '.*prefix: msg\n' and strip trailing blanks
+function msg = trimerr(msg,prefix)
+  idx = index(msg,[prefix,':']);
+  if (idx > 0), msg(1:idx+length(prefix)) = []; end
+  msg = trimleft(deblank(msg));
+endfunction
+
+## strip leading blanks from string
+function str = trimleft(str)
+  idx = find(isspace(str));
+  leading = find(idx == [1:length(idx)]);
+  if !isempty(leading)
+    str = str(leading(end)+1:end);
+  endif
+endfunction
+
+## make a structure out of the named variables
+## (based on Etienne Grossmann's tar function)
+function s = bundle(varargin)
+  for i=1:nargin
+    s.(deblank(argn(i,:))) = varargin{i};
+  end
+endfunction
+
+function body = __extract_test_code (nm)
+  fid = fopen (nm, "rt");
+  body = [];
+  if (fid >= 0)
+    while (! feof(fid))
+      ln = fgetl (fid);
+      if (length(ln) >= 2 && strcmp (ln(1:2), "%!"))
+        body = [body, "\n"];
+        if (length(ln) > 2)
+          body = [body, ln(3:end)];
+        endif
+      endif
+    endwhile
+    fclose (fid);
+  endif
+endfunction
+
+### example from toeplitz
+%!shared msg
+%! msg="expecting vector arguments";
+%!fail ('toeplitz([])', msg);
+%!fail ('toeplitz([1,2],[])', msg);
+%!fail ('toeplitz([1,2;3,4])', msg);
+%!fail ('toeplitz([1,2],[1,2;3,4])', msg);
+%!fail ('toeplitz ([1,2;3,4],[1,2])', msg);
+% !fail ('toeplitz','usage: toeplitz'); # usage doesn't generate an error
+% !fail ('toeplitz(1, 2, 3)', 'usage: toeplitz');
+%!test  assert (toeplitz ([1,2,3], [1,4]), [1,4; 2,1; 3,2]);
+%!demo  toeplitz ([1,2,3,4],[1,5,6])
+
+### example from kron
+%!#error kron  # XXX FIXME XXX suppress these until we can handle output
+%!#error kron(1,2,3)
+%!test assert (isempty (kron ([], rand(3, 4))))
+%!test assert (isempty (kron (rand (3, 4), [])))
+%!test assert (isempty (kron ([], [])))
+%!shared A, B
+%!test
+%! A = [1, 2, 3; 4, 5, 6]; 
+%! B = [1, -1; 2, -2];
+%!assert (size (kron (zeros (3, 0), A)), [ 3*rows(A), 0 ])
+%!assert (size (kron (zeros (0, 3), A)), [ 0, 3*columns(A) ])
+%!assert (size (kron (A, zeros (3, 0))), [ 3*rows(A), 0 ])
+%!assert (size (kron (A, zeros (0, 3))), [ 0, 3*columns(A) ])
+%!assert (kron (pi, e), pi*e)
+%!assert (kron (pi, A), pi*A) 
+%!assert (kron (A, e), e*A)
+%!assert (kron ([1, 2, 3], A), [ A, 2*A, 3*A ])
+%!assert (kron ([1; 2; 3], A), [ A; 2*A; 3*A ])
+%!assert (kron ([1, 2; 3, 4], A), [ A, 2*A; 3*A, 4*A ])
+%!test
+%! res = [1,-1,2,-2,3,-3; 2,-2,4,-4,6,-6; 4,-4,5,-5,6,-6; 8,-8,10,-10,12,-12];
+%! assert (kron (A, B), res)
+
+### an extended demo from specgram
+%!#demo 
+%! ## Speech spectrogram
+%! [x, Fs] = auload(file_in_loadpath("sample.wav")); # audio file
+%! step = fix(5*Fs/1000);     # one spectral slice every 5 ms
+%! window = fix(40*Fs/1000);  # 40 ms data window
+%! fftn = 2^nextpow2(window); # next highest power of 2
+%! [S, f, t] = specgram(x, fftn, Fs, window, window-step);
+%! S = abs(S(2:fftn*4000/Fs,:)); # magnitude in range 0<f<=4000 Hz.
+%! S = S/max(max(S));         # normalize magnitude so that max is 0 dB.
+%! S = max(S, 10^(-40/10));   # clip below -40 dB.
+%! S = min(S, 10^(-3/10));    # clip above -3 dB.
+%! imagesc(flipud(20*log10(S)), 1);
+%! % you should now see a spectrogram in the image window
+
+
+### now test test itself
+
+%!## usage and error testing
+% !fail ('test','usage.*test')           # no args, generates usage()
+% !fail ('test(1,2,3,4)','usage.*test')  # too many args, generates usage()
+%!fail ('test("test", "bogus")','unknown flag')      # incorrect args
+%!fail ('garbage','garbage.*undefined')  # usage on nonexistent function should be
+
+%!error <usage.*test> test                     # no args, generates usage()
+%!error <usage.*test> test(1,2,3,4)            # too many args, generates usage()
+%!error <unknown flag> test("test", 'bogus');  # incorrect args, generates error()
+%!error <garbage' undefined> garbage           # usage on nonexistent function should be
+
+%!error test("test", 'bogus');           # test without pattern
+
+%!warning <warning message> warning('warning message')
+
+%!## test of shared variables
+%!shared a                # create a shared variable
+%!test   a=3;             # assign to a shared variable
+%!test   assert(a,3)      # variable should equal 3    
+%!shared b,c              # replace shared variables
+%!test assert (!exist("a"));   # a no longer exists
+%!test assert (isempty(b));    # variables start off empty
+%!shared a,b,c            # recreate a shared variable
+%!test assert (isempty(a));    # value is empty even if it had a previous value
+%!test a=1; b=2; c=3;   # give values to all variables
+%!test assert ([a,b,c],[1,2,3]); # test all of them together
+%!test c=6;             # update a value
+%!test assert([a, b, c],[1, 2, 6]); # show that the update sticks
+%!shared                    # clear all shared variables
+%!test assert(!exist("a"))  # show that they are cleared
+%!shared a,b,c              # support for initializer shorthand
+%! a=1; b=2; c=4;
+
+%!function x = __test_a(y)
+%! x = 2*y;
+%!assert(__test_a(2),4);       # Test a test function
+
+%!function __test_a (y)
+%! x = 2*y;
+%!test
+%! __test_a(2);                # Test a test function with no return value
+
+%!function [x,z] = __test_a (y)
+%! x = 2*y;
+%! z = 3*y;
+%!test                   # Test a test function with multiple returns
+%! [x,z] = __test_a(3);
+%! assert(x,6); 
+%! assert(z,9);
+
+%!## test of assert block
+%!assert (isempty([]))      # support for test assert shorthand
+
+%!## demo blocks
+%!demo                   # multiline demo block
+%! t=[0:0.01:2*pi]; x=sin(t);
+%! plot(t,x);
+%! % you should now see a sine wave in your figure window
+%!demo a=3               # single line demo blocks work too
+
+%!## this is a comment block. it can contain anything.
+%!##
+%! it is the "#" as the block type that makes it a comment
+%! and it  stays as a comment even through continuation lines
+%! which means that it works well with commenting out whole tests
+
+% !# failure tests.  All the following should fail. These tests should
+% !# be disabled unless you are developing test() since users don't
+% !# like to be presented with expected failures.  I use % ! to disable.
+% !test   error("---------Failure tests.  Use test('test','verbose',1)");
+% !test   assert([a,b,c],[1,3,6]);   # variables have wrong values
+% !bogus                     # unknown block type
+% !error  toeplitz([1,2,3]); # correct usage
+% !test   syntax errors)     # syntax errors fail properly
+% !shared garbage in         # variables must be comma separated
+% !error  syntax++error      # error test fails on syntax errors
+% !error  "succeeds.";       # error test fails if code succeeds
+% !error <wrong pattern> error("message")  # error pattern must match
+% !demo   with syntax error  # syntax errors in demo fail properly
+% !shared a,b,c              
+% !demo                      # shared variables not available in demo
+% ! assert(exist("a"))
+% !error  
+% ! test('/etc/passwd');
+% ! test("nonexistent file");
+% ! ## These don't signal an error, so the test for an error fails. Note 
+% ! ## that the call doesn't reference the current fid (it is unavailable),
+% ! ## so of course the informational message is not printed in the log.