Perl5 git is on https

[perl5.git] / universal.c

diff --git a/universal.c b/universal.c
index 6ee65a6..66eafc5 100644 (file)
--- a/universal.c
+++ b/universal.c
@@ -225,8 +225,8 @@ Perl_sv_does_sv(pTHX_ SV *sv, SV *namesv, U32 flags)
     /* create a PV with value "isa", but with a special address
      * so that perl knows we're really doing "DOES" instead */
     methodname = newSV_type(SVt_PV);
-    SvLEN(methodname) = 0;
-    SvCUR(methodname) = strlen(PL_isa_DOES);
+    SvLEN_set(methodname, 0);
+    SvCUR_set(methodname, strlen(PL_isa_DOES));
     SvPVX(methodname) = (char *)PL_isa_DOES; /* discard 'const' qualifier */
     SvPOK_on(methodname);
     sv_2mortal(methodname);
@@ -986,6 +986,25 @@ XS(XS_re_regexp_pattern)
     NOT_REACHED; /* NOTREACHED */
 }
 
+#ifdef HAS_GETCWD
+
+XS(XS_Internals_getcwd)
+{
+    dXSARGS;
+    SV *sv = sv_newmortal();
+
+    if (items != 0)
+        croak_xs_usage(cv, "");
+
+    (void)getcwd_sv(sv);
+
+    SvTAINTED_on(sv);
+    PUSHs(sv);
+    XSRETURN(1);
+}
+
+#endif
+
 #include "vutil.h"
 #include "vxs.inc"
 
@@ -995,7 +1014,7 @@ struct xsub_details {
     const char *proto;
 };
 
-static const struct xsub_details details[] = {
+static const struct xsub_details these_details[] = {
     {"UNIVERSAL::isa", XS_UNIVERSAL_isa, NULL},
     {"UNIVERSAL::can", XS_UNIVERSAL_can, NULL},
     {"UNIVERSAL::DOES", XS_UNIVERSAL_DOES, NULL},
@@ -1020,6 +1039,9 @@ static const struct xsub_details details[] = {
     {"re::regnames", XS_re_regnames, ";$"},
     {"re::regnames_count", XS_re_regnames_count, ""},
     {"re::regexp_pattern", XS_re_regexp_pattern, "$"},
+#ifdef HAS_GETCWD
+    {"Internals::getcwd", XS_Internals_getcwd, ""},
+#endif
 };
 
 STATIC OP*
@@ -1075,8 +1097,8 @@ void
 Perl_boot_core_UNIVERSAL(pTHX)
 {
     static const char file[] = __FILE__;
-    const struct xsub_details *xsub = details;
-    const struct xsub_details *end = C_ARRAY_END(details);
+    const struct xsub_details *xsub = these_details;
+    const struct xsub_details *end = C_ARRAY_END(these_details);
 
     do {
        newXS_flags(xsub->name, xsub->xsub, file, xsub->proto, 0);
@@ -1089,12 +1111,12 @@ Perl_boot_core_UNIVERSAL(pTHX)
         CV* to_native_cv = get_cv("utf8::unicode_to_native", 0);
         CV* to_unicode_cv = get_cv("utf8::native_to_unicode", 0);
 
-        cv_set_call_checker(to_native_cv,
+        cv_set_call_checker_flags(to_native_cv,
                             optimize_out_native_convert_function,
-                            (SV*) to_native_cv);
-        cv_set_call_checker(to_unicode_cv,
+                            (SV*) to_native_cv, 0);
+        cv_set_call_checker_flags(to_unicode_cv,
                             optimize_out_native_convert_function,
-                            (SV*) to_unicode_cv);
+                            (SV*) to_unicode_cv, 0);
     }
 #endif