Integrate mainline

p4raw-id: //depot/perlio@19046

24 files changed, 314 insertions, 128 deletions

diff --git a/t/comp/parser.t b/t/comp/parser.t
index ad1c5b80bd..54ad351eb1 100644
--- a/t/comp/parser.t
+++ b/t/comp/parser.t
@@ -9,7 +9,7 @@ BEGIN {
 }
 
 require "./test.pl";
-plan( tests => 20 );
+plan( tests => 21 );
 
 eval '%@x=0;';
 like( $@, qr/^Can't modify hash dereference in repeat \(x\)/, '%@x=0' );
@@ -88,3 +88,12 @@ is( $@, '', 'PL_lex_brackstack' );
 ${a}{ ${a}[ @{b}{
 ${a}{
 }
+
+# Bug #21575
+# ensure that the second print statement works, by playing a bit
+# with the test output.
+my %data = ( foo => "\n" );
+print "#";
+print(
+$data{foo});
+pass();
diff --git a/t/io/crlf.t b/t/io/crlf.t
index 5f879f2681..084be211fd 100644
--- a/t/io/crlf.t
+++ b/t/io/crlf.t
@@ -35,7 +35,7 @@ if (find PerlIO::Layer 'perlio') {
   eval 'use PerlIO::scalar';
   skip(q/miniperl cannnot load PerlIO::scalar/)
       if $@ =~ /dynamic loading not available/;
-  my $fcontents = join "", map {"$_\r\n"} "a".."zzz";
+  my $fcontents = join "", map {"$_\015\012"} "a".."zzz";
   open my $fh, "<:crlf", \$fcontents;
   local $/ = "xxx";
   local $_ = <$fh>;
diff --git a/t/io/utf8.t b/t/io/utf8.t
index edf5fddb74..c7ad296d8d 100755
--- a/t/io/utf8.t
+++ b/t/io/utf8.t
@@ -11,56 +11,44 @@ BEGIN {
 
 no utf8; # needed for use utf8 not griping about the raw octets
 
+require "./test.pl";
+
+plan(tests => 49);
+
 $| = 1;
-print "1..49\n";
 
 open(F,"+>:utf8",'a');
 print F chr(0x100).'£';
-print '#'.tell(F)."\n";
-print "not " unless tell(F) == 4;
-print "ok 1\n";
+ok( tell(F) == 4, tell(F) );
 print F "\n";
-print '#'.tell(F)."\n";
-print "not " unless tell(F) >= 5;
-print "ok 2\n";
+ok( tell(F) >= 5, tell(F) );
 seek(F,0,0);
-print "not " unless getc(F) eq chr(0x100);
-print "ok 3\n";
-print "not " unless getc(F) eq "£";
-print "ok 4\n";
-print "not " unless getc(F) eq "\n";
-print "ok 5\n";
+ok( getc(F) eq chr(0x100) );
+ok( getc(F) eq "£" );
+ok( getc(F) eq "\n" );
 seek(F,0,0);
 binmode(F,":bytes");
 my $chr = chr(0xc4);
 if (ord('A') == 193) { $chr = chr(0x8c); } # EBCDIC
-print "not " unless getc(F) eq $chr;
-print "ok 6\n";
+ok( getc(F) eq $chr );
 $chr = chr(0x80);
 if (ord('A') == 193) { $chr = chr(0x41); } # EBCDIC
-print "not " unless getc(F) eq $chr;
-print "ok 7\n";
+ok( getc(F) eq $chr );
 $chr = chr(0xc2);
 if (ord('A') == 193) { $chr = chr(0x80); } # EBCDIC
-print "not " unless getc(F) eq $chr;
-print "ok 8\n";
+ok( getc(F) eq $chr );
 $chr = chr(0xa3);
 if (ord('A') == 193) { $chr = chr(0x44); } # EBCDIC
-print "not " unless getc(F) eq $chr;
-print "ok 9\n";
-print "not " unless getc(F) eq "\n";
-print "ok 10\n";
+ok( getc(F) eq $chr );
+ok( getc(F) eq "\n" );
 seek(F,0,0);
 binmode(F,":utf8");
-print "not " unless scalar(<F>) eq "\x{100}£\n";
-print "ok 11\n";
+ok( scalar(<F>) eq "\x{100}£\n" );
 seek(F,0,0);
 $buf = chr(0x200);
 $count = read(F,$buf,2,1);
-print "not " unless $count == 2;
-print "ok 12\n";
-print "not " unless $buf eq "\x{200}\x{100}£";
-print "ok 13\n";
+ok( $count == 2 );
+ok( $buf eq "\x{200}\x{100}£" );
 close(F);
 
 {
@@ -74,8 +62,7 @@ close(F);
     open F, "<:utf8", 'a' or die $!;
     $x = <F>;
     chomp($x);
-    print "not " unless $x eq chr(300);
-    print "ok 14\n";
+    ok( $x eq chr(300) );
 
     open F, "a" or die $!; # Not UTF
     binmode(F, ":bytes");
@@ -83,8 +70,7 @@ close(F);
     chomp($x);
     $chr = chr(196).chr(172);
     if (ord('A') == 193) { $chr = chr(141).chr(83); } # EBCDIC
-    print "not " unless $x eq $chr;
-    print "ok 15\n";
+    ok( $x eq $chr );
     close F;
 
     open F, ">:utf8", 'a' or die $!;
@@ -94,29 +80,25 @@ close(F);
     my $y;
     { my $x = tell(F);
       { use bytes; $y = length($a);}
-      print "not " unless $x == $y;
-      print "ok 16\n";
+      ok( $x == $y );
   }
 
     { # Check byte length of $b
 	use bytes; my $y = length($b);
-	print "not " unless $y == 1;
-	print "ok 17\n";
+	ok( $y == 1 );
     }
 
     print F $b,"\n"; # Don't upgrades $b
 
     { # Check byte length of $b
 	use bytes; my $y = length($b);
-	print "not ($y) " unless $y == 1;
-	print "ok 18\n";
+	ok( $y == 1 );
     }
 
     {
 	my $x = tell(F);
 	{ use bytes; if (ord('A')==193){$y += 2;}else{$y += 3;}} # EBCDIC ASCII
-	print "not ($x,$y) " unless $x == $y;
-	print "ok 19\n";
+	ok( $x == $y );
     }
 
     close F;
@@ -127,15 +109,13 @@ close(F);
     chomp($x);
     $chr = v196.172.194.130;
     if (ord('A') == 193) { $chr = v141.83.130; } # EBCDIC
-    printf "not (%vd) ", $x unless $x eq $chr;
-    print "ok 20\n";
+    ok( $x eq $chr, sprintf('(%vd)', $x) );
 
     open F, "<:utf8", "a" or die $!;
     $x = <F>;
     chomp($x);
     close F;
-    printf "not (%vd) ", $x unless $x eq chr(300).chr(130);
-    print "ok 21\n";
+    ok( $x eq chr(300).chr(130), sprintf('(%vd)', $x) );
 
     open F, ">", "a" or die $!;
     if (${^OPEN} =~ /:utf8/) {
@@ -148,9 +128,8 @@ close(F);
 	use warnings 'utf8';
 	local $SIG{__WARN__} = sub { $w = $_[0] };
 	print F $a;
-	print "not " if ($@ || $w !~ /Wide character in print/i);
+        ok( !($@ || $w !~ /Wide character in print/i) );
     }
-    print "ok 22\n";
 }
 
 # Hm. Time to get more evil.
@@ -165,8 +144,7 @@ binmode(F, ":bytes");
 $x = <F>; chomp $x;
 $chr = v196.172.130;
 if (ord('A') == 193) { $chr = v141.83.130; } # EBCDIC
-print "not " unless $x eq $chr;
-print "ok 23\n";
+ok( $x eq $chr );
 
 # Right.
 open F, ">:utf8", "a" or die $!;
@@ -178,17 +156,16 @@ close F;
 
 open F, "<", "a" or die $!;
 $x = <F>; chomp $x;
-print "not " unless $x eq $chr;
-print "ok 24\n";
+ok( $x eq $chr );
 
 # Now we have a deformed file.
 
 if (ord('A') == 193) {
-    print "ok 25 # Skip: EBCDIC\n"; # EBCDIC doesn't complain
+    skip( "EBCDIC doesn't complain" );
 } else {
     open F, "<:utf8", "a" or die $!;
     $x = <F>; chomp $x;
-    local $SIG{__WARN__} = sub { print "ok 25\n" };
+    local $SIG{__WARN__} = sub { ok( 1 ) };
     eval { sprintf "%vd\n", $x };
 }
 
@@ -223,7 +200,7 @@ for (@a) {
     }
 }
 close F;
-print "ok 26\n";
+ok( 1 );
 
 {
     # Check that warnings are on on I/O, and that they can be muffled.
@@ -236,14 +213,14 @@ print "ok 26\n";
     print F chr(0x100);
     close(F);
 
-    print $@ =~ /Wide character in print/ ? "ok 27\n" : "not ok 27\n";
+    like( $@, 'Wide character in print' );
 
     undef $@;
     open F, ">:utf8", "a";
     print F chr(0x100);
     close(F);
 
-    print defined $@ ? "not ok 28\n" : "ok 28\n";
+    isnt( defined $@ );
 
     undef $@;
     open F, ">a";
@@ -251,7 +228,7 @@ print "ok 26\n";
     print F chr(0x100);
     close(F);
 
-    print defined $@ ? "not ok 29\n" : "ok 29\n";
+    isnt( defined $@ );
 
     no warnings 'utf8';
 
@@ -260,7 +237,7 @@ print "ok 26\n";
     print F chr(0x100);
     close(F);
 
-    print defined $@ ? "not ok 30\n" : "ok 30\n";
+    isnt( defined $@ );
 
     use warnings 'utf8';
 
@@ -270,7 +247,7 @@ print "ok 26\n";
     print F chr(0x100);
     close(F);
 
-    print $@ =~ /Wide character in print/ ? "ok 31\n" : "not ok 31\n";
+    like( $@, 'Wide character in print' );
 }
 
 {
@@ -279,8 +256,7 @@ print "ok 26\n";
     open F, "<:bytes", "a";
     my $b = chr 0x100;
     $b .= <F>;
-    print $b eq chr(0x100).chr(0xde) ? "ok 32" : "not ok 32";
-    print " \#21395 '.= <>' utf8 vs. bytes\n";
+    ok( $b eq chr(0x100).chr(0xde), "21395 '.= <>' utf8 vs. bytes" );
     close F;
 }
 
@@ -290,8 +266,7 @@ print "ok 26\n";
     open F, "<:utf8", "a";
     my $b = "\xde";
     $b .= <F>;
-    print $b eq chr(0xde).chr(0x100) ? "ok 33" : "not ok 33";
-    print " \#21395 '.= <>' bytes vs. utf8\n";
+    ok( $b eq chr(0xde).chr(0x100), "21395 '.= <>' bytes vs. utf8" );
     close F;
 }
 
@@ -316,13 +291,12 @@ print "ok 26\n";
 	    utf8::upgrade($s) if $v->[1] eq "utf8";
 
 	    $s .= <F>;
-	    print $s eq chr($v->[0]) . chr($u->[0]) ?
-		"ok $t # rcatline utf8\n" : "not ok $t # rcatline utf8\n";
+	    ok( $s eq chr($v->[0]) . chr($u->[0]), 'rcatline utf8' );
 	    close F;
 	    $t++;
 	}
     }
-    # last test here 47
+    # last test here 49
 }
 
 # sysread() and syswrite() tested in lib/open.t since Fnctl is used
diff --git a/t/lib/h2ph.h b/t/lib/h2ph.h
index c60e8f008d..f13b69c6d6 100644
--- a/t/lib/h2ph.h
+++ b/t/lib/h2ph.h
@@ -121,4 +121,15 @@ enum flimflam {
   flam                      
  } flamflim;
 
+/* Handle multi-line quoted strings: */
+__asm__ __volatile__("
+    this
+    produces
+    no
+    output
+");
+
+#define multiline "multiline
+string"
+
 #endif /* _H2PH_H_ */
diff --git a/t/lib/h2ph.pht b/t/lib/h2ph.pht
index 796d6a8e0b..8bc16369a9 100644
--- a/t/lib/h2ph.pht
+++ b/t/lib/h2ph.pht
@@ -84,5 +84,6 @@ unless(defined(&_H2PH_H_)) {
     }
     eval("sub flim () { 0; }") unless defined(&flim);
     eval("sub flam () { 1; }") unless defined(&flam);
+    eval 'sub multiline () {"multilinestring";}' unless defined(&multiline);
 }
 1;
diff --git a/t/lib/warnings/pp_pack b/t/lib/warnings/pp_pack
index 62fa6ecfc7..0f447c75b6 100644
--- a/t/lib/warnings/pp_pack
+++ b/t/lib/warnings/pp_pack
@@ -18,8 +18,8 @@ no warnings 'unpack' ;
 my @b = unpack ("A,A", "22") ;
 my $b = pack ("A,A", 1,2) ;
 EXPECT
-Invalid type in unpack: ',' at - line 4.
-Invalid type in pack: ',' at - line 5.
+Invalid type ',' in unpack at - line 4.
+Invalid type ',' in pack at - line 5.
 ########
 # pp.c
 use warnings 'uninitialized' ;
@@ -73,10 +73,10 @@ print unpack("c", pack("c", -128)), "\n";
 print unpack("c", pack("c",  127)), "\n";
 print unpack("c", pack("c",  128)), "\n";
 EXPECT
-Character in "C" format wrapped at - line 3.
-Character in "C" format wrapped at - line 3.
-Character in "c" format wrapped at - line 3.
-Character in "c" format wrapped at - line 3.
+Character in 'C' format wrapped in pack at - line 3.
+Character in 'C' format wrapped in pack at - line 3.
+Character in 'c' format wrapped in pack at - line 3.
+Character in 'c' format wrapped in pack at - line 3.
 255
 0
 255
diff --git a/t/op/eval.t b/t/op/eval.t
index 8e8f69c0b8..a6d78c4dbd 100755
--- a/t/op/eval.t
+++ b/t/op/eval.t
@@ -5,7 +5,7 @@ BEGIN {
     @INC = '../lib';
 }
 
-print "1..87\n";
+print "1..88\n";
 
 eval 'print "ok 1\n";';
 
@@ -419,3 +419,6 @@ $test++;
     $test++;
   }
 }
