Assertion failure with $/=*foo; warn;

$ ./perl -Ilib -e '$/=*foo; <>; warn' <./perl
Assertion failed: (!isGV_with_GP(_svcur)), function Perl_mess_sv, file util.c, line 1467.
Abort trap

The assertion happens when ‘<...> line 42’ is being appended to
the message.

The line of code in question is this:

	    const bool line_mode = (RsSIMPLE(PL_rs) &&
			      SvCUR(PL_rs) == 1 && *SvPVX_const(PL_rs) == '\n');

It uses this macro in perl.h:

#define RsSIMPLE(sv)  (SvOK(sv) && (! SvPOK(sv) || SvCUR(sv)))

which was last modified by commit af7d13df559:

-#define RsSIMPLE(sv)  (SvOK(sv) && SvCUR(sv))
-#define RsPARA(sv)    (SvOK(sv) && ! SvCUR(sv))
+#define RsSIMPLE(sv)  (SvOK(sv) && (! SvPOK(sv) || SvCUR(sv)))
+#define RsPARA(sv)    (SvPOK(sv) && ! SvCUR(sv))

So it looks as though it has always called SvCUR on something that is
not necessarily a PV.  As of commit af7d13df559, it has also called
SvPVX on a potential non-PV.

Fixing this simply involves using SvPV instead of SvPVX.

I don’t know that t/io/open.t is the best place for the test, but all
the other ‘<...> line 42’ tests are there.

diff --git a/t/io/open.t b/t/io/open.t
index 6b1f1d7..696ba98 100644 (file)
--- a/t/io/open.t
+++ b/t/io/open.t
@@ -10,7 +10,7 @@ $|  = 1;
 use warnings;
 use Config;
 
-plan tests => 119;
+plan tests => 120;
 
 my $Perl = which_perl();
 
@@ -278,6 +278,11 @@ SKIP: {
     open($fh3{k}, "TEST");
     gimme($fh3{k});
     like($@, qr/<\$fh3\{...}> line 1\./, "autoviv fh lexical helem");
+
+    local $/ = *F;  # used to cause an assertion failure
+    gimme($fh3{k});
+    like($@, qr/<\$fh3\{...}> chunk 2\./,
+       '<...> line 1 when $/ is set to a glob');
 }
     
 SKIP: {

diff --git a/util.c b/util.c
index d0fea67..9c9c072 100644 (file)
--- a/util.c
+++ b/util.c
@@ -1306,8 +1306,9 @@ Perl_mess_sv(pTHX_ SV *basemsg, bool consume)
        if (GvIO(PL_last_in_gv) && (SvTYPE(GvIOp(PL_last_in_gv)) == SVt_PVIO)
                && IoLINES(GvIOp(PL_last_in_gv)))
        {
+           STRLEN l;
            const bool line_mode = (RsSIMPLE(PL_rs) &&
-                             SvCUR(PL_rs) == 1 && *SvPVX_const(PL_rs) == '\n');
+                                  *SvPV_const(PL_rs,l) == '\n' && l == 1);
            Perl_sv_catpvf(aTHX_ sv, ", <%"SVf"> %s %"IVdf,
                           SVfARG(PL_last_in_gv == PL_argvgv
                                  ? &PL_sv_no