File: fail.m

package info (click to toggle)
octave 3.8.2-4
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 84,396 kB
  • ctags: 45,547
  • sloc: cpp: 293,356; ansic: 42,041; fortran: 23,669; sh: 13,629; objc: 7,890; yacc: 7,093; lex: 3,442; java: 2,125; makefile: 1,589; perl: 1,009; awk: 974; xml: 34
file content (154 lines) | stat: -rw-r--r-- 5,116 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
## Copyright (C) 2005-2013 Paul Kienzle
##
## This file is part of Octave.
##
## Octave is free software; you can redistribute it and/or modify it
## under the terms of the GNU General Public License as published by
## the Free Software Foundation; either version 3 of the License, or (at
## your option) any later version.
##
## Octave is distributed in the hope that it will be useful, but
## WITHOUT ANY WARRANTY; without even the implied warranty of
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
## General Public License for more details.
##
## You should have received a copy of the GNU General Public License
## along with Octave; see the file COPYING.  If not, see
## <http://www.gnu.org/licenses/>.
##
## Original version by Paul Kienzle distributed as free software in the
## public domain.

## -*- texinfo -*-
## @deftypefn  {Function File} {} fail (@var{code})
## @deftypefnx {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
##
##
## Code must be in the form of a string that may be passed by
## @code{fail} to the Octave interpreter via the @code{evalin} function,
## that is, a (quoted) string constant or a string variable.
##
## If called with two arguments, the behavior is similar to
## @code{fail (@var{code})}, except the return value will only be true if
## code fails with an error message containing pattern (case sensitive).
## If the code fails with a different error to that given in pattern,
## the message produced is:
##
## @example
## @group
##           expected <pattern>
##           but got <text of actual error>
## @end group
## @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.
## @seealso{assert}
## @end deftypefn

## Author: Paul Kienzle <pkienzle@users.sf.net>

function ret = fail (code, pattern, warning_pattern)

  if (nargin < 1 || nargin > 3)
    print_usage ();
  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

  ## match any nonempty message
  if (isempty (pattern))
    pattern = ".";
  endif

  ## allow assert (fail ())
  if (nargout)
    ret = 1;
  endif

  if (test_warning)
    ## Perform the warning test.
    ## Clear old warnings.
    lastwarn ();
    ## Make sure warnings are turned on.
    state = warning ("query", "quiet");
    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);
      ## Retrieve new warnings.
      err = lastwarn ();
      warning (state.state, "quiet");
      if (isempty (err))
        msg = sprintf ("expected warning <%s> but got none", pattern);
      else
        ## Transform "warning: ...\n" to "...".
        err([1:9, end]) = [];
        if (! isempty (regexp (err, pattern, "once")))
          return;
        endif
        msg = sprintf ("expected warning <%s>\nbut got <%s>", pattern, err);
      endif
    catch
      warning (state.state, "quiet");
      err = lasterr;
      ## Transform "error: ...\n", to "...".
      err([1:7, end]) = [];
      msg = sprintf ("expected warning <%s> but got error <%s>", pattern, err);
    end_try_catch

  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;
      endif
      msg = sprintf ("expected error <%s>\nbut got <%s>", pattern, err);
    end_try_catch
  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?!?

%% Test that fail() itself will generate an error
%!error fail ("1")
%!error <undefined> fail ("a*[2;3]", "nonconformant")
%!error <expected error>  fail ("a*[2,3]", "usage:")
%!error <warning failure> fail ("warning ('warning failure')", "warning", "success")