+
+sub Foo {} print Foo(eval {});
+print "ok ",$test++," - #20798 (used to dump core)\n";
diff --git a/t/op/goto.t b/t/op/goto.t
index 122c624324..5b30dc5f41 100755
--- a/t/op/goto.t
+++ b/t/op/goto.t
@@ -2,7 +2,7 @@
 
 # "This IS structured code.  It's just randomly structured."
 
-print "1..27\n";
+print "1..28\n";
 
 while ($?) {
     $foo = 1;
@@ -177,6 +177,14 @@ print ($ok ? "ok 22\n" : "not ok 22\n");
     print "ok 27 - weird case of goto and for(;;) loop\n";
 }
 
+# bug #9990 - don't prematurely free the CV we're &going to.
+
+sub f1 {
+    my $x;
+    goto sub { $x; print "ok 28 - don't prematurely free CV\n" }
+}
+f1();
+
 exit;
 
 bypass:
diff --git a/t/op/inc.t b/t/op/inc.t
index f360c031fe..56d27d20a5 100755
--- a/t/op/inc.t
+++ b/t/op/inc.t
@@ -2,7 +2,7 @@
 
 # use strict;
 
-print "1..24\n";
+print "1..26\n";
 
 my $test = 1;
 
@@ -87,6 +87,12 @@ $b = -$a;
 $b=$b-1;
 ok ($b == -(++$a), $a);
 
