1########################################################################
2##
3## Copyright (C) 2000-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  {} {} assert (@var{cond})
28## @deftypefnx {} {} assert (@var{cond}, @var{errmsg})
29## @deftypefnx {} {} assert (@var{cond}, @var{errmsg}, @dots{})
30## @deftypefnx {} {} assert (@var{cond}, @var{msg_id}, @var{errmsg}, @dots{})
31## @deftypefnx {} {} assert (@var{observed}, @var{expected})
32## @deftypefnx {} {} assert (@var{observed}, @var{expected}, @var{tol})
33##
34## Produce an error if the specified condition is not met.
35##
36## @code{assert} can be called in three different ways.
37##
38## @table @code
39## @item  assert (@var{cond})
40## @itemx assert (@var{cond}, @var{errmsg})
41## @itemx assert (@var{cond}, @var{errmsg}, @dots{})
42## @itemx assert (@var{cond}, @var{msg_id}, @var{errmsg}, @dots{})
43## Called with a single argument @var{cond}, @code{assert} produces an error if
44## @var{cond} is false (numeric zero).
45##
46## Any additional arguments are passed to the @code{error} function for
47## processing.
48##
49## @item assert (@var{observed}, @var{expected})
50## Produce an error if observed is not the same as expected.
51##
52## Note that @var{observed} and @var{expected} can be scalars, vectors,
53## matrices, strings, cell arrays, or structures.
54##
55## @item assert (@var{observed}, @var{expected}, @var{tol})
56## Produce an error if observed is not the same as expected but equality
57## comparison for numeric data uses a tolerance @var{tol}.
58##
59## If @var{tol} is positive then it is an absolute tolerance which will produce
60## an error if @code{abs (@var{observed} - @var{expected}) > abs (@var{tol})}.
61##
62## If @var{tol} is negative then it is a relative tolerance which will produce
63## an error if @code{abs (@var{observed} - @var{expected}) >
64## abs (@var{tol} * @var{expected})}.
65##
66## If @var{expected} is zero @var{tol} will always be interpreted as an
67## absolute tolerance.
68##
69## If @var{tol} is not scalar its dimensions must agree with those of
70## @var{observed} and @var{expected} and tests are performed on an
71## element-by-element basis.
72## @end table
73## @seealso{fail, test, error, isequal}
74## @end deftypefn
75
76function assert (cond, varargin)
77
78  if (nargin == 0)
79    print_usage ();
80  endif
81
82  persistent call_depth = -1;
83  persistent errmsg;
84
85  unwind_protect
86
87    call_depth += 1;
88
89    if (call_depth == 0)
90      errmsg = "";
91    endif
92
93    if (nargin == 1 || (nargin > 1 && islogical (cond) && ischar (varargin{1})))
94      if ((! isnumeric (cond) && ! islogical (cond))
95          || isempty (cond) || ! all (cond(:)))
96        if (nargin == 1)
97          ## Perhaps, say which elements failed?
98          argin = ["(" inputname(1, false) ")"];
99          error ("assert %s failed", argin);
100        else
101          error (varargin{:});
102        endif
103      endif
104    else
105      expected = varargin{1};
106      if (nargin < 3)
107        tol = 0;
108      elseif (nargin == 3)
109        tol = varargin{2};
110      else
111        print_usage ();
112      endif
113
114      ## Add to list as the errors accumulate.  If empty at end then no errors.
115      err.index = {};
116      err.observed = {};
117      err.expected = {};
118      err.reason = {};
119
120      if (ischar (expected))
121        if (! ischar (cond))
122          err.index{end+1} = ".";
123          err.expected{end+1} = expected;
124          if (isnumeric (cond))
125            err.observed{end+1} = num2str (cond);
126            err.reason{end+1} = "Expected string, but observed number";
127          else
128            err.observed{end+1} = "O";
129            err.reason{end+1} = ["Expected string, but observed " class(cond)];
130          endif
131        elseif (! strcmp (cond, expected))
132          err.index{end+1} = "[]";
133          err.observed{end+1} = cond;
134          err.expected{end+1} = expected;
135          err.reason{end+1} = "Strings don't match";
136        endif
137
138      elseif (iscell (expected))
139        if (! iscell (cond))
140          err.index{end+1} = ".";
141          err.observed{end+1} = "O";
142          err.expected{end+1} = "E";
143          err.reason{end+1} = ["Expected cell, but observed " class(cond)];
144        elseif (ndims (cond) != ndims (expected)
145                || any (size (cond) != size (expected)))
146          err.index{end+1} = ".";
147          err.observed{end+1} = ["O(" sprintf("%dx", size(cond))(1:end-1) ")"];
148          err.expected{end+1} = ["E(" sprintf("%dx", size(expected))(1:end-1) ")"];
149          err.reason{end+1} = "Dimensions don't match";
150        else
151          try
152            ## Recursively compare cell arrays
153            for i = 1:length (expected(:))
154              assert (cond{i}, expected{i}, tol);
155            endfor
156          catch
157            err.index{end+1} = "{}";
158            err.observed{end+1} = "O";
159            err.expected{end+1} = "E";
160            err.reason{end+1} = "Cell configuration error";
161          end_try_catch
162        endif
163
164      elseif (is_function_handle (expected))
165        if (! is_function_handle (cond))
166          err.index{end+1} = "@";
167          err.observed{end+1} = "O";
168          err.expected{end+1} = "E";
169          err.reason{end+1} = ["Expected function handle, but observed " class(cond)];
170        elseif (! isequal (cond, expected))
171          err.index{end+1} = "@";
172          err.observed{end+1} = "O";
173          err.expected{end+1} = "E";
174          err.reason{end+1} = "Function handles don't match";
175        endif
176
177      elseif (isstruct (expected))
178        if (! isstruct (cond))
179          err.index{end+1} = ".";
180          err.observed{end+1} = "O";
181          err.expected{end+1} = "E";
182          err.reason{end+1} = ["Expected struct, but observed " class(cond)];
183        elseif (ndims (cond) != ndims (expected)
184                || any (size (cond) != size (expected))
185                || numfields (cond) != numfields (expected))
186
187          err.index{end+1} = ".";
188          err.observed{end+1} = ["O(" sprintf("%dx", size(cond))(1:end-1) ")"];
189          err.expected{end+1} = ["E(" sprintf("%dx", size(expected))(1:end-1) ")"];
190          err.reason{end+1} = "Structure sizes don't match";
191        elseif (! strcmp (sort (fieldnames (cond)),
192                          sort (fieldnames (expected))))
193          err.index{end+1} = ".";
194          err.observed{end+1} = "O";
195          err.expected{end+1} = "E";
196          err.reason{end+1} = "Structure fieldname mismatch";
197        else
198          try
199            ## Test if both structs are empty, i.e. 0x0, Nx0, or Nx0 structs.
200            ## In this case the values cannot be extracted for comparison as
201            ## they are not assignable and not defined.
202            assert (isempty (cond), isempty (expected));
203
204            if (! isempty (cond))
205              for [v, k] = cond
206                if (numel (cond) == 1)
207                  v = {v};
208                else
209                  v = v(:)';
210                endif
211                ## Recursively call assert for struct array values
212                assert (v, {expected.(k)}, tol);
213              endfor
214            endif
215          catch
216            err.index{end+1} = ".";
217            err.observed{end+1} = "O";
218            err.expected{end+1} = "E";
219            err.reason{end+1} = "Structure configuration error";
220          end_try_catch
221        endif
222
223      elseif (ndims (cond) != ndims (expected)
224              || any (size (cond) != size (expected)))
225        err.index{end+1} = ".";
226        err.observed{end+1} = ["O(" sprintf("%dx", size(cond))(1:end-1) ")"];
227        err.expected{end+1} = ["E(" sprintf("%dx", size(expected))(1:end-1) ")"];
228        err.reason{end+1} = "Dimensions don't match";
229
230      else  # Numeric comparison
231        if (nargin < 3)
232          ## Without explicit tolerance, be more strict.
233          if (! strcmp (class (cond), class (expected)))
234            err.index{end+1} = "()";
235            err.observed{end+1} = "O";
236            err.expected{end+1} = "E";
237            err.reason{end+1} = ["Class " class(cond) " != " class(expected)];
238          elseif (isnumeric (cond) || islogical (cond))
239            if (issparse (cond) != issparse (expected))
240              err.index{end+1} = "()";
241              err.observed{end+1} = "O";
242              err.expected{end+1} = "E";
243              if (issparse (cond))
244                err.reason{end+1} = "sparse != non-sparse";
245              else
246                err.reason{end+1} = "non-sparse != sparse";
247              endif
248            elseif (iscomplex (cond) != iscomplex (expected))
249              err.index{end+1} = "()";
250              err.observed{end+1} = "O";
251              err.expected{end+1} = "E";
252             if (iscomplex (cond))
253                err.reason{end+1} = "complex != real";
254              else
255                err.reason{end+1} = "real != complex";
256              endif
257            endif
258          endif
259        endif
260
261        if (isempty (err.index))
262
263          A = cond;
264          B = expected;
265
266          ## Check exceptional values.
267          errvec = (  isna (real (A)) != isna (real (B))
268                    | isna (imag (A)) != isna (imag (B)));
269          erridx = find (errvec);
270          if (! isempty (erridx))
271            err.index(end+1:end+length (erridx)) = ...
272              ind2tuple (size (A), erridx);
273            err.observed(end+1:end+length (erridx)) = ...
274              strtrim (cellstr (num2str (A(erridx) (:))));
275            err.expected(end+1:end+length (erridx)) = ...
276              strtrim (cellstr (num2str (B(erridx) (:))));
277            err.reason(end+1:end+length (erridx)) = ...
278              repmat ({"'NA' mismatch"}, length (erridx), 1);
279          endif
280          errseen = errvec;
281
282          errvec = (  isnan (real (A)) != isnan (real (B))
283                    | isnan (imag (A)) != isnan (imag (B)));
284          erridx = find (errvec & ! errseen);
285          if (! isempty (erridx))
286            err.index(end+1:end+length (erridx)) = ...
287              ind2tuple (size (A), erridx);
288            err.observed(end+1:end+length (erridx)) = ...
289              strtrim (cellstr (num2str (A(erridx) (:))));
290            err.expected(end+1:end+length (erridx)) = ...
291              strtrim (cellstr (num2str (B(erridx) (:))));
292            err.reason(end+1:end+length (erridx)) = ...
293              repmat ({"'NaN' mismatch"}, length (erridx), 1);
294          endif
295          errseen |= errvec;
296
297          errvec =   ((isinf (real (A)) | isinf (real (B))) ...
298                      & (real (A) != real (B)))             ...
299                   | ((isinf (imag (A)) | isinf (imag (B))) ...
300                      & (imag (A) != imag (B)));
301          erridx = find (errvec & ! errseen);
302          if (! isempty (erridx))
303            err.index(end+1:end+length (erridx)) = ...
304              ind2tuple (size (A), erridx);
305            err.observed(end+1:end+length (erridx)) = ...
306              strtrim (cellstr (num2str (A(erridx) (:))));
307            err.expected(end+1:end+length (erridx)) = ...
308              strtrim (cellstr (num2str (B(erridx) (:))));
309            err.reason(end+1:end+length (erridx)) = ...
310              repmat ({"'Inf' mismatch"}, length (erridx), 1);
311          endif
312          errseen |= errvec;
313
314          ## Check normal values.
315          ## Replace exceptional values already checked above by zero.
316          A_null_real = real (A);
317          B_null_real = real (B);
318          exclude = errseen ...
319                    | ! isfinite (A_null_real) & ! isfinite (B_null_real);
320          A_null_real(exclude) = 0;
321          B_null_real(exclude) = 0;
322          A_null_imag = imag (A);
323          B_null_imag = imag (B);
324          exclude = errseen ...
325                    | ! isfinite (A_null_imag) & ! isfinite (B_null_imag);
326          A_null_imag(exclude) = 0;
327          B_null_imag(exclude) = 0;
328          A_null = complex (A_null_real, A_null_imag);
329          B_null = complex (B_null_real, B_null_imag);
330          if (isscalar (tol))
331            mtol = tol * ones (size (A));
332          else
333            mtol = tol;
334          endif
335
336          k = (mtol == 0);
337          erridx = find ((A_null != B_null) & k);
338          if (! isempty (erridx))
339            err.index(end+1:end+length (erridx)) = ...
340              ind2tuple (size (A), erridx);
341            err.observed(end+1:end+length (erridx)) = ...
342              strtrim (cellstr (num2str (A(erridx) (:))));
343            err.expected(end+1:end+length (erridx)) = ...
344              strtrim (cellstr (num2str (B(erridx) (:))));
345            err.reason(end+1:end+length (erridx)) = ...
346              ostrsplit (deblank (
347                         sprintf ("Abs err %.5g exceeds tol %.5g by %.1g\n",
348                [abs(A_null(erridx) - B_null(erridx))(:), mtol(erridx)(:), ...
349                 abs(A_null(erridx) - B_null(erridx))(:)-mtol(erridx)(:)].')),
350                         "\n");
351          endif
352
353          k = (mtol > 0);
354          erridx = find ((abs (A_null - B_null) > mtol) & k);
355          if (! isempty (erridx))
356            err.index(end+1:end+length (erridx)) = ...
357              ind2tuple (size (A), erridx);
358            err.observed(end+1:end+length (erridx)) = ...
359              strtrim (cellstr (num2str (A(erridx) (:))));
360            err.expected(end+1:end+length (erridx)) = ...
361              strtrim (cellstr (num2str (B(erridx) (:))));
362            err.reason(end+1:end+length (erridx)) = ...
363              ostrsplit (deblank (
364                         sprintf ("Abs err %.5g exceeds tol %.5g by %.1g\n",
365                [abs(A_null(erridx) - B_null(erridx))(:), mtol(erridx)(:), ...
366                 abs(A_null(erridx) - B_null(erridx))(:)-mtol(erridx)(:)].')),
367                         "\n");
368          endif
369
370          k = (mtol < 0);
371          if (any (k(:)))
372            ## Test for absolute error where relative error can't be calculated.
373            erridx = find ((B_null == 0) & abs (A_null) > abs (mtol) & k);
374            if (! isempty (erridx))
375              err.index(end+1:end+length (erridx)) = ...
376                ind2tuple (size (A), erridx);
377              err.observed(end+1:end+length (erridx)) = ...
378                strtrim (cellstr (num2str (A(erridx) (:))));
379              err.expected(end+1:end+length (erridx)) = ...
380                strtrim (cellstr (num2str (B(erridx) (:))));
381              err.reason(end+1:end+length (erridx)) = ...
382                ostrsplit (deblank (
383                           sprintf ("Abs err %.5g exceeds tol %.5g by %.1g\n",
384                      [abs(A_null(erridx) - B_null(erridx)), -mtol(erridx), ...
385                       abs(A_null(erridx) - B_null(erridx))+mtol(erridx)].')),
386                           "\n");
387            endif
388            ## Test for relative error
389            Bdiv = Inf (size (B_null));
390            Bdiv(k & (B_null != 0)) = B_null(k & (B_null != 0));
391            relerr = abs ((A_null - B_null) ./ abs (Bdiv));
392            erridx = find ((relerr > abs (mtol)) & k);
393            if (! isempty (erridx))
394              err.index(end+1:end+length (erridx)) = ...
395                ind2tuple (size (A), erridx);
396              err.observed(end+1:end+length (erridx)) = ...
397                strtrim (cellstr (num2str (A(erridx) (:))));
398              err.expected(end+1:end+length (erridx)) = ...
399                strtrim (cellstr (num2str (B(erridx) (:))));
400              err.reason(end+1:end+length (erridx)) = ...
401                ostrsplit (deblank (
402                           sprintf ("Rel err %.5g exceeds tol %.5g by %.1g\n",
403                                    [relerr(erridx)(:), -mtol(erridx)(:), ...
404                                     relerr(erridx)(:)+mtol(erridx)(:)].')),
405                           "\n");
406            endif
407          endif
408        endif
409
410      endif
411
412      ## Print any errors
413      if (! isempty (err.index))
414        arg_names = cell (nargin, 1);
415        for i = 1:nargin
416          arg_names{i} = inputname (i, false);
417        endfor
418        argin = ["(" strjoin(arg_names, ",") ")"];
419        if (! isempty (errmsg))
420          errmsg = [errmsg "\n"];
421        endif
422        errmsg = [errmsg, pprint(argin, err)];
423      endif
424
425    endif
426
427  unwind_protect_cleanup
428    call_depth -= 1;
429  end_unwind_protect
430
431  if (call_depth == -1)
432    ## Last time through.  If there were any errors on any pass, raise a flag.
433    if (! isempty (errmsg))
434      error (errmsg);
435    endif
436  endif
437
438endfunction
439
440
441## empty input
442%!error assert ([])
443%!error assert ("")
444%!error assert ({})
445%!error assert (struct ([]))
446%!assert (zeros (3,0), zeros (3,0))
447%!error <O\(3x0\)\s+E\(0x2\)> assert (zeros (3,0), zeros (0,2))
448%!error <Dimensions don't match> assert (zeros (3,0), [])
449%!error <Dimensions don't match> assert (zeros (2,0,2), zeros (2,0))
450
451## conditions
452%!assert (isempty ([]))
453%!assert (1)
454%!error assert (0)
455%!assert (ones (3,1))
456%!assert (ones (1,3))
457%!assert (ones (3,4))
458%!error assert ([1,0,1])
459%!error assert ([1;1;0])
460%!error assert ([1,0;1,1])
461%!error <2-part error> assert (false, "%s %s", "2-part", "error")
462%!error <2-part error> assert (false, "TST:msg_id", "%s %s", "2-part", "error")
463
464## scalars
465%!error <Dimensions don't match> assert (3, [3,3])
466%!error <Dimensions don't match> assert (3, [3,3; 3,3])
467%!error <Dimensions don't match> assert ([3,3; 3,3], 3)
468%!assert (3, 3)
469%!error <Abs err 1 exceeds tol> assert (3, 4)
470%!assert (3+eps, 3, eps)
471%!assert (3, 3+eps, eps)
472%!error <Abs err 4.4409e-0?16 exceeds tol> assert (3+2*eps, 3, eps)
473%!error <Abs err 4.4409e-0?16 exceeds tol> assert (3, 3+2*eps, eps)
474
475## vectors
476%!assert ([1,2,3],[1,2,3])
477%!assert ([1;2;3],[1;2;3])
478%!error <Abs err 1 exceeds tol 0> assert ([2,2,3,3],[1,2,3,4])
479%!error <Abs err 1 exceeds tol 0.5> assert ([2,2,3,3],[1,2,3,4],0.5)
480%!error <Rel err 1 exceeds tol 0.1> assert ([2,2,3,5],[1,2,3,4],-0.1)
481%!error <Abs err 1 exceeds tol 0> assert ([6;6;7;7],[5;6;7;8])
482%!error <Abs err 1 exceeds tol 0.5> assert ([6;6;7;7],[5;6;7;8],0.5)
483%!error <Rel err .* exceeds tol 0.1> assert ([6;6;7;7],[5;6;7;8],-0.1)
484%!error <Dimensions don't match> assert ([1,2,3],[1;2;3])
485%!error <Dimensions don't match> assert ([1,2],[1,2,3])
486%!error <Dimensions don't match> assert ([1;2;3],[1;2])
487
488## matrices
489%!assert ([1,2;3,4],[1,2;3,4])
490%!error <\(1,2\)\s+4\s+2> assert ([1,4;3,4],[1,2;3,4])
491%!error <Dimensions don't match> assert ([1,3;2,4;3,5],[1,2;3,4])
492%!test  # 2-D matrix
493%! A = [1 2 3]'*[1,2];
494%! assert (A, A);
495%! fail ("assert (A.*(A!=2),A)");
496%!test  # N-D matrix
497%! X = zeros (2,2,3);
498%! Y = X;
499%! Y(1,2,3) = 1.5;
500%! fail ("assert (X,Y)", "\(1,2,3\).*Abs err 1.5 exceeds tol 0");
501
502## must give a small tolerance for floating point errors on relative
503%!assert (100+100*eps, 100, -2*eps)
504%!assert (100, 100+100*eps, -2*eps)
505%!error <Rel err .* exceeds tol> assert (100+300*eps, 100, -2*eps)
506%!error <Rel err .* exceeds tol> assert (100, 100+300*eps, -2*eps)
507
508## test relative vs. absolute tolerances
509%!test  assert (0.1+eps, 0.1, 2*eps);
510%!error <Rel err 2.2204e-0?15 exceeds tol> assert (0.1+eps, 0.1, -2*eps)
511%!test  assert (100+100*eps, 100, -2*eps);
512%!error <Abs err 2.8422e-0?14 exceeds tol> assert (100+100*eps, 100, 2*eps)
513
514## Corner case of relative tolerance with 0 divider
515%!error <Abs err 2 exceeds tol 0.1> assert (2, 0, -0.1)
516
517## Extra checking of inputs when tolerance unspecified.
518%!error <Class single != double> assert (single (1), 1)
519%!error <Class uint8 != uint16> assert (uint8 (1), uint16 (1))
520%!error <sparse != non-sparse> assert (sparse([1]), [1])
521%!error <non-sparse != sparse> assert ([1], sparse([1]))
522%!error <complex != real> assert (1+i, 1)
523%!error <real != complex> assert (1, 1+i)
524
525## exceptional values
526%!assert ([NaN, NA, Inf, -Inf, 1+eps, eps], [NaN, NA, Inf, -Inf, 1, 0], eps)
527
528%!error <'NaN' mismatch> assert (NaN, 1)
529%!error <'NaN' mismatch> assert ([NaN 1], [1 NaN])
530%!test
531%! try
532%!   assert ([NaN 1], [1 NaN]);
533%! catch
534%!   errmsg = lasterr ();
535%!   if (sum (errmsg () == "\n") != 4)
536%!     error ("Too many errors reported for NaN assert");
537%!   elseif (strfind (errmsg, "NA"))
538%!     error ("NA reported for NaN assert");
539%!   elseif (strfind (errmsg, "Abs err NaN exceeds tol 0"))
540%!     error ("Abs err reported for NaN assert");
541%!   endif
542%! end_try_catch
543
544%!error <'NA' mismatch> assert (NA, 1)
545%!error assert ([NA 1]', [1 NA]')
546%!test
547%! try
548%!   assert ([NA 1]', [1 NA]');
549%! catch
550%!   errmsg = lasterr ();
551%!   if (sum (errmsg () == "\n") != 4)
552%!     error ("Too many errors reported for NA assert");
553%!   elseif (strfind (errmsg, "NaN"))
554%!     error ("NaN reported for NA assert");
555%!   elseif (strfind (errmsg, "Abs err NA exceeds tol 0"))
556%!     error ("Abs err reported for NA assert");
557%!   endif
558%! end_try_catch
559%!error assert ([(complex (NA, 1)) (complex (2, NA))], [(complex (NA, 2)) 2])
560
561%!error <'Inf' mismatch> assert (-Inf, Inf)
562%!error <'Inf' mismatch> assert ([-Inf Inf], [Inf -Inf])
563%!test
564%! try
565%!   assert (complex (Inf, 0.2), complex (-Inf, 0.2 + 2*eps), eps);
566%! catch
567%!   errmsg = lasterr ();
568%!   if (sum (errmsg () == "\n") != 3)
569%!     error ("Too many errors reported for Inf assert");
570%!   elseif (strfind (errmsg, "Abs err"))
571%!     error ("Abs err reported for Inf assert");
572%!   endif
573%! end_try_catch
574%!error <Abs err> assert (complex (Inf, 0.2), complex (Inf, 0.2 + 2*eps), eps)
575
576## strings
577%!assert ("dog", "dog")
578%!error <Strings don't match> assert ("dog", "cat")
579%!error <Expected string, but observed number> assert (3, "dog")
580%!error <Class char != double> assert ("dog", [3 3 3])
581%!error <Expected string, but observed cell> assert ({"dog"}, "dog")
582%!error <Expected string, but observed struct> assert (struct ("dog", 3), "dog")
583
584## cell arrays
585%!error <Expected cell, but observed double> assert (1, {1})
586%!error <Dimensions don't match> assert (cell (1,2,3), cell (3,2,1))
587%!test
588%! x = {{{1}}, 2};  # cell with multiple levels
589%! y = x;
590%! assert (x,y);
591%! y{1}{1}{1} = 3;
592%! fail ("assert (x,y)", "Abs err 2 exceeds tol 0");
593
594## function handles
595%!assert (@sin, @sin)
596%!error <Function handles don't match> assert (@sin, @cos)
597%!error <Expected function handle, but observed double> assert (pi, @cos)
598%!error <Class function_handle != double> assert (@sin, pi)
599
600%!test
601%! x = {[3], [1,2,3]; 100+100*eps, "dog"};
602%! y = x;
603%! assert (x, y);
604%! y = x; y(1,1) = [2];
605%! fail ("assert (x, y)");
606%! y = x; y(1,2) = [0, 2, 3];
607%! fail ("assert (x, y)");
608%! y = x; y(2,1) = 101;
609%! fail ("assert (x, y)");
610%! y = x; y(2,2) = "cat";
611%! fail ("assert (x, y)");
612%! y = x; y(1,1) = [2];  y(1,2) = [0, 2, 3]; y(2,1) = 101; y(2,2) = "cat";
613%! fail ("assert (x, y)");
614
615## structures
616%!error <Expected struct, but observed double> assert (1, struct ("a", 1))
617%!error <Structure sizes don't match>
618%! x(1,2,3).a = 1;
619%! y(1,2).a = 1;
620%! assert (x,y);
621%!error <Structure sizes don't match>
622%! x(1,2,3).a = 1;
623%! y(3,2,2).a = 1;
624%! assert (x,y);
625%!error <Structure sizes don't match>
626%! x.a = 1;
627%! x.b = 1;
628%! y.a = 1;
629%! assert (x,y);
630%!error <Structure fieldname mismatch>
631%! x.b = 1;
632%! y.a = 1;
633%! assert (x,y);
634
635%!test
636%! x.a = 1; x.b=[2, 2];
637%! y.a = 1; y.b=[2, 2];
638%! assert (x, y);
639%! y.b=3;
640%! fail ("assert (x, y)");
641%! fail ("assert (3, x)");
642%! fail ("assert (x, 3)");
643%! ## Empty structures
644%! x = resize (x, 0, 1);
645%! y = resize (y, 0, 1);
646%! assert (x, y);
647
648## vector of tolerances
649%!test
650%! x = [-40:0];
651%! y1 = (10.^x).*(10.^x);
652%! y2 = 10.^(2*x);
653%! ## Increase tolerance from eps (y1) to 4*eps (y1) because of an upstream bug
654%! ## in mingw-w64: https://sourceforge.net/p/mingw-w64/bugs/466/
655%! assert (y1, y2, 4*eps (y1));
656%! fail ("assert (y1, y2 + eps*1e-70, eps (y1))");
657
658## Multiple tolerances
659%!test
660%! x = [1 2; 3 4];
661%! y = [0 -1; 1 2];
662%! tol = [-0.1 0; -0.2 0.3];
663%! try
664%!   assert (x, y, tol);
665%! catch
666%!   errmsg = lasterr ();
667%!   if (sum (errmsg () == "\n") != 6)
668%!     error ("Incorrect number of errors reported");
669%!   endif
670%!   assert (! isempty (regexp (errmsg, '\(1,2\).*Abs err 3 exceeds tol 0\>')));
671%!   assert (! isempty (regexp (errmsg, '\(2,2\).*Abs err 2 exceeds tol 0.3')));
672%!   assert (! isempty (regexp (errmsg, '\(1,1\).*Abs err 1 exceeds tol 0.1')));
673%!   assert (! isempty (regexp (errmsg, '\(2,1\).*Rel err 2 exceeds tol 0.2')));
674%! end_try_catch
675
676%!test <*57615>
677%! try
678%!   assert (complex (pi*1e-17,2*pi), 0, 1e-1);
679%! catch
680%!   errmsg = lasterr ();
681%!   assert (isempty (strfind (errmsg, "sprintf: invalid field width")));
682%! end_try_catch
683
684## test input validation
685%!error assert ()
686%!error assert (1,2,3,4)
687
688
689## Convert all error indices into tuple format
690function cout = ind2tuple (matsize, erridx)
691
692  cout = cell (numel (erridx), 1);
693  tmp = cell (1, numel (matsize));
694  [tmp{:}] = ind2sub (matsize, erridx(:));
695  subs = [tmp{:}];
696  if (numel (matsize) == 2)
697    subs = subs(:, matsize != 1);
698  endif
699  for i = 1:numel (erridx)
700    loc = sprintf ("%d,", subs(i,:));
701    cout{i} = ["(" loc(1:end-1) ")"];
702  endfor
703
704endfunction
705
706
707## Pretty print the various errors in a condensed tabular format.
708function str = pprint (argin, err)
709
710  str = ["ASSERT errors for:  assert " argin "\n"];
711  str = [str, "\n  Location  |  Observed  |  Expected  |  Reason\n"];
712  for i = 1:length (err.index)
713    leni = length (err.index{i});
714    leno = length (err.observed{i});
715    lene = length (err.expected{i});
716    str = [str, sprintf("%*s%*s %*s%*s %*s%*s   %s\n",
717                  6+fix(leni/2), err.index{i}   , max (6-fix(leni/2), 0), "",
718                  6+fix(leno/2), err.observed{i}, max (6-fix(leno/2), 0), "",
719                  6+fix(lene/2), err.expected{i}, max (6-fix(lene/2), 0), "",
720                  err.reason{i})];
721  endfor
722
723endfunction
724