pv->pvn for literals in pp_require and Perl_sv_derived_from_pvn
authorDaniel Dragan <bulk88@hotmail.com>
Mon, 12 Nov 2012 16:08:44 +0000 (11:08 -0500)
committerFather Chrysostomos <sprout@cpan.org>
Mon, 12 Nov 2012 19:21:11 +0000 (11:21 -0800)
I found these 2 strlens while stepping through the interp while running a
script and both came from a pp_require. UNIVERSAL::can was not modified
since it is more rarely called than pp_require. A better more through
investigation of version obj comparison and upgrading will need to be done
in the future (new funcs needed for the derived/upg_version idiom, remove
the upg_version since it was changed to always be a ver obj, etc).

perlio.c
pp_ctl.c
t/TEST
universal.c
util.c

index 905e043..a388ba7 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -466,7 +466,6 @@ PerlIO_debug(const char *fmt, ...)
        }
     }
     if (PL_perlio_debug_fd > 0) {
-       dTHX;
 #ifdef USE_ITHREADS
        const char * const s = CopFILE(PL_curcop);
        /* Use fixed buffer as sv_catpvf etc. needs SVs */
@@ -2392,7 +2391,6 @@ PerlIOUnix_refcnt_inc(int fd)
 int
 PerlIOUnix_refcnt_dec(int fd)
 {
-    dTHX;
     int cnt = 0;
     if (fd >= 0) {
        dVAR;
@@ -2401,12 +2399,12 @@ PerlIOUnix_refcnt_dec(int fd)
 #endif
        if (fd >= PL_perlio_fd_refcnt_size) {
            /* diag_listed_as: refcnt_dec: fd %d%s */
-           Perl_croak(aTHX_ "refcnt_dec: fd %d >= refcnt_size %d\n",
+           Perl_croak_nocontext("refcnt_dec: fd %d >= refcnt_size %d\n",
                       fd, PL_perlio_fd_refcnt_size);
        }
        if (PL_perlio_fd_refcnt[fd] <= 0) {
            /* diag_listed_as: refcnt_dec: fd %d%s */
-           Perl_croak(aTHX_ "refcnt_dec: fd %d: %d <= 0\n",
+           Perl_croak_nocontext("refcnt_dec: fd %d: %d <= 0\n",
                       fd, PL_perlio_fd_refcnt[fd]);
        }
        cnt = --PL_perlio_fd_refcnt[fd];
@@ -2416,7 +2414,7 @@ PerlIOUnix_refcnt_dec(int fd)
 #endif
     } else {
        /* diag_listed_as: refcnt_dec: fd %d%s */
-       Perl_croak(aTHX_ "refcnt_dec: fd %d < 0\n", fd);
+       Perl_croak_nocontext("refcnt_dec: fd %d < 0\n", fd);
     }
     return cnt;
 }
@@ -3790,12 +3788,14 @@ PerlIO_releaseFILE(PerlIO *p, FILE *f)
     while ((l = *p)) {
        if (l->tab == &PerlIO_stdio) {
            PerlIOStdio *s = PerlIOSelf(&l, PerlIOStdio);
-           if (s->stdio == f) {
-               dTHX;
+           if (s->stdio == f) { /* not in a loop */
                const int fd = fileno(f);
                if (fd >= 0)
                    PerlIOUnix_refcnt_dec(fd);
-               PerlIO_pop(aTHX_ p);
+               {
+                   dTHX;
+                   PerlIO_pop(aTHX_ p);
+               }
                return;
            }
        }
@@ -5093,9 +5093,9 @@ Perl_PerlIO_context_layers(pTHX_ const char *mode)
 int
 PerlIO_setpos(PerlIO *f, SV *pos)
 {
-    dTHX;
     if (SvOK(pos)) {
        STRLEN len;
+       dTHX;
        const Off_t * const posn = (Off_t *) SvPV(pos, len);
        if (f && len == sizeof(Off_t))
            return PerlIO_seek(f, *posn, SEEK_SET);
index 6849f88..22e1cea 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3601,7 +3601,7 @@ PP(pp_require)
     sv = POPs;
     if ( (SvNIOKp(sv) || SvVOK(sv)) && PL_op->op_type != OP_DOFILE) {
        sv = sv_2mortal(new_version(sv));
-       if (!sv_derived_from(PL_patchlevel, "version"))
+       if (!Perl_sv_derived_from_pvn(aTHX_ PL_patchlevel, STR_WITH_LEN("version"), 0))
            upg_version(PL_patchlevel, TRUE);
        if (cUNOP->op_first->op_type == OP_CONST && cUNOP->op_first->op_private & OPpCONST_NOVER) {
            if ( vcmp(sv,PL_patchlevel) <= 0 )
diff --git a/t/TEST b/t/TEST
index 9e40b17..0ea518d 100755 (executable)
--- a/t/TEST
+++ b/t/TEST
@@ -23,7 +23,7 @@ my %dir_to_switch =
      '../ext/File-Glob/t' => '-I.. -MTestInit', # FIXME - tests assume t/
      );
 
-# "not absolute" is the the default, as it saves some fakery within TestInit
+# "not absolute" is the default, as it saves some fakery within TestInit
 # which can perturb tests, and takes CPU. Working with the upstream author of
 # any of these, to figure out how to remove them from this list, considered
 # "a good thing".
index be06aca..76b6281 100644 (file)
@@ -165,7 +165,7 @@ Perl_sv_derived_from_pvn(pTHX_ SV *sv, const char *const name, const STRLEN len,
     else {
         stash = gv_stashsv(sv, 0);
         if (!stash)
-            stash = gv_stashpv("UNIVERSAL", 0);
+            stash = gv_stashpvs("UNIVERSAL", 0);
     }
 
     return stash ? isa_lookup(stash, name, len, flags) : FALSE;
diff --git a/util.c b/util.c
index 5132c24..c0d1091 100644 (file)
--- a/util.c
+++ b/util.c
@@ -5362,7 +5362,7 @@ int
 Perl_my_socketpair (int family, int type, int protocol, int fd[2]) {
     /* Stevens says that family must be AF_LOCAL, protocol 0.
        I'm going to enforce that, then ignore it, and use TCP (or UDP).  */
-    dTHX;
+    dTHXa(NULL);
     int listener = -1;
     int connector = -1;
     int acceptor = -1;
@@ -5388,6 +5388,7 @@ Perl_my_socketpair (int family, int type, int protocol, int fd[2]) {
        return S_socketpair_udp(fd);
 #endif
 
+    aTHXa(PERL_GET_THX);
     listener = PerlSock_socket(AF_INET, type, 0);
     if (listener == -1)
        return -1;