1 ////////////////////////////////////////////////////////////////////////
2 //
3 // Copyright (C) 1996-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 #if defined (HAVE_CONFIG_H)
27 # include "config.h"
28 #endif
29
30 #include <sstream>
31
32 #include "file-info.h"
33 #include "file-ops.h"
34 #include "file-stat.h"
35 #include "str-vec.h"
36
37 #include "builtin-defun-decls.h"
38 #include "defaults.h"
39 #include "Cell.h"
40 #include "defun.h"
41 #include "error.h"
42 #include "errwarn.h"
43 #include "input.h"
44 #include "ovl.h"
45 #include "ov-usr-fcn.h"
46 #include "ov.h"
47 #include "pager.h"
48 #include "pt-eval.h"
49 #include "pt-jit.h"
50 #include "pt-jump.h"
51 #include "pt-misc.h"
52 #include "pt-pr-code.h"
53 #include "pt-stmt.h"
54 #include "pt-walk.h"
55 #include "symtab.h"
56 #include "interpreter-private.h"
57 #include "interpreter.h"
58 #include "unwind-prot.h"
59 #include "utils.h"
60 #include "parse.h"
61 #include "profiler.h"
62 #include "variables.h"
63 #include "ov-fcn-handle.h"
64
65 // Whether to optimize subsasgn method calls.
66 static bool Voptimize_subsasgn_calls = true;
67
~octave_user_code(void)68 octave_user_code::~octave_user_code (void)
69 {
70 // This function is no longer valid, so remove the pointer to it from
71 // the corresponding scope.
72 // FIXME: would it be better to use shared/weak pointers for this job
73 // instead of storing a bare pointer in the scope object?
74 m_scope.set_user_code (nullptr);
75
76 // FIXME: shouldn't this happen automatically when deleting cmd_list?
77 if (cmd_list)
78 {
79 octave::event_manager& evmgr
80 = octave::__get_event_manager__ ("octave_user_code::~octave_user_code");
81
82 cmd_list->remove_all_breakpoints (evmgr, file_name);
83 }
84
85 delete cmd_list;
86 delete m_file_info;
87 }
88
89 void
get_file_info(void)90 octave_user_code::get_file_info (void)
91 {
92 m_file_info = new octave::file_info (file_name);
93
94 octave::sys::file_stat fs (file_name);
95
96 if (fs && (fs.mtime () > time_parsed ()))
97 warning ("function file '%s' changed since it was parsed",
98 file_name.c_str ());
99 }
100
101 std::string
get_code_line(std::size_t line)102 octave_user_code::get_code_line (std::size_t line)
103 {
104 if (! m_file_info)
105 get_file_info ();
106
107 return m_file_info->get_line (line);
108 }
109
110 std::deque<std::string>
get_code_lines(std::size_t line,std::size_t num_lines)111 octave_user_code::get_code_lines (std::size_t line, std::size_t num_lines)
112 {
113 if (! m_file_info)
114 get_file_info ();
115
116 return m_file_info->get_lines (line, num_lines);
117 }
118
119 void
cache_function_text(const std::string & text,const octave::sys::time & timestamp)120 octave_user_code::cache_function_text (const std::string& text,
121 const octave::sys::time& timestamp)
122 {
123 if (m_file_info)
124 delete m_file_info;
125
126 if (timestamp > time_parsed ())
127 warning ("help text for function is newer than function");
128
129 m_file_info = new octave::file_info (text, timestamp);
130 }
131
132 std::map<std::string, octave_value>
subfunctions(void) const133 octave_user_code::subfunctions (void) const
134 {
135 return std::map<std::string, octave_value> ();
136 }
137
138 octave_value
dump(void) const139 octave_user_code::dump (void) const
140 {
141 std::map<std::string, octave_value> m
142 = {{ "scope_info", m_scope ? m_scope.dump () : "0x0" },
143 { "file_name", file_name },
144 { "time_parsed", t_parsed },
145 { "time_checked", t_checked }};
146
147 return octave_value (m);
148 }
149
150
151 // User defined scripts.
152
153 DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_user_script,
154 "user-defined script",
155 "user-defined script");
156
octave_user_script(void)157 octave_user_script::octave_user_script (void)
158 : octave_user_code ()
159 { }
160
octave_user_script(const std::string & fnm,const std::string & nm,const octave::symbol_scope & scope,octave::tree_statement_list * cmds,const std::string & ds)161 octave_user_script::octave_user_script
162 (const std::string& fnm, const std::string& nm,
163 const octave::symbol_scope& scope, octave::tree_statement_list *cmds,
164 const std::string& ds)
165 : octave_user_code (fnm, nm, scope, cmds, ds)
166 {
167 if (cmd_list)
168 cmd_list->mark_as_script_body ();
169 }
170
octave_user_script(const std::string & fnm,const std::string & nm,const octave::symbol_scope & scope,const std::string & ds)171 octave_user_script::octave_user_script
172 (const std::string& fnm, const std::string& nm,
173 const octave::symbol_scope& scope, const std::string& ds)
174 : octave_user_code (fnm, nm, scope, nullptr, ds)
175 { }
176
177 // We must overload the call method so that we call the proper
178 // push_stack_frame method, which is overloaded for pointers to
179 // octave_function, octave_user_function, and octave_user_script
180 // objects.
181
182 octave_value_list
call(octave::tree_evaluator & tw,int nargout,const octave_value_list & args)183 octave_user_script::call (octave::tree_evaluator& tw, int nargout,
184 const octave_value_list& args)
185 {
186 tw.push_stack_frame (this);
187
188 octave::unwind_action act ([&tw] () { tw.pop_stack_frame (); });
189
190 return execute (tw, nargout, args);
191 }
192
193 octave_value_list
execute(octave::tree_evaluator & tw,int nargout,const octave_value_list & args)194 octave_user_script::execute (octave::tree_evaluator& tw, int nargout,
195 const octave_value_list& args)
196 {
197 return tw.execute_user_script (*this, nargout, args);
198 }
199
200 void
accept(octave::tree_walker & tw)201 octave_user_script::accept (octave::tree_walker& tw)
202 {
203 tw.visit_octave_user_script (*this);
204 }
205
206 // User defined functions.
207
208 DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_user_function,
209 "user-defined function",
210 "user-defined function");
211
212 // Ugh. This really needs to be simplified (code/data?
213 // extrinsic/intrinsic state?).
214
octave_user_function(const octave::symbol_scope & scope,octave::tree_parameter_list * pl,octave::tree_parameter_list * rl,octave::tree_statement_list * cl)215 octave_user_function::octave_user_function
216 (const octave::symbol_scope& scope, octave::tree_parameter_list *pl,
217 octave::tree_parameter_list *rl, octave::tree_statement_list *cl)
218 : octave_user_code ("", "", scope, cl, ""),
219 param_list (pl), ret_list (rl),
220 lead_comm (), trail_comm (),
221 location_line (0), location_column (0),
222 parent_name (), system_fcn_file (false),
223 num_named_args (param_list ? param_list->length () : 0),
224 subfunction (false), inline_function (false),
225 anonymous_function (false), nested_function (false),
226 class_constructor (none), class_method (none)
227 #if defined (HAVE_LLVM)
228 , jit_info (0)
229 #endif
230 {
231 if (cmd_list)
232 cmd_list->mark_as_function_body ();
233 }
234
~octave_user_function(void)235 octave_user_function::~octave_user_function (void)
236 {
237 delete param_list;
238 delete ret_list;
239 delete lead_comm;
240 delete trail_comm;
241
242 #if defined (HAVE_LLVM)
243 delete jit_info;
244 #endif
245 }
246
247 octave_user_function *
define_ret_list(octave::tree_parameter_list * t)248 octave_user_function::define_ret_list (octave::tree_parameter_list *t)
249 {
250 ret_list = t;
251
252 return this;
253 }
254
255 // If there is no explicit end statement at the end of the function,
256 // relocate the no_op that was generated for the end of file condition
257 // to appear on the next line after the last statement in the file, or
258 // the next line after the function keyword if there are no statements.
259 // More precisely, the new location should probably be on the next line
260 // after the end of the parameter list, but we aren't tracking that
261 // information (yet).
262
263 void
maybe_relocate_end_internal(void)264 octave_user_function::maybe_relocate_end_internal (void)
265 {
266 if (cmd_list && ! cmd_list->empty ())
267 {
268 octave::tree_statement *last_stmt = cmd_list->back ();
269
270 if (last_stmt && last_stmt->is_end_of_fcn_or_script ()
271 && last_stmt->is_end_of_file ())
272 {
273 octave::tree_statement_list::reverse_iterator
274 next_to_last_elt = cmd_list->rbegin ();
275
276 next_to_last_elt++;
277
278 int new_eof_line;
279 int new_eof_col;
280
281 if (next_to_last_elt == cmd_list->rend ())
282 {
283 new_eof_line = beginning_line ();
284 new_eof_col = beginning_column ();
285 }
286 else
287 {
288 octave::tree_statement *next_to_last_stmt = *next_to_last_elt;
289
290 new_eof_line = next_to_last_stmt->line ();
291 new_eof_col = next_to_last_stmt->column ();
292 }
293
294 last_stmt->set_location (new_eof_line + 1, new_eof_col);
295 }
296 }
297 }
298
299 void
maybe_relocate_end(void)300 octave_user_function::maybe_relocate_end (void)
301 {
302 std::map<std::string, octave_value> fcns = subfunctions ();
303
304 if (! fcns.empty ())
305 {
306 for (auto& nm_fnval : fcns)
307 {
308 octave_user_function *f = nm_fnval.second.user_function_value ();
309
310 if (f)
311 f->maybe_relocate_end_internal ();
312 }
313 }
314
315 maybe_relocate_end_internal ();
316 }
317
318 void
stash_parent_fcn_scope(const octave::symbol_scope & ps)319 octave_user_function::stash_parent_fcn_scope (const octave::symbol_scope& ps)
320 {
321 m_scope.set_parent (ps);
322 }
323
324 std::string
profiler_name(void) const325 octave_user_function::profiler_name (void) const
326 {
327 std::ostringstream result;
328
329 if (is_anonymous_function ())
330 result << "anonymous@" << fcn_file_name ()
331 << ':' << location_line << ':' << location_column;
332 else if (is_subfunction ())
333 result << parent_fcn_name () << '>' << name ();
334 else if (is_class_method ())
335 result << '@' << dispatch_class () << '/' << name ();
336 else if (is_class_constructor () || is_classdef_constructor ())
337 result << '@' << name ();
338 else if (is_inline_function ())
339 result << "inline@" << fcn_file_name ()
340 << ':' << location_line << ':' << location_column;
341 else
342 result << name ();
343
344 return result.str ();
345 }
346
347 void
mark_as_system_fcn_file(void)348 octave_user_function::mark_as_system_fcn_file (void)
349 {
350 if (! file_name.empty ())
351 {
352 // We really should stash the whole path to the file we found,
353 // when we looked it up, to avoid possible race conditions...
354 // FIXME
355 //
356 // We probably also don't need to get the library directory
357 // every time, but since this function is only called when the
358 // function file is parsed, it probably doesn't matter that
359 // much.
360
361 std::string ff_name = octave::fcn_file_in_path (file_name);
362
363 static const std::string canonical_fcn_file_dir
364 = octave::sys::canonicalize_file_name
365 (octave::config::fcn_file_dir ());
366 static const std::string fcn_file_dir
367 = canonical_fcn_file_dir.empty () ? octave::config::fcn_file_dir ()
368 : canonical_fcn_file_dir;
369
370 if (fcn_file_dir == ff_name.substr (0, fcn_file_dir.length ()))
371 system_fcn_file = true;
372 }
373 else
374 system_fcn_file = false;
375 }
376
377 void
erase_subfunctions(void)378 octave_user_function::erase_subfunctions (void)
379 {
380 m_scope.erase_subfunctions ();
381 }
382
383 bool
takes_varargs(void) const384 octave_user_function::takes_varargs (void) const
385 {
386 return (param_list && param_list->takes_varargs ());
387 }
388
389 bool
takes_var_return(void) const390 octave_user_function::takes_var_return (void) const
391 {
392 return (ret_list && ret_list->takes_varargs ());
393 }
394
395 void
mark_as_private_function(const std::string & cname)396 octave_user_function::mark_as_private_function (const std::string& cname)
397 {
398 m_scope.mark_subfunctions_in_scope_as_private (cname);
399
400 octave_function::mark_as_private_function (cname);
401 }
402
403 void
lock_subfunctions(void)404 octave_user_function::lock_subfunctions (void)
405 {
406 m_scope.lock_subfunctions ();
407 }
408
409 void
unlock_subfunctions(void)410 octave_user_function::unlock_subfunctions (void)
411 {
412 m_scope.unlock_subfunctions ();
413 }
414
415 std::map<std::string, octave_value>
subfunctions(void) const416 octave_user_function::subfunctions (void) const
417 {
418 return m_scope.subfunctions ();
419 }
420
421 // Find definition of final subfunction in list of subfuns:
422 //
423 // sub1>sub2>...>subN
424
425 octave_value
find_subfunction(const std::string & subfuns_arg) const426 octave_user_function::find_subfunction (const std::string& subfuns_arg) const
427 {
428 std::string subfuns = subfuns_arg;
429
430 std::string first_fun = subfuns;
431
432 std::size_t pos = subfuns.find ('>');
433
434 if (pos == std::string::npos)
435 subfuns = "";
436 else
437 {
438 first_fun = subfuns.substr (0, pos-1);
439 subfuns = subfuns.substr (pos+1);
440 }
441
442 octave_value ov_fcn = m_scope.find_subfunction (first_fun);
443
444 if (subfuns.empty ())
445 return ov_fcn;
446
447 octave_user_function *fcn = ov_fcn.user_function_value ();
448
449 return fcn->find_subfunction (subfuns);
450 }
451
452 bool
has_subfunctions(void) const453 octave_user_function::has_subfunctions (void) const
454 {
455 return m_scope.has_subfunctions ();
456 }
457
458 void
stash_subfunction_names(const std::list<std::string> & names)459 octave_user_function::stash_subfunction_names (const std::list<std::string>& names)
460 {
461 m_scope.stash_subfunction_names (names);
462 }
463
464 std::list<std::string>
subfunction_names(void) const465 octave_user_function::subfunction_names (void) const
466 {
467 return m_scope.subfunction_names ();
468 }
469
470 octave_value_list
all_va_args(const octave_value_list & args)471 octave_user_function::all_va_args (const octave_value_list& args)
472 {
473 octave_value_list retval;
474
475 octave_idx_type n = args.length () - num_named_args;
476
477 if (n > 0)
478 retval = args.slice (num_named_args, n);
479
480 return retval;
481 }
482
483 // We must overload the call method so that we call the proper
484 // push_stack_frame method, which is overloaded for pointers to
485 // octave_function, octave_user_function, and octave_user_script
486 // objects.
487
488 octave_value_list
call(octave::tree_evaluator & tw,int nargout,const octave_value_list & args)489 octave_user_function::call (octave::tree_evaluator& tw, int nargout,
490 const octave_value_list& args)
491 {
492 tw.push_stack_frame (this);
493
494 octave::unwind_action act ([&tw] () { tw.pop_stack_frame (); });
495
496 return execute (tw, nargout, args);
497 }
498
499 octave_value_list
execute(octave::tree_evaluator & tw,int nargout,const octave_value_list & args)500 octave_user_function::execute (octave::tree_evaluator& tw, int nargout,
501 const octave_value_list& args)
502 {
503 return tw.execute_user_function (*this, nargout, args);
504 }
505
506 void
accept(octave::tree_walker & tw)507 octave_user_function::accept (octave::tree_walker& tw)
508 {
509 tw.visit_octave_user_function (*this);
510 }
511
512 octave::tree_expression *
special_expr(void)513 octave_user_function::special_expr (void)
514 {
515 assert (is_special_expr ());
516 assert (cmd_list->length () == 1);
517
518 octave::tree_statement *stmt = cmd_list->front ();
519 return stmt->expression ();
520 }
521
522 bool
subsasgn_optimization_ok(void)523 octave_user_function::subsasgn_optimization_ok (void)
524 {
525 bool retval = false;
526 if (Voptimize_subsasgn_calls
527 && param_list && ret_list
528 && param_list->length () > 0 && ! param_list->varargs_only ()
529 && ret_list->length () == 1 && ! ret_list->takes_varargs ())
530 {
531 octave::tree_identifier *par1 = param_list->front ()->ident ();
532 octave::tree_identifier *ret1 = ret_list->front ()->ident ();
533 retval = par1->name () == ret1->name ();
534 }
535
536 return retval;
537 }
538
539 std::string
ctor_type_str(void) const540 octave_user_function::ctor_type_str (void) const
541 {
542 std::string retval;
543
544 switch (class_constructor)
545 {
546 case none:
547 retval = "none";
548 break;
549
550 case legacy:
551 retval = "legacy";
552 break;
553
554 case classdef:
555 retval = "classdef";
556 break;
557
558 default:
559 retval = "unrecognized enum value";
560 break;
561 }
562
563 return retval;
564 }
565
566 std::string
method_type_str(void) const567 octave_user_function::method_type_str (void) const
568 {
569 std::string retval;
570
571 switch (class_method)
572 {
573 case none:
574 retval = "none";
575 break;
576
577 case legacy:
578 retval = "legacy";
579 break;
580
581 case classdef:
582 retval = "classdef";
583 break;
584
585 default:
586 retval = "unrecognized enum value";
587 break;
588 }
589
590 return retval;
591 }
592
593 octave_value
dump(void) const594 octave_user_function::dump (void) const
595 {
596 std::map<std::string, octave_value> m
597 = {{ "user_code", octave_user_code::dump () },
598 { "line", location_line },
599 { "col", location_column },
600 { "end_line", end_location_line },
601 { "end_col", end_location_column },
602 { "parent_name", parent_name },
603 { "system_fcn_file", system_fcn_file },
604 { "num_named_args", num_named_args },
605 { "subfunction", subfunction },
606 { "inline_function", inline_function },
607 { "anonymous_function", anonymous_function },
608 { "nested_function", nested_function },
609 { "ctor_type", ctor_type_str () },
610 { "class_method", class_method }};
611
612 return octave_value (m);
613 }
614
615 void
print_code_function_header(const std::string & prefix)616 octave_user_function::print_code_function_header (const std::string& prefix)
617 {
618 octave::tree_print_code tpc (octave_stdout, prefix);
619
620 tpc.visit_octave_user_function_header (*this);
621 }
622
623 void
print_code_function_trailer(const std::string & prefix)624 octave_user_function::print_code_function_trailer (const std::string& prefix)
625 {
626 octave::tree_print_code tpc (octave_stdout, prefix);
627
628 tpc.visit_octave_user_function_trailer (*this);
629 }
630
631 void
restore_warning_states(void)632 octave_user_function::restore_warning_states (void)
633 {
634 octave::interpreter& interp
635 = octave::__get_interpreter__ ("octave_user_function::restore_warning_states");
636
637 octave::tree_evaluator& tw = interp.get_evaluator ();
638
639 octave_value val
640 = tw.get_auto_fcn_var (octave::stack_frame::SAVED_WARNING_STATES);
641
642 if (val.is_defined ())
643 {
644 // Fail spectacularly if SAVED_WARNING_STATES is not an
645 // octave_map (or octave_scalar_map) object.
646
647 if (! val.isstruct ())
648 panic_impossible ();
649
650 octave_map m = val.map_value ();
651
652 Cell ids = m.contents ("identifier");
653 Cell states = m.contents ("state");
654
655 for (octave_idx_type i = 0; i < m.numel (); i++)
656 Fwarning (interp, ovl (states(i), ids(i)));
657 }
658 }
659
660 DEFMETHOD (nargin, interp, args, ,
661 doc: /* -*- texinfo -*-
662 @deftypefn {} {} nargin ()
663 @deftypefnx {} {} nargin (@var{fcn})
664 Report the number of input arguments to a function.
665
666 Called from within a function, return the number of arguments passed to the
667 function. At the top level, return the number of command line arguments
668 passed to Octave.
669
670 If called with the optional argument @var{fcn}---a function name or
671 handle---return the declared number of arguments that the function can
672 accept.
673
674 If the last argument to @var{fcn} is @var{varargin} the returned value is
675 negative. For example, the function @code{union} for sets is declared as
676
677 @example
678 @group
679 function [y, ia, ib] = union (a, b, varargin)
680
681 and
682
683 nargin ("union")
684 @result{} -3
685 @end group
686 @end example
687
688 Programming Note: @code{nargin} does not work on compiled functions
689 (@file{.oct} files) such as built-in or dynamically loaded functions.
690 @seealso{nargout, narginchk, varargin, inputname}
691 @end deftypefn */)
692 {
693 int nargin = args.length ();
694
695 if (nargin > 1)
696 print_usage ();
697
698 octave_value retval;
699
700 if (nargin == 1)
701 {
702 octave_value func = args(0);
703
704 if (func.is_string ())
705 {
706 octave::symbol_table& symtab = interp.get_symbol_table ();
707
708 std::string name = func.string_value ();
709 func = symtab.find_function (name);
710 if (func.is_undefined ())
711 error ("nargin: invalid function name: %s", name.c_str ());
712 }
713
714 octave_function *fcn_val = func.function_value (true);
715 if (! fcn_val)
716 error ("nargin: FCN must be a string or function handle");
717
718 octave_user_function *fcn = fcn_val->user_function_value (true);
719
720 if (! fcn)
721 {
722 // Matlab gives up for histc, so maybe it's ok that we
723 // give up sometimes too?
724
725 std::string type = fcn_val->type_name ();
726 error ("nargin: number of input arguments unavailable for %s objects",
727 type.c_str ());
728 }
729
730 octave::tree_parameter_list *param_list = fcn->parameter_list ();
731
732 retval = (param_list ? param_list->length () : 0);
733 if (fcn->takes_varargs ())
734 retval = -1 - retval;
735 }
736 else
737 {
738 octave::tree_evaluator& tw = interp.get_evaluator ();
739
740 retval = tw.get_auto_fcn_var (octave::stack_frame::NARGIN);
741
742 if (retval.is_undefined ())
743 retval = 0;
744 }
745
746 return retval;
747 }
748
749 DEFMETHOD (nargout, interp,args, ,
750 doc: /* -*- texinfo -*-
751 @deftypefn {} {} nargout ()
752 @deftypefnx {} {} nargout (@var{fcn})
753 Report the number of output arguments from a function.
754
755 Called from within a function, return the number of values the caller
756 expects to receive. At the top level, @code{nargout} with no argument is
757 undefined and will produce an error.
758
759 If called with the optional argument @var{fcn}---a function name or
760 handle---return the number of declared output values that the function can
761 produce.
762
763 If the final output argument is @var{varargout} the returned value is
764 negative.
765
766 For example,
767
768 @example
769 f ()
770 @end example
771
772 @noindent
773 will cause @code{nargout} to return 0 inside the function @code{f} and
774
775 @example
776 [s, t] = f ()
777 @end example
778
779 @noindent
780 will cause @code{nargout} to return 2 inside the function @code{f}.
781
782 In the second usage,
783
784 @example
785 nargout (@@histc) # or nargout ("histc") using a string input
786 @end example
787
788 @noindent
789 will return 2, because @code{histc} has two outputs, whereas
790
791 @example
792 nargout (@@imread)
793 @end example
794
795 @noindent
796 will return -2, because @code{imread} has two outputs and the second is
797 @var{varargout}.
798
799 Programming Note. @code{nargout} does not work for built-in functions and
800 returns -1 for all anonymous functions.
801 @seealso{nargin, varargout, isargout, nthargout}
802 @end deftypefn */)
803 {
804 int nargin = args.length ();
805
806 if (nargin > 1)
807 print_usage ();
808
809 octave_value retval;
810
811 if (nargin == 1)
812 {
813 octave_value func = args(0);
814
815 if (func.is_string ())
816 {
817 octave::symbol_table& symtab = interp.get_symbol_table ();
818
819 std::string name = func.string_value ();
820 func = symtab.find_function (name);
821 if (func.is_undefined ())
822 error ("nargout: invalid function name: %s", name.c_str ());
823 }
824
825 if (func.is_inline_function ())
826 return ovl (1);
827
828 if (func.is_function_handle ())
829 {
830 octave_fcn_handle *fh = func.fcn_handle_value ();
831
832 if (fh->is_anonymous ())
833 return ovl (-1);
834 }
835
836 octave_function *fcn_val = func.function_value (true);
837 if (! fcn_val)
838 error ("nargout: FCN must be a string or function handle");
839
840 octave_user_function *fcn = fcn_val->user_function_value (true);
841
842 if (! fcn)
843 {
844 // Matlab gives up for histc, so maybe it's ok that we
845 // give up sometimes too?
846
847 std::string type = fcn_val->type_name ();
848 error ("nargout: number of output arguments unavailable for %s objects",
849 type.c_str ());
850 }
851
852 octave::tree_parameter_list *ret_list = fcn->return_list ();
853
854 retval = (ret_list ? ret_list->length () : 0);
855
856 if (fcn->takes_var_return ())
857 retval = -1 - retval;
858 }
859 else
860 {
861 if (interp.at_top_level ())
862 error ("nargout: invalid call at top level");
863
864 octave::tree_evaluator& tw = interp.get_evaluator ();
865
866 retval = tw.get_auto_fcn_var (octave::stack_frame::NARGOUT);
867
868 if (retval.is_undefined ())
869 retval = 0;
870 }
871
872 return retval;
873 }
874
875 DEFUN (optimize_subsasgn_calls, args, nargout,
876 doc: /* -*- texinfo -*-
877 @deftypefn {} {@var{val} =} optimize_subsasgn_calls ()
878 @deftypefnx {} {@var{old_val} =} optimize_subsasgn_calls (@var{new_val})
879 @deftypefnx {} {} optimize_subsasgn_calls (@var{new_val}, "local")
880 Query or set the internal flag for @code{subsasgn} method call
881 optimizations.
882
883 If true, Octave will attempt to eliminate the redundant copying when calling
884 the @code{subsasgn} method of a user-defined class.
885
886 When called from inside a function with the @qcode{"local"} option, the
887 variable is changed locally for the function and any subroutines it calls.
888 The original variable value is restored when exiting the function.
889 @seealso{subsasgn}
890 @end deftypefn */)
891 {
892 return SET_INTERNAL_VARIABLE (optimize_subsasgn_calls);
893 }
894
val_in_table(const Matrix & table,double val)895 static bool val_in_table (const Matrix& table, double val)
896 {
897 if (table.isempty ())
898 return false;
899
900 octave_idx_type i = table.lookup (val, ASCENDING);
901 return (i > 0 && table(i-1) == val);
902 }
903
isargout1(int nargout,const Matrix & ignored,double k)904 static bool isargout1 (int nargout, const Matrix& ignored, double k)
905 {
906 if (k != octave::math::fix (k) || k <= 0)
907 error ("isargout: K must be a positive integer");
908
909 return (k == 1 || k <= nargout) && ! val_in_table (ignored, k);
910 }
911
912 DEFMETHOD (isargout, interp, args, ,
913 doc: /* -*- texinfo -*-
914 @deftypefn {} {} isargout (@var{k})
915 Within a function, return a logical value indicating whether the argument
916 @var{k} will be assigned to a variable on output.
917
918 If the result is false, the argument has been ignored during the function
919 call through the use of the tilde (~) special output argument. Functions
920 can use @code{isargout} to avoid performing unnecessary calculations for
921 outputs which are unwanted.
922
923 If @var{k} is outside the range @code{1:max (nargout)}, the function returns
924 false. @var{k} can also be an array, in which case the function works
925 element-by-element and a logical array is returned. At the top level,
926 @code{isargout} returns an error.
927 @seealso{nargout, varargout, nthargout}
928 @end deftypefn */)
929 {
930 if (args.length () != 1)
931 print_usage ();
932
933 if (interp.at_top_level ())
934 error ("isargout: invalid call at top level");
935
936 octave::tree_evaluator& tw = interp.get_evaluator ();
937
938 octave_value tmp;
939
940 int nargout1 = 0;
941 tmp = tw.get_auto_fcn_var (octave::stack_frame::NARGOUT);
942 if (tmp.is_defined ())
943 nargout1 = tmp.int_value ();
944
945 Matrix ignored;
946 tmp = tw.get_auto_fcn_var (octave::stack_frame::IGNORED);
947 if (tmp.is_defined ())
948 ignored = tmp.matrix_value ();
949
950 if (args(0).is_scalar_type ())
951 {
952 double k = args(0).double_value ();
953
954 return ovl (isargout1 (nargout1, ignored, k));
955 }
956 else if (args(0).isnumeric ())
957 {
958 const NDArray ka = args(0).array_value ();
959
960 boolNDArray r (ka.dims ());
961 for (octave_idx_type i = 0; i < ka.numel (); i++)
962 r(i) = isargout1 (nargout1, ignored, ka(i));
963
964 return ovl (r);
965 }
966 else
967 err_wrong_type_arg ("isargout", args(0));
968
969 return ovl ();
970 }
971
972 /*
973 %!function [x, y] = try_isargout ()
974 %! if (isargout (1))
975 %! if (isargout (2))
976 %! x = 1; y = 2;
977 %! else
978 %! x = -1;
979 %! endif
980 %! else
981 %! if (isargout (2))
982 %! y = -2;
983 %! else
984 %! error ("no outputs requested");
985 %! endif
986 %! endif
987 %!endfunction
988 %!
989 %!function [a, b] = try_isargout2 (x, y)
990 %! a = y;
991 %! b = {isargout(1), isargout(2), x};
992 %!endfunction
993 %!
994 %!test
995 %! [x, y] = try_isargout ();
996 %! assert ([x, y], [1, 2]);
997 %!
998 %!test
999 %! [x, ~] = try_isargout ();
1000 %! assert (x, -1);
1001 %!
1002 %!test
1003 %! [~, y] = try_isargout ();
1004 %! assert (y, -2);
1005 %!
1006 %!error [~, ~] = try_isargout ()
1007 %!
1008 ## Check to see that isargout isn't sticky:
1009 %!test
1010 %! [x, y] = try_isargout ();
1011 %! assert ([x, y], [1, 2]);
1012 %!
1013 ## It should work without ():
1014 %!test
1015 %! [~, y] = try_isargout;
1016 %! assert (y, -2);
1017 %!
1018 ## It should work in function handles, anonymous functions, and cell
1019 ## arrays of handles or anonymous functions.
1020 %!test
1021 %! fh = @try_isargout;
1022 %! af = @() try_isargout;
1023 %! c = {fh, af};
1024 %! [~, y] = fh ();
1025 %! assert (y, -2);
1026 %! [~, y] = af ();
1027 %! assert (y, -2);
1028 %! [~, y] = c{1}();
1029 %! assert (y, -2);
1030 %! [~, y] = c{2}();
1031 %! assert (y, -2);
1032 %!
1033 ## Nesting, anyone?
1034 %!test
1035 %! [~, b] = try_isargout2 (try_isargout, rand);
1036 %! assert (b, {0, 1, -1});
1037 %!test
1038 %! [~, b] = try_isargout2 ({try_isargout, try_isargout}, rand);
1039 %! assert (b, {0, 1, {-1, -1}});
1040 */
1041