Bug Summary

File:libinterp/octave-value/ov-fcn-handle.cc
Location:line 885, column 11
Description:Value stored to 'retval' is never read

Annotated Source Code

1/*
2
3Copyright (C) 2003-2013 John W. Eaton
4Copyright (C) 2009 VZLU Prague, a.s.
5Copyright (C) 2010 Jaroslav Hajek
6
7This file is part of Octave.
8
9Octave is free software; you can redistribute it and/or modify it
10under the terms of the GNU General Public License as published by the
11Free Software Foundation; either version 3 of the License, or (at your
12option) any later version.
13
14Octave is distributed in the hope that it will be useful, but WITHOUT
15ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
16FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
17for more details.
18
19You should have received a copy of the GNU General Public License
20along with Octave; see the file COPYING. If not, see
21<http://www.gnu.org/licenses/>.
22
23*/
24
25#ifdef HAVE_CONFIG_H1
26#include <config.h>
27#endif
28
29#include <iostream>
30#include <sstream>
31#include <vector>
32
33#include "file-ops.h"
34#include "oct-locbuf.h"
35
36#include "defun.h"
37#include "error.h"
38#include "gripes.h"
39#include "input.h"
40#include "oct-map.h"
41#include "ov-base.h"
42#include "ov-fcn-handle.h"
43#include "ov-usr-fcn.h"
44#include "pr-output.h"
45#include "pt-pr-code.h"
46#include "pt-misc.h"
47#include "pt-stmt.h"
48#include "pt-cmd.h"
49#include "pt-exp.h"
50#include "pt-assign.h"
51#include "pt-arg-list.h"
52#include "variables.h"
53#include "parse.h"
54#include "unwind-prot.h"
55#include "defaults.h"
56#include "file-stat.h"
57#include "load-path.h"
58#include "oct-env.h"
59
60#include "byte-swap.h"
61#include "ls-ascii-helper.h"
62#include "ls-hdf5.h"
63#include "ls-oct-ascii.h"
64#include "ls-oct-binary.h"
65#include "ls-utils.h"
66
67DEFINE_OCTAVE_ALLOCATOR (octave_fcn_handle);
68
69DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_fcn_handle,int octave_fcn_handle::t_id (-1); const std::string octave_fcn_handle
::t_name ("function handle"); const std::string octave_fcn_handle
::c_name ("function_handle"); void octave_fcn_handle::register_type
(void) { static octave_fcn_handle exemplar; octave_value v (
&exemplar, true); t_id = octave_value_typeinfo::register_type
(octave_fcn_handle::t_name, octave_fcn_handle::c_name, v); }
70 "function handle",int octave_fcn_handle::t_id (-1); const std::string octave_fcn_handle
::t_name ("function handle"); const std::string octave_fcn_handle
::c_name ("function_handle"); void octave_fcn_handle::register_type
(void) { static octave_fcn_handle exemplar; octave_value v (
&exemplar, true); t_id = octave_value_typeinfo::register_type
(octave_fcn_handle::t_name, octave_fcn_handle::c_name, v); }
71 "function_handle")int octave_fcn_handle::t_id (-1); const std::string octave_fcn_handle
::t_name ("function handle"); const std::string octave_fcn_handle
::c_name ("function_handle"); void octave_fcn_handle::register_type
(void) { static octave_fcn_handle exemplar; octave_value v (
&exemplar, true); t_id = octave_value_typeinfo::register_type
(octave_fcn_handle::t_name, octave_fcn_handle::c_name, v); }
;
72
73const std::string octave_fcn_handle::anonymous ("@<anonymous>");
74
75octave_fcn_handle::octave_fcn_handle (const octave_value& f,
76 const std::string& n)
77 : fcn (f), nm (n), has_overloads (false)
78{
79 octave_user_function *uf = fcn.user_function_value (true);
80
81 if (uf && nm != anonymous)
82 symbol_table::cache_name (uf->scope (), nm);
83
84 if (uf && uf->is_nested_function ())
85 ::error ("handles to nested functions are not yet supported");
86}
87
88octave_value_list
89octave_fcn_handle::subsref (const std::string& type,
90 const std::list<octave_value_list>& idx,
91 int nargout)
92{
93 return octave_fcn_handle::subsref (type, idx, nargout, 0);
94}
95
96octave_value_list
97octave_fcn_handle::subsref (const std::string& type,
98 const std::list<octave_value_list>& idx,
99 int nargout,
100 const std::list<octave_lvalue>* lvalue_list)
101{
102 octave_value_list retval;
103
104 switch (type[0])
105 {
106 case '(':
107 {
108 int tmp_nargout = (type.length () > 1 && nargout == 0) ? 1 : nargout;
109
110 retval = do_multi_index_op (tmp_nargout, idx.front (),
111 idx.size () == 1 ? lvalue_list : 0);
112 }
113 break;
114
115 case '{':
116 case '.':
117 {
118 std::string tnm = type_name ();
119 error ("%s cannot be indexed with %c", tnm.c_str (), type[0]);
120 }
121 break;
122
123 default:
124 panic_impossible ()panic ("impossible state reached in file '%s' at line %d", "octave-value/ov-fcn-handle.cc"
, 124)
;
125 }
126
127 // FIXME: perhaps there should be an
128 // octave_value_list::next_subsref member function? See also
129 // octave_builtin::subsref.
130
131 if (idx.size () > 1)
132 retval = retval(0).next_subsref (nargout, type, idx);
133
134 return retval;
135}
136
137octave_value_list
138octave_fcn_handle::do_multi_index_op (int nargout,
139 const octave_value_list& args)
140{
141 return do_multi_index_op (nargout, args, 0);
142}
143
144octave_value_list
145octave_fcn_handle::do_multi_index_op (int nargout,
146 const octave_value_list& args,
147 const std::list<octave_lvalue>* lvalue_list)
148{
149 octave_value_list retval;
150
151 out_of_date_check (fcn, std::string (), false);
152
153 if (has_overloads)
154 {
155 // Possibly overloaded function.
156 octave_value ov_fcn;
157
158 // Compute dispatch type.
159 builtin_type_t btyp;
160 std::string dispatch_type = get_dispatch_type (args, btyp);
161
162 // Retrieve overload.
163 if (btyp != btyp_unknown)
164 {
165 out_of_date_check (builtin_overloads[btyp], dispatch_type, false);
166 ov_fcn = builtin_overloads[btyp];
167 }
168 else
169 {
170 str_ov_map::iterator it = overloads.find (dispatch_type);
171
172 if (it == overloads.end ())
173 {
174 // Try parent classes too.
175
176 std::list<std::string> plist
177 = symbol_table::parent_classes (dispatch_type);
178
179 std::list<std::string>::const_iterator pit = plist.begin ();
180
181 while (pit != plist.end ())
182 {
183 std::string pname = *pit;
184
185 std::string fnm = fcn_name ();
186
187 octave_value ftmp = symbol_table::find_method (fnm, pname);
188
189 if (ftmp.is_defined ())
190 {
191 set_overload (pname, ftmp);
192
193 out_of_date_check (ftmp, pname, false);
194 ov_fcn = ftmp;
195
196 break;
197 }
198
199 pit++;
200 }
201 }
202 else
203 {
204 out_of_date_check (it->second, dispatch_type, false);
205 ov_fcn = it->second;
206 }
207 }
208
209 if (ov_fcn.is_defined ())
210 retval = ov_fcn.do_multi_index_op (nargout, args, lvalue_list);
211 else if (fcn.is_defined ())
212 retval = fcn.do_multi_index_op (nargout, args, lvalue_list);
213 else
214 error ("%s: no method for class %s",
215 nm.c_str (), dispatch_type.c_str ());
216 }
217 else
218 {
219 // Non-overloaded function (anonymous, subfunction, private function).
220 if (fcn.is_defined ())
221 retval = fcn.do_multi_index_op (nargout, args, lvalue_list);
222 else
223 error ("%s: no longer valid function handle", nm.c_str ());
224 }
225
226 return retval;
227}
228
229bool
230octave_fcn_handle::is_equal_to (const octave_fcn_handle& h) const
231{
232 bool retval = fcn.is_copy_of (h.fcn) && (has_overloads == h.has_overloads);
233 retval = retval && (overloads.size () == h.overloads.size ());
234
235 if (retval && has_overloads)
236 {
237 for (int i = 0; i < btyp_num_types && retval; i++)
238 retval = builtin_overloads[i].is_copy_of (h.builtin_overloads[i]);
239
240 str_ov_map::const_iterator iter = overloads.begin ();
241 str_ov_map::const_iterator hiter = h.overloads.begin ();
242 for (; iter != overloads.end () && retval; iter++, hiter++)
243 retval = (iter->first == hiter->first)
244 && (iter->second.is_copy_of (hiter->second));
245 }
246
247 return retval;
248}
249
250bool
251octave_fcn_handle::set_fcn (const std::string &octaveroot,
252 const std::string& fpath)
253{
254 bool success = true;
255
256 if (octaveroot.length () != 0
257 && fpath.length () >= octaveroot.length ()
258 && fpath.substr (0, octaveroot.length ()) == octaveroot
259 && OCTAVE_EXEC_PREFIX"/usr/local" != octaveroot)
260 {
261 // First check if just replacing matlabroot is enough
262 std::string str = OCTAVE_EXEC_PREFIX"/usr/local" +
263 fpath.substr (octaveroot.length ());
264 file_stat fs (str);
265
266 if (fs.exists ())
267 {
268 size_t xpos = str.find_last_of (file_ops::dir_sep_chars ());
269
270 std::string dir_name = str.substr (0, xpos);
271
272 octave_function *xfcn
273 = load_fcn_from_file (str, dir_name, "", nm);
274
275 if (xfcn)
276 {
277 octave_value tmp (xfcn);
278
279 fcn = octave_value (new octave_fcn_handle (tmp, nm));
280 }
281 else
282 {
283 error ("function handle points to non-existent function");
284 success = false;
285 }
286 }
287 else
288 {
289 // Next just search for it anywhere in the system path
290 string_vector names(3);
291 names(0) = nm + ".oct";
292 names(1) = nm + ".mex";
293 names(2) = nm + ".m";
294
295 dir_path p (load_path::system_path ());
296
297 str = octave_env::make_absolute (p.find_first_of (names));
298
299 size_t xpos = str.find_last_of (file_ops::dir_sep_chars ());
300
301 std::string dir_name = str.substr (0, xpos);
302
303 octave_function *xfcn = load_fcn_from_file (str, dir_name, "", nm);
304
305 if (xfcn)
306 {
307 octave_value tmp (xfcn);
308
309 fcn = octave_value (new octave_fcn_handle (tmp, nm));
310 }
311 else
312 {
313 error ("function handle points to non-existent function");
314 success = false;
315 }
316 }
317 }
318 else
319 {
320 if (fpath.length () > 0)
321 {
322 size_t xpos = fpath.find_last_of (file_ops::dir_sep_chars ());
323
324 std::string dir_name = fpath.substr (0, xpos);
325
326 octave_function *xfcn = load_fcn_from_file (fpath, dir_name, "", nm);
327
328 if (xfcn)
329 {
330 octave_value tmp (xfcn);
331
332 fcn = octave_value (new octave_fcn_handle (tmp, nm));
333 }
334 else
335 {
336 error ("function handle points to non-existent function");
337 success = false;
338 }
339 }
340 else
341 {
342 fcn = symbol_table::find_function (nm);
343
344 if (! fcn.is_function ())
345 {
346 error ("function handle points to non-existent function");
347 success = false;
348 }
349 }
350 }
351
352 return success;
353}
354
355bool
356octave_fcn_handle::save_ascii (std::ostream& os)
357{
358 if (nm == anonymous)
359 {
360 os << nm << "\n";
361
362 print_raw (os, true);
363 os << "\n";
364
365 if (fcn.is_undefined ())
366 return false;
367
368 octave_user_function *f = fcn.user_function_value ();
369
370 std::list<symbol_table::symbol_record> vars
371 = symbol_table::all_variables (f->scope (), 0);
372
373 size_t varlen = vars.size ();
374
375 if (varlen > 0)
376 {
377 os << "# length: " << varlen << "\n";
378
379 for (std::list<symbol_table::symbol_record>::const_iterator
380 p = vars.begin (); p != vars.end (); p++)
381 {
382 if (! save_ascii_data (os, p->varval (0), p->name (), false, 0))
383 return os;
384 }
385 }
386 }
387 else
388 {
389 octave_function *f = function_value ();
390 std::string fnm = f ? f->fcn_file_name () : std::string ();
391
392 os << "# octaveroot: " << OCTAVE_EXEC_PREFIX"/usr/local" << "\n";
393 if (! fnm.empty ())
394 os << "# path: " << fnm << "\n";
395 os << nm << "\n";
396 }
397
398 return true;
399}
400
401bool
402octave_fcn_handle::load_ascii (std::istream& is)
403{
404 bool success = true;
405
406 std::streampos pos = is.tellg ();
407 std::string octaveroot = extract_keyword (is, "octaveroot", true);
408 if (octaveroot.length () == 0)
409 {
410 is.seekg (pos);
411 is.clear ();
412 }
413 pos = is.tellg ();
414 std::string fpath = extract_keyword (is, "path", true);
415 if (fpath.length () == 0)
416 {
417 is.seekg (pos);
418 is.clear ();
419 }
420
421 is >> nm;
422
423 if (nm == anonymous)
424 {
425 skip_preceeding_newline (is);
426
427 std::string buf;
428
429 if (is)
430 {
431
432 // Get a line of text whitespace characters included, leaving
433 // newline in the stream.
434 buf = read_until_newline (is, true);
435
436 }
437
438 pos = is.tellg ();
439
440 unwind_protect_safe frame;
441
442 // Set up temporary scope to use for evaluating the text that
443 // defines the anonymous function.
444
445 symbol_table::scope_id local_scope = symbol_table::alloc_scope ();
446 frame.add_fcn (symbol_table::erase_scope, local_scope);
447
448 symbol_table::set_scope (local_scope);
449
450 octave_call_stack::push (local_scope, 0);
451 frame.add_fcn (octave_call_stack::pop);
452
453 octave_idx_type len = 0;
454
455 if (extract_keyword (is, "length", len, true) && len >= 0)
456 {
457 if (len > 0)
458 {
459 for (octave_idx_type i = 0; i < len; i++)
460 {
461 octave_value t2;
462 bool dummy;
463
464 std::string name
465 = read_ascii_data (is, std::string (), dummy, t2, i);
466
467 if (!is)
468 {
469 error ("load: failed to load anonymous function handle");
470 break;
471 }
472
473 symbol_table::assign (name, t2, local_scope, 0);
474 }
475 }
476 }
477 else
478 {
479 is.seekg (pos);
480 is.clear ();
481 }
482
483 if (is && success)
484 {
485 int parse_status;
486 octave_value anon_fcn_handle =
487 eval_string (buf, true, parse_status);
488
489 if (parse_status == 0)
490 {
491 octave_fcn_handle *fh =
492 anon_fcn_handle.fcn_handle_value ();
493
494 if (fh)
495 {
496 fcn = fh->fcn;
497
498 octave_user_function *uf = fcn.user_function_value (true);
499
500 if (uf)
501 symbol_table::cache_name (uf->scope (), nm);
502 }
503 else
504 success = false;
505 }
506 else
507 success = false;
508 }
509 else
510 success = false;
511 }
512 else
513 success = set_fcn (octaveroot, fpath);
514
515 return success;
516}
517
518bool
519octave_fcn_handle::save_binary (std::ostream& os, bool& save_as_floats)
520{
521 if (nm == anonymous)
522 {
523 std::ostringstream nmbuf;
524
525 if (fcn.is_undefined ())
526 return false;
527
528 octave_user_function *f = fcn.user_function_value ();
529
530 std::list<symbol_table::symbol_record> vars
531 = symbol_table::all_variables (f->scope (), 0);
532
533 size_t varlen = vars.size ();
534
535 if (varlen > 0)
536 nmbuf << nm << " " << varlen;
537 else
538 nmbuf << nm;
539
540 std::string buf_str = nmbuf.str ();
541 int32_t tmp = buf_str.length ();
542 os.write (reinterpret_cast<char *> (&tmp), 4);
543 os.write (buf_str.c_str (), buf_str.length ());
544
545 std::ostringstream buf;
546 print_raw (buf, true);
547 std::string stmp = buf.str ();
548 tmp = stmp.length ();
549 os.write (reinterpret_cast<char *> (&tmp), 4);
550 os.write (stmp.c_str (), stmp.length ());
551
552 if (varlen > 0)
553 {
554 for (std::list<symbol_table::symbol_record>::const_iterator
555 p = vars.begin (); p != vars.end (); p++)
556 {
557 if (! save_binary_data (os, p->varval (0), p->name (),
558 "", 0, save_as_floats))
559 return os;
560 }
561 }
562 }
563 else
564 {
565 std::ostringstream nmbuf;
566
567 octave_function *f = function_value ();
568 std::string fnm = f ? f->fcn_file_name () : std::string ();
569
570 nmbuf << nm << "\n" << OCTAVE_EXEC_PREFIX"/usr/local" << "\n" << fnm;
571
572 std::string buf_str = nmbuf.str ();
573 int32_t tmp = buf_str.length ();
574 os.write (reinterpret_cast<char *> (&tmp), 4);
575 os.write (buf_str.c_str (), buf_str.length ());
576 }
577
578 return true;
579}
580
581bool
582octave_fcn_handle::load_binary (std::istream& is, bool swap,
583 oct_mach_info::float_format fmt)
584{
585 bool success = true;
586
587 int32_t tmp;
588 if (! is.read (reinterpret_cast<char *> (&tmp), 4))
589 return false;
590 if (swap)
591 swap_bytes<4> (&tmp);
592
593 OCTAVE_LOCAL_BUFFER (char, ctmp1, tmp+1)octave_local_buffer<char> _buffer_ctmp1 (tmp+1); char *
ctmp1 = _buffer_ctmp1
;
594 // is.get (ctmp1, tmp+1, 0); caused is.eof () to be true though
595 // effectively not reading over file end
596 is.read (ctmp1, tmp);
597 ctmp1[tmp] = 0;
598 nm = std::string (ctmp1);
599
600 if (! is)
601 return false;
602
603 size_t anl = anonymous.length ();
604
605 if (nm.length () >= anl && nm.substr (0, anl) == anonymous)
606 {
607 octave_idx_type len = 0;
608
609 if (nm.length () > anl)
610 {
611 std::istringstream nm_is (nm.substr (anl));
612 nm_is >> len;
613 nm = nm.substr (0, anl);
614 }
615
616 if (! is.read (reinterpret_cast<char *> (&tmp), 4))
617 return false;
618 if (swap)
619 swap_bytes<4> (&tmp);
620
621 OCTAVE_LOCAL_BUFFER (char, ctmp2, tmp+1)octave_local_buffer<char> _buffer_ctmp2 (tmp+1); char *
ctmp2 = _buffer_ctmp2
;
622 // is.get (ctmp2, tmp+1, 0); caused is.eof () to be true though
623 // effectively not reading over file end
624 is.read (ctmp2, tmp);
625 ctmp2[tmp] = 0;
626
627 unwind_protect_safe frame;
628
629 // Set up temporary scope to use for evaluating the text that
630 // defines the anonymous function.
631
632 symbol_table::scope_id local_scope = symbol_table::alloc_scope ();
633 frame.add_fcn (symbol_table::erase_scope, local_scope);
634
635 symbol_table::set_scope (local_scope);
636
637 octave_call_stack::push (local_scope, 0);
638 frame.add_fcn (octave_call_stack::pop);
639
640 if (len > 0)
641 {
642 for (octave_idx_type i = 0; i < len; i++)
643 {
644 octave_value t2;
645 bool dummy;
646 std::string doc;
647
648 std::string name =
649 read_binary_data (is, swap, fmt, std::string (),
650 dummy, t2, doc);
651
652 if (!is)
653 {
654 error ("load: failed to load anonymous function handle");
655 break;
656 }
657
658 symbol_table::assign (name, t2, local_scope);
659 }
660 }
661
662 if (is && success)
663 {
664 int parse_status;
665 octave_value anon_fcn_handle =
666 eval_string (ctmp2, true, parse_status);
667
668 if (parse_status == 0)
669 {
670 octave_fcn_handle *fh = anon_fcn_handle.fcn_handle_value ();
671
672 if (fh)
673 {
674 fcn = fh->fcn;
675
676 octave_user_function *uf = fcn.user_function_value (true);
677
678 if (uf)
679 symbol_table::cache_name (uf->scope (), nm);
680 }
681 else
682 success = false;
683 }
684 else
685 success = false;
686 }
687 }
688 else
689 {
690 std::string octaveroot;
691 std::string fpath;
692
693 if (nm.find_first_of ("\n") != std::string::npos)
694 {
695 size_t pos1 = nm.find_first_of ("\n");
696 size_t pos2 = nm.find_first_of ("\n", pos1 + 1);
697 octaveroot = nm.substr (pos1 + 1, pos2 - pos1 - 1);
698 fpath = nm.substr (pos2 + 1);
699 nm = nm.substr (0, pos1);
700 }
701
702 success = set_fcn (octaveroot, fpath);
703 }
704
705 return success;
706}
707
708#if defined (HAVE_HDF51)
709bool
710octave_fcn_handle::save_hdf5 (hid_t loc_id, const char *name,
711 bool save_as_floats)
712{
713 bool retval = true;
714
715 hid_t group_hid = -1;
716#if HAVE_HDF5_181
717 group_hid = H5GcreateH5Gcreate2 (loc_id, name, H5P_DEFAULT0, H5P_DEFAULT0, H5P_DEFAULT0);
718#else
719 group_hid = H5GcreateH5Gcreate2 (loc_id, name, 0);
720#endif
721 if (group_hid < 0)
722 return false;
723
724 hid_t space_hid = -1, data_hid = -1, type_hid = -1;;
725
726 // attach the type of the variable
727 type_hid = H5Tcopy (H5T_C_S1(H5open(), H5T_C_S1_g));
728 H5Tset_size (type_hid, nm.length () + 1);
729 if (type_hid < 0)
730 {
731 H5Gclose (group_hid);
732 return false;
733 }
734
735 OCTAVE_LOCAL_BUFFER (hsize_t, hdims, 2)octave_local_buffer<hsize_t> _buffer_hdims (2); hsize_t
*hdims = _buffer_hdims
;
736 hdims[0] = 0;
737 hdims[1] = 0;
738 space_hid = H5Screate_simple (0 , hdims, 0);
739 if (space_hid < 0)
740 {
741 H5Tclose (type_hid);
742 H5Gclose (group_hid);
743 return false;
744 }
745#if HAVE_HDF5_181
746 data_hid = H5DcreateH5Dcreate2 (group_hid, "nm", type_hid, space_hid,
747 H5P_DEFAULT0, H5P_DEFAULT0, H5P_DEFAULT0);
748#else
749 data_hid = H5DcreateH5Dcreate2 (group_hid, "nm", type_hid, space_hid, H5P_DEFAULT0);
750#endif
751 if (data_hid < 0 || H5Dwrite (data_hid, type_hid, H5S_ALL0, H5S_ALL0,
752 H5P_DEFAULT0, nm.c_str ()) < 0)
753 {
754 H5Sclose (space_hid);
755 H5Tclose (type_hid);
756 H5Gclose (group_hid);
757 return false;
758 }
759 H5Dclose (data_hid);
760
761 if (nm == anonymous)
762 {
763 std::ostringstream buf;
764 print_raw (buf, true);
765 std::string stmp = buf.str ();
766
767 // attach the type of the variable
768 H5Tset_size (type_hid, stmp.length () + 1);
769 if (type_hid < 0)
770 {
771 H5Sclose (space_hid);
772 H5Gclose (group_hid);
773 return false;
774 }
775
776#if HAVE_HDF5_181
777 data_hid = H5DcreateH5Dcreate2 (group_hid, "fcn", type_hid, space_hid,
778 H5P_DEFAULT0, H5P_DEFAULT0, H5P_DEFAULT0);
779#else
780 data_hid = H5DcreateH5Dcreate2 (group_hid, "fcn", type_hid, space_hid,
781 H5P_DEFAULT0);
782#endif
783 if (data_hid < 0 || H5Dwrite (data_hid, type_hid, H5S_ALL0, H5S_ALL0,
784 H5P_DEFAULT0, stmp.c_str ()) < 0)
785 {
786 H5Sclose (space_hid);
787 H5Tclose (type_hid);
788 H5Gclose (group_hid);
789 return false;
790 }
791
792 H5Dclose (data_hid);
793
794 octave_user_function *f = fcn.user_function_value ();
795
796 std::list<symbol_table::symbol_record> vars
797 = symbol_table::all_variables (f->scope (), 0);
798
799 size_t varlen = vars.size ();
800
801 if (varlen > 0)
802 {
803 hid_t as_id = H5Screate (H5S_SCALAR);
804
805 if (as_id >= 0)
806 {
807#if HAVE_HDF5_181
808 hid_t a_id = H5AcreateH5Acreate2 (group_hid, "SYMBOL_TABLE",
809 H5T_NATIVE_IDX(H5open(), H5T_NATIVE_INT_g), as_id,
810 H5P_DEFAULT0, H5P_DEFAULT0);
811
812#else
813 hid_t a_id = H5AcreateH5Acreate2 (group_hid, "SYMBOL_TABLE",
814 H5T_NATIVE_IDX(H5open(), H5T_NATIVE_INT_g), as_id, H5P_DEFAULT0);
815#endif
816
817 if (a_id >= 0)
818 {
819 retval = (H5Awrite (a_id, H5T_NATIVE_IDX(H5open(), H5T_NATIVE_INT_g), &varlen) >= 0);
820
821 H5Aclose (a_id);
822 }
823 else
824 retval = false;
825
826 H5Sclose (as_id);
827 }
828 else
829 retval = false;
830#if HAVE_HDF5_181
831 data_hid = H5GcreateH5Gcreate2 (group_hid, "symbol table",
832 H5P_DEFAULT0, H5P_DEFAULT0, H5P_DEFAULT0);
833#else
834 data_hid = H5GcreateH5Gcreate2 (group_hid, "symbol table", 0);
835#endif
836 if (data_hid < 0)
837 {
838 H5Sclose (space_hid);
839 H5Tclose (type_hid);
840 H5Gclose (group_hid);
841 return false;
842 }
843
844 for (std::list<symbol_table::symbol_record>::const_iterator
845 p = vars.begin (); p != vars.end (); p++)
846 {
847 if (! add_hdf5_data (data_hid, p->varval (0), p->name (),
848 "", false, save_as_floats))
849 break;
850 }
851 H5Gclose (data_hid);
852 }
853 }
854 else
855 {
856 std::string octaveroot = OCTAVE_EXEC_PREFIX"/usr/local";
857
858 octave_function *f = function_value ();
859 std::string fpath = f ? f->fcn_file_name () : std::string ();
860
861 H5Sclose (space_hid);
862 hdims[0] = 1;
863 hdims[1] = octaveroot.length ();
864 space_hid = H5Screate_simple (0 , hdims, 0);
865 if (space_hid < 0)
866 {
867 H5Tclose (type_hid);
868 H5Gclose (group_hid);
869 return false;
870 }
871
872 H5Tclose (type_hid);
873 type_hid = H5Tcopy (H5T_C_S1(H5open(), H5T_C_S1_g));
874 H5Tset_size (type_hid, octaveroot.length () + 1);
875#if HAVE_HDF5_181
876 hid_t a_id = H5AcreateH5Acreate2 (group_hid, "OCTAVEROOT",
877 type_hid, space_hid, H5P_DEFAULT0, H5P_DEFAULT0);
878#else
879 hid_t a_id = H5AcreateH5Acreate2 (group_hid, "OCTAVEROOT",
880 type_hid, space_hid, H5P_DEFAULT0);
881#endif
882
883 if (a_id >= 0)
884 {
885 retval = (H5Awrite (a_id, type_hid, octaveroot.c_str ()) >= 0);
Value stored to 'retval' is never read
886
887 H5Aclose (a_id);
888 }
889 else
890 {
891 H5Sclose (space_hid);
892 H5Tclose (type_hid);
893 H5Gclose (group_hid);
894 return false;
895 }
896
897 H5Sclose (space_hid);
898 hdims[0] = 1;
899 hdims[1] = fpath.length ();
900 space_hid = H5Screate_simple (0 , hdims, 0);
901 if (space_hid < 0)
902 {
903 H5Tclose (type_hid);
904 H5Gclose (group_hid);
905 return false;
906 }
907
908 H5Tclose (type_hid);
909 type_hid = H5Tcopy (H5T_C_S1(H5open(), H5T_C_S1_g));
910 H5Tset_size (type_hid, fpath.length () + 1);
911
912#if HAVE_HDF5_181
913 a_id = H5AcreateH5Acreate2 (group_hid, "FILE", type_hid, space_hid,
914 H5P_DEFAULT0, H5P_DEFAULT0);
915#else
916 a_id = H5AcreateH5Acreate2 (group_hid, "FILE", type_hid, space_hid, H5P_DEFAULT0);
917#endif
918
919 if (a_id >= 0)
920 {
921 retval = (H5Awrite (a_id, type_hid, fpath.c_str ()) >= 0);
922
923 H5Aclose (a_id);
924 }
925 else
926 retval = false;
927 }
928
929 H5Sclose (space_hid);
930 H5Tclose (type_hid);
931 H5Gclose (group_hid);
932
933 return retval;
934}
935
936bool
937octave_fcn_handle::load_hdf5 (hid_t loc_id, const char *name)
938{
939 bool success = true;
940
941 hid_t group_hid, data_hid, space_hid, type_hid, type_class_hid, st_id;
942 hsize_t rank;
943 int slen;
944
945#if HAVE_HDF5_181
946 group_hid = H5GopenH5Gopen2 (loc_id, name, H5P_DEFAULT0);
947#else
948 group_hid = H5GopenH5Gopen2 (loc_id, name);
949#endif
950 if (group_hid < 0)
951 return false;
952
953#if HAVE_HDF5_181
954 data_hid = H5DopenH5Dopen2 (group_hid, "nm", H5P_DEFAULT0);
955#else
956 data_hid = H5DopenH5Dopen2 (group_hid, "nm");
957#endif
958
959 if (data_hid < 0)
960 {
961 H5Gclose (group_hid);
962 return false;
963 }
964
965 type_hid = H5Dget_type (data_hid);
966 type_class_hid = H5Tget_class (type_hid);
967
968 if (type_class_hid != H5T_STRING)
969 {
970 H5Tclose (type_hid);
971 H5Dclose (data_hid);
972 H5Gclose (group_hid);
973 return false;
974 }
975
976 space_hid = H5Dget_space (data_hid);
977 rank = H5Sget_simple_extent_ndims (space_hid);
978
979 if (rank != 0)
980 {
981 H5Sclose (space_hid);
982 H5Tclose (type_hid);
983 H5Dclose (data_hid);
984 H5Gclose (group_hid);
985 return false;
986 }
987
988 slen = H5Tget_size (type_hid);
989 if (slen < 0)
990 {
991 H5Sclose (space_hid);
992 H5Tclose (type_hid);
993 H5Dclose (data_hid);
994 H5Gclose (group_hid);
995 return false;
996 }
997
998 OCTAVE_LOCAL_BUFFER (char, nm_tmp, slen)octave_local_buffer<char> _buffer_nm_tmp (slen); char *
nm_tmp = _buffer_nm_tmp
;
999
1000 // create datatype for (null-terminated) string to read into:
1001 st_id = H5Tcopy (H5T_C_S1(H5open(), H5T_C_S1_g));
1002 H5Tset_size (st_id, slen);
1003
1004 if (H5Dread (data_hid, st_id, H5S_ALL0, H5S_ALL0, H5P_DEFAULT0, nm_tmp) < 0)
1005 {
1006 H5Tclose (st_id);
1007 H5Sclose (space_hid);
1008 H5Tclose (type_hid);
1009 H5Dclose (data_hid);
1010 H5Gclose (group_hid);
1011 return false;
1012 }
1013 H5Tclose (st_id);
1014 H5Dclose (data_hid);
1015 nm = nm_tmp;
1016
1017 if (nm == anonymous)
1018 {
1019#if HAVE_HDF5_181
1020 data_hid = H5DopenH5Dopen2 (group_hid, "fcn", H5P_DEFAULT0);
1021#else
1022 data_hid = H5DopenH5Dopen2 (group_hid, "fcn");
1023#endif
1024
1025 if (data_hid < 0)
1026 {
1027 H5Sclose (space_hid);
1028 H5Tclose (type_hid);
1029 H5Gclose (group_hid);
1030 return false;
1031 }
1032
1033 H5Tclose (type_hid);
1034 type_hid = H5Dget_type (data_hid);
1035 type_class_hid = H5Tget_class (type_hid);
1036
1037 if (type_class_hid != H5T_STRING)
1038 {
1039 H5Sclose (space_hid);
1040 H5Tclose (type_hid);
1041 H5Dclose (data_hid);
1042 H5Gclose (group_hid);
1043 return false;
1044 }
1045
1046 H5Sclose (space_hid);
1047 space_hid = H5Dget_space (data_hid);
1048 rank = H5Sget_simple_extent_ndims (space_hid);
1049
1050 if (rank != 0)
1051 {
1052 H5Sclose (space_hid);
1053 H5Tclose (type_hid);
1054 H5Dclose (data_hid);
1055 H5Gclose (group_hid);
1056 return false;
1057 }
1058
1059 slen = H5Tget_size (type_hid);
1060 if (slen < 0)
1061 {
1062 H5Sclose (space_hid);
1063 H5Tclose (type_hid);
1064 H5Dclose (data_hid);
1065 H5Gclose (group_hid);
1066 return false;
1067 }
1068
1069 OCTAVE_LOCAL_BUFFER (char, fcn_tmp, slen)octave_local_buffer<char> _buffer_fcn_tmp (slen); char *
fcn_tmp = _buffer_fcn_tmp
;
1070
1071 // create datatype for (null-terminated) string to read into:
1072 st_id = H5Tcopy (H5T_C_S1(H5open(), H5T_C_S1_g));
1073 H5Tset_size (st_id, slen);
1074
1075 if (H5Dread (data_hid, st_id, H5S_ALL0, H5S_ALL0, H5P_DEFAULT0, fcn_tmp) < 0)
1076 {
1077 H5Tclose (st_id);
1078 H5Sclose (space_hid);
1079 H5Tclose (type_hid);
1080 H5Dclose (data_hid);
1081 H5Gclose (group_hid);
1082 return false;
1083 }
1084 H5Tclose (st_id);
1085 H5Dclose (data_hid);
1086
1087 octave_idx_type len = 0;
1088
1089 // we have to pull some shenanigans here to make sure
1090 // HDF5 doesn't print out all sorts of error messages if we
1091 // call H5Aopen for a non-existing attribute
1092
1093 H5E_auto_tH5E_auto2_t err_func;
1094 void *err_func_data;
1095
1096 // turn off error reporting temporarily, but save the error
1097 // reporting function:
1098#if HAVE_HDF5_181
1099 H5Eget_autoH5Eget_auto2 (H5E_DEFAULT0, &err_func, &err_func_data);
1100 H5Eset_autoH5Eset_auto2 (H5E_DEFAULT0, 0, 0);
1101#else
1102 H5Eget_autoH5Eget_auto2 (&err_func, &err_func_data);
1103 H5Eset_autoH5Eset_auto2 (0, 0);
1104#endif
1105
1106 hid_t attr_id = H5Aopen_name (group_hid, "SYMBOL_TABLE");
1107
1108 if (attr_id >= 0)
1109 {
1110 if (H5Aread (attr_id, H5T_NATIVE_IDX(H5open(), H5T_NATIVE_INT_g), &len) < 0)
1111 success = false;
1112
1113 H5Aclose (attr_id);
1114 }
1115
1116 // restore error reporting:
1117#if HAVE_HDF5_181
1118 H5Eset_autoH5Eset_auto2 (H5E_DEFAULT0, err_func, err_func_data);
1119#else
1120 H5Eset_autoH5Eset_auto2 (err_func, err_func_data);
1121#endif
1122
1123 unwind_protect_safe frame;
1124
1125 // Set up temporary scope to use for evaluating the text that
1126 // defines the anonymous function.
1127
1128 symbol_table::scope_id local_scope = symbol_table::alloc_scope ();
1129 frame.add_fcn (symbol_table::erase_scope, local_scope);
1130
1131 symbol_table::set_scope (local_scope);
1132
1133 octave_call_stack::push (local_scope, 0);
1134 frame.add_fcn (octave_call_stack::pop);
1135
1136 if (len > 0 && success)
1137 {
1138 hsize_t num_obj = 0;
1139#if HAVE_HDF5_181
1140 data_hid = H5GopenH5Gopen2 (group_hid, "symbol table", H5P_DEFAULT0);
1141#else
1142 data_hid = H5GopenH5Gopen2 (group_hid, "symbol table");
1143#endif
1144 H5Gget_num_objs (data_hid, &num_obj);
1145 H5Gclose (data_hid);
1146
1147 if (num_obj != static_cast<hsize_t>(len))
1148 {
1149 error ("load: failed to load anonymous function handle");
1150 success = false;
1151 }
1152
1153 if (! error_state)
1154 {
1155 hdf5_callback_data dsub;
1156 int current_item = 0;
1157 for (octave_idx_type i = 0; i < len; i++)
1158 {
1159 if (H5Giterate (group_hid, "symbol table", &current_item,
1160 hdf5_read_next_data, &dsub) <= 0)
1161 {
1162 error ("load: failed to load anonymous function handle");
1163 success = false;
1164 break;
1165 }
1166
1167 symbol_table::assign (dsub.name, dsub.tc, local_scope);
1168 }
1169 }
1170 }
1171
1172 if (success)
1173 {
1174 int parse_status;
1175 octave_value anon_fcn_handle =
1176 eval_string (fcn_tmp, true, parse_status);
1177
1178 if (parse_status == 0)
1179 {
1180 octave_fcn_handle *fh = anon_fcn_handle.fcn_handle_value ();
1181
1182 if (fh)
1183 {
1184 fcn = fh->fcn;
1185
1186 octave_user_function *uf = fcn.user_function_value (true);
1187
1188 if (uf)
1189 symbol_table::cache_name (uf->scope (), nm);
1190 }
1191 else
1192 success = false;
1193 }
1194 else
1195 success = false;
1196 }
1197
1198 frame.run ();
1199 }
1200 else
1201 {
1202 std::string octaveroot;
1203 std::string fpath;
1204
1205 // we have to pull some shenanigans here to make sure
1206 // HDF5 doesn't print out all sorts of error messages if we
1207 // call H5Aopen for a non-existing attribute
1208
1209 H5E_auto_tH5E_auto2_t err_func;
1210 void *err_func_data;
1211
1212 // turn off error reporting temporarily, but save the error
1213 // reporting function:
1214#if HAVE_HDF5_181
1215 H5Eget_autoH5Eget_auto2 (H5E_DEFAULT0, &err_func, &err_func_data);
1216 H5Eset_autoH5Eset_auto2 (H5E_DEFAULT0, 0, 0);
1217#else
1218 H5Eget_autoH5Eget_auto2 (&err_func, &err_func_data);
1219 H5Eset_autoH5Eset_auto2 (0, 0);
1220#endif
1221
1222 hid_t attr_id = H5Aopen_name (group_hid, "OCTAVEROOT");
1223 if (attr_id >= 0)
1224 {
1225 H5Tclose (type_hid);
1226 type_hid = H5Aget_type (attr_id);
1227 type_class_hid = H5Tget_class (type_hid);
1228
1229 if (type_class_hid != H5T_STRING)
1230 success = false;
1231 else
1232 {
1233 slen = H5Tget_size (type_hid);
1234 st_id = H5Tcopy (H5T_C_S1(H5open(), H5T_C_S1_g));
1235 H5Tset_size (st_id, slen);
1236 OCTAVE_LOCAL_BUFFER (char, root_tmp, slen)octave_local_buffer<char> _buffer_root_tmp (slen); char
*root_tmp = _buffer_root_tmp
;
1237
1238 if (H5Aread (attr_id, st_id, root_tmp) < 0)
1239 success = false;
1240 else
1241 octaveroot = root_tmp;
1242
1243 H5Tclose (st_id);
1244 }
1245
1246 H5Aclose (attr_id);
1247 }
1248
1249 if (success)
1250 {
1251 attr_id = H5Aopen_name (group_hid, "FILE");
1252 if (attr_id >= 0)
1253 {
1254 H5Tclose (type_hid);
1255 type_hid = H5Aget_type (attr_id);
1256 type_class_hid = H5Tget_class (type_hid);
1257
1258 if (type_class_hid != H5T_STRING)
1259 success = false;
1260 else
1261 {
1262 slen = H5Tget_size (type_hid);
1263 st_id = H5Tcopy (H5T_C_S1(H5open(), H5T_C_S1_g));
1264 H5Tset_size (st_id, slen);
1265 OCTAVE_LOCAL_BUFFER (char, path_tmp, slen)octave_local_buffer<char> _buffer_path_tmp (slen); char
*path_tmp = _buffer_path_tmp
;
1266
1267 if (H5Aread (attr_id, st_id, path_tmp) < 0)
1268 success = false;
1269 else
1270 fpath = path_tmp;
1271
1272 H5Tclose (st_id);
1273 }
1274
1275 H5Aclose (attr_id);
1276 }
1277 }
1278
1279 // restore error reporting:
1280#if HAVE_HDF5_181
1281 H5Eset_autoH5Eset_auto2 (H5E_DEFAULT0, err_func, err_func_data);
1282#else
1283 H5Eset_autoH5Eset_auto2 (err_func, err_func_data);
1284#endif
1285
1286 success = (success ? set_fcn (octaveroot, fpath) : success);
1287 }
1288
1289 H5Tclose (type_hid);
1290 H5Sclose (space_hid);
1291 H5Gclose (group_hid);
1292
1293 return success;
1294}
1295
1296#endif
1297
1298/*
1299%!test
1300%! a = 2;
1301%! f = @(x) a + x;
1302%! g = @(x) 2 * x;
1303%! hm = @version;
1304%! hdld = @svd;
1305%! hbi = @log2;
1306%! f2 = f;
1307%! g2 = g;
1308%! hm2 = hm;
1309%! hdld2 = hdld;
1310%! hbi2 = hbi;
1311%! modes = {"-text", "-binary"};
1312%! if (isfield (octave_config_info, "HAVE_HDF5")
1313%! && octave_config_info ("HAVE_HDF5"))
1314%! modes(end+1) = "-hdf5";
1315%! endif
1316%! for i = 1:numel (modes)
1317%! mode = modes{i};
1318%! nm = tmpnam ();
1319%! unwind_protect
1320%! f2 (1); # bug #33857
1321%! save (mode, nm, "f2", "g2", "hm2", "hdld2", "hbi2");
1322%! clear f2 g2 hm2 hdld2 hbi2
1323%! load (nm);
1324%! assert (f (2), f2 (2));
1325%! assert (g (2), g2 (2));
1326%! assert (g (3), g2 (3));
1327%! unlink (nm);
1328%! save (mode, nm, "f2", "g2", "hm2", "hdld2", "hbi2");
1329%! unwind_protect_cleanup
1330%! unlink (nm);
1331%! end_unwind_protect
1332%! endfor
1333*/
1334
1335/*
1336%!function fcn_handle_save_recurse (n, mode, nm, f2, g2, hm2, hdld2, hbi2)
1337%! if (n == 0)
1338%! save (mode, nm, "f2", "g2", "hm2", "hdld2", "hbi2");
1339%! else
1340%! fcn_handle_save_recurse (n - 1, mode, nm, f2, g2, hm2, hdld2, hbi2);
1341%! endif
1342%!endfunction
1343%!function [f2, g2, hm2, hdld2, hbi2] = fcn_handle_load_recurse (n, nm)
1344%! if (n == 0)
1345%! load (nm)
1346%! else
1347%! [f2, g2, hm2, hdld2, hbi2] = fcn_handle_load_recurse (n - 1, nm);
1348%! endif
1349%!endfunction
1350
1351Test for bug #35876
1352%!test
1353%! a = 2;
1354%! f = @(x) a + x;
1355%! g = @(x) 2 * x;
1356%! hm = @version;
1357%! hdld = @svd;
1358%! hbi = @log2;
1359%! f2 = f;
1360%! g2 = g;
1361%! hm2 = hm;
1362%! hdld2 = hdld;
1363%! hbi2 = hbi;
1364%! modes = {"-text", "-binary"};
1365%! if (isfield (octave_config_info, "HAVE_HDF5")
1366%! && octave_config_info ("HAVE_HDF5"))
1367%! modes(end+1) = "-hdf5";
1368%! endif
1369%! for i = 1:numel (modes)
1370%! mode = modes{i};
1371%! nm = tmpnam ();
1372%! unwind_protect
1373%! fcn_handle_save_recurse (2, mode, nm, f2, g2, hm2, hdld2, hbi2);
1374%! clear f2 g2 hm2 hdld2 hbi2
1375%! [f2, f2, hm2, hdld2, hbi2] = fcn_handle_load_recurse (2, nm);
1376%! load (nm);
1377%! assert (f (2), f2 (2));
1378%! assert (g (2), g2 (2));
1379%! assert (g (3), g2 (3));
1380%! unlink (nm);
1381%! fcn_handle_save_recurse (2, mode, nm, f2, g2, hm2, hdld2, hbi2);
1382%! unwind_protect_cleanup
1383%! unlink (nm);
1384%! end_unwind_protect
1385%! endfor
1386*/
1387
1388void
1389octave_fcn_handle::print (std::ostream& os, bool pr_as_read_syntax) const
1390{
1391 print_raw (os, pr_as_read_syntax);
1392 newline (os);
1393}
1394
1395void
1396octave_fcn_handle::print_raw (std::ostream& os, bool pr_as_read_syntax) const
1397{
1398 bool printed = false;
1399
1400 if (nm == anonymous)
1401 {
1402 tree_print_code tpc (os);
1403
1404 // FCN is const because this member function is, so we can't
1405 // use it to call user_function_value, so we make a copy first.
1406
1407 octave_value ftmp = fcn;
1408
1409 octave_user_function *f = ftmp.user_function_value ();
1410
1411 if (f)
1412 {
1413 tree_parameter_list *p = f->parameter_list ();
1414
1415 os << "@(";
1416
1417 if (p)
1418 p->accept (tpc);
1419
1420 os << ") ";
1421
1422 tpc.print_fcn_handle_body (f->body ());
1423
1424 printed = true;
1425 }
1426 }
1427
1428 if (! printed)
1429 octave_print_internal (os, "@" + nm, pr_as_read_syntax,
1430 current_print_indent_level ());
1431}
1432
1433octave_value
1434make_fcn_handle (const std::string& nm, bool local_funcs)
1435{
1436 octave_value retval;
1437
1438 // Bow to the god of compatibility.
1439
1440 // FIXME: it seems ugly to put this here, but there is no single
1441 // function in the parser that converts from the operator name to
1442 // the corresponding function name. At least try to do it without N
1443 // string compares.
1444
1445 std::string tnm = nm;
1446
1447 size_t len = nm.length ();
1448
1449 if (len == 3 && nm == ".**")
1450 tnm = "power";
1451 else if (len == 2)
1452 {
1453 if (nm[0] == '.')
1454 {
1455 switch (nm[1])
1456 {
1457 case '\'':
1458 tnm = "transpose";
1459 break;
1460
1461 case '+':
1462 tnm = "plus";
1463 break;
1464
1465 case '-':
1466 tnm = "minus";
1467 break;
1468
1469 case '*':
1470 tnm = "times";
1471 break;
1472
1473 case '/':
1474 tnm = "rdivide";
1475 break;
1476
1477 case '^':
1478 tnm = "power";
1479 break;
1480
1481 case '\\':
1482 tnm = "ldivide";
1483 break;
1484 }
1485 }
1486 else if (nm[1] == '=')
1487 {
1488 switch (nm[0])
1489 {
1490 case '<':
1491 tnm = "le";
1492 break;
1493
1494 case '=':
1495 tnm = "eq";
1496 break;
1497
1498 case '>':
1499 tnm = "ge";
1500 break;
1501
1502 case '~':
1503 case '!':
1504 tnm = "ne";
1505 break;
1506 }
1507 }
1508 else if (nm == "**")
1509 tnm = "mpower";
1510 }
1511 else if (len == 1)
1512 {
1513 switch (nm[0])
1514 {
1515 case '~':
1516 case '!':
1517 tnm = "not";
1518 break;
1519
1520 case '\'':
1521 tnm = "ctranspose";
1522 break;
1523
1524 case '+':
1525 tnm = "plus";
1526 break;
1527
1528 case '-':
1529 tnm = "minus";
1530 break;
1531
1532 case '*':
1533 tnm = "mtimes";
1534 break;
1535
1536 case '/':
1537 tnm = "mrdivide";
1538 break;
1539
1540 case '^':
1541 tnm = "mpower";
1542 break;
1543
1544 case '\\':
1545 tnm = "mldivide";
1546 break;
1547
1548 case '<':
1549 tnm = "lt";
1550 break;
1551
1552 case '>':
1553 tnm = "gt";
1554 break;
1555
1556 case '&':
1557 tnm = "and";
1558 break;
1559
1560 case '|':
1561 tnm = "or";
1562 break;
1563 }
1564 }
1565
1566 octave_value f = symbol_table::find_function (tnm, octave_value_list (),
1567 local_funcs);
1568
1569 octave_function *fptr = f.function_value (true);
1570
1571 // Here we are just looking to see if FCN is a method or constructor
1572 // for any class.
1573 if (local_funcs && fptr
1574 && (fptr->is_subfunction () || fptr->is_private_function ()
1575 || fptr->is_class_constructor ()))
1576 {
1577 // Locally visible function.
1578 retval = octave_value (new octave_fcn_handle (f, tnm));
1579 }
1580 else
1581 {
1582 // Globally visible (or no match yet). Query overloads.
1583 std::list<std::string> classes = load_path::overloads (tnm);
1584 bool any_match = fptr != 0 || classes.size () > 0;
1585 if (! any_match)
1586 {
1587 // No match found, try updating load_path and query classes again.
1588 load_path::update ();
1589 classes = load_path::overloads (tnm);
1590 any_match = classes.size () > 0;
1591 }
1592
1593 if (any_match)
1594 {
1595 octave_fcn_handle *fh = new octave_fcn_handle (f, tnm);
1596 retval = fh;
1597
1598 for (std::list<std::string>::iterator iter = classes.begin ();
1599 iter != classes.end (); iter++)
1600 {
1601 std::string class_name = *iter;
1602 octave_value fmeth = symbol_table::find_method (tnm, class_name);
1603
1604 bool is_builtin = false;
1605 for (int i = 0; i < btyp_num_types; i++)
1606 {
1607 // FIXME: Too slow? Maybe binary lookup?
1608 if (class_name == btyp_class_name[i])
1609 {
1610 is_builtin = true;
1611 fh->set_overload (static_cast<builtin_type_t> (i), fmeth);
1612 }
1613 }
1614
1615 if (! is_builtin)
1616 fh->set_overload (class_name, fmeth);
1617 }
1618 }
1619 else
1620 error ("@%s: no function and no method found", tnm.c_str ());
1621 }
1622
1623 return retval;
1624}
1625
1626/*
1627%!test
1628%! x = {".**", "power";
1629%! ".'", "transpose";
1630%! ".+", "plus";
1631%! ".-", "minus";
1632%! ".*", "times";
1633%! "./", "rdivide";
1634%! ".^", "power";
1635%! ".\\", "ldivide";
1636%! "<=", "le";
1637%! "==", "eq";
1638%! ">=", "ge";
1639%! "~=", "ne";
1640%! "!=", "ne";
1641%! "**", "mpower";
1642%! "~", "not";
1643%! "!", "not";
1644%! "\'", "ctranspose";
1645%! "+", "plus";
1646%! "-", "minus";
1647%! "*", "mtimes";
1648%! "/", "mrdivide";
1649%! "^", "mpower";
1650%! "\\", "mldivide";
1651%! "<", "lt";
1652%! ">", "gt";
1653%! "&", "and";
1654%! "|", "or"};
1655%! for i = 1:rows (x)
1656%! assert (functions (str2func (x{i,1})).function, x{i,2});
1657%! endfor
1658*/
1659
1660DEFUN (functions, args, ,octave_value_list Ffunctions (const octave_value_list& args
, int )
1661 "-*- texinfo -*-\n\octave_value_list Ffunctions (const octave_value_list& args
, int )
1662@deftypefn {Built-in Function} {} functions (@var{fcn_handle})\n\octave_value_list Ffunctions (const octave_value_list& args
, int )
1663Return a struct containing information about the function handle\n\octave_value_list Ffunctions (const octave_value_list& args
, int )
1664@var{fcn_handle}.\n\octave_value_list Ffunctions (const octave_value_list& args
, int )
1665@end deftypefn")octave_value_list Ffunctions (const octave_value_list& args
, int )
1666{
1667 octave_value retval;
1668
1669 if (args.length () == 1)
1670 {
1671 octave_fcn_handle *fh = args(0).fcn_handle_value ();
1672
1673 if (! error_state)
1674 {
1675 octave_function *fcn = fh ? fh->function_value () : 0;
1676
1677 if (fcn)
1678 {
1679 octave_scalar_map m;
1680
1681 std::string fh_nm = fh->fcn_name ();
1682
1683 if (fh_nm == octave_fcn_handle::anonymous)
1684 {
1685 std::ostringstream buf;
1686 fh->print_raw (buf);
1687 m.setfield ("function", buf.str ());
1688
1689 m.setfield ("type", "anonymous");
1690 }
1691 else
1692 {
1693 m.setfield ("function", fh_nm);
1694
1695 if (fcn->is_subfunction ())
1696 {
1697 m.setfield ("type", "subfunction");
1698 Cell parentage (dim_vector (1, 2));
1699 parentage.elem (0) = fh_nm;
1700 parentage.elem (1) = fcn->parent_fcn_name ();
1701 m.setfield ("parentage", octave_value (parentage));
1702 }
1703 else if (fcn->is_private_function ())
1704 m.setfield ("type", "private");
1705 else if (fh->is_overloaded ())
1706 m.setfield ("type", "overloaded");
1707 else
1708 m.setfield ("type", "simple");
1709 }
1710
1711 std::string nm = fcn->fcn_file_name ();
1712
1713 if (fh_nm == octave_fcn_handle::anonymous)
1714 {
1715 m.setfield ("file", nm);
1716
1717 octave_user_function *fu = fh->user_function_value ();
1718
1719 std::list<symbol_table::symbol_record> vars
1720 = symbol_table::all_variables (fu->scope (), 0);
1721
1722 size_t varlen = vars.size ();
1723
1724 if (varlen > 0)
1725 {
1726 octave_scalar_map ws;
1727 for (std::list<symbol_table::symbol_record>::const_iterator
1728 p = vars.begin (); p != vars.end (); p++)
1729 {
1730 ws.assign (p->name (), p->varval (0));
1731 }
1732
1733 m.setfield ("workspace", ws);
1734 }
1735 }
1736 else if (fcn->is_user_function () || fcn->is_user_script ())
1737 {
1738 octave_function *fu = fh->function_value ();
1739 m.setfield ("file", fu->fcn_file_name ());
1740 }
1741 else
1742 m.setfield ("file", "");
1743
1744 retval = m;
1745 }
1746 else
1747 error ("functions: FCN_HANDLE is not a valid function handle object");
1748 }
1749 else
1750 error ("functions: FCN_HANDLE argument must be a function handle object");
1751 }
1752 else
1753 print_usage ();
1754
1755 return retval;
1756}
1757
1758DEFUN (func2str, args, ,octave_value_list Ffunc2str (const octave_value_list& args
, int )
1759 "-*- texinfo -*-\n\octave_value_list Ffunc2str (const octave_value_list& args
, int )
1760@deftypefn {Built-in Function} {} func2str (@var{fcn_handle})\n\octave_value_list Ffunc2str (const octave_value_list& args
, int )
1761Return a string containing the name of the function referenced by\n\octave_value_list Ffunc2str (const octave_value_list& args
, int )
1762the function handle @var{fcn_handle}.\n\octave_value_list Ffunc2str (const octave_value_list& args
, int )
1763@end deftypefn")octave_value_list Ffunc2str (const octave_value_list& args
, int )
1764{
1765 octave_value retval;
1766
1767 if (args.length () == 1)
1768 {
1769 octave_fcn_handle *fh = args(0).fcn_handle_value ();
1770
1771 if (! error_state && fh)
1772 {
1773 std::string fh_nm = fh->fcn_name ();
1774
1775 if (fh_nm == octave_fcn_handle::anonymous)
1776 {
1777 std::ostringstream buf;
1778
1779 fh->print_raw (buf);
1780
1781 retval = buf.str ();
1782 }
1783 else
1784 retval = fh_nm;
1785 }
1786 else
1787 error ("func2str: FCN_HANDLE must be a valid function handle");
1788 }
1789 else
1790 print_usage ();
1791
1792 return retval;
1793}
1794
1795DEFUN (str2func, args, ,octave_value_list Fstr2func (const octave_value_list& args
, int )
1796 "-*- texinfo -*-\n\octave_value_list Fstr2func (const octave_value_list& args
, int )
1797@deftypefn {Built-in Function} {} str2func (@var{fcn_name})\n\octave_value_list Fstr2func (const octave_value_list& args
, int )
1798@deftypefnx {Built-in Function} {} str2func (@var{fcn_name}, \"global\")\n\octave_value_list Fstr2func (const octave_value_list& args
, int )
1799Return a function handle constructed from the string @var{fcn_name}.\n\octave_value_list Fstr2func (const octave_value_list& args
, int )
1800If the optional @qcode{\"global\"} argument is passed, locally visible\n\octave_value_list Fstr2func (const octave_value_list& args
, int )
1801functions are ignored in the lookup.\n\octave_value_list Fstr2func (const octave_value_list& args
, int )
1802@end deftypefn")octave_value_list Fstr2func (const octave_value_list& args
, int )
1803{
1804 octave_value retval;
1805 int nargin = args.length ();
1806
1807 if (nargin == 1 || nargin == 2)
1808 {
1809 std::string nm = args(0).string_value ();
1810
1811 if (! error_state)
1812 retval = make_fcn_handle (nm, nargin != 2);
1813 else
1814 error ("str2func: FCN_NAME must be a string");
1815 }
1816 else
1817 print_usage ();
1818
1819 return retval;
1820}
1821
1822/*
1823%!function y = __testrecursionfunc (f, x, n)
1824%! if (nargin < 3)
1825%! n = 0;
1826%! endif
1827%! if (n > 2)
1828%! y = f (x);
1829%! else
1830%! n++;
1831%! y = __testrecursionfunc (@(x) f (2*x), x, n);
1832%! endif
1833%!endfunction
1834%!
1835%!assert (__testrecursionfunc (@(x) x, 1), 8)
1836*/
1837
1838DEFUN (is_function_handle, args, ,octave_value_list Fis_function_handle (const octave_value_list
& args, int )
1839 "-*- texinfo -*-\n\octave_value_list Fis_function_handle (const octave_value_list
& args, int )
1840@deftypefn {Built-in Function} {} is_function_handle (@var{x})\n\octave_value_list Fis_function_handle (const octave_value_list
& args, int )
1841Return true if @var{x} is a function handle.\n\octave_value_list Fis_function_handle (const octave_value_list
& args, int )
1842@seealso{isa, typeinfo, class}\n\octave_value_list Fis_function_handle (const octave_value_list
& args, int )
1843@end deftypefn")octave_value_list Fis_function_handle (const octave_value_list
& args, int )
1844{
1845 octave_value retval;
1846
1847 int nargin = args.length ();
1848
1849 if (nargin == 1)
1850 retval = args(0).is_function_handle ();
1851 else
1852 print_usage ();
1853
1854 return retval;
1855}
1856
1857/*
1858%!shared fh
1859%! fh = @(x) x;
1860
1861%!assert (is_function_handle (fh))
1862%!assert (! is_function_handle ({fh}))
1863%!assert (! is_function_handle (1))
1864
1865%!error is_function_handle ()
1866%!error is_function_handle (1, 2)
1867*/
1868
1869octave_fcn_binder::octave_fcn_binder (const octave_value& f,
1870 const octave_value& root,
1871 const octave_value_list& templ,
1872 const std::vector<int>& mask,
1873 int exp_nargin)
1874 : octave_fcn_handle (f), root_handle (root), arg_template (templ),
1875 arg_mask (mask), expected_nargin (exp_nargin)
1876{
1877}
1878
1879octave_fcn_handle *
1880octave_fcn_binder::maybe_binder (const octave_value& f)
1881{
1882 octave_fcn_handle *retval = 0;
1883
1884 octave_user_function *usr_fcn = f.user_function_value (false);
1885 tree_parameter_list *param_list = usr_fcn ? usr_fcn->parameter_list () : 0;
1886
1887 // Verify that the body is a single expression (always true in theory).
1888
1889 tree_statement_list *cmd_list = usr_fcn ? usr_fcn->body () : 0;
1890 tree_expression *body_expr = (cmd_list->length () == 1
1891 ? cmd_list->front ()->expression () : 0);
1892
1893
1894 if (body_expr && body_expr->is_index_expression ()
1895 && ! (param_list && param_list->takes_varargs ()))
1896 {
1897 // It's an index expression.
1898 tree_index_expression *idx_expr = dynamic_cast<tree_index_expression *>
1899 (body_expr);
1900 tree_expression *head_expr = idx_expr->expression ();
1901 std::list<tree_argument_list *> arg_lists = idx_expr->arg_lists ();
1902 std::string type_tags = idx_expr->type_tags ();
1903
1904 if (type_tags.length () == 1 && type_tags[0] == '('
1905 && head_expr->is_identifier ())
1906 {
1907 assert (arg_lists.size () == 1)((arg_lists.size () == 1) ? static_cast<void> (0) : __assert_fail
("arg_lists.size () == 1", "octave-value/ov-fcn-handle.cc", 1907
, __PRETTY_FUNCTION__))
;
1908
1909 // It's a single index expression: a(x,y,....)
1910 tree_identifier *head_id =
1911 dynamic_cast<tree_identifier *> (head_expr);
1912 tree_argument_list *arg_list = arg_lists.front ();
1913
1914 // Build a map of input params to their position.
1915 std::map<std::string, int> arginmap;
1916 int npar = 0;
1917
1918 if (param_list)
1919 {
1920 for (tree_parameter_list::iterator it = param_list->begin ();
1921 it != param_list->end (); ++it, ++npar)
1922 {
1923 tree_decl_elt *elt = *it;
1924 tree_identifier *id = elt ? elt->ident () : 0;
1925 if (id && ! id->is_black_hole ())
1926 arginmap[id->name ()] = npar;
1927 }
1928 }
1929
1930 if (arg_list && arg_list->length () > 0)
1931 {
1932 bool bad = false;
1933 int nargs = arg_list->length ();
1934 octave_value_list arg_template (nargs);
1935 std::vector<int> arg_mask (nargs);
1936
1937 // Verify that each argument is either a named param, a constant,
1938 // or a defined identifier.
1939 int iarg = 0;
1940 for (tree_argument_list::iterator it = arg_list->begin ();
1941 it != arg_list->end (); ++it, ++iarg)
1942 {
1943 tree_expression *elt = *it;
1944 if (elt && elt->is_constant ())
1945 {
1946 arg_template(iarg) = elt->rvalue1 ();
1947 arg_mask[iarg] = -1;
1948 }
1949 else if (elt && elt->is_identifier ())
1950 {
1951 tree_identifier *elt_id =
1952 dynamic_cast<tree_identifier *> (elt);
1953 if (arginmap.find (elt_id->name ()) != arginmap.end ())
1954 {
1955 arg_mask[iarg] = arginmap[elt_id->name ()];
1956 }
1957 else if (elt_id->is_defined ())
1958 {
1959 arg_template(iarg) = elt_id->rvalue1 ();
1960 arg_mask[iarg] = -1;
1961 }
1962 else
1963 {
1964 bad = true;
1965 break;
1966 }
1967 }
1968 else
1969 {
1970 bad = true;
1971 break;
1972 }
1973 }
1974
1975 octave_value root_val;
1976
1977 if (! bad)
1978 {
1979 // If the head is a value, use it as root.
1980 if (head_id->is_defined ())
1981 root_val = head_id->rvalue1 ();
1982 else
1983 {
1984 // It's a name.
1985 std::string head_name = head_id->name ();
1986 // Function handles can't handle legacy dispatch, so
1987 // we make sure it's not defined.
1988 if (symbol_table::get_dispatch (head_name).size () > 0)
1989 bad = true;
1990 else
1991 {
1992 // Simulate try/catch.
1993 unwind_protect frame;
1994 interpreter_try (frame);
1995
1996 root_val = make_fcn_handle (head_name);
1997 if (error_state)
1998 bad = true;
1999 }
2000 }
2001 }
2002
2003 if (! bad)
2004 {
2005 // Stash proper name tags.
2006 std::list<string_vector> arg_names = idx_expr->arg_names ();
2007 assert (arg_names.size () == 1)((arg_names.size () == 1) ? static_cast<void> (0) : __assert_fail
("arg_names.size () == 1", "octave-value/ov-fcn-handle.cc", 2007
, __PRETTY_FUNCTION__))
;
2008 arg_template.stash_name_tags (arg_names.front ());
2009
2010 retval = new octave_fcn_binder (f, root_val, arg_template,
2011 arg_mask, npar);
2012 }
2013 }
2014 }
2015 }
2016
2017 if (! retval)
2018 retval = new octave_fcn_handle (f, octave_fcn_handle::anonymous);
2019
2020 return retval;
2021}
2022
2023octave_value_list
2024octave_fcn_binder::do_multi_index_op (int nargout,
2025 const octave_value_list& args)
2026{
2027 return do_multi_index_op (nargout, args, 0);
2028}
2029
2030octave_value_list
2031octave_fcn_binder::do_multi_index_op (int nargout,
2032 const octave_value_list& args,
2033 const std::list<octave_lvalue>* lvalue_list)
2034{
2035 octave_value_list retval;
2036
2037 if (args.length () == expected_nargin)
2038 {
2039 for (int i = 0; i < arg_template.length (); i++)
2040 {
2041 int j = arg_mask[i];
2042 if (j >= 0)
2043 arg_template(i) = args(j); // May force a copy...
2044 }
2045
2046 // Make a shallow copy of arg_template, to ensure consistency throughout
2047 // the following call even if we happen to get back here.
2048 octave_value_list tmp (arg_template);
2049 retval = root_handle.do_multi_index_op (nargout, tmp, lvalue_list);
2050 }
2051 else
2052 retval = octave_fcn_handle::do_multi_index_op (nargout, args, lvalue_list);
2053
2054 return retval;
2055}
2056
2057/*
2058%!function r = __f (g, i)
2059%! r = g(i);
2060%!endfunction
2061%!test
2062%! x = [1,2;3,4];
2063%! assert (__f (@(i) x(:,i), 1), [1;3]);
2064*/