# HG changeset patch # User John W. Eaton # Date 1600220624 14400 # Tue Sep 15 21:43:44 2020 -0400 # Branch stable # Node ID 5b5c5a1b2db6ea314567fd1325c946f8db3b587f # Parent b12ff2cea46a6cd604501b922604b1cc2f7f40e1 tmp inputname commit diff --git a/libinterp/corefcn/call-stack.cc b/libinterp/corefcn/call-stack.cc --- a/libinterp/corefcn/call-stack.cc +++ b/libinterp/corefcn/call-stack.cc @@ -1125,6 +1125,17 @@ namespace octave { return m_cs[m_curr_frame]->get_auto_fcn_var (avt); } + + octave_value call_stack::inputname (octave_idx_type n, bool id_only) const + { + size_t user_frame = m_curr_frame; + + std::shared_ptr frm = m_cs[user_frame]; + + frm = frm->static_link (); + + return frm->inputname (n, id_only); + } } DEFMETHOD (max_stack_depth, interp, args, nargout, @@ -1293,3 +1304,40 @@ complex, nesting, persistent. return tw.do_who (argc, argv, nargout == 1, true); } + +DEFMETHOD (inputname, interp, args, , + doc: /* -*- texinfo -*- +@deftypefn {} {} inputname (@var{n}) +@deftypefnx {} {} inputname (@var{n}, @var{id_only}) +Return the name of the @var{n}-th argument to the calling function. + +If the argument is not a simple variable name, return an empty string. As +an example, a reference to a field in a structure such as @code{s.field} is +not a simple name and will return @qcode{""}. + +@code{inputname} is only useful within a function. When used at the command +line it always returns an empty string. + +By default, return an empty string if the @var{n}-th argument is not +a valid variable name. If the optional argument @var{id_only} is +false, return the text of the argument even if it is not a valid +variable name. +@seealso{nargin, nthargout} +@end deftypefn */) +{ + if (args.length () < 1 || args.length () > 2) + print_usage (); + + octave_idx_type n + = args(0).xidx_type_value ("inputname: N must be an integer"); + + bool id_only = true; + if (args.length () > 1) + id_only = args(1).xbool_value ("inputname: ID_ONLY must be logical"); + + octave::tree_evaluator& tw = interp.get_evaluator (); + + // Interpreter uses 1-based indexing but internal indexing is 0-based. + + return tw.inputname (n-1, id_only); +} diff --git a/libinterp/corefcn/call-stack.h b/libinterp/corefcn/call-stack.h --- a/libinterp/corefcn/call-stack.h +++ b/libinterp/corefcn/call-stack.h @@ -304,6 +304,8 @@ namespace octave octave_value get_auto_fcn_var (stack_frame::auto_var_type avt) const; + octave_value inputname (octave_idx_type n, bool id_only = true) const; + private: tree_evaluator& m_evaluator; diff --git a/libinterp/corefcn/stack-frame.cc b/libinterp/corefcn/stack-frame.cc --- a/libinterp/corefcn/stack-frame.cc +++ b/libinterp/corefcn/stack-frame.cc @@ -27,6 +27,8 @@ # include "config.h" #endif +#include + #include "lo-regexp.h" #include "str-vec.h" @@ -242,6 +244,11 @@ namespace octave return m_access_link->get_auto_fcn_var (avt); } + octave_value inputname (octave_idx_type, bool) const + { + error ("inputname: invalid call to inputname in script"); + } + // We only need to override one of each of these functions. The // using declaration will avoid warnings about partially-overloaded // virtual functions. @@ -334,6 +341,28 @@ namespace octave m_auto_vars.at (avt) = val; } + octave_value inputname (octave_idx_type n, bool var_only = true) const + { + if (! m_static_link) + error ("inputname must be called from a function"); + + octave_value ov_arg_names = get_auto_fcn_var (ARG_NAMES); + + Cell cell_arg_names = ov_arg_names.cell_value (); + + if (n < 0 || n >= cell_arg_names.numel ()) + error ("invalid input (N = %" OCTAVE_IDX_TYPE_FORMAT ")", n+1); + + octave_value ov_nm = cell_arg_names.xelem (n); + + std::string nm = ov_nm.string_value (); + + if (var_only && ! m_static_link->is_variable (nm)) + return ""; + + return ov_nm; + } + // We only need to override one of each of these functions. The // using declaration will avoid warnings about partially-overloaded // virtual functions. diff --git a/libinterp/corefcn/stack-frame.h b/libinterp/corefcn/stack-frame.h --- a/libinterp/corefcn/stack-frame.h +++ b/libinterp/corefcn/stack-frame.h @@ -416,6 +416,12 @@ namespace octave virtual void set_auto_fcn_var (auto_var_type, const octave_value&) = 0; + virtual octave_value inputname (octave_idx_type /*n*/, + bool /*id_only*/ = true) const + { + return ""; + } + virtual octave_value varval (const symbol_record& sym) const = 0;; virtual octave_value varval (size_t data_offset) const; diff --git a/libinterp/parse-tree/pt-arg-list.cc b/libinterp/parse-tree/pt-arg-list.cc --- a/libinterp/parse-tree/pt-arg-list.cc +++ b/libinterp/parse-tree/pt-arg-list.cc @@ -122,7 +122,16 @@ namespace octave int k = 0; for (tree_expression *elt : *this) - retval(k++) = elt->str_print_code (); + { + if (elt->is_identifier ()) + { + tree_identifier *id = dynamic_cast (elt); + + retval(k++) = id->name (); + } + else + k++; + } return retval; } diff --git a/libinterp/parse-tree/pt-eval.cc b/libinterp/parse-tree/pt-eval.cc --- a/libinterp/parse-tree/pt-eval.cc +++ b/libinterp/parse-tree/pt-eval.cc @@ -1595,6 +1595,12 @@ namespace octave return m_call_stack.get_auto_fcn_var (avt); } + octave_value + tree_evaluator::inputname (octave_idx_type n, bool id_only) const + { + return m_call_stack.inputname (n, id_only); + } + void tree_evaluator::define_parameter_list_from_arg_vector (tree_parameter_list *param_list, const octave_value_list& args) diff --git a/libinterp/parse-tree/pt-eval.h b/libinterp/parse-tree/pt-eval.h --- a/libinterp/parse-tree/pt-eval.h +++ b/libinterp/parse-tree/pt-eval.h @@ -350,6 +350,8 @@ namespace octave octave_value get_auto_fcn_var (stack_frame::auto_var_type avt) const; + octave_value inputname (octave_idx_type n, bool id_only = true) const; + void define_parameter_list_from_arg_vector (tree_parameter_list *param_list, const octave_value_list& args); diff --git a/scripts/miscellaneous/inputname.m b/scripts/miscellaneous/inputname.m deleted file mode 100644 --- a/scripts/miscellaneous/inputname.m +++ /dev/null @@ -1,106 +0,0 @@ -######################################################################## -## -## Copyright (C) 2004-2020 The Octave Project Developers -## -## See the file COPYRIGHT.md in the top-level directory of this -## distribution or . -## -## 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 -## . -## -######################################################################## -## -## Original version by Paul Kienzle distributed as free software in the -## public domain. - -## -*- texinfo -*- -## @deftypefn {} {} inputname (@var{n}) -## @deftypefnx {} {} inputname (@var{n}, @var{ids_only}) -## Return the name of the @var{n}-th argument to the calling function. -## -## If the argument is not a simple variable name, return an empty string. As -## an example, a reference to a field in a structure such as @code{s.field} is -## not a simple name and will return @qcode{""}. -## -## @code{inputname} is only useful within a function. When used at the command -## line it always returns an empty string. -## -## By default, return an empty string if the @var{n}-th argument is not -## a valid variable name. If the optional argument @var{ids_only} is -## false, return the text of the argument even if it is not a valid -## variable name. -## @seealso{nargin, nthargout} -## @end deftypefn - -function name = inputname (n, ids_only = true) - - if (nargin < 1 || nargin > 2) - print_usage (); - endif - - name = ""; - try - name = evalin ("caller", sprintf ("__varval__ ('.argn.'){%d}", fix (n))); - catch - return; - end_try_catch - - ## For compatibility with Matlab, - ## return empty string if argument name is not a valid identifier. - if (ids_only && ! isvarname (name)) - name = ""; - endif - -endfunction - - -## Warning: heap big magic in the following tests!!! -## The test function builds a private context for each test, with only the -## specified values shared between them. It does this using the following -## template: -## -## function [] = testfn () -## -## endfunction -## -## To test inputname, I need a function context invoked with known parameter -## names. So define a couple of shared parameters, et voila!, the test is -## trivial. - -%!shared hello, worldly -%!assert (inputname (1), "hello") -%!assert (inputname (2), "worldly") -%!assert (inputname (3), "") - -## Clear parameter list so that testfn is created with zero inputs/outputs -%!shared -%!assert (inputname (-1), "") -%!assert (inputname (1), "") - -%!function r = __foo1__ (x, y) -%! r = inputname (2); -%!endfunction -%!assert (__foo1__ (pi, e), "e") -%!assert (feval (@__foo1__, pi, e), "e") - -%!function r = __foo2__ (x, y) -%! r = inputname (2, false); -%!endfunction -%!assert (__foo2__ (pi+1, 2+2), "2 + 2") -%!assert (feval (@__foo2__, pi, pi/2), "pi / 2") - -%!error inputname () -%!error inputname (1,2,3) diff --git a/scripts/miscellaneous/module.mk b/scripts/miscellaneous/module.mk --- a/scripts/miscellaneous/module.mk +++ b/scripts/miscellaneous/module.mk @@ -31,7 +31,6 @@ FCN_FILE_DIRS += \ %reldir%/gunzip.m \ %reldir%/info.m \ %reldir%/inputParser.m \ - %reldir%/inputname.m \ %reldir%/isdeployed.m \ %reldir%/isfile.m \ %reldir%/isfolder.m \