1 //////////////////////////////////////////////////////////////////////// 2 // 3 // Copyright (C) 1996-2021 The Octave Project Developers 4 // 5 // See the file COPYRIGHT.md in the top-level directory of this 6 // distribution or <https://octave.org/copyright/>. 7 // 8 // This file is part of Octave. 9 // 10 // Octave is free software: you can redistribute it and/or modify it 11 // under the terms of the GNU General Public License as published by 12 // the Free Software Foundation, either version 3 of the License, or 13 // (at your option) any later version. 14 // 15 // Octave is distributed in the hope that it will be useful, but 16 // WITHOUT ANY WARRANTY; without even the implied warranty of 17 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 // GNU General Public License for more details. 19 // 20 // You should have received a copy of the GNU General Public License 21 // along with Octave; see the file COPYING. If not, see 22 // <https://www.gnu.org/licenses/>. 23 // 24 //////////////////////////////////////////////////////////////////////// 25 26 #if defined (HAVE_CONFIG_H) 27 # include "config.h" 28 #endif 29 30 #include <string> 31 32 #include "error.h" 33 #include "oct-lvalue.h" 34 #include "ov.h" 35 #include "parse.h" 36 #include "pt-arg-list.h" 37 #include "pt-assign.h" 38 39 namespace octave 40 { 41 // Simple assignment expressions. 42 tree_simple_assignment(tree_expression * le,tree_expression * re,bool plhs,int l,int c,octave_value::assign_op t)43 tree_simple_assignment::tree_simple_assignment (tree_expression *le, 44 tree_expression *re, 45 bool plhs, int l, int c, 46 octave_value::assign_op t) 47 : tree_expression (l, c), m_lhs (le), m_rhs (re), m_preserve (plhs), 48 m_ans_assign (), m_etype (t) 49 { } 50 ~tree_simple_assignment(void)51 tree_simple_assignment::~tree_simple_assignment (void) 52 { 53 if (! m_preserve) 54 delete m_lhs; 55 56 delete m_rhs; 57 } 58 59 std::string oper(void) const60 tree_simple_assignment::oper (void) const 61 { 62 return octave_value::assign_op_as_string (m_etype); 63 } 64 65 tree_expression * dup(symbol_scope & scope) const66 tree_simple_assignment::dup (symbol_scope& scope) const 67 { 68 tree_simple_assignment *new_sa 69 = new tree_simple_assignment (m_lhs ? m_lhs->dup (scope) : nullptr, 70 m_rhs ? m_rhs->dup (scope) : nullptr, 71 m_preserve, m_etype); 72 73 new_sa->copy_base (*this); 74 75 return new_sa; 76 } 77 78 octave_value evaluate(tree_evaluator & tw,int)79 tree_simple_assignment::evaluate (tree_evaluator& tw, int) 80 { 81 octave_value val; 82 83 if (m_rhs) 84 { 85 try 86 { 87 octave_lvalue ult = m_lhs->lvalue (tw); 88 89 std::list<octave_lvalue> lvalue_list; 90 lvalue_list.push_back (ult); 91 92 unwind_action act ([&tw] (const std::list<octave_lvalue> *lvl) 93 { 94 tw.set_lvalue_list (lvl); 95 }, tw.lvalue_list ()); 96 tw.set_lvalue_list (&lvalue_list); 97 98 if (ult.numel () != 1) 99 err_invalid_structure_assignment (); 100 101 octave_value rhs_val = m_rhs->evaluate (tw); 102 103 if (rhs_val.is_undefined ()) 104 error ("value on right hand side of assignment is undefined"); 105 106 if (rhs_val.is_cs_list ()) 107 { 108 const octave_value_list lst = rhs_val.list_value (); 109 110 if (lst.empty ()) 111 error ("invalid number of elements on RHS of assignment"); 112 113 rhs_val = lst(0); 114 } 115 116 ult.assign (m_etype, rhs_val); 117 118 if (m_etype == octave_value::op_asn_eq) 119 val = rhs_val; 120 else 121 val = ult.value (); 122 123 if (print_result () && tw.statement_printing_enabled ()) 124 { 125 // We clear any index here so that we can 126 // get the new value of the referenced 127 // object below, instead of the indexed 128 // value (which should be the same as the 129 // right hand side value). 130 131 ult.clear_index (); 132 133 octave_value lhs_val = ult.value (); 134 135 octave_value_list args = ovl (lhs_val); 136 args.stash_name_tags (string_vector (m_lhs->name ())); 137 feval ("display", args); 138 } 139 } 140 catch (index_exception& e) 141 { 142 e.set_var (m_lhs->name ()); 143 std::string msg = e.message (); 144 error_with_id (e.err_id (), "%s", msg.c_str ()); 145 } 146 } 147 148 return val; 149 } 150 151 // Multi-valued assignment expressions. 152 tree_multi_assignment(tree_argument_list * lst,tree_expression * r,bool plhs,int l,int c)153 tree_multi_assignment::tree_multi_assignment (tree_argument_list *lst, 154 tree_expression *r, 155 bool plhs, int l, int c) 156 : tree_expression (l, c), m_lhs (lst), m_rhs (r), m_preserve (plhs) 157 { } 158 ~tree_multi_assignment(void)159 tree_multi_assignment::~tree_multi_assignment (void) 160 { 161 if (! m_preserve) 162 delete m_lhs; 163 164 delete m_rhs; 165 } 166 167 std::string oper(void) const168 tree_multi_assignment::oper (void) const 169 { 170 return octave_value::assign_op_as_string (op_type ()); 171 } 172 173 tree_expression * dup(symbol_scope &) const174 tree_multi_assignment::dup (symbol_scope&) const 175 { 176 panic_impossible (); 177 return nullptr; 178 } 179 180 octave_value_list evaluate_n(tree_evaluator & tw,int)181 tree_multi_assignment::evaluate_n (tree_evaluator& tw, int) 182 { 183 octave_value_list val; 184 185 if (m_rhs) 186 { 187 std::list<octave_lvalue> lvalue_list = tw.make_lvalue_list (m_lhs); 188 189 unwind_action act ([&tw] (const std::list<octave_lvalue> *lvl) 190 { 191 tw.set_lvalue_list (lvl); 192 }, tw.lvalue_list ()); 193 tw.set_lvalue_list (&lvalue_list); 194 195 octave_idx_type n_out = 0; 196 197 for (const auto& lval : lvalue_list) 198 n_out += lval.numel (); 199 200 // The following trick is used to keep rhs_val constant. 201 const octave_value_list rhs_val1 = m_rhs->evaluate_n (tw, n_out); 202 const octave_value_list rhs_val = (rhs_val1.length () == 1 203 && rhs_val1(0).is_cs_list () 204 ? rhs_val1(0).list_value () 205 : rhs_val1); 206 207 tw.set_lvalue_list (nullptr); 208 209 octave_idx_type k = 0; 210 211 octave_idx_type n = rhs_val.length (); 212 213 // To avoid copying per elements and possible optimizations, we 214 // postpone joining the final values. 215 std::list<octave_value_list> retval_list; 216 217 auto q = m_lhs->begin (); 218 219 for (octave_lvalue ult : lvalue_list) 220 { 221 tree_expression *lhs_elt = *q++; 222 223 octave_idx_type nel = ult.numel (); 224 225 if (nel != 1) 226 { 227 // Huge kluge so that wrapper scripts with lines like 228 // 229 // [varargout{1:nargout}] = fcn (args); 230 // 231 // or 232 // 233 // varargout = cell (1, nargout); 234 // [varargout{1:nargout}] = fcn (args); 235 // 236 // or 237 // 238 // varargout = cell (1, nargout); 239 // [varargout{:}] = fcn (args); 240 // 241 // Will work the same as calling fcn directly when nargout 242 // is 0 and fcn produces more than one output even when 243 // nargout is 0. See also bug #43813. 244 245 if (lvalue_list.size () == 1 && nel == 0 && n > 0 246 && ! ult.is_black_hole () && ult.index_type () == "{" 247 && (ult.index_is_empty () 248 || (ult.is_defined () && ult.index_is_colon ()))) 249 { 250 // Convert undefined lvalue with empty index to a cell 251 // array with a single value and indexed by 1 to 252 // handle a single output. 253 254 nel = 1; 255 256 ult.define (Cell (1, 1)); 257 258 ult.clear_index (); 259 std::list<octave_value_list> idx; 260 idx.push_back (octave_value_list (octave_value (1))); 261 ult.set_index ("{", idx); 262 } 263 264 if (k + nel > n) 265 error ("some elements undefined in return list"); 266 267 // This element of the return list expects a 268 // comma-separated list of values. Slicing avoids 269 // copying. 270 271 octave_value_list ovl = rhs_val.slice (k, nel); 272 273 ult.assign (octave_value::op_asn_eq, octave_value (ovl)); 274 275 retval_list.push_back (ovl); 276 277 k += nel; 278 } 279 else 280 { 281 if (k < n) 282 { 283 if (ult.is_black_hole ()) 284 { 285 k++; 286 continue; 287 } 288 else 289 { 290 octave_value tmp = rhs_val(k); 291 292 if (tmp.is_undefined ()) 293 error ("element number %" OCTAVE_IDX_TYPE_FORMAT 294 " undefined in return list", k+1); 295 296 ult.assign (octave_value::op_asn_eq, tmp); 297 298 retval_list.push_back (tmp); 299 300 k++; 301 } 302 } 303 else 304 { 305 // This can happen for a function like 306 // 307 // function varargout = f () 308 // varargout{1} = nargout; 309 // endfunction 310 // 311 // called with 312 // 313 // [a, ~] = f (); 314 // 315 // Then the list of of RHS values will contain one 316 // element but we are iterating over the list of all 317 // RHS values. We shouldn't complain that a value we 318 // don't need is missing from the list. 319 320 if (! ult.is_black_hole ()) 321 error ("element number %" OCTAVE_IDX_TYPE_FORMAT 322 " undefined in return list", k+1); 323 324 k++; 325 continue; 326 } 327 } 328 329 if (print_result () && tw.statement_printing_enabled ()) 330 { 331 // We clear any index here so that we can get 332 // the new value of the referenced object below, 333 // instead of the indexed value (which should be 334 // the same as the right hand side value). 335 336 ult.clear_index (); 337 338 octave_value lhs_val = ult.value (); 339 340 octave_value_list args = ovl (lhs_val); 341 args.stash_name_tags (string_vector (lhs_elt->name ())); 342 feval ("display", args); 343 } 344 } 345 346 // Concatenate return values. 347 val = retval_list; 348 } 349 350 return val; 351 } 352 } 353 354 /* 355 %!function varargout = f1 () 356 %! varargout{1} = nargout; 357 %!endfunction 358 %! 359 %!test 360 %! [a, ~] = f1 (); 361 %! assert (a, 2); 362 %!test 363 %! [a, ~, ~, ~, ~] = f1 (); 364 %! assert (a, 5); 365 366 %!function [x, y] = f2 () 367 %! y = 1; 368 %!endfunction 369 %! 370 %!test 371 %! [~, y] = f2 (); 372 %! assert (y, 1); 373 374 %!function [x, y, varargout] = f3 () 375 %! y = 1; 376 %! varargout = {2, 3}; 377 %!endfunction 378 %! 379 %!test 380 %! [~, y, a, b] = f3 (); 381 %! assert ([y, a, b], [1, 2, 3]); 382 %!test 383 %! [~, y, ~, b] = f3 (); 384 %! assert ([y, b], [1, 3]); 385 */ 386