FAQ
The following patch resolves the discrepancy between print STDERR
and warn/die, with supplementary tests:

#!/usr/bin/perl -w
sub TIEHANDLE { bless [] } sub PRINT { $_ = $_[1]; s/^not //; print; }
print "1..3\n"; tie *STDERR => __PACKAGE__;
print STDERR "not ok 1 - print STDERR\n";
warn "not ok 2 - warn\n";
die "not ok 3 - die\n";

It does so by modifying up Perl_die_where and Perl_vwarn to check
whether if GvIOp(PL_stderrgv) is tied.

This is my very first C program, so bear with me if there's gaping
holes in it. :-)

Thanks,
/Autrijus/

diff -rdu perl/pp_ctl.c perl.2/pp_ctl.c
--- perl/pp_ctl.c Sat Feb 9 05:38:07 2002
+++ perl.2/pp_ctl.c Sat Feb 16 08:03:01 2002
@@ -1224,6 +1224,9 @@
Perl_die_where(pTHX_ char *message, STRLEN msglen)
{
STRLEN n_a;
+ IO *io;
+ MAGIC *mg;
+
if (PL_in_eval) {
I32 cxix;
register PERL_CONTEXT *cx;
@@ -1303,7 +1306,19 @@
}
if (!message)
message = SvPVx(ERRSV, msglen);
- {
+
+ /* if STDERR is tied, print to it instead */
+ if (PL_stderrgv && (io = GvIOp(PL_stderrgv))
+ && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar))) {
+ dSP; ENTER;
+ PUSHMARK(SP);
+ XPUSHs(SvTIED_obj((SV*)io, mg));
+ XPUSHs(sv_2mortal(newSVpvn(message, msglen)));
+ PUTBACK;
+ call_method("PRINT", G_SCALAR);
+ LEAVE;
+ }
+ else {
#ifdef USE_SFIO
/* SFIO can really mess with your errno */
int e = errno;
diff -rdu perl/t/op/tiehandle.t perl.2/t/op/tiehandle.t
--- perl/t/op/tiehandle.t Fri Jan 4 00:49:56 2002
+++ perl.2/t/op/tiehandle.t Sat Feb 16 08:20:51 2002
@@ -77,7 +77,7 @@

use Symbol;

-print "1..38\n";
+print "1..39\n";

my $fh = gensym;

@@ -160,7 +160,7 @@
use warnings;
# Special case of aliasing STDERR, which used
# to dump core when warnings were enabled
- *STDERR = *$fh;
+ local *STDERR = *$fh;
@expect = (PRINT => $ob,"some","text");
$r = print STDERR @expect[2,3];
ok($r == 1);
@@ -215,5 +215,18 @@
sub TIEHANDLE {bless {}}
sub TIEHASH {bless {}}
sub TIEARRAY {bless {}}
+}
+
+{
+ # warnings should pass to the PRINT method of tied STDERR
+ my @received;
+
+ local *STDERR = *$fh;
+ local *Implement::PRINT = sub { @received = @_ };
+
+ $r = warn("some", "text", "\n");
+ @expect = (PRINT => $ob,"sometext\n");
+
+ Implement::compare(PRINT => @received);
}

diff -rdu perl/util.c perl.2/util.c
--- perl/util.c Sat Feb 9 05:38:07 2002
+++ perl.2/util.c Sat Feb 16 07:55:48 2002
@@ -1356,6 +1356,8 @@
CV *cv;
SV *msv;
STRLEN msglen;
+ IO *io;
+ MAGIC *mg;

msv = vmess(pat, args);
message = SvPV(msv, msglen);
@@ -1388,6 +1390,20 @@
return;
}
}
+
+ /* if STDERR is tied, use it instead */
+ if (PL_stderrgv && (io = GvIOp(PL_stderrgv))
+ && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar))) {
+ dSP; ENTER;
+ PUSHMARK(SP);
+ XPUSHs(SvTIED_obj((SV*)io, mg));
+ XPUSHs(sv_2mortal(newSVpvn(message, msglen)));
+ PUTBACK;
+ call_method("PRINT", G_SCALAR);
+ LEAVE;
+ return;
+ }
+
{
PerlIO *serr = Perl_error_log;

Search Discussions

  • Arthur Bergman at Feb 17, 2002 at 12:43 pm

    The following patch resolves the discrepancy between print STDERR
    and warn/die, with supplementary tests:

    #!/usr/bin/perl -w
    sub TIEHANDLE { bless [] } sub PRINT { $_ = $_[1]; s/^not //; print; }
    print "1..3\n"; tie *STDERR => __PACKAGE__;
    print STDERR "not ok 1 - print STDERR\n";
    warn "not ok 2 - warn\n";
    die "not ok 3 - die\n";

    It does so by modifying up Perl_die_where and Perl_vwarn to check
    whether if GvIOp(PL_stderrgv) is tied.

    This is my very first C program, so bear with me if there's gaping
    holes in it. :-)

    Thanks,
    /Autrijus/
    Thanks, applied as 14727, this was very welcome.

Related Discussions

Discussion Navigation
viewthread | post
Discussion Overview
groupperl5-porters @
categoriesperl
postedFeb 17, '02 at 11:54a
activeFeb 17, '02 at 12:43p
posts2
users2
websiteperl.org

2 users in discussion

Autrijus Tang: 1 post Arthur Bergman: 1 post

People

Translate

site design / logo © 2021 Grokbase