This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Assertion failure with $/=*foo; warn;
authorFather Chrysostomos <sprout@cpan.org>
Thu, 24 May 2012 06:24:35 +0000 (23:24 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Thu, 7 Jun 2012 15:18:50 +0000 (08:18 -0700)
$ ./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.

t/io/open.t
util.c

index 6b1f1d7..696ba98 100644 (file)
@@ -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