1########################################################################
2##
3## Copyright (C) 2005-2021 The Octave Project Developers
4##
5## See the file COPYRIGHT.md in the top-level directory of this
6## distribution or <https://octave.org/copyright/>.
7##
8## This file is part of Octave.
9##
10## Octave is free software: you can redistribute it and/or modify it
11## under the terms of the GNU General Public License as published by
12## the Free Software Foundation, either version 3 of the License, or
13## (at your option) any later version.
14##
15## Octave is distributed in the hope that it will be useful, but
16## WITHOUT ANY WARRANTY; without even the implied warranty of
17## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18## GNU General Public License for more details.
19##
20## You should have received a copy of the GNU General Public License
21## along with Octave; see the file COPYING.  If not, see
22## <https://www.gnu.org/licenses/>.
23##
24########################################################################
25
26## -*- texinfo -*-
27## @deftypefn  {} {} test @var{name}
28## @deftypefnx {} {} test @var{name} quiet|normal|verbose
29## @deftypefnx {} {} test ("@var{name}", "quiet|normal|verbose", @var{fid})
30## @deftypefnx {} {} test ("@var{name}", "quiet|normal|verbose", @var{fname})
31## @deftypefnx {} {@var{success} =} test (@dots{})
32## @deftypefnx {} {[@var{n}, @var{nmax}, @var{nxfail}, @var{nbug}, @var{nskip}, @var{nrtskip}, @var{nregression}] =} test (@dots{})
33## @deftypefnx {} {[@var{code}, @var{idx}] =} test ("@var{name}", "grabdemo")
34## @deftypefnx {} {} test ([], "explain", @var{fid})
35## @deftypefnx {} {} test ([], "explain", @var{fname})
36##
37## Perform built-in self-tests from the first file in the loadpath matching
38## @var{name}.
39##
40## @code{test} can be called in either command or functional form.  The exact
41## operation of test is determined by a combination of mode (interactive or
42## batch), reporting level (@qcode{"quiet"}, @qcode{"normal"},
43## @qcode{"verbose"}), and whether a logfile or summary output variable is
44## used.
45##
46## The default mode when @code{test} is called from the command line is
47## interactive.  In this mode, tests will be run until the first error is
48## encountered, or all tests complete successfully.  In batch mode, all tests
49## are run regardless of any failures, and the results are collected for
50## reporting.  Tests which require user interaction, i.e., demo blocks,
51## are never run in batch mode.
52##
53## Batch mode is enabled by either 1) specifying a logfile using the third
54## argument @var{fname} or @var{fid}, or 2) requesting an output argument
55## such as @var{success}, @var{n}, etc.
56##
57## The optional second argument determines the amount of output to generate and
58## which types of tests to run.  The default value is @qcode{"normal"}.
59## Requesting an output argument will suppress printing the final summary
60## message and any intermediate warnings, unless verbose reporting is
61## enabled.
62##
63## @table @asis
64## @item @qcode{"quiet"}
65## Print a summary message when all tests pass, or print an error with the
66## results of the first bad test when a failure occurs.  Don't run tests which
67## require user interaction.
68##
69## @item @qcode{"normal"}
70## Display warning messages about skipped tests or failing xtests during test
71## execution.
72## Print a summary message when all tests pass, or print an error with the
73## results of the first bad test when a failure occurs.  Don't run tests which
74## require user interaction.
75##
76## @item @qcode{"verbose"}
77## Display tests before execution.  Print all warning messages.  In interactive
78## mode, run all tests including those which require user interaction.
79## @end table
80##
81## The optional third input argument specifies a logfile where results of the
82## tests should be written.  The logfile may be a character string
83## (@var{fname}) or an open file descriptor ID (@var{fid}).  To enable batch
84## processing, but still print the results to the screen, use @code{stdout} for
85## @var{fid}.
86##
87## When called with just a single output argument @var{success}, @code{test}
88## returns true if all of the tests were successful.  If called with more
89## than one output argument then the number of successful tests (@var{n}),
90## the total number of tests in the file (@var{nmax}), the number of xtest
91## failures (@var{nxfail}), the number of tests failed due known bugs
92## (@var{nbug}), the number of tests skipped due to missing features
93## (@var{nskip}), the number of tests skipped due to run-time
94## conditions (@var{nrtskip}), and the number of regressions
95## (@var{nregression}) are returned.
96##
97## Example
98##
99## @example
100## @group
101## test sind
102## @result{}
103## PASSES 5 out of 5 tests
104##
105## [n, nmax] = test ("sind")
106## @result{}
107## n =  5
108## nmax =  5
109## @end group
110## @end example
111##
112## Additional Calling Syntaxes
113##
114## If the second argument is the string @qcode{"grabdemo"}, the contents of
115## any built-in demo blocks are extracted but not executed.  The text for all
116## code blocks is concatenated and returned as @var{code} with @var{idx} being
117## a vector of positions of the ends of each demo block.  For an easier way to
118## extract demo blocks from files, @xref{XREFexample,,example}.
119##
120## If the second argument is @qcode{"explain"} then @var{name} is ignored and
121## an explanation of the line markers used in @code{test} output reports is
122## written to the file specified by @var{fname} or @var{fid}.
123##
124## @seealso{assert, fail, demo, example, error}
125## @end deftypefn
126
127## Programming Note: All variables for test() must use the internal prefix "__".
128## %!share variables are eval'ed into the current workspace and therefore might
129## collide with the names used in the test.m function itself.
130
131function [__n, __nmax, __nxfail, __nbug, __nskip, __nrtskip, __nregression] = test (__name, __flag = "normal", __fid = [])
132
133  ## Output from test is prefixed by a "key" to quickly understand the issue.
134  persistent __signal_fail  = "!!!!! ";
135  persistent __signal_empty = "????? ";
136  persistent __signal_block = "***** ";
137  persistent __signal_file  = ">>>>> ";
138  persistent __signal_skip  = "----- ";
139
140  if (nargin < 1 || nargin > 3)
141    print_usage ();
142  elseif (! isempty (__name) && ! ischar (__name))
143    error ("test: NAME must be a string");
144  elseif (! ischar (__flag))
145    error ("test: second argument must be a string");
146  elseif (isempty (__name) && (nargin != 3 || ! strcmp (__flag, "explain")))
147    print_usage ();
148  endif
149
150  ## Decide if error messages should be collected.
151  __logfile = ! isempty (__fid);
152  __batch = __logfile || nargout > 0;
153  __close_fid = false;
154  if (__logfile)
155    if (ischar (__fid))
156      __fname = __fid;
157      __fid = fopen (__fname, "wt");
158      if (__fid < 0)
159        error ("test: could not open log file %s", __fname);
160      endif
161      __close_fid = true;
162    endif
163    if (! strcmp (__flag, "explain"))
164      fprintf (__fid, "%sprocessing %s\n", __signal_file, __name);
165      fflush (__fid);
166    endif
167  else
168    __fid = stdout;
169  endif
170
171  if (strcmp (__flag, "normal"))
172    __grabdemo = false;
173    __rundemo  = false;
174    if (__logfile)
175      __verbose = 1;
176    elseif (__batch)
177      __verbose = -1;
178    else
179      __verbose = 0;
180    endif
181  elseif (strcmp (__flag, "quiet"))
182    __grabdemo = false;
183    __rundemo  = false;
184    __verbose  = -1;
185  elseif (strcmp (__flag, "verbose"))
186    __grabdemo = false;
187    __rundemo  = ! __batch;
188    __verbose  = 1;
189  elseif (strcmp (__flag, "grabdemo"))
190    __grabdemo = true;
191    __rundemo  = false;
192    __verbose  = -1;
193    __demo_code = "";
194    __demo_idx = [];
195  elseif (strcmp (__flag, "explain"))
196    fprintf (__fid, "# %s new test file\n", __signal_file);
197    fprintf (__fid, "# %s no tests in file\n", __signal_empty);
198    fprintf (__fid, "# %s test had an unexpected result\n", __signal_fail);
199    fprintf (__fid, "# %s test was skipped\n", __signal_skip);
200    fprintf (__fid, "# %s code for the test\n\n", __signal_block);
201    fprintf (__fid, "# Search for the unexpected results in the file\n");
202    fprintf (__fid, "# then page back to find the filename which caused it.\n");
203    fprintf (__fid, "# The result may be an unexpected failure (in which\n");
204    fprintf (__fid, "# case an error will be reported) or an unexpected\n");
205    fprintf (__fid, "# success (in which case no error will be reported).\n");
206    fflush (__fid);
207    if (__close_fid)
208      fclose (__fid);
209    endif
210    return;
211  else
212    error ("test: unknown flag '%s'", __flag);
213  endif
214
215  ## Locate the file with tests.
216  __file = file_in_loadpath (__name, "all");
217  for suffix = {".m", ".cc", ".cc-tst", ".c-tst", ".C-tst", ".cpp-tst", ...
218                ".cxx-tst"}
219    if (! isempty (__file))
220      break;
221    endif
222    __file = file_in_loadpath ([__name, suffix{1}], "all");
223  endfor
224  if (iscell (__file))
225    if (isempty (__file))
226      __file = "";
227    else
228      __file = __file{1};  # If repeats, return first in path.
229    endif
230  endif
231  if (isempty (__file))
232    if (__grabdemo)
233      __n = "";
234      __nmax = -1;
235    else
236      ftype = exist (__name);
237      if (ftype == 3)
238        fprintf (__fid, "%s%s source code with tests for dynamically linked function not found\n", __signal_empty, __name);
239      elseif (ftype == 5)
240        fprintf (__fid, "%s%s is a built-in function\n", __signal_empty, __name);
241      elseif (any (strcmp (__operators__ (), __name)))
242        fprintf (__fid, "%s%s is an operator\n", __signal_empty, __name);
243      elseif (any (strcmp (__keywords__ (), __name)))
244        fprintf (__fid, "%s%s is a keyword\n", __signal_empty, __name);
245      else
246        fprintf (__fid, "%s%s does not exist in path\n", __signal_empty, __name);
247      endif
248      fflush (__fid);
249      if (nargout > 0)
250        if (nargout == 1)
251          __n = false;
252        else
253          __n = __nmax = 0;
254        endif
255      endif
256    endif
257    if (__close_fid)
258      fclose (__fid);
259    endif
260    return;
261  endif
262
263  ## Grab the test code from the file.
264  __body = __extract_test_code (__file);
265
266  if (isempty (__body))
267    if (__grabdemo)
268      __n = "";
269      __nmax = [];
270    else
271      fprintf (__fid, "%s%s has no tests available\n", __signal_empty, __file);
272      fflush (__fid);
273      if (nargout > 0)
274        if (nargout == 1)
275          __n = false;
276        else
277          __n = __nmax = 0;
278        endif
279      endif
280    endif
281    if (__close_fid)
282      fclose (__fid);
283    endif
284    return;
285  else
286    ## Add a dummy comment block to the end for ease of indexing.
287    if (__body(end) == "\n")
288      __body = ["\n" __body "#"];
289    else
290      __body = ["\n" __body "\n#"];
291    endif
292  endif
293
294  ## Chop it up into blocks for evaluation.
295  __lineidx = find (__body == "\n");
296  __blockidx = __lineidx(find (! isspace (__body(__lineidx+1))))+1;
297
298  ## Ready to start tests.
299  ## If in batch mode, with a logfile, report what is happening.
300  if (__verbose > 0)
301    disp ([__signal_file, __file]);
302  endif
303
304  ## Track file descriptor leaks
305  __fid_list_orig = fopen ("all");
306
307  ## Track variable leaks
308  __base_variables_orig = evalin ("base", "who");
309  ## Add automatic variable "ans" which may not have been created yet.
310  __base_variables_orig{end+1} = "ans";
311
312  ## Track variable leaks
313  __global_variables_orig = who ("global");
314
315  ## Assume all tests will pass.
316  __all_success = true;
317
318  ## Process each block separately, initially with no shared variables.
319  __tests = __successes = 0;
320  __xfail = __xbug = __xskip = __xrtskip = __xregression = 0;
321  __shared = " ";
322  __shared_r = " ";
323  __clearfcn = "";
324  for __i = 1:numel (__blockidx)-1
325
326    ## FIXME: Should other global settings be similarly saved and restored?
327    orig_wstate = warning ();
328    unwind_protect
329
330      ## Extract the block.
331      __block = __body(__blockidx(__i):__blockidx(__i+1)-2);
332
333      ## Print the code block before execution if in verbose mode.
334      if (__verbose > 0)
335        fprintf (__fid, "%s%s\n", __signal_block, __block);
336        fflush (__fid);
337      endif
338
339      ## Split __block into __type and __code.
340      __idx = find (! isletter (__block));
341      if (isempty (__idx))
342        __type = __block;
343        __code = "";
344      else
345        __type = __block(1:__idx(1)-1);
346        __code = __block(__idx(1):length (__block));
347      endif
348
349      ## Assume the block will succeed.
350      __success = true;
351      __msg = [];
352      __istest = false;
353      __isxtest = false;
354      __bug_id = "";
355      __fixed_bug = false;
356
357### DEMO
358
359      ## If in __grabdemo mode, then don't process any other block type.
360      ## So that the other block types don't have to worry about
361      ## this __grabdemo mode, the demo block processor grabs all block
362      ## types and skips those which aren't demo blocks.
363
364      __isdemo = strcmp (__type, "demo");
365      if (__grabdemo || __isdemo)
366        if (__grabdemo && __isdemo)
367          if (isempty (__demo_code))
368            __demo_code = __code;
369            __demo_idx = [1, length(__demo_code)+1];
370          else
371            __demo_code = [__demo_code, __code];
372            __demo_idx = [__demo_idx, length(__demo_code)+1];
373          endif
374
375        elseif (__rundemo && __isdemo)
376          try
377            ## process the code in an environment without variables
378            eval (sprintf ("function __test__ ()\n%s\nendfunction", __code));
379            __test__;
380            input ("Press <enter> to continue: ", "s");
381          catch
382            __success = false;
383            __msg = [__signal_fail "demo failed\n" lasterr()];
384          end_try_catch
385          clear __test__;
386
387        endif
388        ## Code already processed.
389        __code = "";
390
391### SHARED
392
393      elseif (strcmp (__type, "shared"))
394        ## Separate initialization code from variables.
395        __idx = find (__code == "\n");
396        if (isempty (__idx))
397          __vars = __code;
398          __code = "";
399        else
400          __vars = __code (1:__idx(1)-1);
401          __code = __code (__idx(1):length (__code));
402        endif
403
404        ## Strip comments off the variables.
405        __idx = find (__vars == "%" | __vars == "#");
406        if (! isempty (__idx))
407          __vars = __vars(1:__idx(1)-1);
408        endif
409
410        if (! isempty (deblank (__shared)))
411          ## Explicitly clear any existing shared variables so that
412          ## onCleanup actions will be executed.
413          __shared_vars = strtrim (ostrsplit (__shared, ","));
414          if (! isempty (__shared_vars))
415            clear (__shared_vars{:});
416          endif
417        endif
418
419        ## Assign default values to variables.
420        try
421          __vars = deblank (__vars);
422          if (! isempty (__vars))
423            eval ([strrep(__vars, ",", "=[];"), "=[];"]);
424            __shared = __vars;
425            __shared_r = ["[ " __vars "] = "];
426          else
427            __shared = " ";
428            __shared_r = " ";
429          endif
430        catch
431          ## Couldn't declare, so don't initialize.
432          __code = "";
433          __success = false;
434          __msg = [__signal_fail "shared variable initialization failed\n"];
435        end_try_catch
436
437        ## Initialization code will be evaluated below.
438
439### FUNCTION
440
441      elseif (strcmp (__type, "function"))
442        persistent __fn = 0;
443        __name_position = function_name (__block);
444        if (isempty (__name_position))
445          __success = false;
446          __msg = [__signal_fail "test failed: missing function name\n"];
447        else
448          __name = __block(__name_position(1):__name_position(2));
449          __code = __block;
450          try
451            eval (__code);  # Define the function
452            __clearfcn = sprintf ("%sclear %s;\n", __clearfcn, __name);
453          catch
454            __success = false;
455            __msg = [__signal_fail "test failed: syntax error\n" lasterr()];
456          end_try_catch
457        endif
458        __code = "";
459
460### ENDFUNCTION
461
462      elseif (strcmp (__type, "endfunction"))
463        ## endfunction simply declares the end of a previous function block.
464        ## There is no processing to be done here, just skip to next block.
465        __code = "";
466
467### ASSERT
468### ASSERT <BUG-ID>
469### FAIL
470### FAIL <BUG-ID>
471###
472###   BUG-ID is a bug number from the bug tracker.  A prefix of '*'
473###   indicates a bug that has been fixed.  Tests that fail for fixed
474###   bugs are reported as regressions.
475
476      elseif (strcmp (__type, "assert") || strcmp (__type, "fail"))
477        [__bug_id, __code, __fixed_bug] = getbugid (__code);
478        if (isempty (__bug_id))
479          __istest = true;
480        else
481          __isxtest = true;
482        endif
483        ## Put the keyword back on the code.
484        __code = [__type __code];
485        ## The code will be evaluated below as a test block.
486
487### ERROR/WARNING
488
489      elseif (strcmp (__type, "error") || strcmp (__type, "warning"))
490        __istest = true;
491        __iswarning = strcmp (__type, "warning");
492        [__pattern, __id, __code] = getpattern (__code);
493        if (__id)
494          __patstr = ["id=" __id];
495        else
496          if (! strcmp (__pattern, '.'))
497            __patstr = ["<" __pattern ">"];
498          else
499            __patstr = ifelse (__iswarning, "a warning", "an error");
500          endif
501        endif
502        try
503          eval (sprintf ("function __test__(%s)\n%s\nendfunction",
504                         __shared, __code));
505        catch
506          __success = false;
507          __msg = [__signal_fail "test failed: syntax error\n" lasterr()];
508        end_try_catch
509
510        if (__success)
511          __success = false;
512          __warnstate = warning ("query", "quiet");
513          warning ("on", "quiet");
514          ## Clear error and warning strings before starting
515          lasterr ("");
516          lastwarn ("");
517          try
518            eval (sprintf ("__test__(%s);", __shared));
519            if (! __iswarning)
520              __msg = [__signal_fail "error failed.\n" ...
521                                     "Expected " __patstr ", but got no error\n"];
522            else
523              if (! isempty (__id))
524                [~, __err] = lastwarn ();
525                __mismatch = ! strcmp (__err, __id);
526              else
527                __err = trimerr (lastwarn (), "warning");
528                __mismatch = isempty (regexp (__err, __pattern, "once"));
529              endif
530              warning (__warnstate.state, "quiet");
531              if (isempty (__err))
532                __msg = [__signal_fail "warning failed.\n" ...
533                                       "Expected " __patstr ", but got no warning\n"];
534              elseif (__mismatch)
535                __msg = [__signal_fail "warning failed.\n" ...
536                                       "Expected " __patstr ", but got <" __err ">\n"];
537              else
538                __success = true;
539              endif
540            endif
541
542          catch
543            if (! isempty (__id))
544              [~, __err] = lasterr ();
545              __mismatch = ! strcmp (__err, __id);
546            else
547              __err = trimerr (lasterr (), "error");
548              __mismatch = isempty (regexp (__err, __pattern, "once"));
549            endif
550            warning (__warnstate.state, "quiet");
551            if (__iswarning)
552              __msg = [__signal_fail "warning failed.\n" ...
553                                     "Expected warning " __patstr ...
554                                     ", but got error <" __err ">\n"];
555            elseif (__mismatch)
556              __msg = [__signal_fail "error failed.\n" ...
557                                     "Expected " __patstr ", but got <" __err ">\n"];
558            else
559              __success = true;
560            endif
561          end_try_catch
562          clear __test__;
563        endif
564        ## Code already processed.
565        __code = "";
566
567### TESTIF HAVE_FEATURE
568### TESTIF HAVE_FEATURE ; RUNTIME_CONDITION
569### TESTIF HAVE_FEATURE <BUG-ID>
570### TESTIF HAVE_FEATURE ; RUNTIME_CONDITION <BUG-ID>
571###
572###   HAVE_FEATURE is a comma- or whitespace separated list of
573###   macro names that may be checked with __have_feature__.
574###
575###   RUNTIME_CONDITION is an expression to evaluate to check
576###   whether some condition is met when the test is executed.  For
577###   example, have_window_system.
578###
579###   BUG-ID is a bug number from the bug tracker.  A prefix of '*'
580###   indicates a bug that has been fixed.  Tests that fail for fixed
581###   bugs are reported as regressions.
582
583      elseif (strcmp (__type, "testif"))
584        __e = regexp (__code, '.$', 'lineanchors', 'once');
585        ## Strip any comment and bug-id from testif line before
586        ## looking for features
587        __feat_line = strtok (__code(1:__e), '#%');
588        __idx1 = index (__feat_line, "<");
589        if (__idx1)
590          __tmp = __feat_line(__idx1+1:end);
591          __idx2 = index (__tmp, ">");
592          if (__idx2)
593            __bug_id = __tmp(1:__idx2-1);
594            if (strncmp (__bug_id, "*", 1))
595              __bug_id = __bug_id(2:end);
596              __fixed_bug = true;
597            endif
598            __feat_line = __feat_line(1:__idx1-1);
599          endif
600        endif
601        __idx = index (__feat_line, ";");
602        if (__idx)
603          __runtime_feat_test = __feat_line(__idx+1:end);
604          __feat_line = __feat_line(1:__idx-1);
605        else
606          __runtime_feat_test = "";
607        endif
608        __feat = regexp (__feat_line, '\w+', 'match');
609        __feat = strrep (__feat, "HAVE_", "");
610        __have_feat = __have_feature__ (__feat);
611        if (__have_feat)
612          if (isempty (__runtime_feat_test) || eval (__runtime_feat_test))
613            if (isempty (__bug_id))
614              __istest = true;
615            else
616              __isxtest = true;
617            endif
618            __code = __code(__e + 1 : end);
619          else
620            __xrtskip += 1;
621            __code = ""; # Skip the code.
622            __msg = [__signal_skip "skipped test (runtime test)\n"];
623          endif
624        else
625          __xskip += 1;
626          __code = ""; # Skip the code.
627          __msg = [__signal_skip "skipped test (missing feature)\n"];
628        endif
629
630### TEST
631### TEST <BUG-ID>
632###
633###   BUG-ID is a bug number from the bug tracker.  A prefix of '*'
634###   indicates a bug that has been fixed.  Tests that fail for fixed
635###   bugs are reported as regressions.
636
637      elseif (strcmp (__type, "test"))
638        [__bug_id, __code, __fixed_bug] = getbugid (__code);
639        if (! isempty (__bug_id))
640          __isxtest = true;
641        else
642          __istest = true;
643        endif
644        ## Code will be evaluated below.
645
646### XTEST
647### XTEST <BUG-ID>
648###
649###   BUG-ID is a bug number from the bug tracker.  A prefix of '*'
650###   indicates a bug that has been fixed.  Tests that fail for fixed
651###   bugs are reported as regressions.
652
653      elseif (strcmp (__type, "xtest"))
654        __isxtest = true;
655        [__bug_id, __code, __fixed_bug] = getbugid (__code);
656        ## Code will be evaluated below.
657
658### Comment block.
659
660      elseif (strcmp (__block(1:1), "#"))
661        __code = ""; # skip the code
662
663### Unknown block.
664
665      else
666        __istest = true;
667        __success = false;
668        __msg = [__signal_fail "unknown test type!\n"];
669        __code = ""; # skip the code
670      endif
671
672      ## evaluate code for test, shared, and assert.
673      if (! isempty(__code))
674        try
675          eval (sprintf ("function %s__test__(%s)\n%s\nendfunction",
676                         __shared_r, __shared, __code));
677          eval (sprintf ("%s__test__(%s);", __shared_r, __shared));
678        catch
679          if (isempty (lasterr ()))
680            error ("test: empty error text, probably Ctrl-C --- aborting");
681          else
682            __success = false;
683            if (__isxtest)
684              if (isempty (__bug_id))
685                if (__fixed_bug)
686                  __xregression += 1;
687                  __msg = "regression";
688                else
689                  __xfail += 1;
690                  __msg = "known failure";
691                endif
692              else
693                if (__fixed_bug)
694                  __xregression += 1;
695                else
696                  __xbug += 1;
697                endif
698                if (all (isdigit (__bug_id)))
699                  __bug_id = ["https://octave.org/testfailure/?" __bug_id];
700                endif
701                if (__fixed_bug)
702                  __msg = ["regression: " __bug_id];
703                else
704                  __msg = ["known bug: " __bug_id];
705                endif
706              endif
707            else
708              __msg = "test failed";
709            endif
710            __msg = [__signal_fail __msg "\n" lasterr()];
711          endif
712        end_try_catch
713        clear __test__;
714      endif
715
716      ## All done.  Remember if we were successful and print any messages.
717      if (! isempty (__msg) && (__verbose >= 0 || __logfile))
718        ## Make sure the user knows what caused the error.
719        if (__verbose < 1)
720          fprintf (__fid, "%s%s\n", __signal_block, __block);
721          fflush (__fid);
722        endif
723        fprintf (__fid, "%s\n", __msg);
724        ## Show the variable context.
725        if (! strcmp (__type, "error")
726            && ! strcmp (__type, "testif")
727            && ! strcmp (__type, "xtest")
728            && ! all (__shared == " "))
729          fputs (__fid, "shared variables ");
730          eval (sprintf ("fdisp(__fid,var2struct(%s));", __shared));
731        endif
732        fflush (__fid);
733      endif
734      if (! __success && ! __isxtest)
735        __all_success = false;
736        ## Stop after 1 error if not in batch mode or only pass/fail requested.
737        if (! __batch || nargout == 1)
738          if (nargout > 0)
739            if (nargout == 1)
740              __n = false;
741            else
742              __n = __nmax = 0;
743            endif
744          endif
745          if (__close_fid)
746            fclose (__fid);
747          endif
748          return;
749        endif
750      endif
751      __tests += (__istest || __isxtest);
752      __successes += __success && (__istest || __isxtest);
753
754    unwind_protect_cleanup
755      warning ("off", "all");
756      warning (orig_wstate);
757    end_unwind_protect
758  endfor
759
760  ## Verify test file did not leak file descriptors.
761  if (! isempty (setdiff (fopen ("all"), __fid_list_orig)))
762    warning ("test: file %s leaked file descriptors\n", __file);
763  endif
764
765  ## Verify test file did not leak variables in to base workspace.
766  __leaked_vars = setdiff (evalin ("base", "who"), __base_variables_orig);
767  if (! isempty (__leaked_vars))
768    warning ("test: file %s leaked variables to base workspace:%s\n",
769             __file, sprintf (" %s", __leaked_vars{:}));
770  endif
771
772  ## Verify test file did not leak global variables.
773  __leaked_vars = setdiff (who ("global"), __global_variables_orig);
774  if (! isempty (__leaked_vars))
775    warning ("test: file %s leaked global variables:%s\n",
776             __file, sprintf (" %s", __leaked_vars{:}));
777  endif
778
779  ## Explicitly clear any existing shared variables so that onCleanup
780  ## actions will be executed.
781  __shared_vars = strtrim (ostrsplit (__shared, ","));
782  if (! isempty (__shared_vars))
783    clear (__shared_vars{:});
784  endif
785
786  ## Clear any functions created during test run.
787  eval (__clearfcn, "");
788
789  if (nargout == 0)
790    if (__tests || __xfail || __xbug || __xskip || __xrtskip)
791      if (__xfail || __xbug)
792        if (__xfail && __xbug)
793          printf ("PASSES %d out of %d test%s (%d known failure%s; %d known bug%s)\n",
794                  __successes, __tests, ifelse (__tests > 1, "s", ""),
795                  __xfail, ifelse (__xfail > 1, "s", ""),
796                  __xbug, ifelse (__xbug > 1, "s", ""));
797        elseif (__xfail)
798          printf ("PASSES %d out of %d test%s (%d known failure%s)\n",
799                  __successes, __tests, ifelse (__tests > 1, "s", ""),
800                  __xfail, ifelse (__xfail > 1, "s", ""));
801        elseif (__xbug)
802          printf ("PASSES %d out of %d test%s (%d known bug%s)\n",
803                  __successes, __tests, ifelse (__tests > 1, "s", ""),
804                  __xbug, ifelse (__xbug > 1, "s", ""));
805        endif
806      else
807        printf ("PASSES %d out of %d test%s\n", __successes, __tests,
808               ifelse (__tests > 1, "s", ""));
809      endif
810      if (__xskip)
811        printf ("Skipped %d test%s due to missing features\n", __xskip,
812                ifelse (__xskip > 1, "s", ""));
813      endif
814      if (__xrtskip)
815        printf ("Skipped %d test%s due to run-time conditions\n", __xrtskip,
816                ifelse (__xrtskip > 1, "s", ""));
817      endif
818    else
819      printf ("%s%s has no tests available\n", __signal_empty, __file);
820    endif
821  elseif (__grabdemo)
822    __n    = __demo_code;
823    __nmax = __demo_idx;
824  elseif (nargout == 1)
825    __n = __all_success;
826  else
827    __n = __successes;
828    __nmax = __tests;
829    __nxfail = __xfail;
830    __nbug = __xbug;
831    __nskip = __xskip;
832    __nrtskip = __xrtskip;
833    __nregression = __xregression;
834  endif
835
836endfunction
837
838
839## Create structure with fieldnames the name of the input variables.
840function s = var2struct (varargin)
841  for i = 1:nargin
842    s.(inputname (i, true)) = varargin{i};
843  endfor
844endfunction
845
846## Find [start,end] of fn in 'function [a,b] = fn'.
847function pos = function_name (def)
848
849  pos = [];
850
851  ## Find the end of the name.
852  right = find (def == "(", 1);
853  if (isempty (right))
854    return;
855  endif
856  right = find (def(1:right-1) != " ", 1, "last");
857
858  ## Find the beginning of the name.
859  left = max ([find(def(1:right)==" ", 1, "last"), ...
860               find(def(1:right)=="=", 1, "last")]);
861  if (isempty (left))
862    return;
863  endif
864  left += 1;
865
866  ## Return the end points of the name.
867  pos = [left, right];
868
869endfunction
870
871## Strip <pattern> from '<pattern> code'.
872## Optionally also handles 'id=ID code'
873function [pattern, id, rest] = getpattern (str)
874
875  pattern = ".";
876  id = [];
877  rest = str;
878  str = trimleft (str);
879  if (! isempty (str) && str(1) == "<")
880    close = index (str, ">");
881    if (close)
882      pattern = str(2:close-1);
883      rest = str(close+1:end);
884    endif
885  elseif (strncmp (str, "id=", 3))
886    [id, rest] = strtok (str(4:end));
887  endif
888
889endfunction
890
891## Strip <bug-id> from '<pattern> code'.
892function [bug_id, rest, fixed] = getbugid (str)
893
894  bug_id = "";
895  rest = str;
896  fixed = false;
897
898  str = trimleft (str);
899  if (! isempty (str) && str(1) == "<")
900    close = index (str, ">");
901    if (close)
902      bug_id = str(2:close-1);
903      if (strncmp (bug_id, "*", 1))
904        bug_id = bug_id(2:end);
905        fixed = true;
906      endif
907      rest = str(close+1:end);
908    endif
909  endif
910
911endfunction
912
913
914## Strip '.*prefix:' from '.*prefix: msg\n' and strip trailing blanks.
915function msg = trimerr (msg, prefix)
916  idx = index (msg, [prefix ":"]);
917  if (idx > 0)
918    msg(1:idx+length(prefix)) = [];
919  endif
920  msg = strtrim (msg);
921endfunction
922
923## Strip leading blanks from string.
924function str = trimleft (str)
925  idx = find (! isspace (str), 1);
926  str = str(idx:end);
927endfunction
928
929function body = __extract_test_code (nm)
930  fid = fopen (nm, "rt");
931  body = "";
932  if (fid >= 0)
933    while (ischar (ln = fgets (fid)))
934      if (strncmp (ln, "%!", 2))
935        body = [body, ln(3:end)];
936      endif
937    endwhile
938    fclose (fid);
939  endif
940endfunction
941
942
943## example from toeplitz
944%!shared msg1,msg2
945%! msg1 = "C must be a vector";
946%! msg2 = "C and R must be vectors";
947%!fail ("toeplitz ([])", msg1)
948%!fail ("toeplitz ([1,2;3,4])", msg1)
949%!fail ("toeplitz ([1,2],[])", msg2)
950%!fail ("toeplitz ([1,2],[1,2;3,4])", msg2)
951%!fail ("toeplitz ([1,2;3,4],[1,2])", msg2)
952%!test fail ("toeplitz", "Invalid call to toeplitz")
953%!fail ("toeplitz (1, 2, 3)", "Invalid call to toeplitz")
954%!test assert (toeplitz ([1,2,3], [1,4]), [1,4; 2,1; 3,2])
955%!assert (toeplitz ([1,2,3], [1,4]), [1,4; 2,1; 3,2])
956%!demo toeplitz ([1,2,3,4],[1,5,6])
957
958## example from kron
959%!error <Invalid call to kron> kron ()
960%!error <Invalid call to kron> kron (1)
961%!test assert (isempty (kron ([], rand (3, 4))))
962%!test assert (isempty (kron (rand (3, 4), [])))
963%!test assert (isempty (kron ([], [])))
964%!shared A, B
965%!test
966%! A = [1, 2, 3; 4, 5, 6];
967%! B = [1, -1; 2, -2];
968%!assert (size (kron (zeros (3, 0), A)), [ 3*rows(A), 0 ])
969%!assert (size (kron (zeros (0, 3), A)), [ 0, 3*columns(A) ])
970%!assert (size (kron (A, zeros (3, 0))), [ 3*rows(A), 0 ])
971%!assert (size (kron (A, zeros (0, 3))), [ 0, 3*columns(A) ])
972%!assert (kron (pi, e), pi*e)
973%!assert (kron (pi, A), pi*A)
974%!assert (kron (A, e), e*A)
975%!assert (kron ([1, 2, 3], A), [ A, 2*A, 3*A ])
976%!assert (kron ([1; 2; 3], A), [ A; 2*A; 3*A ])
977%!assert (kron ([1, 2; 3, 4], A), [ A, 2*A; 3*A, 4*A ])
978%!test
979%! 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];
980%! assert (kron (A, B), res);
981%!shared  # clear out shared variables
982
983## Now verify test() itself
984
985## Test 'fail' keyword
986%!fail ("test", "Invalid call to test")  # no args, generates usage()
987%!fail ("test (1,2,3,4)", "usage.*test") # too many args, generates usage()
988%!fail ('test ("test", "invalid")', "unknown flag")  # incorrect args
989%!fail ('garbage','garbage.*undefined')  # usage on nonexistent function should be
990
991## Test 'error' keyword
992%!error test              # no args, generates usage()
993%!error test (1,2,3,4)    # too many args, generates usage()
994%!error <unknown flag> test ("test", "invalid"); # incorrect args
995%!error test ("test", "invalid");  # test without pattern
996%!error <'garbage' undefined> garbage; # usage on nonexistent function is error
997
998## Test 'warning' keyword
999%!warning warning ("warning message");   # no pattern
1000%!warning <warning message> warning ("warning message");   # with pattern
1001
1002## Test 'shared' keyword
1003%!shared a                # create a shared variable
1004%!test a = 3;             # assign to a shared variable
1005%!test assert (a, 3)      # variable should equal 3
1006%!shared b,c              # replace shared variables
1007%!test assert (! exist ("a", "var"));  # a no longer exists
1008%!test assert (isempty (b));   # variables start off empty
1009%!shared a,b,c            # recreate a shared variable
1010%!test assert (isempty (a));   # value is empty even if it had a previous value
1011%!test a=1; b=2; c=3;   # give values to all variables
1012%!test assert ([a,b,c], [1,2,3]); # test all of them together
1013%!test c=6;               # update a value
1014%!test assert ([a,b,c], [1,2,6]); # show that the update sticks
1015%!shared                  # clear all shared variables
1016%!test assert (! exist ("a", "var")) # show that they are cleared
1017%!shared a,b,c            # support for initializer shorthand
1018%! a=1; b=2; c=4;
1019%!shared                  # clear all shared variables for remainder of tests
1020
1021## Test 'function' keyword
1022%!function x = __test_a (y)
1023%!  x = 2*y;
1024%!endfunction
1025%!assert (__test_a (2), 4)  # Test a test function
1026
1027%!function __test_a (y)
1028%!  x = 2*y;
1029%!endfunction
1030%!test
1031%! __test_a (2);            # Test a test function with no return value
1032
1033%!function [x,z] = __test_a (y)
1034%!  x = 2*y;
1035%!  z = 3*y;
1036%!endfunction
1037%!test
1038%! [x,z] = __test_a (3);    # Test a test function with multiple returns
1039%! assert (x,6);
1040%! assert (z,9);
1041
1042## Test 'assert' keyword
1043%!assert (isempty ([]))     # support for test assert shorthand
1044%!assert (size (ones (1,2,3)), [1 2 3])
1045
1046## Test 'demo' keyword
1047%!demo                      # multiline demo block
1048%! t = [0:0.01:2*pi]; x = sin (t);
1049%! plot (t,x);
1050%! % you should now see a sine wave in your figure window
1051
1052%!demo a=3                  # single line demo blocks work too
1053
1054%!test
1055%! [code, idx] = test ("test", "grabdemo");
1056%! assert (numel (idx), 4);
1057%! assert (code(idx(3):end),
1058%!         " a=3                  # single line demo blocks work too");
1059
1060## Test 'testif' keyword
1061%!testif HAVE_INVALID_FEATURE
1062%! error ("testif executed code despite not having feature");
1063
1064## Test 'xtest' keyword
1065%!xtest
1066%! assert (1, 1);      # Test passes
1067%!xtest <53613>
1068%! assert (0, 1);      # Test fails
1069
1070## Test comment block.  It can contain anything.
1071%!##
1072%! it is the "#" as the block type that makes it a comment
1073%! and it stays as a comment even through continuation lines
1074%! which means that it works well with commenting out whole tests
1075
1076## Test test() input validation
1077%!error <NAME must be a string> test (1)
1078%!error <second argument must be a string> test ("ls", 1)
1079%!error test ([], "normal")
1080
1081## All of the following tests should fail.  These tests should
1082## be disabled unless you are developing test() since users don't
1083## like to be presented with known failures.
1084## %!test   error("---------Failure tests.  Use test('test','verbose',1)");
1085## %!test   assert([a,b,c],[1,3,6]);   # variables have wrong values
1086## %!invalid                   # unknown block type
1087## %!error  toeplitz([1,2,3]); # correct usage
1088## %!test   syntax errors)     # syntax errors fail properly
1089## %!shared garbage in         # variables must be comma separated
1090## %!error  syntax++error      # error test fails on syntax errors
1091## %!error  "succeeds.";       # error test fails if code succeeds
1092## %!error <wrong pattern> error("message")  # error pattern must match
1093## %!demo   with syntax error  # syntax errors in demo fail properly
1094## %!shared a,b,c
1095## %!demo                      # shared variables not available in demo
1096## %! assert (exist ("a", "var"))
1097## %!error
1098## %! test ('/etc/passwd');
1099## %! test ("nonexistent file");
1100## %! ## These don't signal an error, so the test for an error fails.  Note
1101## %! ## that the call doesn't reference the current fid (it is unavailable),
1102## %! ## so of course the informational message is not printed in the log.
1103