Change 14904 by pudge@pudge-mobile on 2002/02/27 21:25:39
Integrate from maintperl.
Affected files ...
.... //depot/maint-5.6/macperl/doio.c#3 integrate
.... //depot/maint-5.6/macperl/op.c#6 integrate
.... //depot/maint-5.6/macperl/t/io/open.t#3 integrate
.... //depot/maint-5.6/macperl/t/pragma/strict-subs#2 integrate
Differences ...
==== //depot/maint-5.6/macperl/doio.c#3 (text) ====
Index: perl/doio.c
--- perl/doio.c.~1~ Wed Feb 27 14:30:06 2002
+++ perl/doio.c Wed Feb 27 14:30:06 2002
@@ -457,38 +457,53 @@
fd = PerlIO_fileno(saveifp);
if (saveofp) {
PerlIO_flush(saveofp); /* emulate PerlIO_close() */
- if (saveofp != saveifp) { /* was a socket? */
+ if (saveofp != saveifp) { /* was a socket? */
PerlIO_close(saveofp);
- if (fd > 2)
- Safefree(saveofp);
}
}
if (fd != PerlIO_fileno(fp)) {
- Pid_t pid;
- SV *sv;
-
PerlLIO_dup2(PerlIO_fileno(fp), fd);
#ifdef VMS
if (fd != PerlIO_fileno(PerlIO_stdin())) {
- char newname[FILENAME_MAX+1];
- if (fgetname(fp, newname)) {
- if (fd == PerlIO_fileno(PerlIO_stdout()))
Perl_vmssetuserlnm("SYS$OUTPUT", newname);
- if (fd == PerlIO_fileno(PerlIO_stderr()))
Perl_vmssetuserlnm("SYS$ERROR", newname);
- }
+ char newname[FILENAME_MAX+1];
+ if (fgetname(fp, newname)) {
+ if (fd == PerlIO_fileno(PerlIO_stdout()))
+ Perl_vmssetuserlnm("SYS$OUTPUT", newname);
+ if (fd == PerlIO_fileno(PerlIO_stderr()))
+ Perl_vmssetuserlnm("SYS$ERROR", newname);
+ }
+ }
+#endif
+
+#if !defined(WIN32)
+ /* PL_fdpid isn't used on Windows, so avoid this useless work.
+ * XXX Probably the same for a lot of other places. */
+ {
+ Pid_t pid;
+ SV *sv;
+
+ LOCK_FDPID_MUTEX;
+ sv = *av_fetch(PL_fdpid,PerlIO_fileno(fp),TRUE);
+ (void)SvUPGRADE(sv, SVt_IV);
+ pid = SvIVX(sv);
+ SvIVX(sv) = 0;
+ sv = *av_fetch(PL_fdpid,fd,TRUE);
+ (void)SvUPGRADE(sv, SVt_IV);
+ SvIVX(sv) = pid;
+ UNLOCK_FDPID_MUTEX;
}
#endif
- LOCK_FDPID_MUTEX;
- sv = *av_fetch(PL_fdpid,PerlIO_fileno(fp),TRUE);
- (void)SvUPGRADE(sv, SVt_IV);
- pid = SvIVX(sv);
- SvIVX(sv) = 0;
- sv = *av_fetch(PL_fdpid,fd,TRUE);
- UNLOCK_FDPID_MUTEX;
- (void)SvUPGRADE(sv, SVt_IV);
- SvIVX(sv) = pid;
- if (!was_fdopen)
+
+ if (was_fdopen) {
+ /* need to close fp without closing underlying fd */
+ int ofd = PerlIO_fileno(fp);
+ int dupfd = PerlLIO_dup(ofd);
+ PerlIO_close(fp);
+ PerlLIO_dup2(dupfd,ofd);
+ PerlLIO_close(dupfd);
+ }
+ else
PerlIO_close(fp);
-
}
fp = saveifp;
PerlIO_clearerr(fp);
==== //depot/maint-5.6/macperl/op.c#6 (text) ====
Index: perl/op.c
--- perl/op.c.~1~ Wed Feb 27 14:30:06 2002
+++ perl/op.c Wed Feb 27 14:30:06 2002
@@ -2352,6 +2352,7 @@
o->op_type = OP_RV2AV;
o->op_ppaddr = PL_ppaddr[OP_RV2AV];
+ o->op_seq = 0; /* needs to be revisited in peep() */
curop = ((UNOP*)o)->op_first;
((UNOP*)o)->op_first = newSVOP(OP_CONST, 0, SvREFCNT_inc(*PL_stack_sp--));
op_free(curop);
==== //depot/maint-5.6/macperl/t/io/open.t#3 (xtext) ====
Index: perl/t/io/open.t
--- perl/t/io/open.t.~1~ Wed Feb 27 14:30:06 2002
+++ perl/t/io/open.t Wed Feb 27 14:30:06 2002
@@ -8,11 +8,12 @@
# $RCSfile$
$| = 1;
use warnings;
+use File::Spec;
$Is_MacOS = $^O eq 'MacOS';
$Is_VMS = $^O eq 'VMS';
$Is_Dos = $^O eq 'dos';
-print "1..66\n";
+print "1..69\n";
my $test = 1;
@@ -271,7 +272,7 @@
local *F;
for (1..2) {
if ($Is_Dos) {
- open(F, "echo \\#foo|") or print "not ";
+ open(F, "echo \\#foo|") or print "not ";
} else {
open(F, "echo #foo|") or print "not ";
}
@@ -281,7 +282,7 @@
ok;
for (1..2) {
if ($Is_Dos) {
- open(F, "-|", "echo \\#foo") or print "not ";
+ open(F, "-|", "echo \\#foo") or print "not ";
} else {
open(F, "-|", "echo #foo") or print "not ";
}
@@ -290,3 +291,42 @@
}
ok;
}
+
+
+# this used to leak FILE* pointers on all platforms (and also died on
+# Windows after running a few hundred times)
+
+my $devnull = File::Spec->devnull;
+{
+ my $loopcount;
+
+ $loopcount = 0;
+ while ($loopcount++ < 555) {
+ open NEWOUT, ">$devnull" or die;
+ open SAVEOUT, ">&STDOUT" or die;
+ open STDOUT, ">&=" . fileno(NEWOUT) or die;
+ open STDOUT, ">&SAVEOUT" or die;
+ close NEWOUT;
+ }
+ ok;
+
+ $loopcount = 0;
+ while ($loopcount++ < 555) {
+ open NEWOUT, ">$devnull" or die;
+ open SAVEOUT, ">&STDOUT" or die;
+ open STDOUT, ">&=NEWOUT" or die;
+ open STDOUT, ">&SAVEOUT" or die;
+ close NEWOUT;
+ }
+ ok;
+
+ $loopcount = 0;
+ while ($loopcount++ < 555) {
+ open NEWOUT, ">$devnull" or die;
+ open SAVEOUT, ">&STDOUT" or die;
+ open STDOUT, ">&NEWOUT" or die;
+ open STDOUT, ">&SAVEOUT" or die;
+ close NEWOUT;
+ }
+ ok;
+}
==== //depot/maint-5.6/macperl/t/pragma/strict-subs#2 (text) ====
Index: perl/t/pragma/strict-subs
--- perl/t/pragma/strict-subs.~1~ Wed Feb 27 14:30:06 2002
+++ perl/t/pragma/strict-subs Wed Feb 27 14:30:06 2002
@@ -51,6 +51,15 @@
########
# strict subs - error
+use strict 'subs' ;
+my @a = (1..2);
+my $b = xyz;
+EXPECT
+Bareword "xyz" not allowed while "strict subs" in use at - line 5.
+Execution of - aborted due to compilation errors.
+########
+
+# strict subs - error
use strict ;
Fred ;
EXPECT
End of Patch.
