From: Daniel Chetlin <daniel@chetlin.com>
Date: Mon, 2 Oct 2000 14:53:27 +0000 (-0700)
Subject: Fix aliasing of tied filehandles
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=01bb7c6d67bc951562ed98068eba189cadd42374;p=p5sagit%2Fp5-mst-13.2.git

Fix aliasing of tied filehandles
Message-ID: <20001002145327.C1617@ilmd>

p4raw-id: //depot/perl@7110
---

diff --git a/perl.h b/perl.h
index 5661851..0b5c6ea 100644
--- a/perl.h
+++ b/perl.h
@@ -2056,6 +2056,7 @@ Gid_t getegid (void);
 
 #ifndef Perl_error_log
 #  define Perl_error_log	(PL_stderrgv			\
+				 && GvIOp(PL_stderrgv)          \
 				 && IoOFP(GvIOp(PL_stderrgv))	\
 				 ? IoOFP(GvIOp(PL_stderrgv))	\
 				 : PerlIO_stderr())
diff --git a/pp_hot.c b/pp_hot.c
index 17710d5..7d39514 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -377,6 +377,7 @@ PP(pp_print)
     else
 	gv = PL_defoutgv;
     if ((mg = SvTIED_mg((SV*)gv, 'q'))) {
+      had_magic:
 	if (MARK == ORIGMARK) {
 	    /* If using default handle then we need to make space to
 	     * pass object as 1st arg, so move other args up ...
@@ -400,6 +401,8 @@ PP(pp_print)
     }
     if (!(io = GvIO(gv))) {
         dTHR;
+        if ((GvEGV(gv)) && (mg = SvTIED_mg((SV*)GvEGV(gv),'q')))
+            goto had_magic;
 	if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
 	    report_evil_fh(gv, io, PL_op->op_type);
 	SETERRNO(EBADF,RMS$_IFI);
diff --git a/t/op/tiehandle.t b/t/op/tiehandle.t
index d7e6a78..b04bdb7 100755
--- a/t/op/tiehandle.t
+++ b/t/op/tiehandle.t
@@ -77,7 +77,7 @@ package main;
 
 use Symbol;
 
-print "1..29\n";
+print "1..33\n";
 
 my $fh = gensym;
 
@@ -149,3 +149,19 @@ ok($data eq "qwerty");
 @expect = (CLOSE => $ob);
 $r = close $fh;
 ok($r == 5);
+
+# Does aliasing work with tied FHs?
+*ALIAS = *$fh;
+@expect = (PRINT => $ob,"some","text");
+$r = print ALIAS @expect[2,3];
+ok($r == 1);
+
+{
+    use warnings;
+    # Special case of aliasing STDERR, which used
+    # to dump core when warnings were enabled
+    *STDERR = *$fh;
+    @expect = (PRINT => $ob,"some","text");
+    $r = print STDERR @expect[2,3];
+    ok($r == 1);
+}