1use std::sync::Arc;
5
6use parking_lot::RwLock;
7use rand::seq::SliceRandom;
8use rand::Rng;
9
10use crate::ast::{Block, Program};
11use crate::interpreter::{ExecResult, Interpreter, ModuleExportLists, WantarrayCtx};
12use crate::value::{BlessedRef, HeapObject, PerlSub, PerlValue};
13
14pub fn program_needs_list_util(program: &Program) -> bool {
17 let s = format!("{program:?}");
18 s.contains("List::Util")
19 || s.contains("chunked")
20 || s.contains("windowed")
21 || s.contains("fold")
22 || s.contains("inject")
23 || s.contains("find_all")
24}
25
26pub fn ensure_list_util(interp: &mut Interpreter) {
29 if interp.subs.contains_key("List::Util::sum") {
30 return;
31 }
32 install_list_util(interp);
33}
34
35pub fn install_sub_util(interp: &mut Interpreter) {
39 if interp.subs.contains_key("Sub::Util::set_subname") {
40 return;
41 }
42 let empty: Block = vec![];
43 let export_ok: Vec<String> = SUB_UTIL_NATIVE.iter().map(|s| (*s).to_string()).collect();
44 interp.module_export_lists.insert(
45 "Sub::Util".to_string(),
46 ModuleExportLists {
47 export: vec![],
48 export_ok,
49 },
50 );
51 for name in SUB_UTIL_NATIVE {
52 let key = format!("Sub::Util::{}", name);
53 interp.subs.insert(
54 key.clone(),
55 Arc::new(PerlSub {
56 name: key,
57 params: vec![],
58 body: empty.clone(),
59 prototype: None,
60 closure_env: None,
61 fib_like: None,
62 }),
63 );
64 }
65}
66
67const SUB_UTIL_NATIVE: &[&str] = &["set_subname", "subname"];
68
69pub fn install_scalar_util(interp: &mut Interpreter) {
70 if interp.subs.contains_key("Scalar::Util::blessed") {
71 return;
72 }
73 let empty: Block = vec![];
74 let export_ok: Vec<String> = SCALAR_UTIL_NATIVE
75 .iter()
76 .map(|s| (*s).to_string())
77 .collect();
78 interp.module_export_lists.insert(
79 "Scalar::Util".to_string(),
80 ModuleExportLists {
81 export: vec![],
82 export_ok,
83 },
84 );
85 for name in SCALAR_UTIL_NATIVE {
86 let key = format!("Scalar::Util::{}", name);
87 interp.subs.insert(
88 key.clone(),
89 Arc::new(PerlSub {
90 name: key,
91 params: vec![],
92 body: empty.clone(),
93 prototype: None,
94 closure_env: None,
95 fib_like: None,
96 }),
97 );
98 }
99}
100
101const SCALAR_UTIL_NATIVE: &[&str] = &[
102 "blessed", "refaddr", "reftype", "weaken", "unweaken", "isweak",
103];
104
105pub fn install_list_util(interp: &mut Interpreter) {
107 let empty: Block = vec![];
108 let export_ok: Vec<String> = LIST_UTIL_ROOT.iter().map(|s| (*s).to_string()).collect();
109 interp.module_export_lists.insert(
110 "List::Util".to_string(),
111 ModuleExportLists {
112 export: export_ok.clone(),
113 export_ok,
114 },
115 );
116 for name in LIST_UTIL_ROOT {
117 let key = format!("List::Util::{}", name);
118 interp.subs.insert(
119 key.clone(),
120 Arc::new(PerlSub {
121 name: key,
122 params: vec![],
123 body: empty.clone(),
124 prototype: None,
125 closure_env: None,
126 fib_like: None,
127 }),
128 );
129 }
130 for name in PAIR_METHODS {
131 let key = format!("List::Util::_Pair::{}", name);
132 interp.subs.insert(
133 key.clone(),
134 Arc::new(PerlSub {
135 name: key,
136 params: vec![],
137 body: empty.clone(),
138 prototype: None,
139 closure_env: None,
140 fib_like: None,
141 }),
142 );
143 }
144}
145
146const LIST_UTIL_ROOT: &[&str] = &[
147 "all",
148 "any",
149 "first",
150 "min",
151 "max",
152 "minstr",
153 "maxstr",
154 "mean",
155 "median",
156 "mode",
157 "none",
158 "notall",
159 "product",
160 "reduce",
161 "fold",
162 "reductions",
163 "sum",
164 "sum0",
165 "stddev",
166 "variance",
167 "sample",
168 "shuffle",
169 "uniq",
170 "uniqint",
171 "uniqnum",
172 "uniqstr",
173 "zip",
174 "zip_longest",
175 "zip_shortest",
176 "mesh",
177 "mesh_longest",
178 "mesh_shortest",
179 "chunked",
180 "windowed",
181 "head",
182 "tail",
183 "pairs",
184 "unpairs",
185 "pairkeys",
186 "pairvalues",
187 "pairmap",
188 "pairgrep",
189 "pairfirst",
190];
191
192const PAIR_METHODS: &[&str] = &["key", "value", "TO_JSON"];
193
194pub(crate) fn native_dispatch(
196 interp: &mut Interpreter,
197 sub: &PerlSub,
198 args: &[PerlValue],
199 want: WantarrayCtx,
200) -> Option<ExecResult> {
201 match sub.name.as_str() {
202 "List::Util::uniq" => Some(dispatch_ok(uniq_with_want(args, want))),
203 "List::Util::uniqstr" => Some(dispatch_ok(uniqstr_with_want(args, want))),
204 "List::Util::uniqint" => Some(dispatch_ok(uniqint_with_want(args, want))),
205 "List::Util::uniqnum" => Some(dispatch_ok(uniqnum_with_want(args, want))),
206 "List::Util::sum" => Some(dispatch_ok(sum(args).map(|v| aggregate_wantarray(v, want)))),
207 "List::Util::sum0" => Some(dispatch_ok(
208 sum0(args).map(|v| aggregate_wantarray(v, want)),
209 )),
210 "List::Util::product" => Some(dispatch_ok(
211 product(args).map(|v| aggregate_wantarray(v, want)),
212 )),
213 "List::Util::mean" => Some(dispatch_ok(
214 mean(args).map(|v| aggregate_wantarray(v, want)),
215 )),
216 "List::Util::median" => Some(dispatch_ok(
217 median(args).map(|v| aggregate_wantarray(v, want)),
218 )),
219 "List::Util::mode" => Some(dispatch_ok(mode_with_want(args, want))),
220 "List::Util::variance" => Some(dispatch_ok(
221 variance(args).map(|v| aggregate_wantarray(v, want)),
222 )),
223 "List::Util::stddev" => Some(dispatch_ok(
224 stddev(args).map(|v| aggregate_wantarray(v, want)),
225 )),
226 "List::Util::min" => Some(dispatch_ok(
227 minmax(args, MinMax::MinNum).map(|v| aggregate_wantarray(v, want)),
228 )),
229 "List::Util::max" => Some(dispatch_ok(
230 minmax(args, MinMax::MaxNum).map(|v| aggregate_wantarray(v, want)),
231 )),
232 "List::Util::minstr" => Some(dispatch_ok(
233 minmax(args, MinMax::MinStr).map(|v| aggregate_wantarray(v, want)),
234 )),
235 "List::Util::maxstr" => Some(dispatch_ok(
236 minmax(args, MinMax::MaxStr).map(|v| aggregate_wantarray(v, want)),
237 )),
238 "List::Util::shuffle" => Some(dispatch_ok(shuffle_native(interp, args))),
239 "List::Util::chunked" => Some(dispatch_ok(chunked_with_want(args, want))),
240 "List::Util::windowed" => Some(dispatch_ok(windowed_with_want(args, want))),
241 "List::Util::sample" => Some(dispatch_ok(sample_native(interp, args))),
242 "List::Util::head" => Some(dispatch_ok(head_tail_take_impl(
243 args,
244 HeadTailTake::ListUtilHead,
245 want,
246 ))),
247 "List::Util::tail" => Some(dispatch_ok(head_tail_take_impl(
248 args,
249 HeadTailTake::ListUtilTail,
250 want,
251 ))),
252 "List::Util::reduce" | "List::Util::fold" => Some(reduce_like(interp, args, want, false)),
253 "List::Util::reductions" => Some(reduce_like(interp, args, want, true)),
254 "List::Util::any" => Some(any_all_none(interp, args, want, AnyMode::Any)),
255 "List::Util::all" => Some(any_all_none(interp, args, want, AnyMode::All)),
256 "List::Util::none" => Some(any_all_none(interp, args, want, AnyMode::None)),
257 "List::Util::notall" => Some(any_all_none(interp, args, want, AnyMode::NotAll)),
258 "List::Util::first" => Some(first_native(interp, args, want)),
259 "List::Util::pairs" => Some(dispatch_ok(pairs_native(args))),
260 "List::Util::unpairs" => Some(dispatch_ok(unpairs_native(args))),
261 "List::Util::pairkeys" => Some(dispatch_ok(pairkeys_values(true, args))),
262 "List::Util::pairvalues" => Some(dispatch_ok(pairkeys_values(false, args))),
263 "List::Util::pairgrep" => Some(pairgrep_map(interp, args, want, PairMode::Grep)),
264 "List::Util::pairmap" => Some(pairgrep_map(interp, args, want, PairMode::Map)),
265 "List::Util::pairfirst" => Some(pairgrep_map(interp, args, want, PairMode::First)),
266 "List::Util::zip" | "List::Util::zip_longest" => {
267 Some(dispatch_ok(zip_mesh(args, ZipMesh::ZipLongest)))
268 }
269 "List::Util::zip_shortest" => Some(dispatch_ok(zip_mesh(args, ZipMesh::ZipShortest))),
270 "List::Util::mesh" | "List::Util::mesh_longest" => {
271 Some(dispatch_ok(zip_mesh(args, ZipMesh::MeshLongest)))
272 }
273 "List::Util::mesh_shortest" => Some(dispatch_ok(zip_mesh(args, ZipMesh::MeshShortest))),
274 "List::Util::_Pair::key" => Some(dispatch_ok(pair_accessor(args, 0))),
275 "List::Util::_Pair::value" => Some(dispatch_ok(pair_accessor(args, 1))),
276 "List::Util::_Pair::TO_JSON" => Some(dispatch_ok(pair_to_json(args))),
277 "Scalar::Util::blessed" => Some(dispatch_ok(scalar_util_blessed(args.first()))),
278 "Scalar::Util::refaddr" => Some(dispatch_ok(scalar_util_refaddr(args.first()))),
279 "Scalar::Util::reftype" => Some(dispatch_ok(scalar_util_reftype(args.first()))),
280 "Scalar::Util::weaken" | "Scalar::Util::unweaken" => {
281 Some(dispatch_ok(Ok(PerlValue::UNDEF)))
282 }
283 "Scalar::Util::isweak" => Some(dispatch_ok(Ok(PerlValue::integer(0)))),
284 "Sub::Util::set_subname" | "Sub::Util::subname" => {
285 Some(dispatch_ok(sub_util_set_subname(args)))
286 }
287 "utf8::unicode_to_native" => Some(dispatch_ok(utf8_unicode_to_native(args.first()))),
289 _ => None,
290 }
291}
292
293fn sub_util_set_subname(args: &[PerlValue]) -> crate::error::PerlResult<PerlValue> {
295 Ok(args.get(1).cloned().unwrap_or(PerlValue::UNDEF))
296}
297
298fn utf8_unicode_to_native(arg: Option<&PerlValue>) -> crate::error::PerlResult<PerlValue> {
299 let n = arg.map(|a| a.to_int()).unwrap_or(0);
300 Ok(PerlValue::integer(n))
301}
302
303fn scalar_util_blessed(arg: Option<&PerlValue>) -> crate::error::PerlResult<PerlValue> {
304 let Some(v) = arg else {
305 return Ok(PerlValue::UNDEF);
306 };
307 Ok(v.as_blessed_ref()
308 .map(|b| PerlValue::string(b.class.clone()))
309 .unwrap_or(PerlValue::UNDEF))
310}
311
312fn scalar_util_refaddr(arg: Option<&PerlValue>) -> crate::error::PerlResult<PerlValue> {
313 let Some(v) = arg else {
314 return Ok(PerlValue::UNDEF);
315 };
316 if v.is_undef() {
317 return Ok(PerlValue::UNDEF);
318 }
319 if v.with_heap(|_| ()).is_none() {
320 return Ok(PerlValue::UNDEF);
321 }
322 Ok(PerlValue::integer(v.raw_bits() as i64))
323}
324
325fn scalar_util_reftype(arg: Option<&PerlValue>) -> crate::error::PerlResult<PerlValue> {
326 let Some(v) = arg else {
327 return Ok(PerlValue::UNDEF);
328 };
329 if v.is_undef() {
330 return Ok(PerlValue::UNDEF);
331 }
332 if let Some(b) = v.as_blessed_ref() {
333 let inner = b.data.read().clone();
334 return scalar_util_reftype(Some(&inner));
335 }
336 Ok(v.with_heap(|h| {
337 let t = match h {
338 HeapObject::Array(_) | HeapObject::ArrayRef(_) | HeapObject::ArrayBindingRef(_) => {
339 Some("ARRAY")
340 }
341 HeapObject::Hash(_) | HeapObject::HashRef(_) | HeapObject::HashBindingRef(_) => {
342 Some("HASH")
343 }
344 HeapObject::ScalarRef(_) | HeapObject::ScalarBindingRef(_) => Some("SCALAR"),
345 HeapObject::CodeRef(_) => Some("CODE"),
346 HeapObject::Regex(_, _, _) => Some("REGEXP"),
347 _ => None,
348 };
349 t.map(|s| PerlValue::string(s.to_string()))
350 })
351 .flatten()
352 .unwrap_or(PerlValue::UNDEF))
353}
354
355fn dispatch_ok(r: crate::error::PerlResult<PerlValue>) -> ExecResult {
356 match r {
357 Ok(v) => Ok(v),
358 Err(e) => Err(e.into()),
359 }
360}
361
362#[inline]
364fn aggregate_wantarray(v: PerlValue, want: WantarrayCtx) -> PerlValue {
365 if want == WantarrayCtx::List {
366 PerlValue::array(vec![v])
367 } else {
368 v
369 }
370}
371
372enum MinMax {
373 MinNum,
374 MaxNum,
375 MinStr,
376 MaxStr,
377}
378
379fn minmax(args: &[PerlValue], mode: MinMax) -> crate::error::PerlResult<PerlValue> {
380 if args.is_empty() {
381 return Ok(PerlValue::UNDEF);
382 }
383 let mut it = args.iter().cloned();
384 let mut m = it.next().unwrap();
385 for x in it {
386 m = match mode {
387 MinMax::MinNum => {
388 if x.to_number() < m.to_number() {
389 x
390 } else {
391 m
392 }
393 }
394 MinMax::MaxNum => {
395 if x.to_number() > m.to_number() {
396 x
397 } else {
398 m
399 }
400 }
401 MinMax::MinStr => {
402 if x.to_string().cmp(&m.to_string()) == std::cmp::Ordering::Less {
403 x
404 } else {
405 m
406 }
407 }
408 MinMax::MaxStr => {
409 if x.to_string().cmp(&m.to_string()) == std::cmp::Ordering::Greater {
410 x
411 } else {
412 m
413 }
414 }
415 };
416 }
417 Ok(m)
418}
419
420fn uniq_with_want(args: &[PerlValue], want: WantarrayCtx) -> crate::error::PerlResult<PerlValue> {
421 let a = uniq_list(args)?;
422 if want == WantarrayCtx::Scalar {
423 if let Some(x) = a.as_array_vec() {
424 return Ok(PerlValue::integer(x.len() as i64));
425 }
426 }
427 Ok(a)
428}
429
430fn uniq_list(args: &[PerlValue]) -> crate::error::PerlResult<PerlValue> {
432 let mut out = Vec::new();
433 let mut seen = std::collections::HashSet::new();
434 for arg in args {
435 if arg.is_iterator() {
436 let iter = arg.clone().into_iterator();
437 while let Some(x) = iter.next_item() {
438 let key = x.to_string();
439 if seen.insert(key) {
440 out.push(x);
441 }
442 }
443 } else if let Some(arr) = arg.as_array_vec() {
444 for x in arr {
445 let key = x.to_string();
446 if seen.insert(key) {
447 out.push(x.clone());
448 }
449 }
450 } else {
451 let key = arg.to_string();
452 if seen.insert(key) {
453 out.push(arg.clone());
454 }
455 }
456 }
457 Ok(PerlValue::array(out))
458}
459
460fn uniqstr_with_want(
461 args: &[PerlValue],
462 want: WantarrayCtx,
463) -> crate::error::PerlResult<PerlValue> {
464 let a = uniqstr_list(args)?;
465 if want == WantarrayCtx::Scalar {
466 if let Some(x) = a.as_array_vec() {
467 return Ok(PerlValue::integer(x.len() as i64));
468 }
469 }
470 Ok(a)
471}
472
473fn uniqstr_list(args: &[PerlValue]) -> crate::error::PerlResult<PerlValue> {
474 let mut out = Vec::new();
475 let mut prev: Option<String> = None;
476 let mut have = false;
477 for x in args.iter().cloned() {
478 let s = x.to_string();
479 if !have || prev.as_ref() != Some(&s) {
480 out.push(x);
481 prev = Some(s);
482 have = true;
483 }
484 }
485 Ok(PerlValue::array(out))
486}
487
488fn uniqint_with_want(
489 args: &[PerlValue],
490 want: WantarrayCtx,
491) -> crate::error::PerlResult<PerlValue> {
492 let a = uniqint_list(args)?;
493 if want == WantarrayCtx::Scalar {
494 if let Some(x) = a.as_array_vec() {
495 return Ok(PerlValue::integer(x.len() as i64));
496 }
497 }
498 Ok(a)
499}
500
501fn uniqint_list(args: &[PerlValue]) -> crate::error::PerlResult<PerlValue> {
502 let mut out = Vec::new();
503 let mut prev: Option<i64> = None;
504 let mut have = false;
505 for x in args {
506 let n = x.to_int();
507 if !have || prev != Some(n) {
508 out.push(PerlValue::integer(n));
509 prev = Some(n);
510 have = true;
511 }
512 }
513 Ok(PerlValue::array(out))
514}
515
516fn num_eq(a: f64, b: f64) -> bool {
517 if a.is_nan() && b.is_nan() {
518 return true;
519 }
520 a == b
521}
522
523fn uniqnum_with_want(
524 args: &[PerlValue],
525 want: WantarrayCtx,
526) -> crate::error::PerlResult<PerlValue> {
527 let a = uniqnum_list(args)?;
528 if want == WantarrayCtx::Scalar {
529 if let Some(x) = a.as_array_vec() {
530 return Ok(PerlValue::integer(x.len() as i64));
531 }
532 }
533 Ok(a)
534}
535
536fn uniqnum_list(args: &[PerlValue]) -> crate::error::PerlResult<PerlValue> {
537 let mut out = Vec::new();
538 let mut prev: Option<f64> = None;
539 let mut have = false;
540 for x in args.iter().cloned() {
541 let n = x.to_number();
542 if !have || !num_eq(prev.unwrap(), n) {
543 out.push(x);
544 prev = Some(n);
545 have = true;
546 }
547 }
548 Ok(PerlValue::array(out))
549}
550
551fn sum(args: &[PerlValue]) -> crate::error::PerlResult<PerlValue> {
552 if args.is_empty() {
553 return Ok(PerlValue::UNDEF);
554 }
555 let mut s = 0.0;
556 for x in args {
557 if x.is_iterator() {
558 let iter = x.clone().into_iterator();
559 while let Some(item) = iter.next_item() {
560 s += item.to_number();
561 }
562 } else if let Some(arr) = x.as_array_vec() {
563 for item in arr {
564 s += item.to_number();
565 }
566 } else {
567 s += x.to_number();
568 }
569 }
570 Ok(PerlValue::float(s))
571}
572
573fn sum0(args: &[PerlValue]) -> crate::error::PerlResult<PerlValue> {
574 let mut s = 0.0;
575 for x in args {
576 if x.is_iterator() {
577 let iter = x.clone().into_iterator();
578 while let Some(item) = iter.next_item() {
579 s += item.to_number();
580 }
581 } else if let Some(arr) = x.as_array_vec() {
582 for item in arr {
583 s += item.to_number();
584 }
585 } else {
586 s += x.to_number();
587 }
588 }
589 Ok(PerlValue::float(s))
590}
591
592fn product(args: &[PerlValue]) -> crate::error::PerlResult<PerlValue> {
593 let mut p = 1.0;
594 for x in args {
595 if x.is_iterator() {
596 let iter = x.clone().into_iterator();
597 while let Some(item) = iter.next_item() {
598 p *= item.to_number();
599 }
600 } else if let Some(arr) = x.as_array_vec() {
601 for item in arr {
602 p *= item.to_number();
603 }
604 } else {
605 p *= x.to_number();
606 }
607 }
608 Ok(PerlValue::float(p))
609}
610
611fn mean(args: &[PerlValue]) -> crate::error::PerlResult<PerlValue> {
613 if args.is_empty() {
614 return Ok(PerlValue::UNDEF);
615 }
616 let n = args.len() as f64;
617 let s: f64 = args.iter().map(|x| x.to_number()).sum();
618 Ok(PerlValue::float(s / n))
619}
620
621fn median(args: &[PerlValue]) -> crate::error::PerlResult<PerlValue> {
623 if args.is_empty() {
624 return Ok(PerlValue::UNDEF);
625 }
626 let mut v: Vec<f64> = args.iter().map(|x| x.to_number()).collect();
627 v.sort_by(|a, b| a.total_cmp(b));
628 let n = v.len();
629 let mid = if n % 2 == 1 {
630 v[n / 2]
631 } else {
632 (v[n / 2 - 1] + v[n / 2]) / 2.0
633 };
634 Ok(PerlValue::float(mid))
635}
636
637fn mode_with_want(args: &[PerlValue], want: WantarrayCtx) -> crate::error::PerlResult<PerlValue> {
639 if args.is_empty() {
640 return Ok(match want {
641 WantarrayCtx::List => PerlValue::array(vec![]),
642 WantarrayCtx::Scalar | WantarrayCtx::Void => PerlValue::UNDEF,
643 });
644 }
645 let nums: Vec<f64> = args.iter().map(|x| x.to_number()).collect();
646 let mut idx: Vec<usize> = (0..args.len()).collect();
647 idx.sort_by(|&i, &j| nums[i].total_cmp(&nums[j]));
648 let mut best_len = 0usize;
649 let mut mode_starts: Vec<usize> = Vec::new();
650 let mut i = 0;
651 while i < idx.len() {
652 let mut j = i + 1;
653 while j < idx.len() && num_eq(nums[idx[i]], nums[idx[j]]) {
654 j += 1;
655 }
656 let run_len = j - i;
657 if run_len > best_len {
658 best_len = run_len;
659 mode_starts.clear();
660 mode_starts.push(idx[i]);
661 } else if run_len == best_len {
662 mode_starts.push(idx[i]);
663 }
664 i = j;
665 }
666 let modes: Vec<PerlValue> = mode_starts.into_iter().map(|ix| args[ix].clone()).collect();
667 let first = modes.first().cloned().unwrap_or(PerlValue::UNDEF);
668 Ok(match want {
669 WantarrayCtx::List => PerlValue::array(modes),
670 WantarrayCtx::Scalar => first,
671 WantarrayCtx::Void => PerlValue::UNDEF,
672 })
673}
674
675fn variance(args: &[PerlValue]) -> crate::error::PerlResult<PerlValue> {
677 if args.is_empty() {
678 return Ok(PerlValue::UNDEF);
679 }
680 let n = args.len() as f64;
681 let mean_v: f64 = args.iter().map(|x| x.to_number()).sum::<f64>() / n;
682 let var: f64 = args
683 .iter()
684 .map(|x| {
685 let d = x.to_number() - mean_v;
686 d * d
687 })
688 .sum::<f64>()
689 / n;
690 Ok(PerlValue::float(var))
691}
692
693fn stddev(args: &[PerlValue]) -> crate::error::PerlResult<PerlValue> {
694 if args.is_empty() {
695 return Ok(PerlValue::UNDEF);
696 }
697 let var = variance(args)?;
698 Ok(PerlValue::float(var.to_number().sqrt()))
699}
700
701fn shuffle_native(
702 interp: &mut Interpreter,
703 args: &[PerlValue],
704) -> crate::error::PerlResult<PerlValue> {
705 let mut v: Vec<PerlValue> = args.to_vec();
706 v.shuffle(&mut interp.rand_rng);
707 Ok(PerlValue::array(v))
708}
709
710fn chunked_with_want(
713 args: &[PerlValue],
714 want: WantarrayCtx,
715) -> crate::error::PerlResult<PerlValue> {
716 if args.is_empty() {
717 return Err(crate::error::PerlError::runtime(
718 "List::Util::chunked: expected LIST, N",
719 0,
720 ));
721 }
722 let n = args[args.len() - 1].to_int().max(0) as usize;
725 let items: Vec<PerlValue> = args[..args.len().saturating_sub(1)].to_vec();
726 if n == 0 {
727 return Ok(match want {
728 WantarrayCtx::Scalar => PerlValue::integer(0),
729 _ => PerlValue::array(vec![]),
730 });
731 }
732 let mut chunk_refs = Vec::new();
733 let mut i = 0;
734 while i < items.len() {
735 let end = (i + n).min(items.len());
736 chunk_refs.push(PerlValue::array_ref(Arc::new(RwLock::new(
737 items[i..end].to_vec(),
738 ))));
739 i = end;
740 }
741 let n_chunks = chunk_refs.len() as i64;
742 let out = PerlValue::array(chunk_refs);
743 Ok(match want {
744 WantarrayCtx::Scalar => PerlValue::integer(n_chunks),
745 _ => out,
746 })
747}
748
749fn windowed_with_want(
753 args: &[PerlValue],
754 want: WantarrayCtx,
755) -> crate::error::PerlResult<PerlValue> {
756 if args.is_empty() {
757 return Err(crate::error::PerlError::runtime(
758 "List::Util::windowed: expected LIST, N",
759 0,
760 ));
761 }
762 let (n, items) = if args.len() == 1 {
764 (2usize, args[0].to_list())
765 } else {
766 let n = args[args.len() - 1].to_int().max(0) as usize;
767 let items: Vec<PerlValue> = args[..args.len().saturating_sub(1)].to_vec();
768 (n, items)
769 };
770 if n == 0 || items.len() < n {
771 return Ok(match want {
772 WantarrayCtx::Scalar => PerlValue::integer(0),
773 _ => PerlValue::array(vec![]),
774 });
775 }
776 let mut windows = Vec::new();
777 for i in 0..=(items.len() - n) {
778 windows.push(PerlValue::array_ref(Arc::new(RwLock::new(
779 items[i..i + n].to_vec(),
780 ))));
781 }
782 let nw = windows.len() as i64;
783 let out = PerlValue::array(windows);
784 Ok(match want {
785 WantarrayCtx::Scalar => PerlValue::integer(nw),
786 _ => out,
787 })
788}
789
790fn sample_native(
791 interp: &mut Interpreter,
792 args: &[PerlValue],
793) -> crate::error::PerlResult<PerlValue> {
794 if args.is_empty() {
795 return Ok(PerlValue::array(vec![]));
796 }
797 let n = args[0].to_int().max(0) as usize;
798 let mut pool: Vec<PerlValue> = args[1..].to_vec();
799 let mut out = Vec::new();
800 for _ in 0..n {
801 if pool.is_empty() {
802 break;
803 }
804 let j = interp.rand_rng.gen_range(0..pool.len());
805 out.push(pool.swap_remove(j));
806 }
807 Ok(PerlValue::array(out))
808}
809
810#[derive(Clone, Copy)]
811pub(crate) enum HeadTailTake {
812 Take,
814 ListUtilHead,
816 ListUtilTail,
818}
819
820pub(crate) fn head_tail_take_impl(
825 args: &[PerlValue],
826 kind: HeadTailTake,
827 want: WantarrayCtx,
828) -> crate::error::PerlResult<PerlValue> {
829 if args.is_empty() {
830 return Ok(match want {
831 WantarrayCtx::Scalar => PerlValue::UNDEF,
832 _ => PerlValue::array(vec![]),
833 });
834 }
835 let (raw, list) = if args.len() == 1 {
836 let mut list = Vec::new();
838 list.extend(args[0].to_list());
839 (1, list)
840 } else {
841 let raw = args[args.len() - 1].to_int();
843 let mut list = Vec::new();
844 for a in &args[..args.len() - 1] {
845 list.extend(a.to_list());
846 }
847 (raw, list)
848 };
849 let n = list.len() as i64;
850 let take_n = match kind {
851 HeadTailTake::Take => {
852 let size = raw.max(0);
853 size.min(n).max(0) as usize
854 }
855 HeadTailTake::ListUtilHead | HeadTailTake::ListUtilTail => {
856 let size = raw;
857 if size >= 0 {
858 size.min(n).max(0) as usize
859 } else {
860 let k = (-size).min(n);
861 (n - k) as usize
862 }
863 }
864 };
865 let out: Vec<PerlValue> = match kind {
866 HeadTailTake::Take | HeadTailTake::ListUtilHead => list.into_iter().take(take_n).collect(),
867 HeadTailTake::ListUtilTail => {
868 let len = list.len();
869 let skip = len.saturating_sub(take_n);
870 list.into_iter().skip(skip).collect()
871 }
872 };
873 Ok(match want {
874 WantarrayCtx::Scalar => out.last().cloned().unwrap_or(PerlValue::UNDEF),
875 _ => PerlValue::array(out),
876 })
877}
878
879pub(crate) fn extension_tail_impl(
883 args: &[PerlValue],
884 want: WantarrayCtx,
885) -> crate::error::PerlResult<PerlValue> {
886 if args.is_empty() {
887 return Ok(match want {
888 WantarrayCtx::Scalar => PerlValue::UNDEF,
889 _ => PerlValue::array(vec![]),
890 });
891 }
892 let raw = if args.len() == 1 {
894 1
895 } else {
896 args[args.len() - 1].to_int()
897 };
898 let mut list: Vec<PerlValue> = if args.len() == 1 {
899 args[0].to_list()
900 } else {
901 let mut list = Vec::new();
902 for a in &args[..args.len() - 1] {
903 list.extend(a.to_list());
904 }
905 list
906 };
907 if list.len() == 1 && list[0].is_string_like() {
908 let s = list[0].to_string();
909 if s.contains('\n') || s.contains('\r') {
910 list = s
911 .lines()
912 .map(|ln| PerlValue::string(ln.to_string()))
913 .collect();
914 }
915 }
916 let n = list.len() as i64;
917 let take_n = raw.max(0).min(n).max(0) as usize;
918 let len = list.len();
919 let skip = len.saturating_sub(take_n);
920 let out: Vec<PerlValue> = list.into_iter().skip(skip).collect();
921 Ok(match want {
922 WantarrayCtx::Scalar => out.last().cloned().unwrap_or(PerlValue::UNDEF),
923 _ => PerlValue::array(out),
924 })
925}
926
927pub(crate) fn extension_drop_impl(
931 args: &[PerlValue],
932 want: WantarrayCtx,
933) -> crate::error::PerlResult<PerlValue> {
934 if args.is_empty() {
935 return Ok(match want {
936 WantarrayCtx::Scalar => PerlValue::UNDEF,
937 _ => PerlValue::array(vec![]),
938 });
939 }
940 let raw = if args.len() == 1 {
942 1
943 } else {
944 args[args.len() - 1].to_int()
945 };
946 let mut list: Vec<PerlValue> = if args.len() == 1 {
947 args[0].to_list()
948 } else {
949 let mut list = Vec::new();
950 for a in &args[..args.len() - 1] {
951 list.extend(a.to_list());
952 }
953 list
954 };
955 if list.len() == 1 && list[0].is_string_like() {
956 let s = list[0].to_string();
957 if s.contains('\n') || s.contains('\r') {
958 list = s
959 .lines()
960 .map(|ln| PerlValue::string(ln.to_string()))
961 .collect();
962 }
963 }
964 let n = list.len();
965 let skip_n = raw.max(0).min(n as i64) as usize;
966 let out: Vec<PerlValue> = list.into_iter().skip(skip_n).collect();
967 Ok(match want {
968 WantarrayCtx::Scalar => out.last().cloned().unwrap_or(PerlValue::UNDEF),
969 _ => PerlValue::array(out),
970 })
971}
972
973fn reduce_like(
974 interp: &mut Interpreter,
975 args: &[PerlValue],
976 want: WantarrayCtx,
977 reductions: bool,
978) -> ExecResult {
979 let code = match args.first().and_then(|x| x.as_code_ref()) {
980 Some(s) => s,
981 _ => {
982 return Err(crate::error::PerlError::runtime(
983 "List::Util::reduce: first argument must be a CODE reference",
984 0,
985 )
986 .into());
987 }
988 };
989 let items: Vec<PerlValue> = args[1..].to_vec();
990 if items.is_empty() {
991 if reductions {
992 return Ok(PerlValue::array(vec![]));
993 }
994 return Ok(PerlValue::UNDEF);
995 }
996 if items.len() == 1 {
997 if reductions {
998 return Ok(PerlValue::array(vec![items[0].clone()]));
999 }
1000 return Ok(items[0].clone());
1001 }
1002 let mut acc = items[0].clone();
1003 let mut chain: Vec<PerlValue> = if reductions {
1004 vec![acc.clone()]
1005 } else {
1006 vec![]
1007 };
1008 for b in items.iter().skip(1) {
1009 let _ = interp.scope.set_scalar("a", acc.clone());
1010 let _ = interp.scope.set_scalar("b", b.clone());
1011 let _ = interp.scope.set_scalar("_0", acc.clone());
1012 let _ = interp.scope.set_scalar("_1", b.clone());
1013 acc = interp.call_sub(&code, vec![], WantarrayCtx::Scalar, 0)?;
1014 if reductions {
1015 chain.push(acc.clone());
1016 }
1017 }
1018 if reductions {
1019 if want == WantarrayCtx::Scalar {
1020 return Ok(chain.last().cloned().unwrap_or(PerlValue::UNDEF));
1021 }
1022 return Ok(PerlValue::array(chain));
1023 }
1024 Ok(acc)
1025}
1026
1027enum AnyMode {
1028 Any,
1029 All,
1030 None,
1031 NotAll,
1032}
1033
1034fn any_all_none(
1035 interp: &mut Interpreter,
1036 args: &[PerlValue],
1037 _want: WantarrayCtx,
1038 mode: AnyMode,
1039) -> ExecResult {
1040 let code = match args.first().and_then(|x| x.as_code_ref()) {
1041 Some(s) => s,
1042 _ => {
1043 return Err(crate::error::PerlError::runtime(
1044 "List::Util::any/all/...: first argument must be a CODE reference",
1045 0,
1046 )
1047 .into());
1048 }
1049 };
1050 let items: Vec<PerlValue> = args[1..].to_vec();
1051 let empty_ok = matches!(mode, AnyMode::All | AnyMode::None);
1052 if items.is_empty() {
1053 return Ok(PerlValue::integer(if empty_ok { 1 } else { 0 }));
1054 }
1055 for it in items {
1056 interp.scope.set_topic(it);
1057 let v = interp.call_sub(&code, vec![], WantarrayCtx::Scalar, 0)?;
1058 let t = v.is_true();
1059 match mode {
1060 AnyMode::Any if t => return Ok(PerlValue::integer(1)),
1061 AnyMode::All if !t => return Ok(PerlValue::integer(0)),
1062 AnyMode::None if t => return Ok(PerlValue::integer(0)),
1063 AnyMode::NotAll if !t => return Ok(PerlValue::integer(1)),
1064 _ => {}
1065 }
1066 }
1067 Ok(PerlValue::integer(match mode {
1068 AnyMode::Any => 0,
1069 AnyMode::All => 1,
1070 AnyMode::None => 1,
1071 AnyMode::NotAll => 0,
1072 }))
1073}
1074
1075fn first_native(interp: &mut Interpreter, args: &[PerlValue], _want: WantarrayCtx) -> ExecResult {
1076 let code = match args.first().and_then(|x| x.as_code_ref()) {
1077 Some(s) => s,
1078 _ => {
1079 return Err(crate::error::PerlError::runtime(
1080 "List::Util::first: first argument must be a CODE reference",
1081 0,
1082 )
1083 .into());
1084 }
1085 };
1086 let items: Vec<PerlValue> = args[1..].to_vec();
1087 for it in items {
1088 interp.scope.set_topic(it.clone());
1089 let v = interp.call_sub(&code, vec![], WantarrayCtx::Scalar, 0)?;
1090 if v.is_true() {
1091 return Ok(it);
1092 }
1093 }
1094 Ok(PerlValue::UNDEF)
1095}
1096
1097fn pairs_native(args: &[PerlValue]) -> crate::error::PerlResult<PerlValue> {
1098 let mut out = Vec::new();
1099 let mut i = 0;
1100 while i + 1 < args.len() {
1101 let row = vec![args[i].clone(), args[i + 1].clone()];
1102 let ar = PerlValue::array_ref(Arc::new(RwLock::new(row)));
1103 let b = PerlValue::blessed(Arc::new(BlessedRef::new_blessed(
1104 "List::Util::_Pair".to_string(),
1105 ar,
1106 )));
1107 out.push(b);
1108 i += 2;
1109 }
1110 Ok(PerlValue::array(out))
1111}
1112
1113fn unpairs_native(args: &[PerlValue]) -> crate::error::PerlResult<PerlValue> {
1114 let mut out = Vec::new();
1115 for x in args {
1116 if let Some(r) = x.as_array_ref() {
1117 let g = r.read();
1118 out.push(g.first().cloned().unwrap_or(PerlValue::UNDEF));
1119 out.push(g.get(1).cloned().unwrap_or(PerlValue::UNDEF));
1120 } else if let Some(b) = x.as_blessed_ref() {
1121 if b.class == "List::Util::_Pair" {
1122 let d = b.data.read();
1123 if let Some(r) = d.as_array_ref() {
1124 let g = r.read();
1125 out.push(g.first().cloned().unwrap_or(PerlValue::UNDEF));
1126 out.push(g.get(1).cloned().unwrap_or(PerlValue::UNDEF));
1127 }
1128 } else {
1129 out.push(PerlValue::UNDEF);
1130 out.push(PerlValue::UNDEF);
1131 }
1132 } else {
1133 out.push(PerlValue::UNDEF);
1134 out.push(PerlValue::UNDEF);
1135 }
1136 }
1137 Ok(PerlValue::array(out))
1138}
1139
1140fn pairkeys_values(keys: bool, args: &[PerlValue]) -> crate::error::PerlResult<PerlValue> {
1141 let mut out = Vec::new();
1142 let mut i = 0;
1143 while i + 1 < args.len() {
1144 out.push(if keys {
1145 args[i].clone()
1146 } else {
1147 args[i + 1].clone()
1148 });
1149 i += 2;
1150 }
1151 Ok(PerlValue::array(out))
1152}
1153
1154enum PairMode {
1155 Grep,
1156 Map,
1157 First,
1158}
1159
1160fn pairgrep_map(
1161 interp: &mut Interpreter,
1162 args: &[PerlValue],
1163 want: WantarrayCtx,
1164 mode: PairMode,
1165) -> ExecResult {
1166 let code = match args.first().and_then(|x| x.as_code_ref()) {
1167 Some(s) => s,
1168 _ => {
1169 return Err(crate::error::PerlError::runtime(
1170 "pairgrep/pairmap/pairfirst: first argument must be a CODE reference",
1171 0,
1172 )
1173 .into());
1174 }
1175 };
1176 let flat: Vec<PerlValue> = args[1..].to_vec();
1177 match mode {
1178 PairMode::Grep => {
1179 let mut out = Vec::new();
1180 let mut i = 0;
1181 while i + 1 < flat.len() {
1182 let a = flat[i].clone();
1183 let b = flat[i + 1].clone();
1184 let _ = interp.scope.set_scalar("a", a.clone());
1185 let _ = interp.scope.set_scalar("b", b.clone());
1186 let _ = interp.scope.set_scalar("_0", a.clone());
1187 let _ = interp.scope.set_scalar("_1", b.clone());
1188 let v = interp.call_sub(&code, vec![], WantarrayCtx::Scalar, 0)?;
1189 if v.is_true() {
1190 out.push(a);
1191 out.push(b);
1192 }
1193 i += 2;
1194 }
1195 if want == WantarrayCtx::Scalar {
1196 return Ok(PerlValue::integer((out.len() / 2) as i64));
1197 }
1198 Ok(PerlValue::array(out))
1199 }
1200 PairMode::Map => {
1201 let mut out = Vec::new();
1202 let mut i = 0;
1203 while i + 1 < flat.len() {
1204 let _ = interp.scope.set_scalar("a", flat[i].clone());
1205 let _ = interp.scope.set_scalar("b", flat[i + 1].clone());
1206 let _ = interp.scope.set_scalar("_0", flat[i].clone());
1207 let _ = interp.scope.set_scalar("_1", flat[i + 1].clone());
1208 let produced = interp.call_sub(&code, vec![], WantarrayCtx::List, 0)?;
1209 if let Some(items) = produced.as_array_vec() {
1210 out.extend(items);
1211 } else {
1212 out.push(produced);
1213 }
1214 i += 2;
1215 }
1216 if want == WantarrayCtx::Scalar {
1217 return Ok(PerlValue::integer(out.len() as i64));
1218 }
1219 Ok(PerlValue::array(out))
1220 }
1221 PairMode::First => {
1222 let mut i = 0;
1223 while i + 1 < flat.len() {
1224 let a = flat[i].clone();
1225 let b = flat[i + 1].clone();
1226 let _ = interp.scope.set_scalar("a", a.clone());
1227 let _ = interp.scope.set_scalar("b", b.clone());
1228 let _ = interp.scope.set_scalar("_0", a.clone());
1229 let _ = interp.scope.set_scalar("_1", b.clone());
1230 let v = interp.call_sub(&code, vec![], WantarrayCtx::Scalar, 0)?;
1231 if v.is_true() {
1232 if want == WantarrayCtx::Scalar {
1233 return Ok(PerlValue::integer(1));
1234 }
1235 return Ok(PerlValue::array(vec![a, b]));
1236 }
1237 i += 2;
1238 }
1239 if want == WantarrayCtx::Scalar {
1240 return Ok(PerlValue::integer(0));
1241 }
1242 Ok(PerlValue::array(vec![]))
1243 }
1244 }
1245}
1246
1247fn pair_accessor(args: &[PerlValue], idx: usize) -> crate::error::PerlResult<PerlValue> {
1248 let obj = args.first().ok_or_else(|| {
1249 crate::error::PerlError::runtime("List::Util::_Pair::key/value: missing invocant", 0)
1250 })?;
1251 pair_field(obj, idx)
1252}
1253
1254fn pair_field(obj: &PerlValue, idx: usize) -> crate::error::PerlResult<PerlValue> {
1255 let b = obj.as_blessed_ref().ok_or_else(|| {
1256 crate::error::PerlError::runtime("List::Util::_Pair::method: not a pair object", 0)
1257 })?;
1258 if b.class != "List::Util::_Pair" {
1259 return Err(crate::error::PerlError::runtime(
1260 "List::Util::_Pair::method: not a pair object",
1261 0,
1262 ));
1263 }
1264 let d = b.data.read();
1265 if let Some(r) = d.as_array_ref() {
1266 let g = r.read();
1267 return Ok(g.get(idx).cloned().unwrap_or(PerlValue::UNDEF));
1268 }
1269 Err(crate::error::PerlError::runtime(
1270 "List::Util::_Pair: internal data is not an ARRAY reference",
1271 0,
1272 ))
1273}
1274
1275fn pair_to_json(args: &[PerlValue]) -> crate::error::PerlResult<PerlValue> {
1276 let obj = args.first().ok_or_else(|| {
1277 crate::error::PerlError::runtime("List::Util::_Pair::TO_JSON: missing invocant", 0)
1278 })?;
1279 let k = pair_field(obj, 0)?;
1280 let v = pair_field(obj, 1)?;
1281 Ok(PerlValue::array(vec![k, v]))
1282}
1283
1284enum ZipMesh {
1285 ZipLongest,
1286 ZipShortest,
1287 MeshLongest,
1288 MeshShortest,
1289}
1290
1291fn zip_mesh(args: &[PerlValue], mode: ZipMesh) -> crate::error::PerlResult<PerlValue> {
1292 let arrays: Vec<Vec<PerlValue>> = args.iter().map(arg_to_list).collect();
1293 if arrays.is_empty() {
1294 return Ok(PerlValue::array(vec![]));
1295 }
1296 let min_len = arrays.iter().map(|a| a.len()).min().unwrap_or(0);
1297 let max_len = arrays.iter().map(|a| a.len()).max().unwrap_or(0);
1298 let len = match mode {
1299 ZipMesh::ZipShortest | ZipMesh::MeshShortest => min_len,
1300 ZipMesh::ZipLongest | ZipMesh::MeshLongest => max_len,
1301 };
1302 match mode {
1303 ZipMesh::ZipLongest | ZipMesh::ZipShortest => {
1304 let mut out = Vec::new();
1305 for i in 0..len {
1306 let mut row = Vec::new();
1307 for a in &arrays {
1308 row.push(a.get(i).cloned().unwrap_or(PerlValue::UNDEF));
1309 }
1310 out.push(PerlValue::array_ref(Arc::new(RwLock::new(row))));
1311 }
1312 Ok(PerlValue::array(out))
1313 }
1314 ZipMesh::MeshLongest | ZipMesh::MeshShortest => {
1315 let mut out = Vec::new();
1316 for i in 0..len {
1317 for a in &arrays {
1318 out.push(a.get(i).cloned().unwrap_or(PerlValue::UNDEF));
1319 }
1320 }
1321 Ok(PerlValue::array(out))
1322 }
1323 }
1324}
1325
1326fn arg_to_list(v: &PerlValue) -> Vec<PerlValue> {
1327 if let Some(a) = v.as_array_vec() {
1328 a
1329 } else if let Some(r) = v.as_array_ref() {
1330 r.read().clone()
1331 } else {
1332 vec![v.clone()]
1333 }
1334}
1335
1336#[cfg(test)]
1337mod tests {
1338 use super::*;
1339 use crate::interpreter::{Interpreter, WantarrayCtx};
1340 use crate::value::PerlValue;
1341
1342 fn call_native(
1343 interp: &mut Interpreter,
1344 fq: &str,
1345 args: &[PerlValue],
1346 want: WantarrayCtx,
1347 ) -> PerlValue {
1348 ensure_list_util(interp);
1349 let sub = interp
1350 .subs
1351 .get(fq)
1352 .unwrap_or_else(|| panic!("missing fn {fq}"))
1353 .clone();
1354 match native_dispatch(interp, &sub, args, want) {
1355 Some(Ok(v)) => v,
1356 Some(Err(e)) => panic!("{:?}", e),
1357 None => panic!("not a List::Util native: {fq}"),
1358 }
1359 }
1360
1361 #[test]
1362 fn sum_and_product() {
1363 let mut i = Interpreter::new();
1364 let s = call_native(
1365 &mut i,
1366 "List::Util::sum",
1367 &[
1368 PerlValue::integer(1),
1369 PerlValue::integer(2),
1370 PerlValue::integer(3),
1371 ],
1372 WantarrayCtx::Scalar,
1373 );
1374 assert_eq!(s.to_int(), 6);
1375 let p = call_native(
1376 &mut i,
1377 "List::Util::product",
1378 &[PerlValue::integer(2), PerlValue::integer(3)],
1379 WantarrayCtx::Scalar,
1380 );
1381 assert_eq!(p.to_int(), 6);
1382 }
1383
1384 #[test]
1385 fn sum_empty_is_undef_sum0_empty_is_zero() {
1386 let mut i = Interpreter::new();
1387 let s = call_native(&mut i, "List::Util::sum", &[], WantarrayCtx::Scalar);
1388 assert!(s.is_undef());
1389 let z = call_native(&mut i, "List::Util::sum0", &[], WantarrayCtx::Scalar);
1390 assert_eq!(z.to_int(), 0);
1391 }
1392
1393 #[test]
1394 fn product_empty_is_one() {
1395 let mut i = Interpreter::new();
1396 let p = call_native(&mut i, "List::Util::product", &[], WantarrayCtx::Scalar);
1397 assert_eq!(p.to_int(), 1);
1398 }
1399
1400 #[test]
1401 fn min_max_minstr_maxstr() {
1402 let mut i = Interpreter::new();
1403 let mn = call_native(
1404 &mut i,
1405 "List::Util::min",
1406 &[PerlValue::float(3.0), PerlValue::float(1.0)],
1407 WantarrayCtx::Scalar,
1408 );
1409 assert_eq!(mn.to_int(), 1);
1410 let mx = call_native(
1411 &mut i,
1412 "List::Util::max",
1413 &[PerlValue::integer(3), PerlValue::integer(9)],
1414 WantarrayCtx::Scalar,
1415 );
1416 assert_eq!(mx.to_int(), 9);
1417 let ms = call_native(
1418 &mut i,
1419 "List::Util::minstr",
1420 &[PerlValue::string("z".into()), PerlValue::string("a".into())],
1421 WantarrayCtx::Scalar,
1422 );
1423 assert_eq!(ms.to_string(), "a");
1424 }
1425
1426 #[test]
1427 fn mean_median_mode_variance_stddev() {
1428 let mut i = Interpreter::new();
1429 assert!(call_native(&mut i, "List::Util::mean", &[], WantarrayCtx::Scalar).is_undef());
1430 let m = call_native(
1431 &mut i,
1432 "List::Util::mean",
1433 &[
1434 PerlValue::integer(2),
1435 PerlValue::integer(4),
1436 PerlValue::integer(10),
1437 ],
1438 WantarrayCtx::Scalar,
1439 );
1440 assert!((m.to_number() - 16.0 / 3.0).abs() < 1e-9);
1441
1442 let med_odd = call_native(
1443 &mut i,
1444 "List::Util::median",
1445 &[
1446 PerlValue::integer(3),
1447 PerlValue::integer(1),
1448 PerlValue::integer(2),
1449 ],
1450 WantarrayCtx::Scalar,
1451 );
1452 assert_eq!(med_odd.to_int(), 2);
1453
1454 let med_even = call_native(
1455 &mut i,
1456 "List::Util::median",
1457 &[
1458 PerlValue::integer(10),
1459 PerlValue::integer(20),
1460 PerlValue::integer(30),
1461 PerlValue::integer(40),
1462 ],
1463 WantarrayCtx::Scalar,
1464 );
1465 assert!((med_even.to_number() - 25.0).abs() < 1e-9);
1466
1467 let mode_sc = call_native(
1468 &mut i,
1469 "List::Util::mode",
1470 &[
1471 PerlValue::integer(1),
1472 PerlValue::integer(2),
1473 PerlValue::integer(2),
1474 PerlValue::integer(3),
1475 ],
1476 WantarrayCtx::Scalar,
1477 );
1478 assert_eq!(mode_sc.to_int(), 2);
1479
1480 let mode_li = call_native(
1481 &mut i,
1482 "List::Util::mode",
1483 &[
1484 PerlValue::integer(1),
1485 PerlValue::integer(2),
1486 PerlValue::integer(2),
1487 PerlValue::integer(3),
1488 PerlValue::integer(3),
1489 ],
1490 WantarrayCtx::List,
1491 );
1492 let mv = mode_li.as_array_vec().expect("mode list");
1493 assert_eq!(mv.len(), 2);
1494 assert_eq!(mv[0].to_int(), 2);
1495 assert_eq!(mv[1].to_int(), 3);
1496
1497 let var_one = call_native(
1498 &mut i,
1499 "List::Util::variance",
1500 &[PerlValue::integer(5)],
1501 WantarrayCtx::Scalar,
1502 );
1503 assert_eq!(var_one.to_number(), 0.0);
1504
1505 let var_pop = call_native(
1506 &mut i,
1507 "List::Util::variance",
1508 &[
1509 PerlValue::integer(2),
1510 PerlValue::integer(4),
1511 PerlValue::integer(6),
1512 ],
1513 WantarrayCtx::Scalar,
1514 );
1515 assert!((var_pop.to_number() - 8.0 / 3.0).abs() < 1e-9);
1516
1517 let sd = call_native(
1518 &mut i,
1519 "List::Util::stddev",
1520 &[PerlValue::integer(0), PerlValue::integer(0)],
1521 WantarrayCtx::Scalar,
1522 );
1523 assert_eq!(sd.to_number(), 0.0);
1524 }
1525
1526 #[test]
1527 fn sum_product_min_max_list_context_returns_one_element_array() {
1528 let mut i = Interpreter::new();
1529 let args_sum = [
1530 PerlValue::integer(1),
1531 PerlValue::integer(2),
1532 PerlValue::integer(3),
1533 ];
1534 let ls = call_native(&mut i, "List::Util::sum", &args_sum, WantarrayCtx::List);
1535 let asum = ls.as_array_vec().expect("sum list");
1536 assert_eq!(asum.len(), 1);
1537 assert_eq!(asum[0].to_int(), 6);
1538
1539 let lp = call_native(
1540 &mut i,
1541 "List::Util::product",
1542 &[PerlValue::integer(2), PerlValue::integer(4)],
1543 WantarrayCtx::List,
1544 );
1545 let ap = lp.as_array_vec().expect("product list");
1546 assert_eq!(ap.len(), 1);
1547 assert_eq!(ap[0].to_int(), 8);
1548
1549 let lmn = call_native(
1550 &mut i,
1551 "List::Util::min",
1552 &[PerlValue::integer(9), PerlValue::integer(2)],
1553 WantarrayCtx::List,
1554 );
1555 assert_eq!(lmn.as_array_vec().unwrap()[0].to_int(), 2);
1556 let lmx = call_native(
1557 &mut i,
1558 "List::Util::max",
1559 &[PerlValue::integer(9), PerlValue::integer(2)],
1560 WantarrayCtx::List,
1561 );
1562 assert_eq!(lmx.as_array_vec().unwrap()[0].to_int(), 9);
1563 }
1564
1565 #[test]
1566 fn min_max_empty_undef() {
1567 let mut i = Interpreter::new();
1568 let mn = call_native(&mut i, "List::Util::min", &[], WantarrayCtx::Scalar);
1569 assert!(mn.is_undef());
1570 }
1571
1572 #[test]
1573 fn uniq_adjacent_strings() {
1574 let mut i = Interpreter::new();
1575 let u = call_native(
1576 &mut i,
1577 "List::Util::uniq",
1578 &[
1579 PerlValue::string("a".into()),
1580 PerlValue::string("a".into()),
1581 PerlValue::string("b".into()),
1582 ],
1583 WantarrayCtx::List,
1584 );
1585 let v = u.as_array_vec().expect("array");
1586 assert_eq!(v.len(), 2);
1587 assert_eq!(v[0].to_string(), "a");
1588 assert_eq!(v[1].to_string(), "b");
1589 }
1590
1591 #[test]
1592 fn uniqstr_compares_strings_not_dwim() {
1593 let mut i = Interpreter::new();
1594 let u = call_native(
1595 &mut i,
1596 "List::Util::uniqstr",
1597 &[PerlValue::string("01".into()), PerlValue::integer(1)],
1598 WantarrayCtx::List,
1599 );
1600 let v = u.as_array_vec().expect("array");
1601 assert_eq!(v.len(), 2);
1602 }
1603
1604 #[test]
1605 fn uniqint_coerces_to_int() {
1606 let mut i = Interpreter::new();
1607 let u = call_native(
1608 &mut i,
1609 "List::Util::uniqint",
1610 &[
1611 PerlValue::integer(2),
1612 PerlValue::integer(2),
1613 PerlValue::integer(3),
1614 ],
1615 WantarrayCtx::List,
1616 );
1617 let v = u.as_array_vec().expect("array");
1618 assert_eq!(v.len(), 2);
1619 assert_eq!(v[0].to_int(), 2);
1620 assert_eq!(v[1].to_int(), 3);
1621 }
1622
1623 #[test]
1624 fn chunked_splits_list_last_arg_is_size() {
1625 let mut i = Interpreter::new();
1626 let c = call_native(
1627 &mut i,
1628 "List::Util::chunked",
1629 &[
1630 PerlValue::integer(1),
1631 PerlValue::integer(2),
1632 PerlValue::integer(3),
1633 PerlValue::integer(4),
1634 PerlValue::integer(2),
1635 ],
1636 WantarrayCtx::List,
1637 );
1638 let rows = c.as_array_vec().expect("chunked list");
1639 assert_eq!(rows.len(), 2);
1640 let ar0 = rows[0].as_array_ref().expect("chunk");
1641 let r0 = ar0.read();
1642 assert_eq!(r0.len(), 2);
1643 assert_eq!(r0[0].to_int(), 1);
1644 assert_eq!(r0[1].to_int(), 2);
1645 let ar1 = rows[1].as_array_ref().expect("chunk");
1646 let r1 = ar1.read();
1647 assert_eq!(r1.len(), 2);
1648 assert_eq!(r1[0].to_int(), 3);
1649 assert_eq!(r1[1].to_int(), 4);
1650
1651 let ns = call_native(
1652 &mut i,
1653 "List::Util::chunked",
1654 &[
1655 PerlValue::integer(1),
1656 PerlValue::integer(2),
1657 PerlValue::integer(3),
1658 PerlValue::integer(2),
1659 ],
1660 WantarrayCtx::Scalar,
1661 );
1662 assert_eq!(ns.to_int(), 2);
1663 }
1664
1665 #[test]
1666 fn chunked_native_n_zero_and_empty_list() {
1667 let mut i = Interpreter::new();
1668 let z = call_native(
1669 &mut i,
1670 "List::Util::chunked",
1671 &[
1672 PerlValue::integer(1),
1673 PerlValue::integer(2),
1674 PerlValue::integer(0),
1675 ],
1676 WantarrayCtx::Scalar,
1677 );
1678 assert_eq!(z.to_int(), 0);
1679 let zl = call_native(
1680 &mut i,
1681 "List::Util::chunked",
1682 &[
1683 PerlValue::integer(1),
1684 PerlValue::integer(2),
1685 PerlValue::integer(0),
1686 ],
1687 WantarrayCtx::List,
1688 );
1689 assert!(zl.as_array_vec().is_some_and(|v| v.is_empty()));
1690
1691 let only_n = call_native(
1692 &mut i,
1693 "List::Util::chunked",
1694 &[PerlValue::integer(5)],
1695 WantarrayCtx::Scalar,
1696 );
1697 assert_eq!(only_n.to_int(), 0);
1698 }
1699
1700 #[test]
1701 fn chunked_native_chunk_size_exceeds_length() {
1702 let mut i = Interpreter::new();
1703 let c = call_native(
1704 &mut i,
1705 "List::Util::chunked",
1706 &[
1707 PerlValue::integer(1),
1708 PerlValue::integer(2),
1709 PerlValue::integer(99),
1710 ],
1711 WantarrayCtx::List,
1712 );
1713 let rows = c.as_array_vec().expect("chunks");
1714 assert_eq!(rows.len(), 1);
1715 let ar = rows[0].as_array_ref().expect("chunk");
1716 let r = ar.read();
1717 assert_eq!(r.len(), 2);
1718 assert_eq!(r[0].to_int(), 1);
1719 assert_eq!(r[1].to_int(), 2);
1720 }
1721
1722 #[test]
1723 fn windowed_overlapping_windows() {
1724 let mut i = Interpreter::new();
1725 let w = call_native(
1726 &mut i,
1727 "List::Util::windowed",
1728 &[
1729 PerlValue::integer(1),
1730 PerlValue::integer(2),
1731 PerlValue::integer(3),
1732 PerlValue::integer(2),
1733 ],
1734 WantarrayCtx::List,
1735 );
1736 let rows = w.as_array_vec().expect("windowed list");
1737 assert_eq!(rows.len(), 2);
1738 let ar0 = rows[0].as_array_ref().expect("win");
1739 let r0 = ar0.read();
1740 assert_eq!(r0.len(), 2);
1741 assert_eq!(r0[0].to_int(), 1);
1742 assert_eq!(r0[1].to_int(), 2);
1743 let ar1 = rows[1].as_array_ref().expect("win");
1744 let r1 = ar1.read();
1745 assert_eq!(r1[0].to_int(), 2);
1746 assert_eq!(r1[1].to_int(), 3);
1747 }
1748
1749 #[test]
1750 fn windowed_zero_n_empty() {
1751 let mut i = Interpreter::new();
1752 let w = call_native(
1753 &mut i,
1754 "List::Util::windowed",
1755 &[
1756 PerlValue::integer(1),
1757 PerlValue::integer(2),
1758 PerlValue::integer(0),
1759 ],
1760 WantarrayCtx::List,
1761 );
1762 assert!(w.as_array_vec().unwrap().is_empty());
1763 }
1764
1765 #[test]
1766 fn windowed_n_larger_than_list_empty() {
1767 let mut i = Interpreter::new();
1768 let w = call_native(
1769 &mut i,
1770 "List::Util::windowed",
1771 &[
1772 PerlValue::integer(1),
1773 PerlValue::integer(2),
1774 PerlValue::integer(5),
1775 ],
1776 WantarrayCtx::Scalar,
1777 );
1778 assert_eq!(w.to_int(), 0);
1779 }
1780
1781 #[test]
1782 fn windowed_single_full_width_window() {
1783 let mut i = Interpreter::new();
1784 let w = call_native(
1785 &mut i,
1786 "List::Util::windowed",
1787 &[
1788 PerlValue::integer(10),
1789 PerlValue::integer(20),
1790 PerlValue::integer(30),
1791 PerlValue::integer(3),
1792 ],
1793 WantarrayCtx::List,
1794 );
1795 let rows = w.as_array_vec().expect("one row");
1796 assert_eq!(rows.len(), 1);
1797 let ar = rows[0].as_array_ref().expect("win");
1798 let r = ar.read();
1799 assert_eq!(r.len(), 3);
1800 assert_eq!(r[0].to_int(), 10);
1801 assert_eq!(r[2].to_int(), 30);
1802 }
1803
1804 #[test]
1805 fn head_and_tail() {
1806 let mut i = Interpreter::new();
1807 let h = call_native(
1808 &mut i,
1809 "List::Util::head",
1810 &[
1811 PerlValue::integer(10),
1812 PerlValue::integer(20),
1813 PerlValue::integer(30),
1814 PerlValue::integer(2),
1815 ],
1816 WantarrayCtx::List,
1817 );
1818 let hv = h.as_array_vec().unwrap();
1819 assert_eq!(hv.len(), 2);
1820 assert_eq!(hv[0].to_int(), 10);
1821 let hs = call_native(
1822 &mut i,
1823 "List::Util::head",
1824 &[
1825 PerlValue::integer(10),
1826 PerlValue::integer(20),
1827 PerlValue::integer(30),
1828 PerlValue::integer(2),
1829 ],
1830 WantarrayCtx::Scalar,
1831 );
1832 assert_eq!(hs.to_int(), 20);
1833 let hn = call_native(
1834 &mut i,
1835 "List::Util::head",
1836 &[
1837 PerlValue::integer(1),
1838 PerlValue::integer(2),
1839 PerlValue::integer(3),
1840 PerlValue::integer(-1),
1841 ],
1842 WantarrayCtx::List,
1843 );
1844 let hnv = hn.as_array_vec().unwrap();
1845 assert_eq!(hnv.len(), 2);
1846 assert_eq!(hnv[0].to_int(), 1);
1847 assert_eq!(hnv[1].to_int(), 2);
1848 let t = call_native(
1849 &mut i,
1850 "List::Util::tail",
1851 &[
1852 PerlValue::integer(10),
1853 PerlValue::integer(20),
1854 PerlValue::integer(30),
1855 PerlValue::integer(2),
1856 ],
1857 WantarrayCtx::List,
1858 );
1859 let tv = t.as_array_vec().unwrap();
1860 assert_eq!(tv.len(), 2);
1861 assert_eq!(tv[1].to_int(), 30);
1862 let ts = call_native(
1863 &mut i,
1864 "List::Util::tail",
1865 &[
1866 PerlValue::integer(10),
1867 PerlValue::integer(20),
1868 PerlValue::integer(30),
1869 PerlValue::integer(2),
1870 ],
1871 WantarrayCtx::Scalar,
1872 );
1873 assert_eq!(ts.to_int(), 30);
1874 }
1875
1876 #[test]
1877 fn pairkeys_and_pairvalues() {
1878 let mut i = Interpreter::new();
1879 let k = call_native(
1880 &mut i,
1881 "List::Util::pairkeys",
1882 &[
1883 PerlValue::string("a".into()),
1884 PerlValue::integer(1),
1885 PerlValue::string("b".into()),
1886 PerlValue::integer(2),
1887 ],
1888 WantarrayCtx::List,
1889 );
1890 let kv = k.as_array_vec().unwrap();
1891 assert_eq!(kv.len(), 2);
1892 assert_eq!(kv[0].to_string(), "a");
1893 assert_eq!(kv[1].to_string(), "b");
1894 let vals = call_native(
1895 &mut i,
1896 "List::Util::pairvalues",
1897 &[
1898 PerlValue::string("a".into()),
1899 PerlValue::integer(1),
1900 PerlValue::string("b".into()),
1901 PerlValue::integer(2),
1902 ],
1903 WantarrayCtx::List,
1904 );
1905 let vv = vals.as_array_vec().unwrap();
1906 assert_eq!(vv[0].to_int(), 1);
1907 assert_eq!(vv[1].to_int(), 2);
1908 }
1909
1910 #[test]
1911 fn zip_shortest_two_lists() {
1912 let mut i = Interpreter::new();
1913 let z = call_native(
1914 &mut i,
1915 "List::Util::zip_shortest",
1916 &[
1917 PerlValue::array(vec![PerlValue::integer(1), PerlValue::integer(2)]),
1918 PerlValue::array(vec![PerlValue::integer(10)]),
1919 ],
1920 WantarrayCtx::List,
1921 );
1922 let rows = z.as_array_vec().unwrap();
1923 assert_eq!(rows.len(), 1);
1924 let row = rows[0].as_array_ref().expect("row ref");
1925 let g = row.read();
1926 assert_eq!(g.len(), 2);
1927 assert_eq!(g[0].to_int(), 1);
1928 assert_eq!(g[1].to_int(), 10);
1929 }
1930
1931 #[test]
1932 fn mesh_interleaves_rows() {
1933 let mut i = Interpreter::new();
1934 let m = call_native(
1935 &mut i,
1936 "List::Util::mesh_shortest",
1937 &[
1938 PerlValue::array(vec![PerlValue::integer(1), PerlValue::integer(2)]),
1939 PerlValue::array(vec![PerlValue::integer(10), PerlValue::integer(20)]),
1940 ],
1941 WantarrayCtx::List,
1942 );
1943 let v = m.as_array_vec().unwrap();
1944 assert_eq!(v.len(), 4);
1945 assert_eq!(v[0].to_int(), 1);
1946 assert_eq!(v[1].to_int(), 10);
1947 assert_eq!(v[2].to_int(), 2);
1948 assert_eq!(v[3].to_int(), 20);
1949 }
1950
1951 #[test]
1952 fn sample_without_pool_returns_empty() {
1953 let mut i = Interpreter::new();
1954 let s = call_native(
1955 &mut i,
1956 "List::Util::sample",
1957 &[PerlValue::integer(3)],
1958 WantarrayCtx::List,
1959 );
1960 let v = s.as_array_vec().unwrap();
1961 assert!(v.is_empty());
1962 }
1963
1964 #[test]
1965 fn sub_util_set_subname_returns_coderef_arg() {
1966 let mut i = Interpreter::new();
1967 let cr = PerlValue::integer(42);
1968 let out = call_native(
1969 &mut i,
1970 "Sub::Util::set_subname",
1971 &[PerlValue::string("main::foo".into()), cr.clone()],
1972 WantarrayCtx::Scalar,
1973 );
1974 assert_eq!(out.to_int(), 42);
1975 let out2 = call_native(
1976 &mut i,
1977 "Sub::Util::subname",
1978 &[PerlValue::string("main::bar".into()), cr],
1979 WantarrayCtx::Scalar,
1980 );
1981 assert_eq!(out2.to_int(), 42);
1982 }
1983}