+$a = undef;
+ok ($a++ eq '0', do { $a=undef; $a++ }, "postinc undef returns '0'");
+
+$a = undef;
+ok (!defined($a--), do { $a=undef; $a-- }, "postdec undef returns undef");
+
 # Verify that shared hash keys become unshared.
 
 sub check_same {
diff --git a/t/op/magic.t b/t/op/magic.t
index 8f598a1049..3279e1e4ea 100755
--- a/t/op/magic.t
+++ b/t/op/magic.t
@@ -124,6 +124,7 @@ END
     }
 END
     close CMDPIPE;
+    $? >>= 8 if $^O eq 'VMS'; # POSIX status hiding in 2nd byte
     print $? & 0xFF ? "ok 6\n" : "not ok 6\n";
 
     $test += 4;
diff --git a/t/op/method.t b/t/op/method.t
index ae8031a9f6..aaf29be8df 100755
--- a/t/op/method.t
+++ b/t/op/method.t
@@ -284,6 +284,7 @@ for my $meth (['Bar', 'Foo::Bar'],
 {
     fresh_perl_is(<<EOT,
 package UNIVERSAL; sub AUTOLOAD { my \$c = shift; print "\$c \$AUTOLOAD\\n" }
+sub DESTROY {} # IO object destructor called in MacOS, because of Mac::err
 package Xyz;
 package main; Foo->$meth->[0]();
 EOT
diff --git a/t/op/mkdir.t b/t/op/mkdir.t
index b9c4df785a..226089b0c8 100755
--- a/t/op/mkdir.t
+++ b/t/op/mkdir.t
@@ -24,7 +24,12 @@ print ($! =~ /cannot find|such|exist|not found|not a directory/i ? "ok 7\n" : "#
 print (mkdir('blurfl') ? "ok 8\n" : "not ok 8\n");
 print (rmdir('blurfl') ? "ok 9\n" : "not ok 9\n");
 # trailing slashes will be removed before the system call to mkdir
-print (mkdir('blurfl///') ? "ok 10\n" : "not ok 10\n");
-print (-d 'blurfl' ? "ok 11\n" : "not ok 11\n");
-print (rmdir('blurfl///') ? "ok 12\n" : "not ok 12\n");
-print (!-d 'blurfl' ? "ok 13\n" : "not ok 13\n");
+# but we don't care for MacOS ...
+if ($^O eq 'MacOS') {
+   print "ok $_\n" for 10..13;
+} else {
+   print (mkdir('blurfl///') ? "ok 10\n" : "not ok 10\n");
+   print (-d 'blurfl' ? "ok 11\n" : "not ok 11\n");
+   print (rmdir('blurfl///') ? "ok 12\n" : "not ok 12\n");
+   print (!-d 'blurfl' ? "ok 13\n" : "not ok 13\n");
+}
diff --git a/t/op/pack.t b/t/op/pack.t
index 9ac5d38f25..af54fdce79 100755
--- a/t/op/pack.t
+++ b/t/op/pack.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 5827;
+plan tests => 5849;
 
 use strict;
 use warnings;
@@ -263,7 +263,7 @@ foreach my $t (@templates) {
         my @t = eval { unpack("$t*", pack("$t*", 12, 34)) };
 
         # quads not supported everywhere
-        skip "Quads not supported", 4 if $@ =~ /Invalid type in pack/;
+        skip "Quads not supported", 4 if $@ =~ /Invalid type/;
         is( $@, '' );
 
         is(scalar @t, 2);
@@ -378,7 +378,7 @@ sub numbers_with_total {
     SKIP: {
         my $out = eval {unpack($format, pack($format, $_))};
         skip "cannot pack '$format' on this perl", 2 if
-          $@ =~ /Invalid type in pack: '$format'/;
+          $@ =~ /Invalid type '$format'/;
 
         is($@, '');
         is($out, $_);
@@ -398,7 +398,7 @@ sub numbers_with_total {
     SKIP: {
       my $sum = eval {unpack "%$_$format*", pack "$format*", @_};
       skip "cannot pack '$format' on this perl", 3
-        if $@ =~ /Invalid type in pack: '$format'/;
+        if $@ =~ /Invalid type '$format'/;
 
       is($@, '');
       ok(defined $sum);
@@ -519,10 +519,10 @@ is(pack("V", 0xdeadbeef), "\xef\xbe\xad\xde");
 
   my ($x, $y, $z);
   eval { ($x) = unpack '/a*','hello' };
-  like($@, qr!/ must follow a numeric type!);
+  like($@, qr!'/' must follow a numeric type!);
   undef $x;
   eval { $x = unpack '/a*','hello' };
-  like($@, qr!/ must follow a numeric type!);
+  like($@, qr!'/' must follow a numeric type!);
 
   undef $x;
   eval { ($z,$x,$y) = unpack 'a3/A C/a* C/Z', "003ok \003yes\004z\000abc" };
@@ -538,10 +538,10 @@ is(pack("V", 0xdeadbeef), "\xef\xbe\xad\xde");
 
   undef $x;
   eval { ($x) = pack '/a*','hello' };
-  like($@,  qr!Invalid type in pack: '/'!);
+  like($@,  qr!Invalid type '/'!);
   undef $x;
   eval { $x = pack '/a*','hello' };
-  like($@,  qr!Invalid type in pack: '/'!);
+  like($@,  qr!Invalid type '/'!);
 
   $z = pack 'n/a* N/Z* w/A*','string','hi there ','etc';
   my $expect = "\000\006string\0\0\0\012hi there \000\003etc";
@@ -781,7 +781,7 @@ foreach (
     # from Wolfgang Laun: fix in change #13288
 
     eval { my $t=unpack("P*", "abc") };
-    like($@, qr/P must have an explicit size/);
+    like($@, qr/'P' must have an explicit size/);
 }
 
 {   # Grouping constructs
@@ -822,6 +822,105 @@ foreach (
     is("@a", "@b");
 }
 
+{  # more on grouping (W.Laun)
+  use warnings;
+  my $warning;
+  local $SIG{__WARN__} = sub {
+      $warning = $_[0];
+  };
+  # @ absolute within ()-group
+  my $badc = pack( '(a)*', unpack( '(@1a @0a @2)*', 'abcd' ) );
+  is( $badc, 'badc' );
+  my @b = ( 1, 2, 3 );
+  my $buf = pack( '(@1c)((@2C)@3c)', @b );
+  is( $buf, "\0\1\0\0\2\3" );
+  my @a = unpack( '(@1c)((@2c)@3c)', $buf );
+  is( "@a", "@b" );
+
+  # various unpack count/code scenarios 
+  my @Env = ( a => 'AAA', b => 'BBB' );
+  my $env = pack( 'S(S/A*S/A*)*', @Env/2, @Env );
+
+  # unpack full length - ok
+  my @pup = unpack( 'S/(S/A* S/A*)', $env );
+  is( "@pup", "@Env" );
+
+  # warn when count/code goes beyond end of string
+  # \0002 \0001 a \0003 AAA \0001 b \0003 BBB
+  #     2     4 5     7  10    1213
+  eval { @pup = unpack( 'S/(S/A* S/A*)', substr( $env, 0, 13 ) ) };
+  like( $@, qr{length/code after end of string} );
+  
+  # postfix repeat count
+  $env = pack( '(S/A* S/A*)' . @Env/2, @Env );
+
+  # warn when count/code goes beyond end of string
+  # \0001 a \0003 AAA \0001  b \0003 BBB
+  #     2 3c    5   8    10 11    13  16
+  eval { @pup = unpack( '(S/A* S/A*)' . @Env/2, substr( $env, 0, 11 ) ) };
+  like( $@, qr{length/code after end of string} );
+
+  # catch stack overflow/segfault
+  eval { $_ = pack( ('(' x 105) . 'A' . (')' x 105) ); };
+  like( $@, qr{Too deeply nested \(\)-groups} );
+}
+
+{ # syntax checks (W.Laun)
+  use warnings;
+  my @warning;
+  local $SIG{__WARN__} = sub {
+      push( @warning, $_[0] );
+  };
+  eval { my $s = pack( 'Ax![4c]A', 1..5 ); };
+  like( $@, qr{Malformed integer in \[\]} );
+
+  eval { my $buf = pack( '(c/*a*)', 'AAA', 'BB' ); };
+  like( $@, qr{'/' does not take a repeat count} );
+
+  eval { my @inf = unpack( 'c/1a', "\x03AAA\x02BB" ); };
+  like( $@, qr{'/' does not take a repeat count} );
+
+  eval { my @inf = unpack( 'c/*a', "\x03AAA\x02BB" ); };
+  like( $@, qr{'/' does not take a repeat count} );
+
+  # white space where possible 
+  my @Env = ( a => 'AAA', b => 'BBB' );
+  my $env = pack( ' S ( S / A*   S / A* )* ', @Env/2, @Env );
+  my @pup = unpack( ' S / ( S / A*   S / A* ) ', $env );
+  is( "@pup", "@Env" );
+
+  # white space in 4 wrong places
+  for my $temp (  'A ![4]', 'A [4]', 'A *', 'A 4' ){
+      eval { my $s = pack( $temp, 'B' ); };
+      like( $@, qr{Invalid type } );
+  }
+
+  # warning for commas
+  @warning = ();
+  my $x = pack( 'I,A', 4, 'X' );
+  like( $warning[0], qr{Invalid type ','} );
+
+  # comma warning only once
+  @warning = ();
+  $x = pack( 'C(C,C)C,C', 65..71  );
+  like( scalar @warning, 1 );
+
+  # forbidden code in []
+  eval { my $x = pack( 'A[@4]', 'XXXX' ); };
+  like( $@, qr{Within \[\]-length '\@' not allowed} );
+
+  # @ repeat default 1
+  my $s = pack( 'AA@A', 'A', 'B', 'C' );
+  my @c = unpack( 'AA@A', $s );
+  is( $s, 'AC' ); 
+  is( "@c", "A C C" ); 
+
+  # no unpack code after /
+  eval { my @a = unpack( "C/", "\3" ); };
+  like( $@, qr{Code missing after '/'} );
+
+}
+
 {  # Repeat count [SUBEXPR]
    my @codes = qw( x A Z a c C B b H h s v n S i I l V N L p P f F d
 		   s! S! i! I! l! L! j J);
@@ -939,7 +1038,7 @@ numbers ('F', -(2**34), -1, 0, 1, 2**34);
 SKIP: {
     my $t = eval { unpack("D*", pack("D", 12.34)) };
 
-    skip "Long doubles not in use", 56 if $@ =~ /Invalid type in pack/;
+    skip "Long doubles not in use", 56 if $@ =~ /Invalid type/;
 
     is(length(pack("D", 0)), $Config{longdblsize});
     numbers ('D', -(2**34), -1, 0, 1, 2**34);
@@ -953,7 +1052,7 @@ foreach my $template (qw(A Z c C s S i I l L n N v V q Q j J f d F D u U w)) {
   SKIP: {
     my $packed = eval {pack "${template}4", 1, 4, 9, 16};
     if ($@) {
-      die unless $@ =~ /Invalid type in pack: '$template'/;
+      die unless $@ =~ /Invalid type '$template'/;
       skip ("$template not supported on this perl",
             $cant_checksum{$template} ? 4 : 8);
     }
diff --git a/t/op/pat.t b/t/op/pat.t
index fdc4f9b2a1..16a38202dd 100755
--- a/t/op/pat.t
+++ b/t/op/pat.t
@@ -6,7 +6,7 @@
 
 $| = 1;
 
-print "1..994\n";
+print "1..996\n";
 
 BEGIN {
     chdir 't' if -d 't';
@@ -3145,5 +3145,18 @@ ok("bbbbac" =~ /$pattern/ && $1 eq 'a', "[perl #3547]");
 	"[perl #21411] (??{ .. }) corrupts split's stack")
 }
 
-# last test 994
+{
+    ok("\x{100}\n" =~ /\x{100}\n$/, "UTF8 length cache and fbm_compile");  
+}
+
+{
+    package Str;
+    use overload q/""/ => sub { ${$_[0]}; };
+    sub new { my ($c, $v) = @_; bless \$v, $c; }
+
+    package main;
+    $_ = Str->new("a\x{100}/\x{100}b");
+    ok(join(":", /\b(.)\x{100}/g) eq "a:/", "re_intuit_start and PL_bostr");
+}
 
+# last test 996
diff --git a/t/op/readline.t b/t/op/readline.t
index ae043123da..1bc9ef44f7 100644
--- a/t/op/readline.t
+++ b/t/op/readline.t
@@ -6,8 +6,15 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 1;
+plan tests => 3;
 
 eval { for (\2) { $_ = <FH> } };
 like($@, 'Modification of a read-only value attempted', '[perl #19566]');
 
+{
+  open A,"+>a"; $a = 3;
+  is($a .= <A>, 3, '#21628 - $a .= <A> , A eof');
+  close A; $a = 4;
+  is($a .= <A>, 4, '#21628 - $a .= <A> , A closed');
+  unlink "a";
+}
diff --git a/t/op/recurse.t b/t/op/recurse.t
index 9d0064068b..10830e6221 100755
--- a/t/op/recurse.t
+++ b/t/op/recurse.t
@@ -113,8 +113,25 @@ is(takeuchi($x, $y, $z), $z + 1, "takeuchi($x, $y, $z) == $z + 1");
 }
 
 # check ok for recursion depth > 65536
-is(runperl(
-	nolib => 1,
-	prog => q{$d=0; $e=1; sub c { ++$d; if ($d > 66000) { $e=0 } else { c(); c() unless $d % 32768 } --$d } c(); exit $e},
-), '', "64K deep recursion - no output expected");
-is($?, 0, "64K deep recursion - no coredump expected");
+{
+    my $r;
+    eval { 
+	$r = runperl(
+		     nolib => 1,
+		     stderr => 1,
+		     prog => q{$d=0; $e=1; sub c { ++$d; if ($d > 66000) { $e=0 } else { c(); c() unless $d % 32768 } --$d } c(); exit $e});
+    };
+  SKIP: {
+      skip("Out of memory -- increase your data/heap?", 2)
+	  if $r =~ /Out of memory/i;
+      is($r, '', "64K deep recursion - no output expected");
+
+      if ($^O eq 'MacOS') {
+          ok(1, "$^O: \$? is unreliable");
+      } else {
+          is($?, 0, "64K deep recursion - no coredump expected");
+      }
+
+  }
+}
+
diff --git a/t/op/split.t b/t/op/split.t
index 3d7e89880b..55b2839b0c 100755
--- a/t/op/split.t
+++ b/t/op/split.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 50;
+plan tests => 52;
 
 $FS = ':';
 
@@ -265,15 +265,14 @@ ok(@ary == 3 &&
 
 {
     # [perl #18195]
-    for my $a (0,1) {
-	$_ = 'readin,database,readout';
-	if ($ARGV[0])  {
-	    $_ .= chr 256;
-	    chop;
+    for my $u (0, 1) {
+	for my $a (0, 1) {
+	    $_ = 'readin,database,readout';
+	    utf8::upgrade $_ if $u;
+	    /(.+)/;
+	    my @d = split /[,]/,$1;
+	    is(join (':',@d), 'readin:database:readout', "[perl #18195]");
 	}
-	/(.+)/;
-	my @d = split /[,]/,$1;
-	is(join (':',@d), 'readin:database:readout', "[perl #18195]")
     }
 }
 
diff --git a/t/op/sprintf.t b/t/op/sprintf.t
index e498c65b35..e767a7885c 100755
--- a/t/op/sprintf.t
+++ b/t/op/sprintf.t
@@ -104,7 +104,7 @@ for ($i = 1; @tests; $i++) {
     }
 }
 
-# In each of the the following lines, there are three required fields:
+# In each of the following lines, there are three required fields:
 # printf template, data to be formatted (as a Perl expression), and
 # expected result of formatting.  An optional fourth field can contain
 # a comment.  Each field is delimited by a starting '>' and a
@@ -359,7 +359,7 @@ __END__
 >%2$d %d %d<	>[12, 34]<	>34 12 34<
 >%3$d %d %d<	>[12, 34, 56]<	>56 12 34<
 >%2$*3$d %d<	>[12, 34, 3]<	> 34 12<
->%*3$2$d %d<	>[12, 34, 3]<	>%*3$2$d 34 INVALID<
+>%*3$2$d %d<	>[12, 34, 3]<	>%*3$2$d 12 INVALID<
 >%2$d<		>12<	>0 UNINIT<
 >%0$d<		>12<	>%0$d INVALID<
 >%1$$d<		>12<	>%1$$d INVALID<
@@ -374,4 +374,9 @@ __END__
 >%vs,%d<	>[1, 2, 3]<	>1,2<
 >%v_<	>''<	>%v_ INVALID<
 >%v#x<	>''<	>%v#x INVALID<
->%v02x<	>"foo\n"<	>66.6f.6f.0a< 
+>%v02x<	>"foo\012"<	>66.6f.6f.0a<
+>%V-%s<		>["Hello"]<	>%V-Hello INVALID<
+>%K %d %d<	>[13, 29]<	>%K 13 29 INVALID<
+>%*.*K %d<	>[13, 29, 76]<	>%*.*K 13 INVALID<
+>%4$K %d<	>[45, 67]<	>%4$K 45 INVALID<
+>%d %K %d<	>[23, 45]<	>23 %K 45 INVALID<
diff --git a/t/op/stat.t b/t/op/stat.t
index 3cdfc233c9..89046c364b 100755
--- a/t/op/stat.t
+++ b/t/op/stat.t
@@ -55,7 +55,7 @@ SKIP: {
 
 SKIP: {
   skip "mtime and ctime not reliable", 2
-    if $Is_MSWin32 or $Is_NetWare or $Is_Cygwin or $Is_Dos;
+    if $Is_MSWin32 or $Is_NetWare or $Is_Cygwin or $Is_Dos or $Is_MacOS;
 
   ok( $mtime,           'mtime' );
   is( $mtime, $ctime,   'mtime == ctime' );
@@ -242,6 +242,11 @@ SKIP: {
     $DEV =~ s{^.+?\s\..+?$}{}m;
     @DEV =  grep { ! m{^\..+$} } @DEV;
 
+    # Irix ls -l marks sockets with 'S' while 's' is a 'XENIX semaphore'.
+    if ($^O eq 'irix') {
+        $DEV =~ s{^S(.+?)}{s$1}mg;
+    }
+
     my $try = sub {
 	my @c1 = eval qq[\$DEV =~ /^$_[0].*/mg];
 	my @c2 = eval qq[grep { $_[1] "/dev/\$_" } \@DEV];
diff --git a/t/op/taint.t b/t/op/taint.t
index 686354ed2f..846e1fd8fd 100755
--- a/t/op/taint.t
+++ b/t/op/taint.t
@@ -966,8 +966,12 @@ else
 
     eval { system("lskdfj does not exist","with","args"); };
     test 204, $@ eq '';
-    eval { exec("lskdfj does not exist","with","args"); };
-    test 205, $@ eq '';
+    if ($Is_MacOS) {
+	print "ok 205 # no exec()\n";
+    } else {
+	eval { exec("lskdfj does not exist","with","args"); };
+	test 205, $@ eq '';
+    }
 
     # If you add tests here update also the above skip block for VMS.
 }
diff --git a/t/op/tie.t b/t/op/tie.t
index 6e73ceec85..49c189e66f 100755
--- a/t/op/tie.t
+++ b/t/op/tie.t
@@ -286,3 +286,12 @@ EXPECT
 7
 8
 0
+########
+#
+# FETCH freeing tie'd SV
+sub TIESCALAR { bless [] }
+sub FETCH { *a = \1; 1 }
+tie $a, 'main';
+print $a;
+EXPECT
+Tied variable freed while still in use at - line 6.
diff --git a/t/pod/testp2pt.pl b/t/pod/testp2pt.pl
index bec55e45b4..a828e85113 100644
--- a/t/pod/testp2pt.pl
+++ b/t/pod/testp2pt.pl
@@ -38,7 +38,9 @@ sub catfile(@) { File::Spec->catfile(@_); }
 my $INSTDIR = abs_path(dirname $0);
 $INSTDIR = VMS::Filespec::unixpath($INSTDIR) if $^O eq 'VMS';
 $INSTDIR =~ s#/$## if $^O eq 'VMS';
+$INSTDIR =~ s#:$## if $^O eq 'MacOS';
 $INSTDIR = (dirname $INSTDIR) if (basename($INSTDIR) eq 'pod');
+$INSTDIR =~ s#:$## if $^O eq 'MacOS';
 $INSTDIR = (dirname $INSTDIR) if (basename($INSTDIR) eq 't');
 my @PODINCDIRS = ( catfile($INSTDIR, 'lib', 'Pod'),
                    catfile($INSTDIR, 'scripts'),
diff --git a/t/run/switchC.t b/t/run/switchC.t
index c3cc4033a7..0f8f16a6ce 100644
--- a/t/run/switchC.t
+++ b/t/run/switchC.t
@@ -23,7 +23,7 @@ END { unlink @tmpfiles }
 $r = runperl( switches => [ '-CO', '-w' ],
 	      prog     => 'print chr(256)',
               stderr   => 1 );
-is( $r, "\xC4\x80", '-CO: no warning on UTF-8 output' );
+like( $r, qr/^\xC4\x80(?:\r?\n)?$/s, '-CO: no warning on UTF-8 output' );
 
 SKIP: {
     if (exists $ENV{PERL_UNICODE} &&
@@ -34,30 +34,29 @@ SKIP: {
 		  prog     => 'print ord(<STDIN>)',
 		  stderr   => 1,
 		  stdin    => "\xC4\x80" );
-    is( $r, 256, '-CI: read in UTF-8 input' );
+    like( $r, qr/^256(?:\r?\n)?$/s, '-CI: read in UTF-8 input' );
 }
 
 $r = runperl( switches => [ '-CE', '-w' ],
 	      prog     => 'warn chr(256), qq(\n)',
               stderr   => 1 );
-chomp $r;
-is( $r, "\xC4\x80", '-CE: UTF-8 stderr' );
+like( $r, qr/^\xC4\x80(?:\r?\n)?$/s, '-CE: UTF-8 stderr' );
 
 $r = runperl( switches => [ '-Co', '-w' ],
 	      prog     => 'open(F, q(>out)); print F chr(256); close F',
               stderr   => 1 );
-is( $r, '', '-Co: auto-UTF-8 open for output' );
+like( $r, qr/^$/s, '-Co: auto-UTF-8 open for output' );
 
 push @tmpfiles, "out";
 
 $r = runperl( switches => [ '-Ci', '-w' ],
 	      prog     => 'open(F, q(<out)); print ord(<F>); close F',
               stderr   => 1 );
-is( $r, 256, '-Ci: auto-UTF-8 open for input' );
+like( $r, qr/^256(?:\r?\n)?$/s, '-Ci: auto-UTF-8 open for input' );
 
 $r = runperl( switches => [ '-CA', '-w' ],
 	      prog     => 'print ord shift',
               stderr   => 1,
               args     => [ chr(256) ] );
-is( $r, 256, '-CA: @ARGV' );
+like( $r, qr/^256(?:\r?\n)?$/s, '-CA: @ARGV' );
 
diff --git a/t/run/switchI.t b/t/run/switchI.t
index fcd2dc00f2..41192cd765 100644
--- a/t/run/switchI.t
+++ b/t/run/switchI.t
@@ -10,16 +10,24 @@ BEGIN {
     plan(4);
 }
 
-ok(grep { $_ eq 'Bla' } @INC);
+my $Is_MacOS = $^O eq 'MacOS';
+my $Is_VMS   = $^O eq 'VMS';
+my $lib;
+
+$lib = $Is_MacOS ? ':Bla:' : 'Bla';
+ok(grep { $_ eq $lib } @INC);
 SKIP: {
-  skip 'Double colons not allowed in dir spec', 1 if $^O eq 'VMS';
-  ok(grep { $_ eq 'Foo::Bar' } @INC);
+  skip 'Double colons not allowed in dir spec', 1 if $Is_VMS;
+  $lib = $Is_MacOS ? 'Foo::Bar:' : 'Foo::Bar';
+  ok(grep { $_ eq $lib } @INC);
 }
 
-fresh_perl_is('print grep { $_ eq "Bla2" } @INC', 'Bla2',
+$lib = $Is_MacOS ? ':Bla2:' : 'Bla2';
+fresh_perl_is("print grep { \$_ eq '$lib' } \@INC", $lib,
 	      { switches => ['-IBla2'] }, '-I');
 SKIP: {
-  skip 'Double colons not allowed in dir spec', 1 if $^O eq 'VMS';
-  fresh_perl_is('print grep { $_ eq "Foo::Bar2" } @INC', 'Foo::Bar2',
+  skip 'Double colons not allowed in dir spec', 1 if $Is_VMS;
+  $lib = $Is_MacOS ? 'Foo::Bar2:' : 'Foo::Bar2';
+  fresh_perl_is("print grep { \$_ eq '$lib' } \@INC", $lib,
 	        { switches => ['-IFoo::Bar2'] }, '-I with colons');
 }