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.
5 #define PERL_NO_GET_CONTEXT /* we want efficiency */
10 #define NEED_sv_2pv_flags 1
13 #if PERL_BCDVERSION >= 0x5006000
14 # include "multicall.h"
18 # define CvISXSUB(cv) CvXSUB(cv)
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
25 #if PERL_BCDVERSION < 0x5007000
30 # define cxinc() my_cxinc(aTHX)
34 cxstack_max = cxstack_max * 3 / 2;
35 Renew(cxstack, cxstack_max + 1, struct context); /* fencepost bug in older CXINC macros requires +1 here */
36 return cxstack_ix + 1;
41 #define sv_copypv(a, b) my_sv_copypv(aTHX_ a, b)
43 my_sv_copypv(pTHX_ SV *const dsv, SV *const ssv)
46 const char * const s = SvPV_const(ssv,len);
56 # define slu_sv_value(sv) (SvIOK(sv)) ? (SvIOK_UV(sv)) ? (NV)(SvUVX(sv)) : (NV)(SvIVX(sv)) : (SvNV(sv))
58 # define slu_sv_value(sv) (SvIOK(sv)) ? (NV)(SvIVX(sv)) : (SvNV(sv))
61 #if PERL_VERSION < 13 || (PERL_VERSION == 13 && PERL_SUBVERSION < 9)
62 # define PERL_HAS_BAD_MULTICALL_REFCOUNT
66 # define croak_no_modify() croak("%s", PL_no_modify)
75 static enum slu_accum accum_type(SV *sv) {
79 if(SvIOK(sv) && !SvNOK(sv) && !SvUOK(sv))
85 /* Magic for set_subname */
86 static MGVTBL subname_vtbl;
88 MODULE=List::Util PACKAGE=List::Util
107 magic = SvAMAGIC(retsv);
109 retval = slu_sv_value(retsv);
111 for(index = 1 ; index < items ; index++) {
112 SV *stacksv = ST(index);
114 if((magic || SvAMAGIC(stacksv)) && (tmpsv = amagic_call(retsv, stacksv, gt_amg, 0))) {
115 if(SvTRUE(tmpsv) ? !ix : ix) {
117 magic = SvAMAGIC(retsv);
119 retval = slu_sv_value(retsv);
124 NV val = slu_sv_value(stacksv);
126 retval = slu_sv_value(retsv);
129 if(val < retval ? !ix : ix) {
155 enum slu_accum accum;
156 int is_product = (ix == 2);
161 case 0: XSRETURN_UNDEF;
162 case 1: ST(0) = newSViv(0); XSRETURN(1);
163 case 2: ST(0) = newSViv(1); XSRETURN(1);
167 switch((accum = accum_type(sv))) {
176 retnv = slu_sv_value(sv);
180 for(index = 1 ; index < items ; index++) {
182 if(accum < ACC_SV && SvAMAGIC(sv)){
185 sv_setnv(retsv, accum == ACC_NV ? retnv : retiv);
190 tmpsv = amagic_call(retsv, sv,
191 is_product ? mult_amg : add_amg,
192 SvAMAGIC(retsv) ? AMGf_assign : 0);
194 switch((accum = accum_type(tmpsv))) {
202 retnv = slu_sv_value(tmpsv);
207 /* fall back to default */
209 is_product ? (retnv = SvNV(retsv) * SvNV(sv))
210 : (retnv = SvNV(retsv) + SvNV(sv));
215 if(!SvNOK(sv) && SvIOK(sv) && (SvIV(sv) < IV_MAX / retiv)) {
219 /* else fallthrough */
222 if(!SvNOK(sv) && SvIOK(sv) && (SvIV(sv) < IV_MAX - retiv)) {
226 /* else fallthrough */
229 /* fallthrough to NV now */
233 is_product ? (retnv *= slu_sv_value(sv))
234 : (retnv += slu_sv_value(sv));
243 case ACC_SV: /* nothing to do */
246 sv_setiv(retsv, retiv);
249 sv_setnv(retsv, retnv);
257 #define SLU_CMP_LARGER 1
258 #define SLU_CMP_SMALLER -1
264 minstr = SLU_CMP_LARGER
265 maxstr = SLU_CMP_SMALLER
276 if(MAXARG & OPpLOCALE) {
277 for(index = 1 ; index < items ; index++) {
278 SV *right = ST(index);
279 if(sv_cmp_locale(left, right) == ix)
285 for(index = 1 ; index < items ; index++) {
286 SV *right = ST(index);
287 if(sv_cmp(left, right) == ix)
306 SV *ret = sv_newmortal();
310 SV **args = &PL_stack_base[ax];
311 CV *cv = sv_2cv(block, &stash, &gv, 0);
314 croak("Not a subroutine reference");
319 agv = gv_fetchpv("a", GV_ADD, SVt_PV);
320 bgv = gv_fetchpv("b", GV_ADD, SVt_PV);
324 SvSetMagicSV(ret, args[1]);
328 I32 gimme = G_SCALAR;
331 for(index = 2 ; index < items ; index++) {
332 GvSV(bgv) = args[index];
334 SvSetMagicSV(ret, *PL_stack_sp);
336 # ifdef PERL_HAS_BAD_MULTICALL_REFCOUNT
337 if(CvDEPTH(multicall_cv) > 1)
338 SvREFCNT_inc_simple_void_NN(multicall_cv);
345 for(index = 2 ; index < items ; index++) {
347 GvSV(bgv) = args[index];
350 call_sv((SV*)cv, G_SCALAR);
352 SvSetMagicSV(ret, *PL_stack_sp);
369 SV **args = &PL_stack_base[ax];
370 CV *cv = sv_2cv(block, &stash, &gv, 0);
373 croak("Not a subroutine reference");
378 SAVESPTR(GvSV(PL_defgv));
382 I32 gimme = G_SCALAR;
385 for(index = 1 ; index < items ; index++) {
386 GvSV(PL_defgv) = args[index];
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);
398 # ifdef PERL_HAS_BAD_MULTICALL_REFCOUNT
399 if(CvDEPTH(multicall_cv) > 1)
400 SvREFCNT_inc_simple_void_NN(multicall_cv);
407 for(index = 1 ; index < items ; index++) {
409 GvSV(PL_defgv) = args[index];
412 call_sv((SV*)cv, G_SCALAR);
413 if(SvTRUEx(*PL_stack_sp)) {
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 */
438 SV **args = &PL_stack_base[ax];
439 CV *cv = sv_2cv(block, &stash, &gv, 0);
442 croak("Not a subroutine reference");
444 SAVESPTR(GvSV(PL_defgv));
448 I32 gimme = G_SCALAR;
452 for(index = 1; index < items; index++) {
453 GvSV(PL_defgv) = args[index];
456 if(SvTRUEx(*PL_stack_sp) ^ invert) {
458 ST(0) = ret_true ? &PL_sv_no : &PL_sv_yes;
468 for(index = 1; index < items; index++) {
470 GvSV(PL_defgv) = args[index];
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;
481 ST(0) = ret_true ? &PL_sv_yes : &PL_sv_no;
492 HV *pairstash = get_hv("List::Util::_Pair::", GV_ADD);
494 if(items % 2 && ckWARN(WARN_MISC))
495 warn("Odd number of elements in pairs");
498 for(; argi < items; argi += 2) {
500 SV *b = argi < items-1 ? ST(argi+1) : &PL_sv_undef;
503 av_push(av, newSVsv(a));
504 av_push(av, newSVsv(b));
506 ST(reti) = sv_2mortal(newRV_noinc((SV *)av));
507 sv_bless(ST(reti), pairstash);
520 /* Unlike pairs(), we're going to trash the input values on the stack
521 * almost as soon as we start generating output. So clone them first
525 Newx(args_copy, items, SV *);
526 SAVEFREEPV(args_copy);
528 Copy(&ST(0), args_copy, items, SV *);
530 for(i = 0; i < items; i++) {
531 SV *pair = args_copy[i];
536 if(SvTYPE(pair) != SVt_RV)
537 croak("Not a reference at List::Util::unpack() argument %d", i);
538 if(SvTYPE(SvRV(pair)) != SVt_PVAV)
539 croak("Not an ARRAY reference at List::Util::unpack() argument %d", i);
541 // TODO: assert pair is an ARRAY ref
542 pairav = (AV *)SvRV(pair);
546 if(AvFILL(pairav) >= 0)
547 mPUSHs(newSVsv(AvARRAY(pairav)[0]));
551 if(AvFILL(pairav) >= 1)
552 mPUSHs(newSVsv(AvARRAY(pairav)[1]));
568 if(items % 2 && ckWARN(WARN_MISC))
569 warn("Odd number of elements in pairkeys");
572 for(; argi < items; argi += 2) {
575 ST(reti++) = sv_2mortal(newSVsv(a));
590 if(items % 2 && ckWARN(WARN_MISC))
591 warn("Odd number of elements in pairvalues");
594 for(; argi < items; argi += 2) {
595 SV *b = argi < items-1 ? ST(argi+1) : &PL_sv_undef;
597 ST(reti++) = sv_2mortal(newSVsv(b));
612 CV *cv = sv_2cv(block, &stash, &gv, 0);
613 I32 ret_gimme = GIMME_V;
614 int argi = 1; /* "shift" the block */
616 if(!(items % 2) && ckWARN(WARN_MISC))
617 warn("Odd number of elements in pairfirst");
619 agv = gv_fetchpv("a", GV_ADD, SVt_PV);
620 bgv = gv_fetchpv("b", GV_ADD, SVt_PV);
625 /* Since MULTICALL is about to move it */
626 SV **stack = PL_stack_base + ax;
629 I32 gimme = G_SCALAR;
632 for(; argi < items; argi += 2) {
633 SV *a = GvSV(agv) = stack[argi];
634 SV *b = GvSV(bgv) = argi < items-1 ? stack[argi+1] : &PL_sv_undef;
638 if(!SvTRUEx(*PL_stack_sp))
642 if(ret_gimme == G_ARRAY) {
643 ST(0) = sv_mortalcopy(a);
644 ST(1) = sv_mortalcopy(b);
656 for(; argi < items; argi += 2) {
658 SV *a = GvSV(agv) = ST(argi);
659 SV *b = GvSV(bgv) = argi < items-1 ? ST(argi+1) : &PL_sv_undef;
662 call_sv((SV*)cv, G_SCALAR);
666 if(!SvTRUEx(*PL_stack_sp))
669 if(ret_gimme == G_ARRAY) {
670 ST(0) = sv_mortalcopy(a);
671 ST(1) = sv_mortalcopy(b);
690 CV *cv = sv_2cv(block, &stash, &gv, 0);
691 I32 ret_gimme = GIMME_V;
693 /* This function never returns more than it consumed in arguments. So we
694 * can build the results "live", behind the arguments
696 int argi = 1; /* "shift" the block */
699 if(!(items % 2) && ckWARN(WARN_MISC))
700 warn("Odd number of elements in pairgrep");
702 agv = gv_fetchpv("a", GV_ADD, SVt_PV);
703 bgv = gv_fetchpv("b", GV_ADD, SVt_PV);
708 /* Since MULTICALL is about to move it */
709 SV **stack = PL_stack_base + ax;
713 I32 gimme = G_SCALAR;
716 for(; argi < items; argi += 2) {
717 SV *a = GvSV(agv) = stack[argi];
718 SV *b = GvSV(bgv) = argi < items-1 ? stack[argi+1] : &PL_sv_undef;
722 if(SvTRUEx(*PL_stack_sp)) {
723 if(ret_gimme == G_ARRAY) {
724 /* We can't mortalise yet or they'd be mortal too early */
725 stack[reti++] = newSVsv(a);
726 stack[reti++] = newSVsv(b);
728 else if(ret_gimme == G_SCALAR)
734 if(ret_gimme == G_ARRAY)
735 for(i = 0; i < reti; i++)
736 sv_2mortal(stack[i]);
741 for(; argi < items; argi += 2) {
743 SV *a = GvSV(agv) = ST(argi);
744 SV *b = GvSV(bgv) = argi < items-1 ? ST(argi+1) : &PL_sv_undef;
747 call_sv((SV*)cv, G_SCALAR);
751 if(SvTRUEx(*PL_stack_sp)) {
752 if(ret_gimme == G_ARRAY) {
753 ST(reti++) = sv_mortalcopy(a);
754 ST(reti++) = sv_mortalcopy(b);
756 else if(ret_gimme == G_SCALAR)
762 if(ret_gimme == G_ARRAY)
764 else if(ret_gimme == G_SCALAR) {
765 ST(0) = newSViv(reti);
778 CV *cv = sv_2cv(block, &stash, &gv, 0);
779 SV **args_copy = NULL;
780 I32 ret_gimme = GIMME_V;
782 int argi = 1; /* "shift" the block */
785 if(!(items % 2) && ckWARN(WARN_MISC))
786 warn("Odd number of elements in pairmap");
788 agv = gv_fetchpv("a", GV_ADD, SVt_PV);
789 bgv = gv_fetchpv("b", GV_ADD, SVt_PV);
792 /* This MULTICALL-based code appears to fail on perl 5.10.0 and 5.8.9
793 * Skip it on those versions (RT#87857)
795 #if defined(dMULTICALL) && (PERL_BCDVERSION > 0x5010000 || PERL_BCDVERSION < 0x5008009)
797 /* Since MULTICALL is about to move it */
798 SV **stack = PL_stack_base + ax;
799 I32 ret_gimme = GIMME_V;
806 for(; argi < items; argi += 2) {
807 SV *a = GvSV(agv) = args_copy ? args_copy[argi] : stack[argi];
808 SV *b = GvSV(bgv) = argi < items-1 ?
809 (args_copy ? args_copy[argi+1] : stack[argi+1]) :
814 count = PL_stack_sp - PL_stack_base;
816 if(count > 2 && !args_copy) {
817 /* We can't return more than 2 results for a given input pair
818 * without trashing the remaining argmuents on the stack still
819 * to be processed. So, we'll copy them out to a temporary
820 * buffer and work from there instead.
821 * We didn't do this initially because in the common case, most
822 * code blocks will return only 1 or 2 items so it won't be
825 int n_args = items - argi;
826 Newx(args_copy, n_args, SV *);
827 SAVEFREEPV(args_copy);
829 Copy(stack + argi, args_copy, n_args, SV *);
835 for(i = 0; i < count; i++)
836 stack[reti++] = newSVsv(PL_stack_sp[i - count + 1]);
840 if(ret_gimme == G_ARRAY)
841 for(i = 0; i < reti; i++)
842 sv_2mortal(stack[i]);
847 for(; argi < items; argi += 2) {
849 SV *a = GvSV(agv) = args_copy ? args_copy[argi] : ST(argi);
850 SV *b = GvSV(bgv) = argi < items-1 ?
851 (args_copy ? args_copy[argi+1] : ST(argi+1)) :
857 count = call_sv((SV*)cv, G_ARRAY);
861 if(count > 2 && !args_copy && ret_gimme == G_ARRAY) {
862 int n_args = items - argi;
863 Newx(args_copy, n_args, SV *);
864 SAVEFREEPV(args_copy);
866 Copy(&ST(argi), args_copy, n_args, SV *);
872 if(ret_gimme == G_ARRAY)
873 for(i = 0; i < count; i++)
874 ST(reti++) = sv_mortalcopy(SP[i - count + 1]);
882 if(ret_gimme == G_ARRAY)
885 ST(0) = sv_2mortal(newSViv(reti));
895 #if (PERL_VERSION < 9)
897 struct op *old_op = PL_op;
899 /* We call pp_rand here so that Drand01 get initialized if rand()
900 or srand() has not already been called
902 memzero((char*)(&dmy_op), sizeof(struct op));
903 /* we let pp_rand() borrow the TARG allocated for this XS sub */
904 dmy_op.op_targ = PL_op->op_targ;
906 (void)*(PL_ppaddr[OP_RAND])(aTHX);
909 /* Initialize Drand01 if rand() or srand() has
910 not already been called
912 if(!PL_srand_called) {
913 (void)seedDrand01((Rand_seed_t)Perl_seed(aTHX));
914 PL_srand_called = TRUE;
918 for (index = items ; index > 1 ; ) {
919 int swap = (int)(Drand01() * (double)(index--));
921 ST(swap) = ST(index);
929 MODULE=List::Util PACKAGE=Scalar::Util
940 (void)SvUPGRADE(TARG, SVt_PVNV);
944 if(SvNOK(num) || SvPOK(num) || SvMAGICAL(num)) {
945 SvNV_set(TARG, SvNV(num));
949 else if(SvUOK(num)) {
950 SvUV_set(TARG, SvUV(num));
956 SvIV_set(TARG, SvIV(num));
960 if(PL_tainting && (SvTAINTED(num) || SvTAINTED(str)))
975 ST(0) = boolSV((SvPOK(sv) || SvPOKp(sv)) && (SvNIOK(sv) || SvNIOKp(sv)));
986 if(!(SvROK(sv) && SvOBJECT(SvRV(sv))))
989 RETVAL = (char*)sv_reftype(SvRV(sv),TRUE);
1004 RETVAL = (char*)sv_reftype(SvRV(sv),FALSE);
1019 RETVAL = PTR2UV(SvRV(sv));
1032 croak("weak references are not implemented in this release of perl");
1043 /* This code stolen from core's sv_rvweaken() and modified */
1047 croak("Can't unweaken a nonreference");
1048 else if (!SvWEAKREF(sv)) {
1049 if(ckWARN(WARN_MISC))
1050 warn("Reference is not weak");
1053 else if (SvREADONLY(sv)) croak_no_modify();
1056 #if PERL_VERSION >= 14
1057 SvWEAKREF_off(sv); SvROK_on(sv);
1058 SvREFCNT_inc_NN(tsv);
1059 Perl_sv_del_backref(aTHX_ tsv, sv);
1061 /* Lacking sv_del_backref() the best we can do is clear the old (weak) ref
1062 * then set a new strong one
1064 sv_setsv(sv, &PL_sv_undef);
1065 SvRV_set(sv, SvREFCNT_inc_NN(tsv));
1069 croak("weak references are not implemented in this release of perl");
1078 ST(0) = boolSV(SvROK(sv) && SvWEAKREF(sv));
1081 croak("weak references are not implemented in this release of perl");
1090 RETVAL = SvREADONLY(sv);
1100 RETVAL = SvTAINTED(sv);
1111 ST(0) = boolSV(SvVOK(sv));
1114 croak("vstrings are not implemented in this release of perl");
1118 looks_like_number(sv)
1124 if(SvAMAGIC(sv) && (tempsv = AMG_CALLun(sv, numer))) {
1127 #if PERL_BCDVERSION < 0x5008005
1128 if(SvPOK(sv) || SvPOKp(sv)) {
1129 RETVAL = looks_like_number(sv) ? &PL_sv_yes : &PL_sv_no;
1132 RETVAL = (SvFLAGS(sv) & (SVf_NOK|SVp_NOK|SVf_IOK|SVp_IOK)) ? &PL_sv_yes : &PL_sv_no;
1135 RETVAL = looks_like_number(sv) ? &PL_sv_yes : &PL_sv_no;
1152 /* must be GLOB or IO */
1156 else if(SvTYPE(sv) == SVt_PVIO){
1161 /* real or tied filehandle? */
1162 if(IoIFP(io) || SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)){
1169 MODULE=List::Util PACKAGE=Sub::Util
1172 set_prototype(proto, code)
1176 SV *cv; /* not CV * */
1180 croak("set_prototype: not a reference");
1183 if(SvTYPE(cv) != SVt_PVCV)
1184 croak("set_prototype: not a subroutine reference");
1187 /* set the prototype */
1188 sv_copypv(cv, proto);
1191 /* delete the prototype */
1199 set_subname(name, sub)
1205 HV *stash = CopSTASH(PL_curcop);
1206 char *s, *end = NULL;
1209 if (!SvROK(sub) && SvGMAGICAL(sub))
1212 cv = (CV *) SvRV(sub);
1213 else if (SvTYPE(sub) == SVt_PVGV)
1215 else if (!SvOK(sub))
1216 croak(PL_no_usym, "a subroutine");
1217 else if (PL_op->op_private & HINT_STRICT_REFS)
1218 croak("Can't use string (\"%.32s\") as %s ref while \"strict refs\" in use",
1219 SvPV_nolen(sub), "a subroutine");
1220 else if ((gv = gv_fetchpv(SvPV_nolen(sub), FALSE, SVt_PVCV)))
1223 croak("Undefined subroutine %s", SvPV_nolen(sub));
1224 if (SvTYPE(cv) != SVt_PVCV && SvTYPE(cv) != SVt_PVFM)
1225 croak("Not a subroutine reference");
1226 for (s = name; *s++; ) {
1227 if (*s == ':' && s[-1] == ':')
1229 else if (*s && s[-1] == '\'')
1234 char *namepv = savepvn(name, end - name);
1235 stash = GvHV(gv_fetchpv(namepv, TRUE, SVt_PVHV));
1240 /* under debugger, provide information about sub location */
1241 if (PL_DBsub && CvGV(cv)) {
1242 HV *hv = GvHV(PL_DBsub);
1244 char *new_pkg = HvNAME(stash);
1246 char *old_name = GvNAME( CvGV(cv) );
1247 char *old_pkg = HvNAME( GvSTASH(CvGV(cv)) );
1249 int old_len = strlen(old_name) + strlen(old_pkg);
1250 int new_len = strlen(name) + strlen(new_pkg);
1255 Newxz(full_name, (old_len > new_len ? old_len : new_len) + 3, char);
1257 strcat(full_name, old_pkg);
1258 strcat(full_name, "::");
1259 strcat(full_name, old_name);
1261 old_data = hv_fetch(hv, full_name, strlen(full_name), 0);
1264 strcpy(full_name, new_pkg);
1265 strcat(full_name, "::");
1266 strcat(full_name, name);
1268 SvREFCNT_inc(*old_data);
1269 if (!hv_store(hv, full_name, strlen(full_name), *old_data, 0))
1270 SvREFCNT_dec(*old_data);
1272 Safefree(full_name);
1275 gv = (GV *) newSV(0);
1276 gv_init(gv, stash, name, s - name, TRUE);
1279 * set_subname needs to create a GV to store the name. The CvGV field of a
1280 * CV is not refcounted, so perl wouldn't know to SvREFCNT_dec() this GV if
1281 * it destroys the containing CV. We use a MAGIC with an empty vtable
1282 * simply for the side-effect of using MGf_REFCOUNTED to store the
1283 * actually-counted reference to the GV.
1286 while (mg && mg->mg_virtual != &subname_vtbl)
1287 mg = mg->mg_moremagic;
1289 Newxz(mg, 1, MAGIC);
1290 mg->mg_moremagic = SvMAGIC(cv);
1291 mg->mg_type = PERL_MAGIC_ext;
1292 mg->mg_virtual = &subname_vtbl;
1293 SvMAGIC_set(cv, mg);
1295 if (mg->mg_flags & MGf_REFCOUNTED)
1296 SvREFCNT_dec(mg->mg_obj);
1297 mg->mg_flags |= MGf_REFCOUNTED;
1298 mg->mg_obj = (SV *) gv;
1315 if (!SvROK(code) && SvGMAGICAL(code))
1318 if(!SvROK(code) || SvTYPE(cv = (CV *)SvRV(code)) != SVt_PVCV)
1319 croak("Not a subroutine reference");
1321 if(!(gv = CvGV(cv)))
1324 mPUSHs(newSVpvf("%s::%s", HvNAME(GvSTASH(gv)), GvNAME(gv)));
1329 HV *lu_stash = gv_stashpvn("List::Util", 10, TRUE);
1330 GV *rmcgv = *(GV**)hv_fetch(lu_stash, "REAL_MULTICALL", 14, TRUE);
1332 #if !defined(SvWEAKREF) || !defined(SvVOK)
1333 HV *su_stash = gv_stashpvn("Scalar::Util", 12, TRUE);
1334 GV *vargv = *(GV**)hv_fetch(su_stash, "EXPORT_FAIL", 11, TRUE);
1336 if(SvTYPE(vargv) != SVt_PVGV)
1337 gv_init(vargv, su_stash, "Scalar::Util", 12, TRUE);
1338 varav = GvAVn(vargv);
1340 if(SvTYPE(rmcgv) != SVt_PVGV)
1341 gv_init(rmcgv, lu_stash, "List::Util", 10, TRUE);
1342 rmcsv = GvSVn(rmcgv);
1344 av_push(varav, newSVpv("weaken",6));
1345 av_push(varav, newSVpv("isweak",6));
1348 av_push(varav, newSVpv("isvstring",9));
1350 #ifdef REAL_MULTICALL
1351 sv_setsv(rmcsv, &PL_sv_yes);
1353 sv_setsv(rmcsv, &PL_sv_no);