Make Perl_gv_fetchpvn_flags actually heed the passed in length.

This means that \0 bytes in symbolic references now work.

p4raw-id: //depot/perl@27028

diff --git a/doio.c b/doio.c
index 019312b..c9d0578 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -336,7 +336,7 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
                        }
                        else {
                            GV *thatgv;
-                           thatgv = gv_fetchpvn_flags(type, type-tend,
+                           thatgv = gv_fetchpvn_flags(type, tend - type,
                                                       0, SVt_PVIO);
                            thatio = GvIO(thatgv);
                        }

diff --git a/gv.c b/gv.c
index 888d2fc..f60d0dc 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -758,27 +758,28 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
     register GV *gv = NULL;
     GV**gvp;
     I32 len;
-    register const char *namend;
+    register const char *name_cursor;
     HV *stash = NULL;
     const I32 no_init = flags & (GV_NOADD_NOINIT | GV_NOINIT);
     const I32 no_expand = flags & GV_NOEXPAND;
     const I32 add = flags & ~SVf_UTF8 & ~GV_NOADD_NOINIT & ~GV_NOEXPAND;
-
-    PERL_UNUSED_ARG(full_len);
+    const char *const name_end = nambeg + full_len;
+    const char *const name_em1 = name_end - 1;
 
     if (*name == '*' && isALPHA(name[1])) /* accidental stringify on a GV? */
        name++;
 
-    for (namend = name; *namend; namend++) {
-       if ((*namend == ':' && namend[1] == ':')
-           || (*namend == '\'' && namend[1]))
+    for (name_cursor = name; name_cursor < name_end; name_cursor++) {
+       if ((*name_cursor == ':' && name_cursor < name_em1
+            && name_cursor[1] == ':')
+           || (*name_cursor == '\'' && name_cursor[1]))
        {
            if (!stash)
                stash = PL_defstash;
            if (!stash || !SvREFCNT(stash)) /* symbol table under destruction */
                return Nullgv;
 
-           len = namend - name;
+           len = name_cursor - name;
            if (len > 0) {
                char smallbuf[128];
                char *tmpbuf;
@@ -808,18 +809,18 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                    stash = GvHV(gv) = newHV();
 
                if (!HvNAME_get(stash))
-                   hv_name_set(stash, nambeg, namend - nambeg, 0);
+                   hv_name_set(stash, nambeg, name_cursor - nambeg, 0);
            }
 
-           if (*namend == ':')
-               namend++;
-           namend++;
-           name = namend;
+           if (*name_cursor == ':')
+               name_cursor++;
+           name_cursor++;
+           name = name_cursor;
            if (!*name)
                return gv ? gv : (GV*)*hv_fetchs(PL_defstash, "main::", TRUE);
        }
     }
-    len = namend - name;
+    len = name_cursor - name;
 
     /* No stash in name, so see how we can default */
 

diff --git a/perl.c b/perl.c
index e9f7795..d145acb 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -4539,9 +4539,9 @@ Perl_init_argv_symbols(pTHX_ register int argc, register char **argv)
                break;
            }
            if ((s = strchr(argv[0], '='))) {
-               *s = '\0';
-               sv_setpv(GvSV(gv_fetchpv(argv[0] + 1, TRUE, SVt_PV)), s + 1);
-               *s = '=';
+               const char *const start_name = argv[0] + 1;
+               sv_setpv(GvSV(gv_fetchpvn_flags(start_name, s - start_name,
+                                               TRUE, SVt_PV)), s + 1);
            }
            else
                sv_setiv(GvSV(gv_fetchpv(argv[0]+1,TRUE, SVt_PV)),1);

diff --git a/t/op/ref.t b/t/op/ref.t
index d4fb4fd..e629d86 100755 (executable)
--- a/t/op/ref.t
+++ b/t/op/ref.t
@@ -423,9 +423,8 @@ TODO: {
 
     is ($$name1, undef, 'Nothing before we start');
     is ($$name2, undef, 'Nothing before we start');
-    $$name2 = "Yummy";
+    $$name1 = "Yummy";
     is ($$name1, "Yummy", 'Accessing via the correct name works');
-    local $TODO = "NUL bytes truncate in symrefs";
     is ($$name2, undef,
        'Accessing via a different NUL-containing name gives nothing');
 }

diff --git a/toke.c b/toke.c
index 5586d08..fafd82e 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -4296,7 +4296,6 @@ Perl_yylex(pTHX)
                    gvp = 0;
                }
                else {
-                   len = 0;
                    if (!gv) {
                        /* Mustn't actually add anything to a symbol table.
                           But also don't want to "initialise" any placeholder
@@ -4305,6 +4304,7 @@ Perl_yylex(pTHX)
                        gv = gv_fetchpvn_flags(PL_tokenbuf, len,
                                               GV_NOADD_NOINIT, SVt_PVCV);
                    }
+                   len = 0;
                }
 
                /* if we saw a global override before, get the right name */
@@ -4450,7 +4450,7 @@ Perl_yylex(pTHX)
 
                    /* Resolve to GV now. */
                    if (SvTYPE(gv) != SVt_PVGV) {
-                       gv = gv_fetchpvn_flags(PL_tokenbuf, len, 0, SVt_PVCV);
+                       gv = gv_fetchpv(PL_tokenbuf, 0, SVt_PVCV);
                        assert (SvTYPE(gv) == SVt_PVGV);
                        /* cv must have been some sort of placeholder, so
                           now needs replacing with a real code reference.  */