PERFORCE change 12553 for review

Change 12553 by pudge@pudge-mobile on 2001/10/21 21:51:34

	Integrate from maintperl
	(Changes 12350, 12496, 12548, 12549, 12550)

Affected files ...

... //depot/maint-5.6/macperl/ext/IO/lib/IO/Seekable.pm#2 integrate
... //depot/maint-5.6/macperl/lib/Carp/Heavy.pm#2 integrate
... //depot/maint-5.6/macperl/t/base/rs.t#2 integrate
... //depot/maint-5.6/macperl/t/lib/filefind-taint.t#5 integrate
... //depot/maint-5.6/macperl/t/pragma/strict-vars#2 integrate
... //depot/maint-5.6/macperl/toke.c#3 integrate

Differences ...

==== //depot/maint-5.6/macperl/ext/IO/lib/IO/Seekable.pm#2 (text) ====
Index: perl/ext/IO/lib/IO/Seekable.pm
--- perl/ext/IO/lib/IO/Seekable.pm.~1~	Sun Oct 21 16:00:05 2001
+++ perl/ext/IO/lib/IO/Seekable.pm	Sun Oct 21 16:00:05 2001
@@ -55,7 +55,7 @@
 
 POS is an offset from the current position. (Seek relative to current)
 
-=item WHENCE=1 (SEEK_END)
+=item WHENCE=2 (SEEK_END)
 
 POS is an offset from the end of the file. (Seek relative to end)
 

==== //depot/maint-5.6/macperl/lib/Carp/Heavy.pm#2 (text) ====
Index: perl/lib/Carp/Heavy.pm
--- perl/lib/Carp/Heavy.pm.~1~	Sun Oct 21 16:00:05 2001
+++ perl/lib/Carp/Heavy.pm	Sun Oct 21 16:00:05 2001
@@ -53,7 +53,7 @@
 	#  subsequent times: $mess .= $sub $error at $file line $line
 	#                                  ^^^^^^
 	#                                 "called"
-	if ($error =~ m/\n$/) {
+	if ($error =~ m/\n\z/) {
 	    $mess .= $error;
 	} else {
 	    # Build a string, $sub, which names the sub-routine called.
@@ -226,12 +226,18 @@
 	    # OK!  We've got a candidate package.  Time to construct the
 	    # relevant error message and return it.
 	    my $msg;
-	    $msg = "$error at $file line $line";
-	    if (defined &Thread::tid) {
-		my $tid = Thread->self->tid;
-		$msg .= " thread $tid" if $tid;
+	    # make sure we don't add debug info if it ends with a newline
+	    if ($error =~ /\n\z/) {
+		$msg = $error;
+	    }
+	    else {
+		$msg = "$error at $file line $line";
+		if (defined &Thread::tid) {
+		    my $tid = Thread->self->tid;
+		    $msg .= " thread $tid" if $tid;
+		}
+		$msg .= "\n";
 	    }
-	    $msg .= "\n";
 	    return $msg;
 	}
     }

==== //depot/maint-5.6/macperl/t/base/rs.t#2 (xtext) ====
Index: perl/t/base/rs.t
--- perl/t/base/rs.t.~1~	Sun Oct 21 16:00:05 2001
+++ perl/t/base/rs.t	Sun Oct 21 16:00:05 2001
@@ -1,7 +1,7 @@
 #!./perl
 # Test $!
 
-print "1..14\n";
+print "1..16\n";
 
 $teststring = "1\n12\n123\n1234\n1234\n12345\n\n123456\n1234567\n";
 
@@ -86,9 +86,7 @@
 $bar = <TESTFILE>;
 if ($bar eq "78") {print "ok 10\n";} else {print "not ok 10\n";}
 
-# Get rid of the temp file
 close TESTFILE;
-unlink "./foo";
 
 # Now for the tricky bit--full record reading
 if ($^O eq 'VMS') {
@@ -130,3 +128,35 @@
   # put their own tests in) so we just punt
   foreach $test (11..14) {print "ok $test # skipped on non-VMS system\n"};
 }
+
+$/ = "\n";
+
+# see if open/readline/close work on our and my variables
+{
+    if (open our $T, "./foo") {
+        my $line = <$T>;
+	print "# $line\n";
+	length($line) == 40 or print "not ";
+        close $T or print "not ";
+    }
+    else {
+	print "not ";
+    }
+    print "ok 15\n";
+}
+
+{
+    if (open my $T, "./foo") {
+        my $line = <$T>;
+	print "# $line\n";
+	length($line) == 40 or print "not ";
+        close $T or print "not ";
+    }
+    else {
+	print "not ";
+    }
+    print "ok 16\n";
+}
+
+# Get rid of the temp file
+END { unlink "./foo"; }

==== //depot/maint-5.6/macperl/t/lib/filefind-taint.t#5 (text) ====
Index: perl/t/lib/filefind-taint.t
--- perl/t/lib/filefind-taint.t.~1~	Sun Oct 21 16:00:05 2001
+++ perl/t/lib/filefind-taint.t	Sun Oct 21 16:00:05 2001
@@ -41,6 +41,9 @@
 use File::Spec;
 use Cwd;
 
+
+my $NonTaintedCwd = $^O eq 'MSWin32' || $^O eq 'cygwin' || $^O eq 'os2';
+
 cleanup();
 
 find({wanted => sub { print "ok 1\n" if $_ eq 'if.t'; },
@@ -326,8 +329,12 @@
 
 print "# $@" if $@;
 #$^D = 8;
-Check( $@ =~ m|insecure cwd| );
-
+if ($NonTaintedCwd) {
+	Skip("$^O does not taint cwd");
+    } 
+else {
+	Check( $@ =~ m|insecure cwd| );
+}
 chdir($cwd_untainted);
 
 
@@ -395,8 +402,12 @@
     eval {File::Find::find( {wanted => \&simple_wanted, untaint => 1,
                              untaint_skip => 1, untaint_pattern =>
                              qr|^(NO_MATCH)$|}, topdir('fa') );};
-    Check( $@ =~ m|insecure cwd| );
-
+    if ($NonTaintedCwd) {
+	Skip("$^O does not taint cwd");
+    } 
+    else {
+	Check( $@ =~ m|insecure cwd| );
+    }
     chdir($cwd_untainted);
 } 
 

==== //depot/maint-5.6/macperl/t/pragma/strict-vars#2 (text) ====
Index: perl/t/pragma/strict-vars
--- perl/t/pragma/strict-vars.~1~	Sun Oct 21 16:00:05 2001
+++ perl/t/pragma/strict-vars	Sun Oct 21 16:00:05 2001
@@ -399,6 +399,20 @@
 Name "Foo::foo" used only once: possible typo at - line 11.
 ########
 
+--FILE-- abc
+ok
+--FILE-- 
+# check if our variables are introduced correctly in readline()
+package Foo;
+use strict 'vars';
+our $FH;
+open $FH, "abc" or die "Can't open 'abc': $!";
+print <$FH>;
+close $FH;
+EXPECT
+ok
+########
+
 # Make sure the strict vars failure still occurs
 # now that the `@i should be written as \@i' failure does not occur
 # 20000522 [email protected] (MJD)

==== //depot/maint-5.6/macperl/toke.c#3 (text) ====
Index: perl/toke.c
--- perl/toke.c.~1~	Sun Oct 21 16:00:05 2001
+++ perl/toke.c	Sun Oct 21 16:00:05 2001
@@ -6569,12 +6569,29 @@
 	       add symbol table ops
 	    */
 	    if ((tmp = pad_findmy(d)) != NOT_IN_PAD) {
-		OP *o = newOP(OP_PADSV, 0);
-		o->op_targ = tmp;
-		PL_lex_op = (OP*)newUNOP(OP_READLINE, 0, o);
+		SV *namesv = AvARRAY(PL_comppad_name)[tmp];
+		if (SvFLAGS(namesv) & SVpad_OUR) {
+		    SV *sym = sv_2mortal(newSVpv(HvNAME(GvSTASH(namesv)),0));
+		    sv_catpvn(sym, "::", 2);
+		    sv_catpv(sym, d+1);
+		    d = SvPVX(sym);
+		    goto intro_sym;
+		}
+		else {
+		    OP *o = newOP(OP_PADSV, 0);
+		    o->op_targ = tmp;
+		    PL_lex_op = (OP*)newUNOP(OP_READLINE, 0, o);
+		}
 	    }
 	    else {
-		GV *gv = gv_fetchpv(d+1,TRUE, SVt_PV);
+		GV *gv;
+		++d;
+intro_sym:
+		gv = gv_fetchpv(d,
+				(PL_in_eval
+				 ? (GV_ADDMULTI | GV_ADDINEVAL)
+				 : TRUE),
+				SVt_PV);
 		PL_lex_op = (OP*)newUNOP(OP_READLINE, 0,
 					    newUNOP(OP_RV2SV, 0,
 						newGVOP(OP_GV, 0, gv)));
End of Patch.