This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade parent from version 0.232 to 0.234
[perl5.git] / cpan / Scalar-List-Utils / ListUtil.xs
CommitLineData
f4a2945e
JH
1/* Copyright (c) 1997-2000 Graham Barr <gbarr@pobox.com>. All rights reserved.
2 * This program is free software; you can redistribute it and/or
3 * modify it under the same terms as Perl itself.
4 */
4daffb2b 5#define PERL_NO_GET_CONTEXT /* we want efficiency */
f4a2945e
JH
6#include <EXTERN.h>
7#include <perl.h>
8#include <XSUB.h>
f4a2945e 9
3630f57e
CBW
10#define NEED_sv_2pv_flags 1
11#include "ppport.h"
92731555 12
3630f57e 13#if PERL_BCDVERSION >= 0x5006000
82f35e8b
RH
14# include "multicall.h"
15#endif
16
3630f57e
CBW
17#ifndef CvISXSUB
18# define CvISXSUB(cv) CvXSUB(cv)
9c3c560b 19#endif
3630f57e 20
9c3c560b
JH
21/* Some platforms have strict exports. And before 5.7.3 cxinc (or Perl_cxinc)
22 was not exported. Therefore platforms like win32, VMS etc have problems
23 so we redefine it here -- GMB
24*/
3630f57e 25#if PERL_BCDVERSION < 0x5007000
9c3c560b 26/* Not in 5.6.1. */
9c3c560b
JH
27# ifdef cxinc
28# undef cxinc
29# endif
30# define cxinc() my_cxinc(aTHX)
31static I32
32my_cxinc(pTHX)
33{
34 cxstack_max = cxstack_max * 3 / 2;
3630f57e 35 Renew(cxstack, cxstack_max + 1, struct context); /* fencepost bug in older CXINC macros requires +1 here */
9c3c560b
JH
36 return cxstack_ix + 1;
37}
1bfb5477
GB
38#endif
39
3630f57e
CBW
40#ifndef sv_copypv
41#define sv_copypv(a, b) my_sv_copypv(aTHX_ a, b)
42static void
43my_sv_copypv(pTHX_ SV *const dsv, SV *const ssv)
44{
45 STRLEN len;
46 const char * const s = SvPV_const(ssv,len);
47 sv_setpvn(dsv,s,len);
98eca5fa 48 if(SvUTF8(ssv))
3630f57e
CBW
49 SvUTF8_on(dsv);
50 else
51 SvUTF8_off(dsv);
52}
1bfb5477
GB
53#endif
54
60f3865b 55#ifdef SVf_IVisUV
b9ae0a2d 56# define slu_sv_value(sv) (SvIOK(sv)) ? (SvIOK_UV(sv)) ? (NV)(SvUVX(sv)) : (NV)(SvIVX(sv)) : (SvNV(sv))
60f3865b 57#else
aaaf1885 58# define slu_sv_value(sv) (SvIOK(sv)) ? (NV)(SvIVX(sv)) : (SvNV(sv))
60f3865b
GB
59#endif
60
c9612cb4
CBW
61#if PERL_VERSION < 13 || (PERL_VERSION == 13 && PERL_SUBVERSION < 9)
62# define PERL_HAS_BAD_MULTICALL_REFCOUNT
63#endif
64
8c167fd9
CBW
65#if PERL_VERSION < 14
66# define croak_no_modify() croak("%s", PL_no_modify)
67#endif
68
b823713c
CBW
69enum slu_accum {
70 ACC_IV,
71 ACC_NV,
72 ACC_SV,
73};
74
75static enum slu_accum accum_type(SV *sv) {
76 if(SvAMAGIC(sv))
77 return ACC_SV;
78
79 if(SvIOK(sv) && !SvNOK(sv) && !SvUOK(sv))
80 return ACC_IV;
81
82 return ACC_NV;
83}
84
d81c2d6a
CBW
85/* Magic for set_subname */
86static MGVTBL subname_vtbl;
87
98eca5fa 88MODULE=List::Util PACKAGE=List::Util
f4a2945e
JH
89
90void
91min(...)
92PROTOTYPE: @
93ALIAS:
94 min = 0
95 max = 1
96CODE:
97{
98 int index;
99 NV retval;
100 SV *retsv;
2ff28616 101 int magic;
98eca5fa
SH
102
103 if(!items)
104 XSRETURN_UNDEF;
105
f4a2945e 106 retsv = ST(0);
2ff28616 107 magic = SvAMAGIC(retsv);
98eca5fa 108 if(!magic)
2ff28616 109 retval = slu_sv_value(retsv);
98eca5fa 110
f4a2945e 111 for(index = 1 ; index < items ; index++) {
98eca5fa 112 SV *stacksv = ST(index);
2ff28616 113 SV *tmpsv;
98eca5fa
SH
114 if((magic || SvAMAGIC(stacksv)) && (tmpsv = amagic_call(retsv, stacksv, gt_amg, 0))) {
115 if(SvTRUE(tmpsv) ? !ix : ix) {
2ff28616
GB
116 retsv = stacksv;
117 magic = SvAMAGIC(retsv);
98eca5fa 118 if(!magic) {
2ff28616
GB
119 retval = slu_sv_value(retsv);
120 }
121 }
122 }
123 else {
124 NV val = slu_sv_value(stacksv);
98eca5fa 125 if(magic) {
2ff28616
GB
126 retval = slu_sv_value(retsv);
127 magic = 0;
128 }
129 if(val < retval ? !ix : ix) {
130 retsv = stacksv;
131 retval = val;
132 }
133 }
f4a2945e
JH
134 }
135 ST(0) = retsv;
136 XSRETURN(1);
137}
138
139
2ff28616 140void
f4a2945e
JH
141sum(...)
142PROTOTYPE: @
98eca5fa
SH
143ALIAS:
144 sum = 0
145 sum0 = 1
146 product = 2
f4a2945e
JH
147CODE:
148{
3630f57e 149 dXSTARG;
60f3865b 150 SV *sv;
b823713c
CBW
151 IV retiv = 0;
152 NV retnv = 0.0;
2ff28616 153 SV *retsv = NULL;
f4a2945e 154 int index;
b823713c 155 enum slu_accum accum;
98eca5fa 156 int is_product = (ix == 2);
b823713c 157 SV *tmpsv;
98eca5fa
SH
158
159 if(!items)
160 switch(ix) {
161 case 0: XSRETURN_UNDEF;
162 case 1: ST(0) = newSViv(0); XSRETURN(1);
163 case 2: ST(0) = newSViv(1); XSRETURN(1);
164 }
165
3630f57e 166 sv = ST(0);
b823713c
CBW
167 switch((accum = accum_type(sv))) {
168 case ACC_SV:
3630f57e 169 retsv = TARG;
2ff28616 170 sv_setsv(retsv, sv);
b823713c
CBW
171 break;
172 case ACC_IV:
173 retiv = SvIV(sv);
174 break;
175 case ACC_NV:
176 retnv = slu_sv_value(sv);
177 break;
2ff28616 178 }
98eca5fa 179
f4a2945e 180 for(index = 1 ; index < items ; index++) {
3630f57e 181 sv = ST(index);
b823713c 182 if(accum < ACC_SV && SvAMAGIC(sv)){
98eca5fa 183 if(!retsv)
3630f57e 184 retsv = TARG;
b823713c
CBW
185 sv_setnv(retsv, accum == ACC_NV ? retnv : retiv);
186 accum = ACC_SV;
3630f57e 187 }
b823713c
CBW
188 switch(accum) {
189 case ACC_SV:
190 tmpsv = amagic_call(retsv, sv,
98eca5fa
SH
191 is_product ? mult_amg : add_amg,
192 SvAMAGIC(retsv) ? AMGf_assign : 0);
3630f57e 193 if(tmpsv) {
b823713c
CBW
194 switch((accum = accum_type(tmpsv))) {
195 case ACC_SV:
3630f57e 196 retsv = tmpsv;
b823713c
CBW
197 break;
198 case ACC_IV:
199 retiv = SvIV(tmpsv);
200 break;
201 case ACC_NV:
202 retnv = slu_sv_value(tmpsv);
203 break;
3630f57e 204 }
2ff28616 205 }
3630f57e
CBW
206 else {
207 /* fall back to default */
b823713c
CBW
208 accum = ACC_NV;
209 is_product ? (retnv = SvNV(retsv) * SvNV(sv))
210 : (retnv = SvNV(retsv) + SvNV(sv));
2ff28616 211 }
b823713c
CBW
212 break;
213 case ACC_IV:
214 if(is_product) {
215 if(!SvNOK(sv) && SvIOK(sv) && (SvIV(sv) < IV_MAX / retiv)) {
216 retiv *= SvIV(sv);
217 break;
218 }
219 /* else fallthrough */
220 }
221 else {
222 if(!SvNOK(sv) && SvIOK(sv) && (SvIV(sv) < IV_MAX - retiv)) {
223 retiv += SvIV(sv);
224 break;
225 }
226 /* else fallthrough */
227 }
228
229 /* fallthrough to NV now */
230 retnv = retiv;
231 accum = ACC_NV;
232 case ACC_NV:
233 is_product ? (retnv *= slu_sv_value(sv))
234 : (retnv += slu_sv_value(sv));
235 break;
2ff28616
GB
236 }
237 }
b823713c
CBW
238
239 if(!retsv)
240 retsv = TARG;
241
242 switch(accum) {
d81c2d6a
CBW
243 case ACC_SV: /* nothing to do */
244 break;
b823713c
CBW
245 case ACC_IV:
246 sv_setiv(retsv, retiv);
247 break;
248 case ACC_NV:
249 sv_setnv(retsv, retnv);
250 break;
f4a2945e 251 }
98eca5fa 252
2ff28616
GB
253 ST(0) = retsv;
254 XSRETURN(1);
f4a2945e 255}
f4a2945e 256
3630f57e
CBW
257#define SLU_CMP_LARGER 1
258#define SLU_CMP_SMALLER -1
f4a2945e
JH
259
260void
261minstr(...)
262PROTOTYPE: @
263ALIAS:
3630f57e
CBW
264 minstr = SLU_CMP_LARGER
265 maxstr = SLU_CMP_SMALLER
f4a2945e
JH
266CODE:
267{
268 SV *left;
269 int index;
98eca5fa
SH
270
271 if(!items)
272 XSRETURN_UNDEF;
273
f4a2945e
JH
274 left = ST(0);
275#ifdef OPpLOCALE
276 if(MAXARG & OPpLOCALE) {
98eca5fa
SH
277 for(index = 1 ; index < items ; index++) {
278 SV *right = ST(index);
279 if(sv_cmp_locale(left, right) == ix)
280 left = right;
281 }
f4a2945e
JH
282 }
283 else {
284#endif
98eca5fa
SH
285 for(index = 1 ; index < items ; index++) {
286 SV *right = ST(index);
287 if(sv_cmp(left, right) == ix)
288 left = right;
289 }
f4a2945e
JH
290#ifdef OPpLOCALE
291 }
292#endif
293 ST(0) = left;
294 XSRETURN(1);
295}
296
297
298
82f35e8b 299
f4a2945e
JH
300void
301reduce(block,...)
98eca5fa 302 SV *block
f4a2945e
JH
303PROTOTYPE: &@
304CODE:
305{
09c2a9b8 306 SV *ret = sv_newmortal();
f4a2945e 307 int index;
f4a2945e
JH
308 GV *agv,*bgv,*gv;
309 HV *stash;
9850bf21 310 SV **args = &PL_stack_base[ax];
98eca5fa 311 CV *cv = sv_2cv(block, &stash, &gv, 0);
1bfb5477 312
98eca5fa
SH
313 if(cv == Nullcv)
314 croak("Not a subroutine reference");
3630f57e 315
98eca5fa
SH
316 if(items <= 1)
317 XSRETURN_UNDEF;
3630f57e
CBW
318
319 agv = gv_fetchpv("a", GV_ADD, SVt_PV);
320 bgv = gv_fetchpv("b", GV_ADD, SVt_PV);
f4a2945e
JH
321 SAVESPTR(GvSV(agv));
322 SAVESPTR(GvSV(bgv));
09c2a9b8 323 GvSV(agv) = ret;
46274848 324 SvSetMagicSV(ret, args[1]);
98eca5fa 325#ifdef dMULTICALL
3630f57e
CBW
326 if(!CvISXSUB(cv)) {
327 dMULTICALL;
328 I32 gimme = G_SCALAR;
329
330 PUSH_MULTICALL(cv);
331 for(index = 2 ; index < items ; index++) {
332 GvSV(bgv) = args[index];
333 MULTICALL;
46274848 334 SvSetMagicSV(ret, *PL_stack_sp);
3630f57e 335 }
98eca5fa
SH
336# ifdef PERL_HAS_BAD_MULTICALL_REFCOUNT
337 if(CvDEPTH(multicall_cv) > 1)
338 SvREFCNT_inc_simple_void_NN(multicall_cv);
339# endif
3630f57e 340 POP_MULTICALL;
f4a2945e 341 }
98eca5fa
SH
342 else
343#endif
344 {
3630f57e
CBW
345 for(index = 2 ; index < items ; index++) {
346 dSP;
347 GvSV(bgv) = args[index];
348
349 PUSHMARK(SP);
350 call_sv((SV*)cv, G_SCALAR);
351
46274848 352 SvSetMagicSV(ret, *PL_stack_sp);
3630f57e
CBW
353 }
354 }
355
09c2a9b8 356 ST(0) = ret;
f4a2945e
JH
357 XSRETURN(1);
358}
359
360void
361first(block,...)
98eca5fa 362 SV *block
f4a2945e
JH
363PROTOTYPE: &@
364CODE:
365{
f4a2945e 366 int index;
f4a2945e
JH
367 GV *gv;
368 HV *stash;
9850bf21 369 SV **args = &PL_stack_base[ax];
3630f57e 370 CV *cv = sv_2cv(block, &stash, &gv, 0);
1bfb5477 371
98eca5fa
SH
372 if(cv == Nullcv)
373 croak("Not a subroutine reference");
3630f57e 374
98eca5fa
SH
375 if(items <= 1)
376 XSRETURN_UNDEF;
60f3865b 377
98eca5fa
SH
378 SAVESPTR(GvSV(PL_defgv));
379#ifdef dMULTICALL
3630f57e
CBW
380 if(!CvISXSUB(cv)) {
381 dMULTICALL;
382 I32 gimme = G_SCALAR;
383 PUSH_MULTICALL(cv);
384
385 for(index = 1 ; index < items ; index++) {
386 GvSV(PL_defgv) = args[index];
387 MULTICALL;
98eca5fa
SH
388 if(SvTRUEx(*PL_stack_sp)) {
389# ifdef PERL_HAS_BAD_MULTICALL_REFCOUNT
390 if(CvDEPTH(multicall_cv) > 1)
391 SvREFCNT_inc_simple_void_NN(multicall_cv);
392# endif
3630f57e
CBW
393 POP_MULTICALL;
394 ST(0) = ST(index);
395 XSRETURN(1);
396 }
397 }
98eca5fa
SH
398# ifdef PERL_HAS_BAD_MULTICALL_REFCOUNT
399 if(CvDEPTH(multicall_cv) > 1)
400 SvREFCNT_inc_simple_void_NN(multicall_cv);
401# endif
3630f57e
CBW
402 POP_MULTICALL;
403 }
98eca5fa
SH
404 else
405#endif
406 {
3630f57e
CBW
407 for(index = 1 ; index < items ; index++) {
408 dSP;
409 GvSV(PL_defgv) = args[index];
410
411 PUSHMARK(SP);
412 call_sv((SV*)cv, G_SCALAR);
98eca5fa 413 if(SvTRUEx(*PL_stack_sp)) {
3630f57e
CBW
414 ST(0) = ST(index);
415 XSRETURN(1);
416 }
417 }
f4a2945e
JH
418 }
419 XSRETURN_UNDEF;
420}
421
6a9ebaf3
SH
422
423void
52102bb4 424any(block,...)
98eca5fa 425 SV *block
52102bb4 426ALIAS:
98eca5fa
SH
427 none = 0
428 all = 1
429 any = 2
52102bb4
SH
430 notall = 3
431PROTOTYPE: &@
432PPCODE:
433{
98eca5fa
SH
434 int ret_true = !(ix & 2); /* return true at end of loop for none/all; false for any/notall */
435 int invert = (ix & 1); /* invert block test for all/notall */
52102bb4
SH
436 GV *gv;
437 HV *stash;
438 SV **args = &PL_stack_base[ax];
439 CV *cv = sv_2cv(block, &stash, &gv, 0);
98eca5fa
SH
440
441 if(cv == Nullcv)
442 croak("Not a subroutine reference");
52102bb4
SH
443
444 SAVESPTR(GvSV(PL_defgv));
445#ifdef dMULTICALL
446 if(!CvISXSUB(cv)) {
98eca5fa
SH
447 dMULTICALL;
448 I32 gimme = G_SCALAR;
449 int index;
450
451 PUSH_MULTICALL(cv);
452 for(index = 1; index < items; index++) {
453 GvSV(PL_defgv) = args[index];
454
455 MULTICALL;
456 if(SvTRUEx(*PL_stack_sp) ^ invert) {
457 POP_MULTICALL;
458 ST(0) = ret_true ? &PL_sv_no : &PL_sv_yes;
459 XSRETURN(1);
460 }
461 }
462 POP_MULTICALL;
52102bb4
SH
463 }
464 else
465#endif
466 {
98eca5fa
SH
467 int index;
468 for(index = 1; index < items; index++) {
469 dSP;
470 GvSV(PL_defgv) = args[index];
471
472 PUSHMARK(SP);
473 call_sv((SV*)cv, G_SCALAR);
474 if(SvTRUEx(*PL_stack_sp) ^ invert) {
475 ST(0) = ret_true ? &PL_sv_no : &PL_sv_yes;
476 XSRETURN(1);
477 }
478 }
52102bb4
SH
479 }
480
98eca5fa 481 ST(0) = ret_true ? &PL_sv_yes : &PL_sv_no;
52102bb4
SH
482 XSRETURN(1);
483}
484
485void
6a9ebaf3 486pairfirst(block,...)
98eca5fa 487 SV *block
6a9ebaf3
SH
488PROTOTYPE: &@
489PPCODE:
490{
491 GV *agv,*bgv,*gv;
492 HV *stash;
493 CV *cv = sv_2cv(block, &stash, &gv, 0);
494 I32 ret_gimme = GIMME_V;
e99e4210 495 int argi = 1; /* "shift" the block */
6a9ebaf3 496
cdc31f74 497 if(!(items % 2) && ckWARN(WARN_MISC))
98eca5fa 498 warn("Odd number of elements in pairfirst");
cdc31f74 499
6a9ebaf3
SH
500 agv = gv_fetchpv("a", GV_ADD, SVt_PV);
501 bgv = gv_fetchpv("b", GV_ADD, SVt_PV);
502 SAVESPTR(GvSV(agv));
503 SAVESPTR(GvSV(bgv));
504#ifdef dMULTICALL
505 if(!CvISXSUB(cv)) {
98eca5fa
SH
506 /* Since MULTICALL is about to move it */
507 SV **stack = PL_stack_base + ax;
6a9ebaf3 508
98eca5fa
SH
509 dMULTICALL;
510 I32 gimme = G_SCALAR;
6a9ebaf3 511
98eca5fa
SH
512 PUSH_MULTICALL(cv);
513 for(; argi < items; argi += 2) {
514 SV *a = GvSV(agv) = stack[argi];
515 SV *b = GvSV(bgv) = argi < items-1 ? stack[argi+1] : &PL_sv_undef;
6a9ebaf3 516
98eca5fa 517 MULTICALL;
6a9ebaf3
SH
518
519 if(!SvTRUEx(*PL_stack_sp))
98eca5fa
SH
520 continue;
521
522 POP_MULTICALL;
523 if(ret_gimme == G_ARRAY) {
524 ST(0) = sv_mortalcopy(a);
525 ST(1) = sv_mortalcopy(b);
526 XSRETURN(2);
527 }
528 else
529 XSRETURN_YES;
530 }
531 POP_MULTICALL;
532 XSRETURN(0);
6a9ebaf3
SH
533 }
534 else
535#endif
536 {
98eca5fa
SH
537 for(; argi < items; argi += 2) {
538 dSP;
539 SV *a = GvSV(agv) = ST(argi);
540 SV *b = GvSV(bgv) = argi < items-1 ? ST(argi+1) : &PL_sv_undef;
6a9ebaf3 541
98eca5fa
SH
542 PUSHMARK(SP);
543 call_sv((SV*)cv, G_SCALAR);
6a9ebaf3 544
98eca5fa 545 SPAGAIN;
6a9ebaf3
SH
546
547 if(!SvTRUEx(*PL_stack_sp))
98eca5fa
SH
548 continue;
549
550 if(ret_gimme == G_ARRAY) {
551 ST(0) = sv_mortalcopy(a);
552 ST(1) = sv_mortalcopy(b);
553 XSRETURN(2);
554 }
555 else
556 XSRETURN_YES;
557 }
6a9ebaf3
SH
558 }
559
560 XSRETURN(0);
561}
562
2dc8d725
CBW
563void
564pairgrep(block,...)
98eca5fa 565 SV *block
2dc8d725
CBW
566PROTOTYPE: &@
567PPCODE:
568{
569 GV *agv,*bgv,*gv;
570 HV *stash;
571 CV *cv = sv_2cv(block, &stash, &gv, 0);
6a9ebaf3 572 I32 ret_gimme = GIMME_V;
2dc8d725
CBW
573
574 /* This function never returns more than it consumed in arguments. So we
575 * can build the results "live", behind the arguments
576 */
e99e4210 577 int argi = 1; /* "shift" the block */
2dc8d725
CBW
578 int reti = 0;
579
cdc31f74 580 if(!(items % 2) && ckWARN(WARN_MISC))
98eca5fa 581 warn("Odd number of elements in pairgrep");
cdc31f74 582
2dc8d725
CBW
583 agv = gv_fetchpv("a", GV_ADD, SVt_PV);
584 bgv = gv_fetchpv("b", GV_ADD, SVt_PV);
585 SAVESPTR(GvSV(agv));
586 SAVESPTR(GvSV(bgv));
6a9ebaf3
SH
587#ifdef dMULTICALL
588 if(!CvISXSUB(cv)) {
98eca5fa
SH
589 /* Since MULTICALL is about to move it */
590 SV **stack = PL_stack_base + ax;
591 int i;
6a9ebaf3 592
98eca5fa
SH
593 dMULTICALL;
594 I32 gimme = G_SCALAR;
6a9ebaf3 595
98eca5fa
SH
596 PUSH_MULTICALL(cv);
597 for(; argi < items; argi += 2) {
598 SV *a = GvSV(agv) = stack[argi];
599 SV *b = GvSV(bgv) = argi < items-1 ? stack[argi+1] : &PL_sv_undef;
2dc8d725 600
98eca5fa 601 MULTICALL;
6a9ebaf3
SH
602
603 if(SvTRUEx(*PL_stack_sp)) {
98eca5fa
SH
604 if(ret_gimme == G_ARRAY) {
605 /* We can't mortalise yet or they'd be mortal too early */
606 stack[reti++] = newSVsv(a);
607 stack[reti++] = newSVsv(b);
608 }
609 else if(ret_gimme == G_SCALAR)
610 reti++;
611 }
612 }
613 POP_MULTICALL;
614
615 if(ret_gimme == G_ARRAY)
616 for(i = 0; i < reti; i++)
617 sv_2mortal(stack[i]);
6a9ebaf3
SH
618 }
619 else
620#endif
2dc8d725 621 {
98eca5fa
SH
622 for(; argi < items; argi += 2) {
623 dSP;
624 SV *a = GvSV(agv) = ST(argi);
625 SV *b = GvSV(bgv) = argi < items-1 ? ST(argi+1) : &PL_sv_undef;
2dc8d725 626
98eca5fa
SH
627 PUSHMARK(SP);
628 call_sv((SV*)cv, G_SCALAR);
2dc8d725 629
98eca5fa 630 SPAGAIN;
2dc8d725 631
6a9ebaf3 632 if(SvTRUEx(*PL_stack_sp)) {
98eca5fa
SH
633 if(ret_gimme == G_ARRAY) {
634 ST(reti++) = sv_mortalcopy(a);
635 ST(reti++) = sv_mortalcopy(b);
636 }
637 else if(ret_gimme == G_SCALAR)
638 reti++;
639 }
640 }
2dc8d725
CBW
641 }
642
6a9ebaf3 643 if(ret_gimme == G_ARRAY)
98eca5fa 644 XSRETURN(reti);
6a9ebaf3 645 else if(ret_gimme == G_SCALAR) {
98eca5fa
SH
646 ST(0) = newSViv(reti);
647 XSRETURN(1);
2dc8d725
CBW
648 }
649}
650
651void
652pairmap(block,...)
98eca5fa 653 SV *block
2dc8d725
CBW
654PROTOTYPE: &@
655PPCODE:
656{
657 GV *agv,*bgv,*gv;
658 HV *stash;
659 CV *cv = sv_2cv(block, &stash, &gv, 0);
660 SV **args_copy = NULL;
6a9ebaf3 661 I32 ret_gimme = GIMME_V;
2dc8d725 662
e99e4210 663 int argi = 1; /* "shift" the block */
2dc8d725
CBW
664 int reti = 0;
665
cdc31f74 666 if(!(items % 2) && ckWARN(WARN_MISC))
98eca5fa 667 warn("Odd number of elements in pairmap");
cdc31f74 668
2dc8d725
CBW
669 agv = gv_fetchpv("a", GV_ADD, SVt_PV);
670 bgv = gv_fetchpv("b", GV_ADD, SVt_PV);
671 SAVESPTR(GvSV(agv));
672 SAVESPTR(GvSV(bgv));
ad434879
SH
673/* This MULTICALL-based code appears to fail on perl 5.10.0 and 5.8.9
674 * Skip it on those versions (RT#87857)
675 */
676#if defined(dMULTICALL) && (PERL_BCDVERSION > 0x5010000 || PERL_BCDVERSION < 0x5008009)
6a9ebaf3 677 if(!CvISXSUB(cv)) {
98eca5fa
SH
678 /* Since MULTICALL is about to move it */
679 SV **stack = PL_stack_base + ax;
680 I32 ret_gimme = GIMME_V;
681 int i;
682
683 dMULTICALL;
684 I32 gimme = G_ARRAY;
685
686 PUSH_MULTICALL(cv);
687 for(; argi < items; argi += 2) {
688 SV *a = GvSV(agv) = args_copy ? args_copy[argi] : stack[argi];
689 SV *b = GvSV(bgv) = argi < items-1 ?
690 (args_copy ? args_copy[argi+1] : stack[argi+1]) :
691 &PL_sv_undef;
692 int count;
693
694 MULTICALL;
695 count = PL_stack_sp - PL_stack_base;
696
697 if(count > 2 && !args_copy) {
698 /* We can't return more than 2 results for a given input pair
699 * without trashing the remaining argmuents on the stack still
700 * to be processed. So, we'll copy them out to a temporary
701 * buffer and work from there instead.
702 * We didn't do this initially because in the common case, most
703 * code blocks will return only 1 or 2 items so it won't be
704 * necessary
705 */
706 int n_args = items - argi;
707 Newx(args_copy, n_args, SV *);
708 SAVEFREEPV(args_copy);
709
710 Copy(stack + argi, args_copy, n_args, SV *);
711
712 argi = 0;
713 items = n_args;
714 }
715
716 for(i = 0; i < count; i++)
717 stack[reti++] = newSVsv(PL_stack_sp[i - count + 1]);
718 }
719 POP_MULTICALL;
720
721 if(ret_gimme == G_ARRAY)
722 for(i = 0; i < reti; i++)
723 sv_2mortal(stack[i]);
6a9ebaf3
SH
724 }
725 else
726#endif
727 {
98eca5fa
SH
728 for(; argi < items; argi += 2) {
729 dSP;
730 SV *a = GvSV(agv) = args_copy ? args_copy[argi] : ST(argi);
731 SV *b = GvSV(bgv) = argi < items-1 ?
732 (args_copy ? args_copy[argi+1] : ST(argi+1)) :
733 &PL_sv_undef;
734 int count;
735 int i;
736
737 PUSHMARK(SP);
738 count = call_sv((SV*)cv, G_ARRAY);
739
740 SPAGAIN;
741
742 if(count > 2 && !args_copy && ret_gimme == G_ARRAY) {
743 int n_args = items - argi;
744 Newx(args_copy, n_args, SV *);
745 SAVEFREEPV(args_copy);
746
747 Copy(&ST(argi), args_copy, n_args, SV *);
748
749 argi = 0;
750 items = n_args;
751 }
752
753 if(ret_gimme == G_ARRAY)
754 for(i = 0; i < count; i++)
755 ST(reti++) = sv_mortalcopy(SP[i - count + 1]);
756 else
757 reti += count;
758
759 PUTBACK;
760 }
2dc8d725
CBW
761 }
762
cdc31f74 763 if(ret_gimme == G_ARRAY)
98eca5fa 764 XSRETURN(reti);
cdc31f74
CBW
765
766 ST(0) = sv_2mortal(newSViv(reti));
767 XSRETURN(1);
2dc8d725
CBW
768}
769
1bfb5477 770void
2dc8d725
CBW
771pairs(...)
772PROTOTYPE: @
773PPCODE:
774{
775 int argi = 0;
776 int reti = 0;
b823713c 777 HV *pairstash = get_hv("List::Util::_Pair::", GV_ADD);
2dc8d725 778
cdc31f74 779 if(items % 2 && ckWARN(WARN_MISC))
98eca5fa 780 warn("Odd number of elements in pairs");
cdc31f74 781
2dc8d725 782 {
98eca5fa
SH
783 for(; argi < items; argi += 2) {
784 SV *a = ST(argi);
785 SV *b = argi < items-1 ? ST(argi+1) : &PL_sv_undef;
2dc8d725 786
98eca5fa
SH
787 AV *av = newAV();
788 av_push(av, newSVsv(a));
789 av_push(av, newSVsv(b));
2dc8d725 790
b823713c
CBW
791 ST(reti) = sv_2mortal(newRV_noinc((SV *)av));
792 sv_bless(ST(reti), pairstash);
793 reti++;
98eca5fa 794 }
2dc8d725
CBW
795 }
796
797 XSRETURN(reti);
798}
799
800void
801pairkeys(...)
802PROTOTYPE: @
803PPCODE:
804{
805 int argi = 0;
806 int reti = 0;
807
cdc31f74 808 if(items % 2 && ckWARN(WARN_MISC))
98eca5fa 809 warn("Odd number of elements in pairkeys");
cdc31f74 810
2dc8d725 811 {
98eca5fa
SH
812 for(; argi < items; argi += 2) {
813 SV *a = ST(argi);
2dc8d725 814
98eca5fa
SH
815 ST(reti++) = sv_2mortal(newSVsv(a));
816 }
2dc8d725
CBW
817 }
818
819 XSRETURN(reti);
820}
821
822void
823pairvalues(...)
824PROTOTYPE: @
825PPCODE:
826{
827 int argi = 0;
828 int reti = 0;
829
cdc31f74 830 if(items % 2 && ckWARN(WARN_MISC))
98eca5fa 831 warn("Odd number of elements in pairvalues");
cdc31f74 832
2dc8d725 833 {
98eca5fa
SH
834 for(; argi < items; argi += 2) {
835 SV *b = argi < items-1 ? ST(argi+1) : &PL_sv_undef;
2dc8d725 836
98eca5fa
SH
837 ST(reti++) = sv_2mortal(newSVsv(b));
838 }
2dc8d725
CBW
839 }
840
841 XSRETURN(reti);
842}
843
844void
1bfb5477
GB
845shuffle(...)
846PROTOTYPE: @
847CODE:
848{
849 int index;
ddf53ba4 850#if (PERL_VERSION < 9)
1bfb5477
GB
851 struct op dmy_op;
852 struct op *old_op = PL_op;
1bfb5477 853
c29e891d
GB
854 /* We call pp_rand here so that Drand01 get initialized if rand()
855 or srand() has not already been called
856 */
1bfb5477 857 memzero((char*)(&dmy_op), sizeof(struct op));
f3548bdc
DM
858 /* we let pp_rand() borrow the TARG allocated for this XS sub */
859 dmy_op.op_targ = PL_op->op_targ;
1bfb5477 860 PL_op = &dmy_op;
20d72259 861 (void)*(PL_ppaddr[OP_RAND])(aTHX);
1bfb5477 862 PL_op = old_op;
82f35e8b
RH
863#else
864 /* Initialize Drand01 if rand() or srand() has
865 not already been called
866 */
98eca5fa 867 if(!PL_srand_called) {
82f35e8b
RH
868 (void)seedDrand01((Rand_seed_t)Perl_seed(aTHX));
869 PL_srand_called = TRUE;
870 }
871#endif
872
1bfb5477 873 for (index = items ; index > 1 ; ) {
98eca5fa
SH
874 int swap = (int)(Drand01() * (double)(index--));
875 SV *tmp = ST(swap);
876 ST(swap) = ST(index);
877 ST(index) = tmp;
1bfb5477 878 }
98eca5fa 879
1bfb5477
GB
880 XSRETURN(items);
881}
882
883
98eca5fa 884MODULE=List::Util PACKAGE=Scalar::Util
f4a2945e
JH
885
886void
887dualvar(num,str)
98eca5fa
SH
888 SV *num
889 SV *str
f4a2945e
JH
890PROTOTYPE: $$
891CODE:
892{
3630f57e 893 dXSTARG;
98eca5fa 894
3630f57e 895 (void)SvUPGRADE(TARG, SVt_PVNV);
98eca5fa 896
3630f57e 897 sv_copypv(TARG,str);
98eca5fa 898
1bfb5477 899 if(SvNOK(num) || SvPOK(num) || SvMAGICAL(num)) {
98eca5fa
SH
900 SvNV_set(TARG, SvNV(num));
901 SvNOK_on(TARG);
f4a2945e 902 }
1bfb5477 903#ifdef SVf_IVisUV
98eca5fa
SH
904 else if(SvUOK(num)) {
905 SvUV_set(TARG, SvUV(num));
906 SvIOK_on(TARG);
907 SvIsUV_on(TARG);
1bfb5477
GB
908 }
909#endif
f4a2945e 910 else {
98eca5fa
SH
911 SvIV_set(TARG, SvIV(num));
912 SvIOK_on(TARG);
f4a2945e 913 }
98eca5fa 914
f4a2945e 915 if(PL_tainting && (SvTAINTED(num) || SvTAINTED(str)))
98eca5fa
SH
916 SvTAINTED_on(TARG);
917
918 ST(0) = TARG;
f4a2945e
JH
919 XSRETURN(1);
920}
921
8b198969
CBW
922void
923isdual(sv)
98eca5fa 924 SV *sv
8b198969
CBW
925PROTOTYPE: $
926CODE:
98eca5fa
SH
927 if(SvMAGICAL(sv))
928 mg_get(sv);
929
8b198969
CBW
930 ST(0) = boolSV((SvPOK(sv) || SvPOKp(sv)) && (SvNIOK(sv) || SvNIOKp(sv)));
931 XSRETURN(1);
932
f4a2945e
JH
933char *
934blessed(sv)
98eca5fa 935 SV *sv
f4a2945e
JH
936PROTOTYPE: $
937CODE:
938{
3630f57e 939 SvGETMAGIC(sv);
98eca5fa
SH
940
941 if(!(SvROK(sv) && SvOBJECT(SvRV(sv))))
942 XSRETURN_UNDEF;
943
4a61a419 944 RETVAL = (char*)sv_reftype(SvRV(sv),TRUE);
f4a2945e
JH
945}
946OUTPUT:
947 RETVAL
948
949char *
950reftype(sv)
98eca5fa 951 SV *sv
f4a2945e
JH
952PROTOTYPE: $
953CODE:
954{
3630f57e 955 SvGETMAGIC(sv);
98eca5fa
SH
956 if(!SvROK(sv))
957 XSRETURN_UNDEF;
958
4a61a419 959 RETVAL = (char*)sv_reftype(SvRV(sv),FALSE);
f4a2945e
JH
960}
961OUTPUT:
962 RETVAL
963
bd1e762a 964UV
60f3865b 965refaddr(sv)
98eca5fa 966 SV *sv
60f3865b
GB
967PROTOTYPE: $
968CODE:
969{
3630f57e 970 SvGETMAGIC(sv);
98eca5fa
SH
971 if(!SvROK(sv))
972 XSRETURN_UNDEF;
973
bd1e762a 974 RETVAL = PTR2UV(SvRV(sv));
60f3865b
GB
975}
976OUTPUT:
977 RETVAL
978
f4a2945e
JH
979void
980weaken(sv)
98eca5fa 981 SV *sv
f4a2945e
JH
982PROTOTYPE: $
983CODE:
984#ifdef SvWEAKREF
98eca5fa 985 sv_rvweaken(sv);
f4a2945e 986#else
98eca5fa 987 croak("weak references are not implemented in this release of perl");
8c167fd9
CBW
988#endif
989
990void
991unweaken(sv)
992 SV *sv
993PROTOTYPE: $
994INIT:
995 SV *tsv;
996CODE:
997#ifdef SvWEAKREF
998 /* This code stolen from core's sv_rvweaken() and modified */
999 if (!SvOK(sv))
1000 return;
1001 if (!SvROK(sv))
1002 croak("Can't unweaken a nonreference");
1003 else if (!SvWEAKREF(sv)) {
6fbeaf2c
SH
1004 if(ckWARN(WARN_MISC))
1005 warn("Reference is not weak");
8c167fd9
CBW
1006 return;
1007 }
1008 else if (SvREADONLY(sv)) croak_no_modify();
1009
1010 tsv = SvRV(sv);
1011#if PERL_VERSION >= 14
1012 SvWEAKREF_off(sv); SvROK_on(sv);
1013 SvREFCNT_inc_NN(tsv);
1014 Perl_sv_del_backref(aTHX_ tsv, sv);
1015#else
1016 /* Lacking sv_del_backref() the best we can do is clear the old (weak) ref
1017 * then set a new strong one
1018 */
568d025d 1019 sv_setsv(sv, &PL_sv_undef);
8c167fd9
CBW
1020 SvRV_set(sv, SvREFCNT_inc_NN(tsv));
1021 SvROK_on(sv);
1022#endif
1023#else
1024 croak("weak references are not implemented in this release of perl");
f4a2945e
JH
1025#endif
1026
c6c619a9 1027void
f4a2945e 1028isweak(sv)
98eca5fa 1029 SV *sv
f4a2945e
JH
1030PROTOTYPE: $
1031CODE:
1032#ifdef SvWEAKREF
98eca5fa
SH
1033 ST(0) = boolSV(SvROK(sv) && SvWEAKREF(sv));
1034 XSRETURN(1);
f4a2945e 1035#else
98eca5fa 1036 croak("weak references are not implemented in this release of perl");
f4a2945e
JH
1037#endif
1038
1039int
1040readonly(sv)
98eca5fa 1041 SV *sv
f4a2945e
JH
1042PROTOTYPE: $
1043CODE:
98eca5fa
SH
1044 SvGETMAGIC(sv);
1045 RETVAL = SvREADONLY(sv);
f4a2945e 1046OUTPUT:
98eca5fa 1047 RETVAL
f4a2945e
JH
1048
1049int
1050tainted(sv)
98eca5fa 1051 SV *sv
f4a2945e
JH
1052PROTOTYPE: $
1053CODE:
98eca5fa
SH
1054 SvGETMAGIC(sv);
1055 RETVAL = SvTAINTED(sv);
f4a2945e 1056OUTPUT:
98eca5fa 1057 RETVAL
f4a2945e 1058
60f3865b
GB
1059void
1060isvstring(sv)
98eca5fa 1061 SV *sv
60f3865b
GB
1062PROTOTYPE: $
1063CODE:
1064#ifdef SvVOK
98eca5fa
SH
1065 SvGETMAGIC(sv);
1066 ST(0) = boolSV(SvVOK(sv));
1067 XSRETURN(1);
60f3865b 1068#else
98eca5fa 1069 croak("vstrings are not implemented in this release of perl");
60f3865b
GB
1070#endif
1071
d81c2d6a 1072SV *
9e7deb6c 1073looks_like_number(sv)
98eca5fa 1074 SV *sv
9e7deb6c
GB
1075PROTOTYPE: $
1076CODE:
98eca5fa
SH
1077 SV *tempsv;
1078 SvGETMAGIC(sv);
1079 if(SvAMAGIC(sv) && (tempsv = AMG_CALLun(sv, numer))) {
1080 sv = tempsv;
1081 }
3630f57e 1082#if PERL_BCDVERSION < 0x5008005
98eca5fa 1083 if(SvPOK(sv) || SvPOKp(sv)) {
d81c2d6a 1084 RETVAL = looks_like_number(sv) ? &PL_sv_yes : &PL_sv_no;
98eca5fa
SH
1085 }
1086 else {
d81c2d6a 1087 RETVAL = (SvFLAGS(sv) & (SVf_NOK|SVp_NOK|SVf_IOK|SVp_IOK)) ? &PL_sv_yes : &PL_sv_no;
98eca5fa 1088 }
4984adac 1089#else
d81c2d6a 1090 RETVAL = looks_like_number(sv) ? &PL_sv_yes : &PL_sv_no;
4984adac 1091#endif
9e7deb6c 1092OUTPUT:
98eca5fa 1093 RETVAL
9e7deb6c 1094
c5661c80 1095void
98eca5fa 1096openhandle(SV *sv)
3630f57e
CBW
1097PROTOTYPE: $
1098CODE:
1099{
98eca5fa 1100 IO *io = NULL;
3630f57e
CBW
1101 SvGETMAGIC(sv);
1102 if(SvROK(sv)){
1103 /* deref first */
1104 sv = SvRV(sv);
1105 }
1106
1107 /* must be GLOB or IO */
1108 if(isGV(sv)){
1109 io = GvIO((GV*)sv);
1110 }
1111 else if(SvTYPE(sv) == SVt_PVIO){
1112 io = (IO*)sv;
1113 }
1114
1115 if(io){
1116 /* real or tied filehandle? */
1117 if(IoIFP(io) || SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)){
1118 XSRETURN(1);
1119 }
1120 }
1121 XSRETURN_UNDEF;
1122}
1123
d81c2d6a
CBW
1124MODULE=List::Util PACKAGE=Sub::Util
1125
1126void
1127set_prototype(proto, code)
1128 SV *proto
1129 SV *code
1130PREINIT:
1131 SV *cv; /* not CV * */
1132PPCODE:
1133 SvGETMAGIC(code);
1134 if(!SvROK(code))
1135 croak("set_prototype: not a reference");
1136
1137 cv = SvRV(code);
1138 if(SvTYPE(cv) != SVt_PVCV)
1139 croak("set_prototype: not a subroutine reference");
1140
1141 if(SvPOK(proto)) {
1142 /* set the prototype */
1143 sv_copypv(cv, proto);
1144 }
1145 else {
1146 /* delete the prototype */
1147 SvPOK_off(cv);
1148 }
1149
1150 PUSHs(code);
1151 XSRETURN(1);
1152
1153void
1154set_subname(name, sub)
1155 char *name
1156 SV *sub
1157PREINIT:
1158 CV *cv = NULL;
1159 GV *gv;
1160 HV *stash = CopSTASH(PL_curcop);
1161 char *s, *end = NULL;
1162 MAGIC *mg;
1163PPCODE:
1164 if (!SvROK(sub) && SvGMAGICAL(sub))
1165 mg_get(sub);
1166 if (SvROK(sub))
1167 cv = (CV *) SvRV(sub);
1168 else if (SvTYPE(sub) == SVt_PVGV)
1169 cv = GvCVu(sub);
1170 else if (!SvOK(sub))
1171 croak(PL_no_usym, "a subroutine");
1172 else if (PL_op->op_private & HINT_STRICT_REFS)
1173 croak("Can't use string (\"%.32s\") as %s ref while \"strict refs\" in use",
1174 SvPV_nolen(sub), "a subroutine");
1175 else if ((gv = gv_fetchpv(SvPV_nolen(sub), FALSE, SVt_PVCV)))
1176 cv = GvCVu(gv);
1177 if (!cv)
1178 croak("Undefined subroutine %s", SvPV_nolen(sub));
1179 if (SvTYPE(cv) != SVt_PVCV && SvTYPE(cv) != SVt_PVFM)
1180 croak("Not a subroutine reference");
1181 for (s = name; *s++; ) {
1182 if (*s == ':' && s[-1] == ':')
1183 end = ++s;
1184 else if (*s && s[-1] == '\'')
1185 end = s;
1186 }
1187 s--;
1188 if (end) {
1189 char *namepv = savepvn(name, end - name);
1190 stash = GvHV(gv_fetchpv(namepv, TRUE, SVt_PVHV));
1191 Safefree(namepv);
1192 name = end;
1193 }
1194
1195 /* under debugger, provide information about sub location */
1196 if (PL_DBsub && CvGV(cv)) {
1197 HV *hv = GvHV(PL_DBsub);
1198
46274848 1199 char *new_pkg = HvNAME(stash);
d81c2d6a 1200
46274848
SH
1201 char *old_name = GvNAME( CvGV(cv) );
1202 char *old_pkg = HvNAME( GvSTASH(CvGV(cv)) );
d81c2d6a
CBW
1203
1204 int old_len = strlen(old_name) + strlen(old_pkg);
1205 int new_len = strlen(name) + strlen(new_pkg);
1206
46274848
SH
1207 SV **old_data;
1208 char *full_name;
1209
d81c2d6a
CBW
1210 Newxz(full_name, (old_len > new_len ? old_len : new_len) + 3, char);
1211
1212 strcat(full_name, old_pkg);
1213 strcat(full_name, "::");
1214 strcat(full_name, old_name);
1215
ca81d151 1216 old_data = hv_fetch(hv, full_name, strlen(full_name), 0);
d81c2d6a
CBW
1217
1218 if (old_data) {
1219 strcpy(full_name, new_pkg);
1220 strcat(full_name, "::");
1221 strcat(full_name, name);
1222
1223 SvREFCNT_inc(*old_data);
1224 if (!hv_store(hv, full_name, strlen(full_name), *old_data, 0))
1225 SvREFCNT_dec(*old_data);
1226 }
1227 Safefree(full_name);
1228 }
1229
1230 gv = (GV *) newSV(0);
1231 gv_init(gv, stash, name, s - name, TRUE);
1232
1233 /*
1234 * set_subname needs to create a GV to store the name. The CvGV field of a
1235 * CV is not refcounted, so perl wouldn't know to SvREFCNT_dec() this GV if
1236 * it destroys the containing CV. We use a MAGIC with an empty vtable
1237 * simply for the side-effect of using MGf_REFCOUNTED to store the
1238 * actually-counted reference to the GV.
1239 */
1240 mg = SvMAGIC(cv);
1241 while (mg && mg->mg_virtual != &subname_vtbl)
1242 mg = mg->mg_moremagic;
1243 if (!mg) {
1244 Newxz(mg, 1, MAGIC);
1245 mg->mg_moremagic = SvMAGIC(cv);
1246 mg->mg_type = PERL_MAGIC_ext;
1247 mg->mg_virtual = &subname_vtbl;
1248 SvMAGIC_set(cv, mg);
1249 }
1250 if (mg->mg_flags & MGf_REFCOUNTED)
1251 SvREFCNT_dec(mg->mg_obj);
1252 mg->mg_flags |= MGf_REFCOUNTED;
1253 mg->mg_obj = (SV *) gv;
1254 SvRMAGICAL_on(cv);
1255 CvANON_off(cv);
1256#ifndef CvGV_set
1257 CvGV(cv) = gv;
1258#else
1259 CvGV_set(cv, gv);
1260#endif
1261 PUSHs(sub);
1262
1263void
1264subname(code)
1265 SV *code
1266PREINIT:
1267 CV *cv;
1268 GV *gv;
1269PPCODE:
1270 if (!SvROK(code) && SvGMAGICAL(code))
1271 mg_get(code);
1272
1273 if(!SvROK(code) || SvTYPE(cv = (CV *)SvRV(code)) != SVt_PVCV)
1274 croak("Not a subroutine reference");
1275
1276 if(!(gv = CvGV(cv)))
1277 XSRETURN(0);
1278
1279 mPUSHs(newSVpvf("%s::%s", HvNAME(GvSTASH(gv)), GvNAME(gv)));
1280 XSRETURN(1);
1281
f4a2945e
JH
1282BOOT:
1283{
9850bf21
RH
1284 HV *lu_stash = gv_stashpvn("List::Util", 10, TRUE);
1285 GV *rmcgv = *(GV**)hv_fetch(lu_stash, "REAL_MULTICALL", 14, TRUE);
1286 SV *rmcsv;
60f3865b 1287#if !defined(SvWEAKREF) || !defined(SvVOK)
9850bf21
RH
1288 HV *su_stash = gv_stashpvn("Scalar::Util", 12, TRUE);
1289 GV *vargv = *(GV**)hv_fetch(su_stash, "EXPORT_FAIL", 11, TRUE);
f4a2945e 1290 AV *varav;
98eca5fa
SH
1291 if(SvTYPE(vargv) != SVt_PVGV)
1292 gv_init(vargv, su_stash, "Scalar::Util", 12, TRUE);
f4a2945e 1293 varav = GvAVn(vargv);
60f3865b 1294#endif
98eca5fa
SH
1295 if(SvTYPE(rmcgv) != SVt_PVGV)
1296 gv_init(rmcgv, lu_stash, "List::Util", 10, TRUE);
9850bf21 1297 rmcsv = GvSVn(rmcgv);
60f3865b 1298#ifndef SvWEAKREF
f4a2945e
JH
1299 av_push(varav, newSVpv("weaken",6));
1300 av_push(varav, newSVpv("isweak",6));
1301#endif
60f3865b
GB
1302#ifndef SvVOK
1303 av_push(varav, newSVpv("isvstring",9));
1304#endif
9850bf21
RH
1305#ifdef REAL_MULTICALL
1306 sv_setsv(rmcsv, &PL_sv_yes);
1307#else
1308 sv_setsv(rmcsv, &PL_sv_no);
1309#endif
f4a2945e 1310}