This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
sysread should not ignore magic on its buffer
authorFather Chrysostomos <sprout@cpan.org>
Thu, 24 Nov 2011 04:26:51 +0000 (20:26 -0800)
committerFather Chrysostomos <sprout@cpan.org>
Thu, 24 Nov 2011 09:45:30 +0000 (01:45 -0800)
sysread uses SvPV_force, which has a bug in it.  Even if the SV_GMAGIC
flag is passed to sv_pvn_force_flags (which SvPV_force does), it
ignores magic in any typeglob argument.

sv.c
t/op/gmagic.t

diff --git a/sv.c b/sv.c
index b8f0b10..31bda3b 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -9014,6 +9014,7 @@ Perl_sv_pvn_force_flags(pTHX_ SV *const sv, STRLEN *const lp, const I32 flags)
 
     PERL_ARGS_ASSERT_SV_PVN_FORCE_FLAGS;
 
+    if (flags & SV_GMAGIC) SvGETMAGIC(sv);
     if (SvTHINKFIRST(sv) && !SvROK(sv))
         sv_force_normal_flags(sv, 0);
 
@@ -9038,7 +9039,7 @@ Perl_sv_pvn_force_flags(pTHX_ SV *const sv, STRLEN *const lp, const I32 flags)
            /* diag_listed_as: Can't coerce %s to %s in %s */
            Perl_croak(aTHX_ "Can't coerce %s to string in %s", sv_reftype(sv,0),
                OP_DESC(PL_op));
-       s = sv_2pv_flags(sv, &len, flags);
+       s = sv_2pv_flags(sv, &len, flags &~ SV_GMAGIC);
        if (lp)
            *lp = len;
 
index daebae4..c502052 100644 (file)
@@ -61,6 +61,30 @@ $c = bless [], o::;
 chomp $c;
 expected_tie_calls(tied $c, 1, 2, 'chomping a ref');
 
+{
+    my $outfile = tempfile();
+    open my $h, ">$outfile" or die  "$0 cannot close $outfile: $!";
+    print $h "bar\n";
+    close $h or die "$0 cannot close $outfile: $!";    
+
+    $c = *foo;                                         # 1 write
+    open $h, $outfile;
+    sysread $h, $c, 3, 7;                              # 1 read; 1 write
+    is $c, "*main::bar", 'what sysread wrote';         # 1 read
+    expected_tie_calls(tied $c, 2, 2, 'calling sysread with tied buf');
+    close $h or die "$0 cannot close $outfile: $!";
+
+ # Do this again, with a utf8 handle
+    $c = *finish;                                      # 1 write
+    open $h, "<:utf8", $outfile;
+    sysread $h, $c, 3, 7;                              # 1 read; 1 write
+    is $c, "*main::bar", 'what sysread wrote';         # 1 read
+    expected_tie_calls(tied $c, 2, 2, 'calling sysread with tied buf');
+    close $h or die "$0 cannot close $outfile: $!";
+
+    unlink_all $outfile;
+}
+
 # autovivication of aelem, helem, of rv2sv combined with get-magic
 {
     my $true = 1;