Change 14904: Integrate from maintperl.

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.