File: | libinterp/octave-value/ov-fcn-handle.cc |
Location: | line 1890, column 33 |
Description: | Called C++ object pointer is null |
1 | /* | |||
2 | ||||
3 | Copyright (C) 2003-2013 John W. Eaton | |||
4 | Copyright (C) 2009 VZLU Prague, a.s. | |||
5 | Copyright (C) 2010 Jaroslav Hajek | |||
6 | ||||
7 | This file is part of Octave. | |||
8 | ||||
9 | Octave is free software; you can redistribute it and/or modify it | |||
10 | under the terms of the GNU General Public License as published by the | |||
11 | Free Software Foundation; either version 3 of the License, or (at your | |||
12 | option) any later version. | |||
13 | ||||
14 | Octave is distributed in the hope that it will be useful, but WITHOUT | |||
15 | ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |||
16 | FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |||
17 | for more details. | |||
18 | ||||
19 | You should have received a copy of the GNU General Public License | |||
20 | along 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 | ||||
67 | DEFINE_OCTAVE_ALLOCATOR (octave_fcn_handle); | |||
68 | ||||
69 | DEFINE_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 | ||||
73 | const std::string octave_fcn_handle::anonymous ("@<anonymous>"); | |||
74 | ||||
75 | octave_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 | ||||
88 | octave_value_list | |||
89 | octave_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 | ||||
96 | octave_value_list | |||
97 | octave_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 | ||||
137 | octave_value_list | |||
138 | octave_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 | ||||
144 | octave_value_list | |||
145 | octave_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 | ||||
229 | bool | |||
230 | octave_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 | ||||
250 | bool | |||
251 | octave_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 | ||||
355 | bool | |||
356 | octave_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 | ||||
401 | bool | |||
402 | octave_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 | ||||
518 | bool | |||
519 | octave_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 | ||||
581 | bool | |||
582 | octave_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) | |||
709 | bool | |||
710 | octave_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); | |||
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 | ||||
936 | bool | |||
937 | octave_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", ¤t_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 | ||||
1351 | Test 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 | ||||
1388 | void | |||
1389 | octave_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 | ||||
1395 | void | |||
1396 | octave_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 | ||||
1433 | octave_value | |||
1434 | make_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 | ||||
1660 | DEFUN (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 ) | |||
1663 | Return 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 | ||||
1758 | DEFUN (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 ) | |||
1761 | Return a string containing the name of the function referenced by\n\octave_value_list Ffunc2str (const octave_value_list& args , int ) | |||
1762 | the 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 | ||||
1795 | DEFUN (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 ) | |||
1799 | Return a function handle constructed from the string @var{fcn_name}.\n\octave_value_list Fstr2func (const octave_value_list& args , int ) | |||
1800 | If the optional @qcode{\"global\"} argument is passed, locally visible\n\octave_value_list Fstr2func (const octave_value_list& args , int ) | |||
1801 | functions 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 | ||||
1838 | DEFUN (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 ) | |||
1841 | Return 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 | ||||
1869 | octave_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 | ||||
1879 | octave_fcn_handle * | |||
1880 | octave_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 | ||||
2023 | octave_value_list | |||
2024 | octave_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 | ||||
2030 | octave_value_list | |||
2031 | octave_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 | */ |