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