3 * Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 * 2005, 2006, 2007, 2008 by Larry Wall and others
6 * You may distribute under the terms of either the GNU General Public
7 * License or the Artistic License, as specified in the README file.
12 * '"The roots of those mountains must be roots indeed; there must be
13 * great secrets buried there which have not been discovered since the
14 * beginning."' --Gandalf, relating Gollum's history
16 * [p.54 of _The Lord of the Rings_, I/ii: "The Shadow of the Past"]
19 /* This file contains the code that implements the functions in Perl's
20 * UNIVERSAL package, such as UNIVERSAL->can().
22 * It is also used to store XS functions that need to be present in
23 * miniperl for a lack of a better place to put them. It might be
24 * clever to move them to separate XS files which would then be pulled
25 * in by some to-be-written build process.
29 #define PERL_IN_UNIVERSAL_C
32 #if defined(USE_PERLIO)
33 #include "perliol.h" /* For the PERLIO_F_XXX */
37 * Contributed by Graham Barr <Graham.Barr@tiuk.ti.com>
38 * The main guts of traverse_isa was actually copied from gv_fetchmeth
42 S_isa_lookup(pTHX_ HV *stash, const char * const name, STRLEN len, U32 flags)
44 const struct mro_meta *const meta = HvMROMETA(stash);
48 PERL_ARGS_ASSERT_ISA_LOOKUP;
51 (void)mro_get_linear_isa(stash);
55 if (hv_common(isa, NULL, name, len, ( flags & SVf_UTF8 ? HVhek_UTF8 : 0),
56 HV_FETCH_ISEXISTS, NULL, 0)) {
57 /* Direct name lookup worked. */
61 /* A stash/class can go by many names (ie. User == main::User), so
62 we use the HvENAME in the stash itself, which is canonical, falling
63 back to HvNAME if necessary. */
64 our_stash = gv_stashpvn(name, len, flags);
67 HEK *canon_name = HvENAME_HEK(our_stash);
68 if (!canon_name) canon_name = HvNAME_HEK(our_stash);
70 if (hv_common(isa, NULL, HEK_KEY(canon_name), HEK_LEN(canon_name),
71 HEK_FLAGS(canon_name),
72 HV_FETCH_ISEXISTS, NULL, HEK_HASH(canon_name))) {
81 =head1 SV Manipulation Functions
83 =for apidoc sv_derived_from_pvn
85 Returns a boolean indicating whether the SV is derived from the specified class
86 I<at the C level>. To check derivation at the Perl level, call C<isa()> as a
89 Currently, the only significant value for C<flags> is SVf_UTF8.
93 =for apidoc sv_derived_from_sv
95 Exactly like L</sv_derived_from_pvn>, but takes the name string in the form
96 of an SV instead of a string/length pair.
103 Perl_sv_derived_from_sv(pTHX_ SV *sv, SV *namesv, U32 flags)
107 PERL_ARGS_ASSERT_SV_DERIVED_FROM_SV;
108 namepv = SvPV(namesv, namelen);
111 return sv_derived_from_pvn(sv, namepv, namelen, flags);
115 =for apidoc sv_derived_from
117 Exactly like L</sv_derived_from_pv>, but doesn't take a C<flags> parameter.
123 Perl_sv_derived_from(pTHX_ SV *sv, const char *const name)
125 PERL_ARGS_ASSERT_SV_DERIVED_FROM;
126 return sv_derived_from_pvn(sv, name, strlen(name), 0);
130 =for apidoc sv_derived_from_pv
132 Exactly like L</sv_derived_from_pvn>, but takes a nul-terminated string
133 instead of a string/length pair.
140 Perl_sv_derived_from_pv(pTHX_ SV *sv, const char *const name, U32 flags)
142 PERL_ARGS_ASSERT_SV_DERIVED_FROM_PV;
143 return sv_derived_from_pvn(sv, name, strlen(name), flags);
147 Perl_sv_derived_from_pvn(pTHX_ SV *sv, const char *const name, const STRLEN len, U32 flags)
151 PERL_ARGS_ASSERT_SV_DERIVED_FROM_PVN;
158 type = sv_reftype(sv,0);
159 if (type && strEQ(type,name))
166 stash = gv_stashsv(sv, 0);
169 if (stash && isa_lookup(stash, name, len, flags))
172 stash = gv_stashpvs("UNIVERSAL", 0);
173 return stash && isa_lookup(stash, name, len, flags);
177 =for apidoc sv_does_sv
179 Returns a boolean indicating whether the SV performs a specific, named role.
180 The SV can be a Perl object or the name of a Perl class.
188 Perl_sv_does_sv(pTHX_ SV *sv, SV *namesv, U32 flags)
195 PERL_ARGS_ASSERT_SV_DOES_SV;
196 PERL_UNUSED_ARG(flags);
203 if (!SvOK(sv) || !(SvROK(sv) || (SvPOK(sv) && SvCUR(sv)))) {
208 if (sv_isobject(sv)) {
209 classname = sv_ref(NULL,SvRV(sv),TRUE);
214 if (sv_eq(classname, namesv)) {
225 methodname = newSVpvs_flags("isa", SVs_TEMP);
226 /* ugly hack: use the SvSCREAM flag so S_method_common
227 * can figure out we're calling DOES() and not isa(),
228 * and report eventual errors correctly. --rgs */
229 SvSCREAM_on(methodname);
230 call_sv(methodname, G_SCALAR | G_METHOD);
233 does_it = SvTRUE( TOPs );
243 Like L</sv_does_pv>, but doesn't take a C<flags> parameter.
249 Perl_sv_does(pTHX_ SV *sv, const char *const name)
251 PERL_ARGS_ASSERT_SV_DOES;
252 return sv_does_sv(sv, newSVpvn_flags(name, strlen(name), SVs_TEMP), 0);
256 =for apidoc sv_does_pv
258 Like L</sv_does_sv>, but takes a nul-terminated string instead of an SV.
265 Perl_sv_does_pv(pTHX_ SV *sv, const char *const name, U32 flags)
267 PERL_ARGS_ASSERT_SV_DOES_PV;
268 return sv_does_sv(sv, newSVpvn_flags(name, strlen(name), SVs_TEMP | flags), flags);
272 =for apidoc sv_does_pvn
274 Like L</sv_does_sv>, but takes a string/length pair instead of an SV.
280 Perl_sv_does_pvn(pTHX_ SV *sv, const char *const name, const STRLEN len, U32 flags)
282 PERL_ARGS_ASSERT_SV_DOES_PVN;
284 return sv_does_sv(sv, newSVpvn_flags(name, len, flags | SVs_TEMP), flags);
288 =for apidoc croak_xs_usage
290 A specialised variant of C<croak()> for emitting the usage message for xsubs
292 croak_xs_usage(cv, "eee_yow");
294 works out the package name and subroutine name from C<cv>, and then calls
295 C<croak()>. Hence if C<cv> is C<&ouch::awk>, it would call C<croak> as:
297 Perl_croak(aTHX_ "Usage: %"SVf"::%"SVf"(%s)", "ouch" "awk", "eee_yow");
303 Perl_croak_xs_usage(const CV *const cv, const char *const params)
305 /* Avoid CvGV as it requires aTHX. */
306 const GV *gv = CvNAMED(cv) ? NULL : cv->sv_any->xcv_gv_u.xcv_gv;
308 PERL_ARGS_ASSERT_CROAK_XS_USAGE;
311 const HV *const stash = GvSTASH(gv);
313 if (HvNAME_get(stash))
314 /* diag_listed_as: SKIPME */
315 Perl_croak_nocontext("Usage: %"HEKf"::%"HEKf"(%s)",
316 HEKfARG(HvNAME_HEK(stash)),
317 HEKfARG(GvNAME_HEK(gv)),
320 /* diag_listed_as: SKIPME */
321 Perl_croak_nocontext("Usage: %"HEKf"(%s)",
322 HEKfARG(GvNAME_HEK(gv)), params);
325 if ((gv = CvGV(cv))) goto got_gv;
327 /* Pants. I don't think that it should be possible to get here. */
328 /* diag_listed_as: SKIPME */
329 Perl_croak(aTHX_ "Usage: CODE(0x%"UVxf")(%s)", PTR2UV(cv), params);
333 XS(XS_UNIVERSAL_isa); /* prototype to pass -Wmissing-prototypes */
339 croak_xs_usage(cv, "reference, kind");
341 SV * const sv = ST(0);
345 if (!SvOK(sv) || !(SvROK(sv) || (SvPOK(sv) && SvCUR(sv))))
348 ST(0) = boolSV(sv_derived_from_sv(sv, ST(1), 0));
353 XS(XS_UNIVERSAL_can); /* prototype to pass -Wmissing-prototypes */
363 croak_xs_usage(cv, "object-ref, method");
369 /* Reject undef and empty string. Note that the string form takes
370 precedence here over the numeric form, as (!1)->foo treats the
371 invocant as the empty string, though it is a dualvar. */
372 if (!SvOK(sv) || (SvPOK(sv) && !SvCUR(sv)))
378 sv = MUTABLE_SV(SvRV(sv));
381 else if (isGV_with_GP(sv) && GvIO(sv))
382 pkg = SvSTASH(GvIO(sv));
384 else if (isGV_with_GP(sv) && GvIO(sv))
385 pkg = SvSTASH(GvIO(sv));
386 else if ((iogv = gv_fetchsv_nomg(sv, 0, SVt_PVIO)) && GvIO(iogv))
387 pkg = SvSTASH(GvIO(iogv));
389 pkg = gv_stashsv(sv, 0);
391 pkg = gv_stashpvs("UNIVERSAL", 0);
395 GV * const gv = gv_fetchmethod_sv_flags(pkg, ST(1), 0);
397 rv = sv_2mortal(newRV(MUTABLE_SV(GvCV(gv))));
404 XS(XS_UNIVERSAL_DOES); /* prototype to pass -Wmissing-prototypes */
405 XS(XS_UNIVERSAL_DOES)
411 Perl_croak(aTHX_ "Usage: invocant->DOES(kind)");
413 SV * const sv = ST(0);
414 if (sv_does_sv( sv, ST(1), 0 ))
421 XS(XS_utf8_is_utf8); /* prototype to pass -Wmissing-prototypes */
426 croak_xs_usage(cv, "sv");
428 SV * const sv = ST(0);
438 XS(XS_utf8_valid); /* prototype to pass -Wmissing-prototypes */
443 croak_xs_usage(cv, "sv");
445 SV * const sv = ST(0);
447 const char * const s = SvPV_const(sv,len);
448 if (!SvUTF8(sv) || is_utf8_string((const U8*)s,len))
456 XS(XS_utf8_encode); /* prototype to pass -Wmissing-prototypes */
461 croak_xs_usage(cv, "sv");
462 sv_utf8_encode(ST(0));
467 XS(XS_utf8_decode); /* prototype to pass -Wmissing-prototypes */
472 croak_xs_usage(cv, "sv");
474 SV * const sv = ST(0);
476 SvPV_force_nolen(sv);
477 RETVAL = sv_utf8_decode(sv);
479 ST(0) = boolSV(RETVAL);
484 XS(XS_utf8_upgrade); /* prototype to pass -Wmissing-prototypes */
489 croak_xs_usage(cv, "sv");
491 SV * const sv = ST(0);
495 RETVAL = sv_utf8_upgrade(sv);
496 XSprePUSH; PUSHi((IV)RETVAL);
501 XS(XS_utf8_downgrade); /* prototype to pass -Wmissing-prototypes */
502 XS(XS_utf8_downgrade)
505 if (items < 1 || items > 2)
506 croak_xs_usage(cv, "sv, failok=0");
508 SV * const sv = ST(0);
509 const bool failok = (items < 2) ? 0 : SvTRUE(ST(1)) ? 1 : 0;
510 const bool RETVAL = sv_utf8_downgrade(sv, failok);
512 ST(0) = boolSV(RETVAL);
517 XS(XS_utf8_native_to_unicode); /* prototype to pass -Wmissing-prototypes */
518 XS(XS_utf8_native_to_unicode)
521 const UV uv = SvUV(ST(0));
524 croak_xs_usage(cv, "sv");
526 ST(0) = sv_2mortal(newSViv(NATIVE_TO_UNI(uv)));
530 XS(XS_utf8_unicode_to_native); /* prototype to pass -Wmissing-prototypes */
531 XS(XS_utf8_unicode_to_native)
534 const UV uv = SvUV(ST(0));
537 croak_xs_usage(cv, "sv");
539 ST(0) = sv_2mortal(newSViv(UNI_TO_NATIVE(uv)));
543 XS(XS_Internals_SvREADONLY); /* prototype to pass -Wmissing-prototypes */
544 XS(XS_Internals_SvREADONLY) /* This is dangerous stuff. */
547 SV * const svz = ST(0);
551 /* [perl #77776] - called as &foo() not foo() */
553 croak_xs_usage(cv, "SCALAR[, ON]");
563 else if (items == 2) {
565 #ifdef PERL_OLD_COPY_ON_WRITE
566 if (SvIsCOW(sv)) sv_force_normal(sv);
568 SvFLAGS(sv) |= SVf_READONLY;
572 /* I hope you really know what you are doing. */
573 SvFLAGS(sv) &=~ SVf_READONLY;
577 XSRETURN_UNDEF; /* Can't happen. */
580 XS(XS_constant__make_const); /* prototype to pass -Wmissing-prototypes */
581 XS(XS_constant__make_const) /* This is dangerous stuff. */
584 SV * const svz = ST(0);
588 /* [perl #77776] - called as &foo() not foo() */
589 if (!SvROK(svz) || items != 1)
590 croak_xs_usage(cv, "SCALAR");
594 #ifdef PERL_OLD_COPY_ON_WRITE
595 if (SvIsCOW(sv)) sv_force_normal(sv);
598 if (SvTYPE(sv) == SVt_PVAV && AvFILLp(sv) != -1) {
599 /* for constant.pm; nobody else should be calling this
602 for (svp = AvARRAY(sv) + AvFILLp(sv)
605 if (*svp) SvPADTMP_on(*svp);
610 XS(XS_Internals_SvREFCNT); /* prototype to pass -Wmissing-prototypes */
611 XS(XS_Internals_SvREFCNT) /* This is dangerous stuff. */
614 SV * const svz = ST(0);
619 /* [perl #77776] - called as &foo() not foo() */
620 if ((items != 1 && items != 2) || !SvROK(svz))
621 croak_xs_usage(cv, "SCALAR[, REFCOUNT]");
625 /* I hope you really know what you are doing. */
626 /* idea is for SvREFCNT(sv) to be accessed only once */
627 refcnt = items == 2 ?
628 /* we free one ref on exit */
629 (SvREFCNT(sv) = SvUV(ST(1)) + 1)
631 XSRETURN_UV(refcnt - 1); /* Minus the ref created for us. */
635 XS(XS_Internals_hv_clear_placehold); /* prototype to pass -Wmissing-prototypes */
636 XS(XS_Internals_hv_clear_placehold)
640 if (items != 1 || !SvROK(ST(0)))
641 croak_xs_usage(cv, "hv");
643 HV * const hv = MUTABLE_HV(SvRV(ST(0)));
644 hv_clear_placeholders(hv);
649 XS(XS_PerlIO_get_layers); /* prototype to pass -Wmissing-prototypes */
650 XS(XS_PerlIO_get_layers)
653 if (items < 1 || items % 2 == 0)
654 croak_xs_usage(cv, "filehandle[,args]");
655 #if defined(USE_PERLIO)
661 bool details = FALSE;
665 for (svp = MARK + 2; svp <= SP; svp += 2) {
666 SV * const * const varp = svp;
667 SV * const * const valp = svp + 1;
669 const char * const key = SvPV_const(*varp, klen);
673 if (klen == 5 && memEQ(key, "input", 5)) {
674 input = SvTRUE(*valp);
679 if (klen == 6 && memEQ(key, "output", 6)) {
680 input = !SvTRUE(*valp);
685 if (klen == 7 && memEQ(key, "details", 7)) {
686 details = SvTRUE(*valp);
693 "get_layers: unknown argument '%s'",
702 gv = MAYBE_DEREF_GV(sv);
704 if (!gv && !SvROK(sv))
705 gv = gv_fetchsv_nomg(sv, 0, SVt_PVIO);
707 if (gv && (io = GvIO(gv))) {
708 AV* const av = PerlIO_get_layers(aTHX_ input ?
709 IoIFP(io) : IoOFP(io));
711 const SSize_t last = av_tindex(av);
714 for (i = last; i >= 0; i -= 3) {
715 SV * const * const namsvp = av_fetch(av, i - 2, FALSE);
716 SV * const * const argsvp = av_fetch(av, i - 1, FALSE);
717 SV * const * const flgsvp = av_fetch(av, i, FALSE);
719 const bool namok = namsvp && *namsvp && SvPOK(*namsvp);
720 const bool argok = argsvp && *argsvp && SvPOK(*argsvp);
721 const bool flgok = flgsvp && *flgsvp && SvIOK(*flgsvp);
723 EXTEND(SP, 3); /* Three is the max in all branches: better check just once */
725 /* Indents of 5? Yuck. */
726 /* We know that PerlIO_get_layers creates a new SV for
727 the name and flags, so we can just take a reference
728 and "steal" it when we free the AV below. */
730 ? sv_2mortal(SvREFCNT_inc_simple_NN(*namsvp))
733 ? newSVpvn_flags(SvPVX_const(*argsvp),
735 (SvUTF8(*argsvp) ? SVf_UTF8 : 0)
739 ? sv_2mortal(SvREFCNT_inc_simple_NN(*flgsvp))
745 PUSHs(sv_2mortal(Perl_newSVpvf(aTHX_ "%"SVf"(%"SVf")",
749 PUSHs(sv_2mortal(SvREFCNT_inc_simple_NN(*namsvp)));
754 const IV flags = SvIVX(*flgsvp);
756 if (flags & PERLIO_F_UTF8) {
757 PUSHs(newSVpvs_flags("utf8", SVs_TEMP));
775 XS(XS_re_is_regexp); /* prototype to pass -Wmissing-prototypes */
782 croak_xs_usage(cv, "sv");
791 XS(XS_re_regnames_count); /* prototype to pass -Wmissing-prototypes */
792 XS(XS_re_regnames_count)
794 REGEXP *rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;
799 croak_xs_usage(cv, "");
807 ret = CALLREG_NAMED_BUFF_COUNT(rx);
810 PUSHs(ret ? sv_2mortal(ret) : &PL_sv_undef);
814 XS(XS_re_regname); /* prototype to pass -Wmissing-prototypes */
822 if (items < 1 || items > 2)
823 croak_xs_usage(cv, "name[, all ]");
828 rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;
833 if (items == 2 && SvTRUE(ST(1))) {
838 ret = CALLREG_NAMED_BUFF_FETCH(rx, ST(0), (flags | RXapif_REGNAME));
841 PUSHs(ret ? sv_2mortal(ret) : &PL_sv_undef);
846 XS(XS_re_regnames); /* prototype to pass -Wmissing-prototypes */
859 croak_xs_usage(cv, "[all]");
861 rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;
866 if (items == 1 && SvTRUE(ST(0))) {
875 ret = CALLREG_NAMED_BUFF_ALL(rx, (flags | RXapif_REGNAMES));
882 av = MUTABLE_AV(SvRV(ret));
883 length = av_tindex(av);
885 EXTEND(SP, length+1); /* better extend stack just once */
886 for (i = 0; i <= length; i++) {
887 entry = av_fetch(av, i, FALSE);
890 Perl_croak(aTHX_ "NULL array element in re::regnames()");
892 mPUSHs(SvREFCNT_inc_simple_NN(*entry));
901 XS(XS_re_regexp_pattern); /* prototype to pass -Wmissing-prototypes */
902 XS(XS_re_regexp_pattern)
906 U8 const gimme = GIMME_V;
911 croak_xs_usage(cv, "sv");
914 Checks if a reference is a regex or not. If the parameter is
915 not a ref, or is not the result of a qr// then returns false
916 in scalar context and an empty list in list context.
917 Otherwise in list context it returns the pattern and the
918 modifiers, in scalar context it returns the pattern just as it
919 would if the qr// was stringified normally, regardless as
920 to the class of the variable and any stringification overloads
924 if ((re = SvRX(ST(0)))) /* assign deliberate */
926 /* Houston, we have a regex! */
929 if ( gimme == G_ARRAY ) {
931 char reflags[sizeof(INT_PAT_MODS) + MAX_CHARSET_NAME_LENGTH];
937 we are in list context so stringify
938 the modifiers that apply. We ignore "negative
939 modifiers" in this scenario, and the default character set
942 if (get_regex_charset(RX_EXTFLAGS(re)) != REGEX_DEPENDS_CHARSET) {
944 const char* const name = get_regex_charset_name(RX_EXTFLAGS(re),
946 Copy(name, reflags + left, len, char);
950 match_flags = (U16)((RX_EXTFLAGS(re) & RXf_PMf_COMPILETIME)
951 >> RXf_PMf_STD_PMMOD_SHIFT);
953 while((ch = *fptr++)) {
954 if(match_flags & 1) {
955 reflags[left++] = ch;
960 pattern = newSVpvn_flags(RX_PRECOMP(re),RX_PRELEN(re),
961 (RX_UTF8(re) ? SVf_UTF8 : 0) | SVs_TEMP);
963 /* return the pattern and the modifiers */
965 PUSHs(newSVpvn_flags(reflags, left, SVs_TEMP));
968 /* Scalar, so use the string that Perl would return */
969 /* return the pattern in (?msixn:..) format */
970 #if PERL_VERSION >= 11
971 pattern = sv_2mortal(newSVsv(MUTABLE_SV(re)));
973 pattern = newSVpvn_flags(RX_WRAPPED(re), RX_WRAPLEN(re),
974 (RX_UTF8(re) ? SVf_UTF8 : 0) | SVs_TEMP);
980 /* It ain't a regexp folks */
981 if ( gimme == G_ARRAY ) {
982 /* return the empty list */
985 /* Because of the (?:..) wrapping involved in a
986 stringified pattern it is impossible to get a
987 result for a real regexp that would evaluate to
988 false. Therefore we can return PL_sv_no to signify
989 that the object is not a regex, this means that one
992 if (regex($might_be_a_regex) eq '(?:foo)') { }
994 and not worry about undefined values.
999 NOT_REACHED; /* NOT-REACHED */
1005 struct xsub_details {
1011 static const struct xsub_details details[] = {
1012 {"UNIVERSAL::isa", XS_UNIVERSAL_isa, NULL},
1013 {"UNIVERSAL::can", XS_UNIVERSAL_can, NULL},
1014 {"UNIVERSAL::DOES", XS_UNIVERSAL_DOES, NULL},
1015 #define VXS_XSUB_DETAILS
1017 #undef VXS_XSUB_DETAILS
1018 {"utf8::is_utf8", XS_utf8_is_utf8, NULL},
1019 {"utf8::valid", XS_utf8_valid, NULL},
1020 {"utf8::encode", XS_utf8_encode, NULL},
1021 {"utf8::decode", XS_utf8_decode, NULL},
1022 {"utf8::upgrade", XS_utf8_upgrade, NULL},
1023 {"utf8::downgrade", XS_utf8_downgrade, NULL},
1024 {"utf8::native_to_unicode", XS_utf8_native_to_unicode, NULL},
1025 {"utf8::unicode_to_native", XS_utf8_unicode_to_native, NULL},
1026 {"Internals::SvREADONLY", XS_Internals_SvREADONLY, "\\[$%@];$"},
1027 {"constant::_make_const", XS_constant__make_const, "\\[$@]"},
1028 {"Internals::SvREFCNT", XS_Internals_SvREFCNT, "\\[$%@];$"},
1029 {"Internals::hv_clear_placeholders", XS_Internals_hv_clear_placehold, "\\%"},
1030 {"PerlIO::get_layers", XS_PerlIO_get_layers, "*;@"},
1031 {"re::is_regexp", XS_re_is_regexp, "$"},
1032 {"re::regname", XS_re_regname, ";$$"},
1033 {"re::regnames", XS_re_regnames, ";$"},
1034 {"re::regnames_count", XS_re_regnames_count, ""},
1035 {"re::regexp_pattern", XS_re_regexp_pattern, "$"},
1039 Perl_boot_core_UNIVERSAL(pTHX)
1041 static const char file[] = __FILE__;
1042 const struct xsub_details *xsub = details;
1043 const struct xsub_details *end = C_ARRAY_END(details);
1046 newXS_flags(xsub->name, xsub->xsub, file, xsub->proto, 0);
1047 } while (++xsub < end);
1049 /* Providing a Regexp::DESTROY fixes #21347. See test in t/op/ref.t */
1052 newCONSTSUB(get_hv("Regexp::", GV_ADD), "DESTROY", NULL);
1053 char ** cvfile = &CvFILE(cv);
1054 char * oldfile = *cvfile;
1056 *cvfile = (char *)file;
1063 * c-indentation-style: bsd
1065 * indent-tabs-mode: nil
1068 * ex: set ts=8 sts=4 sw=4 et: