Integrate mainline.

p4raw-id: //depot/perlio@9411

4 files changed, 118 insertions, 2 deletions

diff --git a/t/lib/cwd.t b/t/lib/cwd.t
new file mode 100644
index 0000000000..adc57f6efb
--- /dev/null
+++ b/t/lib/cwd.t
@@ -0,0 +1,88 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use Config;
+use Cwd;
+use strict;
+use warnings;
+
+print "1..14\n";
+
+# check imports
+print +(defined(&cwd) && 
+	defined(&getcwd) &&
+	defined(&fastcwd) &&
+	defined(&fastgetcwd) ?
+        "" : "not "), "ok 1\n";
+print +(!defined(&chdir) &&
+	!defined(&abs_path) &&
+	!defined(&fast_abs_path) ?
+	"" : "not "), "ok 2\n";
+
+# XXX these tests rely on a working pwd program or shell command
+chomp(my $start = `pwd 2>/dev/null`);
+if ($?) {
+    print "ok 3 # skipped\n";
+    print "ok 4 # skipped\n";
+    print "ok 5 # skipped\n";
+    print "ok 6 # skipped\n";
+} else {
+    my $cwd        = cwd;
+    my $getcwd     = getcwd;
+    my $fastcwd    = fastcwd;
+    my $fastgetcwd = fastgetcwd;
+    print +($cwd        eq $start ? "" : "not "), "ok 3\n";
+    print +($getcwd     eq $start ? "" : "not "), "ok 4\n";
+    print +($fastcwd    eq $start ? "" : "not "), "ok 5\n";
+    print +($fastgetcwd eq $start ? "" : "not "), "ok 6\n";
+}
+
+mkdir "pteerslt", 0777;
+mkdir "pteerslt/path", 0777;
+mkdir "pteerslt/path/to", 0777;
+mkdir "pteerslt/path/to/a", 0777;
+mkdir "pteerslt/path/to/a/dir", 0777;
+Cwd::chdir "pteerslt/path/to/a/dir";
+my $cwd        = cwd;
+my $getcwd     = getcwd;
+my $fastcwd    = fastcwd;
+my $fastgetcwd = fastgetcwd;
+my $want = "t/pteerslt/path/to/a/dir";
+print +($cwd        =~ m|$want$| ? "" : "not "), "ok 7\n";
+print +($getcwd     =~ m|$want$| ? "" : "not "), "ok 8\n";
+print +($fastcwd    =~ m|$want$| ? "" : "not "), "ok 9\n";
+print +($fastgetcwd =~ m|$want$| ? "" : "not "), "ok 10\n";
+
+# Cwd::chdir should also update $ENV{PWD}
+print +($ENV{PWD} =~ m|$want$| ? "" : "not "), "ok 11\n";
+Cwd::chdir ".."; rmdir "dir";
+Cwd::chdir ".."; rmdir "a";
+Cwd::chdir ".."; rmdir "to";
+Cwd::chdir ".."; rmdir "path";
+Cwd::chdir ".."; rmdir "pteerslt";
+print +($ENV{PWD}  =~ m|\bt$| ? "" : "not "), "ok 12\n";
+
+if ($Config{d_symlink}) {
+    my @dirs = split " " => $Config{libpth};
+    my $target = pop @dirs;
+    symlink $target => "linktest";
+    mkdir "pteerslt";
+    chdir "pteerslt";
+    my $rel = "../../t/linktest";
+
+    my $abs_path      = Cwd::abs_path($rel);
+    my $fast_abs_path = Cwd::fast_abs_path($rel);
+    print +($abs_path      eq $target ? "" : "not "), "ok 13\n";
+    print +($fast_abs_path eq $target ? "" : "not "), "ok 14\n";
+
+    chdir "..";
+    rmdir "pteerslt";
+    unlink "linktest";
+} else {
+    print "ok 13 # skipped\n";
+    print "ok 14 # skipped\n";
+}
diff --git a/t/lib/xs-typemap.t b/t/lib/xs-typemap.t
index a3e85da17b..131c32ec83 100644
--- a/t/lib/xs-typemap.t
+++ b/t/lib/xs-typemap.t
@@ -240,7 +240,7 @@ print "# T_OPAQUE\n";
 
 $t = 48;
 $ptr = T_OPAQUE_IN( $t );
-ok(T_OPAQUEPTR_OUT( $ptr ), $t);
+ok(T_OPAQUEPTR_OUT_short( $ptr ), $t);
 
 # T_OPAQUE_array
 my @opq = (2,4,8);
diff --git a/t/op/utf8decode.t b/t/op/utf8decode.t
index 824805d5df..2893ffc62b 100644
--- a/t/op/utf8decode.t
+++ b/t/op/utf8decode.t
@@ -3,7 +3,6 @@
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
-
 }
 
 {
@@ -19,6 +18,20 @@ BEGIN {
     }
 }
 
+{
+    my $wide = v256;
+    use bytes;
+    my $ordwide = ord($wide);
+    printf "# under use bytes ord(v256) = 0x%02x\n", $ordwide;
+    if ($ordwide == 140) {
+	print "1..0 # Skip: UTF-EBCDIC (not UTF-8) used here\n";
+	exit 0;
+    }
+    elsif ($ordwide != 196) {
+	printf "# v256 starts with 0x%02x\n", $ordwide;
+    }
+}
+
 no utf8;
 
 print "1..78\n";
diff --git a/t/pragma/warn/perl b/t/pragma/warn/perl
index 7070dd447c..512ee7fb65 100644
--- a/t/pragma/warn/perl
+++ b/t/pragma/warn/perl
@@ -54,4 +54,19 @@ Name "main::x" used only once: possible typo at - line 4.
 use warnings 'once' ;
 $x = 3 ;
 EXPECT
+########
 
+# perl.c
+{ use warnings 'once' ; $x = 3 ; }
+$y = 3 ;
+EXPECT
+Name "main::x" used only once: possible typo at - line 3.
+########
+
+# perl.c
+$z = 3 ;
+BEGIN { $^W = 1 }
+{ no warnings 'once' ; $x = 3 ; }
+$y = 3 ;
+EXPECT
+Name "main::y" used only once: possible typo at - line 6.