diff options
| -rw-r--r-- | doio.c | 15 | ||||
| -rw-r--r-- | embed.h | 2 | ||||
| -rwxr-xr-x | embed.pl | 2 | ||||
| -rwxr-xr-x | perlapi.c | 4 | ||||
| -rw-r--r-- | proto.h | 2 | ||||
| -rw-r--r-- | sv.c | 2 | ||||
| -rwxr-xr-x | t/io/pipe.t | 17 |
7 files changed, 30 insertions, 14 deletions
@@ -675,7 +675,7 @@ Perl_do_close(pTHX_ GV *gv, bool not_implicit) } return FALSE; } - retval = io_close(io); + retval = io_close(io, not_implicit); if (not_implicit) { IoLINES(io) = 0; IoPAGE(io) = 0; @@ -686,7 +686,7 @@ Perl_do_close(pTHX_ GV *gv, bool not_implicit) } bool -Perl_io_close(pTHX_ IO *io) +Perl_io_close(pTHX_ IO *io, bool not_implicit) { bool retval = FALSE; int status; @@ -694,8 +694,13 @@ Perl_io_close(pTHX_ IO *io) if (IoIFP(io)) { if (IoTYPE(io) == '|') { status = PerlProc_pclose(IoIFP(io)); - STATUS_NATIVE_SET(status); - retval = (STATUS_POSIX == 0); + if (not_implicit) { + STATUS_NATIVE_SET(status); + retval = (STATUS_POSIX == 0); + } + else { + retval = (status != -1); + } } else if (IoTYPE(io) == '-') retval = TRUE; @@ -709,7 +714,7 @@ Perl_io_close(pTHX_ IO *io) } IoOFP(io) = IoIFP(io) = Nullfp; } - else { + else if (not_implicit) { SETERRNO(EBADF,SS$_IVCHAN); } @@ -1531,7 +1531,7 @@ #define init_stacks() Perl_init_stacks(aTHX) #define intro_my() Perl_intro_my(aTHX) #define instr(a,b) Perl_instr(aTHX_ a,b) -#define io_close(a) Perl_io_close(aTHX_ a) +#define io_close(a,b) Perl_io_close(aTHX_ a,b) #define invert(a) Perl_invert(aTHX_ a) #define is_uni_alnum(a) Perl_is_uni_alnum(aTHX_ a) #define is_uni_alnumc(a) Perl_is_uni_alnumc(aTHX_ a) @@ -1196,7 +1196,7 @@ p |void |init_debugger p |void |init_stacks p |U32 |intro_my p |char* |instr |const char* big|const char* little -p |bool |io_close |IO* io +p |bool |io_close |IO* io|bool not_implicit p |OP* |invert |OP* cmd p |bool |is_uni_alnum |U32 c p |bool |is_uni_alnumc |U32 c @@ -1379,9 +1379,9 @@ Perl_instr(pTHXo_ const char* big, const char* little) #undef Perl_io_close bool -Perl_io_close(pTHXo_ IO* io) +Perl_io_close(pTHXo_ IO* io, bool not_implicit) { - return ((CPerlObj*)pPerl)->Perl_io_close(io); + return ((CPerlObj*)pPerl)->Perl_io_close(io, not_implicit); } #undef Perl_invert @@ -202,7 +202,7 @@ VIRTUAL void Perl_init_debugger(pTHX); VIRTUAL void Perl_init_stacks(pTHX); VIRTUAL U32 Perl_intro_my(pTHX); VIRTUAL char* Perl_instr(pTHX_ const char* big, const char* little); -VIRTUAL bool Perl_io_close(pTHX_ IO* io); +VIRTUAL bool Perl_io_close(pTHX_ IO* io, bool not_implicit); VIRTUAL OP* Perl_invert(pTHX_ OP* cmd); VIRTUAL bool Perl_is_uni_alnum(pTHX_ U32 c); VIRTUAL bool Perl_is_uni_alnumc(pTHX_ U32 c); @@ -2979,7 +2979,7 @@ Perl_sv_clear(pTHX_ register SV *sv) IoIFP(sv) != PerlIO_stdout() && IoIFP(sv) != PerlIO_stderr()) { - io_close((IO*)sv); + io_close((IO*)sv, FALSE); } if (IoDIRP(sv)) { PerlDir_close(IoDIRP(sv)); diff --git a/t/io/pipe.t b/t/io/pipe.t index 37949c4546..826cf7434a 100755 --- a/t/io/pipe.t +++ b/t/io/pipe.t @@ -1,7 +1,5 @@ #!./perl -# $RCSfile: pipe.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:31 $ - BEGIN { chdir 't' if -d 't'; unshift @INC, '../lib'; @@ -13,7 +11,7 @@ BEGIN { } $| = 1; -print "1..14\n"; +print "1..15\n"; # External program 'tr' assumed. open(PIPE, "|-") || (exec 'tr', 'YX', 'ko'); @@ -158,3 +156,16 @@ if ($? == 37*256 && $wait == $zombie && ! $!) { print (((open P, "| " ) ? "not " : ""), "ok 13\n"); print (((open P, " |" ) ? "not " : ""), "ok 14\n"); } + +# check that status is unaffected by implicit close +{ + local(*NIL); + open NIL, '|exit 23;' or die "fork failed: $!"; + $? = 42; + # NIL implicitly closed here +} +if ($? != 42) { + print "# status $?, expected 42\nnot "; +} +print "ok 15\n"; +$? = 0; |