Integrate mainline

p4raw-id: //depot/perlio@7830

6 files changed, 865 insertions, 19 deletions

diff --git a/t/lib/filt-util.pl b/t/lib/filt-util.pl
new file mode 100644
index 0000000000..1615873bc9
--- /dev/null
+++ b/t/lib/filt-util.pl
@@ -0,0 +1,48 @@
+sub readFile
+{
+    my ($filename) = @_ ;
+    my ($string) = '' ;
+
+    open (F, "<$filename") 
+	or die "Cannot open $filename: $!\n" ;
+    while (<F>)
+      { $string .= $_ }
+    close F ;
+    $string ;
+}
+
+sub writeFile
+{
+    my($filename, @strings) = @_ ;
+    open (F, ">$filename") 
+	or die "Cannot open $filename: $!\n" ;
+    binmode(F) if $filename =~ /bin$/i;
+    foreach (@strings)
+      { print F }
+    close F ;
+}
+
+sub ok
+{
+    my($number, $result, $note) = @_ ;
+ 
+    $note = "" if ! defined $note ;
+    if ($note) {
+        $note = "# $note" if $note !~ /^\s*#/ ;
+        $note =~ s/^\s*/ / ;
+    }
+
+    print "not " if !$result ;
+    print "ok ${number}${note}\n";
+}
+
+$Inc = '' ;
+foreach (@INC)
+ { $Inc .= "-I$_ " }
+
+$Perl = '' ;
+$Perl = ($ENV{'FULLPERL'} or $^X or 'perl') ;
+
+$Perl = "$Perl -w" ;
+
+1;
diff --git a/t/lib/filt-util.t b/t/lib/filt-util.t
new file mode 100644
index 0000000000..78f47b8b3c
--- /dev/null
+++ b/t/lib/filt-util.t
@@ -0,0 +1,791 @@
+BEGIN {
+    chdir('t') if -d 't';    
+    @INC = '.'; 
+    push @INC, '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ m{\bFilter/Util\b}) {
+        print "1..0 # Skip: Filter::Util was not built\n";
+        exit 0;
+    }
+    require 'lib/filt-util.pl';
+}
+
+print "1..28\n" ;
+
+$Perl = "$Perl -w" ;
+
+use Cwd ;
+$here = getcwd ;
+
+use vars qw($Inc $Perl);
+
+$filename = "call.tst" ;
+$filenamebin = "call.bin" ;
+$module   = "MyTest" ;
+$module2  = "MyTest2" ;
+$module3  = "MyTest3" ;
+$module4  = "MyTest4" ;
+$module5  = "MyTest5" ;
+$nested   = "nested" ;
+$block   = "block" ;
+
+# Test error cases
+##################
+
+# no filter function in module 
+###############################
+
+writeFile("${module}.pm", <<EOM) ;
+package ${module} ;
+
+use Filter::Util::Call ;
+ 
+sub import { filter_add(bless []) }
+
+1 ;
+EOM
+ 
+$a = `$Perl -I. $Inc -e "use ${module} ;"  2>&1` ;
+ok(1, (($? >>8) != 0 or ($^O eq 'MSWin32' && $? != 0))) ;
+ok(2, $a =~ /^Can't locate object method "filter" via package "MyTest"/) ;
+ 
+# no reference parameter in filter_add
+######################################
+
+writeFile("${module}.pm", <<EOM) ;
+package ${module} ;
+ 
+use Filter::Util::Call ;
+ 
+sub import { filter_add() }
+ 
+1 ;
+EOM
+ 
+$a = `$Perl -I. $Inc -e "use ${module} ;"  2>&1` ;
+ok(3, (($? >>8) != 0 or ($^O eq 'MSWin32' && $? != 0))) ;
+#ok(4, $a =~ /^usage: filter_add\(ref\) at ${module}.pm/) ;
+ok(4, $a =~ /^Not enough arguments for Filter::Util::Call::filter_add/) ;
+ 
+
+
+
+# non-error cases
+#################
+
+
+# a simple filter, using a closure
+#################
+
+writeFile("${module}.pm", <<EOM, <<'EOM') ;
+package ${module} ;
+ 
+EOM
+use Filter::Util::Call ;
+sub import { 
+    filter_add(
+  	sub {
+ 
+    	    my ($status) ;
+ 
+    	    if (($status = filter_read()) > 0) {
+        	s/ABC/DEF/g 
+    	    }
+    	    $status ;
+  	} ) ;
+}
+
+1 ;
+EOM
+ 
+writeFile($filename, <<EOM, <<'EOM') ;
+
+use $module ;
+EOM
+
+use Cwd ;
+$here = getcwd ;
+print "I am $here\n" ;
+print "some letters ABC\n" ;
+$y = "ABCDEF" ;
+print <<EOF ;
+Alphabetti Spagetti ($y)
+EOF
+
+EOM
+
+$a = `$Perl -I. $Inc $filename  2>&1` ;
+ok(5, ($? >>8) == 0) ;
+ok(6, $a eq <<EOM) ;
+I am $here
+some letters DEF
+Alphabetti Spagetti (DEFDEF)
+EOM
+
+# a simple filter, not using a closure
+#################
+ 
+writeFile("${module}.pm", <<EOM, <<'EOM') ;
+package ${module} ;
+ 
+EOM
+use Filter::Util::Call ;
+sub import { filter_add(bless []) }
+ 
+sub filter
+{
+    my ($self) = @_ ;
+    my ($status) ;
+ 
+    if (($status = filter_read()) > 0) {
+        s/ABC/DEF/g
+    }
+    $status ;
+}
+
+ 
+1 ;
+EOM
+ 
+writeFile($filename, <<EOM, <<'EOM') ;
+ 
+use $module ;
+EOM
+ 
+use Cwd ;
+$here = getcwd ;
+print "I am $here\n" ;
+print "some letters ABC\n" ;
+$y = "ABCDEF" ;
+print <<EOF ;
+Alphabetti Spagetti ($y)
+EOF
+ 
+EOM
+ 
+$a = `$Perl -I. $Inc $filename  2>&1` ;
+ok(7, ($? >>8) == 0) ;
+ok(8, $a eq <<EOM) ;
+I am $here
+some letters DEF
+Alphabetti Spagetti (DEFDEF)
+EOM
+
+
+# nested filters
+################
+
+
+writeFile("${module2}.pm", <<EOM, <<'EOM') ;
+package ${module2} ;
+use Filter::Util::Call ;
+ 
+EOM
+sub import { filter_add(bless []) }
+ 
+sub filter
+{
+    my ($self) = @_ ;
+    my ($status) ;
+ 
+    if (($status = filter_read()) > 0) {
+        s/XYZ/PQR/g
+    }
+    $status ;
+}
+ 
+1 ;
+EOM
+ 
+writeFile("${module3}.pm", <<EOM, <<'EOM') ;
+package ${module3} ;
+use Filter::Util::Call ;
+ 
+EOM
+sub import { filter_add(
+ 
+    sub 
+    {
+        my ($status) ;
+     
+        if (($status = filter_read()) > 0) {
+            s/Fred/Joe/g
+        }
+        $status ;
+    } ) ;
+}
+ 
+1 ;
+EOM
+ 
+writeFile("${module4}.pm", <<EOM) ;
+package ${module4} ;
+ 
+use $module5 ;
+
+print "I'm feeling used!\n" ;
+print "Fred Joe ABC DEF PQR XYZ\n" ;
+print "See you Today\n" ;
+1;
+EOM
+
+writeFile("${module5}.pm", <<EOM, <<'EOM') ;
+package ${module5} ;
+use Filter::Util::Call ;
+ 
+EOM
+sub import { filter_add(bless []) }
+ 
+sub filter
+{
+    my ($self) = @_ ;
+    my ($status) ;
+ 
+    if (($status = filter_read()) > 0) {
+        s/Today/Tomorrow/g
+    }
+    $status ;
+}
+ 
+1 ;
+EOM
+
+writeFile($filename, <<EOM, <<'EOM') ;
+ 
+# two filters for this file
+use $module ;
+use $module2 ;
+require "$nested" ;
+use $module4 ;
+EOM
+ 
+print "some letters ABCXYZ\n" ;
+$y = "ABCDEFXYZ" ;
+print <<EOF ;
+Fred likes Alphabetti Spagetti ($y)
+EOF
+ 
+EOM
+ 
+writeFile($nested, <<EOM, <<'EOM') ;
+use $module3 ;
+EOM
+ 
+print "This is another file XYZ\n" ;
+print <<EOF ;
+Where is Fred?
+EOF
+ 
+EOM
+
+$a = `$Perl -I. $Inc $filename  2>&1` ;
+ok(9, ($? >>8) == 0) ;
+ok(10, $a eq <<EOM) ;
+I'm feeling used!
+Fred Joe ABC DEF PQR XYZ
+See you Tomorrow
+This is another file XYZ
+Where is Joe?
+some letters DEFPQR
+Fred likes Alphabetti Spagetti (DEFDEFPQR)
+EOM
+
+# using the module context (with a closure)
+###########################################
+ 
+ 
+writeFile("${module2}.pm", <<EOM, <<'EOM') ;
+package ${module2} ;
+use Filter::Util::Call ;
+ 
+EOM
+sub import
+{
+    my ($type) = shift ;
+    my (@strings) = @_ ;
+ 
+ 
+    filter_add (
+ 
+	sub 
+	{
+    	    my ($status) ;
+    	    my ($pattern) ;
+	     
+    	    if (($status = filter_read()) > 0) {
+                foreach $pattern (@strings)
+          	    { s/$pattern/PQR/g }
+    	    }
+	     
+    	    $status ;
+	}
+	)
+ 
+}
+1 ;
+EOM
+ 
+ 
+writeFile($filename, <<EOM, <<'EOM') ;
+ 
+use $module2 qw( XYZ KLM) ;
+use $module2 qw( ABC NMO) ;
+EOM
+ 
+print "some letters ABCXYZ KLM NMO\n" ;
+$y = "ABCDEFXYZKLMNMO" ;
+print <<EOF ;
+Alphabetti Spagetti ($y)
+EOF
+ 
+EOM
+ 
+$a = `$Perl -I. $Inc $filename  2>&1` ;
+ok(11, ($? >>8) == 0) ;
+ok(12, $a eq <<EOM) ;
+some letters PQRPQR PQR PQR
+Alphabetti Spagetti (PQRDEFPQRPQRPQR)
+EOM
+ 
+
+
+# using the module context (without a closure)
+##############################################
+
+
+writeFile("${module2}.pm", <<EOM, <<'EOM') ;
+package ${module2} ;
+use Filter::Util::Call ;
+ 
+EOM
+sub import 
+{ 
+    my ($type) = shift ;
+    my (@strings) = @_ ;
+
+  
+    filter_add (bless [@strings]) 
+}
+ 
+sub filter
+{
+    my ($self) = @_ ;
+    my ($status) ;
+    my ($pattern) ;
+ 
+    if (($status = filter_read()) > 0) {
+	foreach $pattern (@$self)
+          { s/$pattern/PQR/g }
+    }
+
+    $status ;
+}
+ 
+1 ;
+EOM
+ 
+ 
+writeFile($filename, <<EOM, <<'EOM') ;
+ 
+use $module2 qw( XYZ KLM) ;
+use $module2 qw( ABC NMO) ;
+EOM
+ 
+print "some letters ABCXYZ KLM NMO\n" ;
+$y = "ABCDEFXYZKLMNMO" ;
+print <<EOF ;
+Alphabetti Spagetti ($y)
+EOF
+ 
+EOM
+ 
+$a = `$Perl -I. $Inc $filename  2>&1` ;
+ok(13, ($? >>8) == 0) ;
+ok(14, $a eq <<EOM) ;
+some letters PQRPQR PQR PQR
+Alphabetti Spagetti (PQRDEFPQRPQRPQR)
+EOM
+
+# multi line test
+#################
+
+
+writeFile("${module2}.pm", <<EOM, <<'EOM') ;
+package ${module2} ;
+use Filter::Util::Call ;
+ 
+EOM
+sub import
+{ 
+    my ($type) = shift ;
+    my (@strings) = @_ ;
+
+  
+    filter_add(bless []) 
+}
+ 
+sub filter
+{
+    my ($self) = @_ ;
+    my ($status) ;
+ 
+    # read first line
+    if (($status = filter_read()) > 0) {
+	chop ;
+	s/\r$//;
+	# and now the second line (it will append)
+        $status = filter_read() ;
+    }
+
+    $status ;
+}
+ 
+1 ;
+EOM
+ 
+ 
+writeFile($filename, <<EOM, <<'EOM') ;
+ 
+use $module2  ;
+EOM
+print "don't cut me 
+in half\n" ;
+print  
+<<EOF ;
+appen
+ded
+EO
+F
+ 
+EOM
+ 
+$a = `$Perl -I. $Inc $filename  2>&1` ;
+ok(15, ($? >>8) == 0) ;
+ok(16, $a eq <<EOM) ;
+don't cut me in half
+appended
+EOM
+
+# Block test
+#############
+
+writeFile("${block}.pm", <<EOM, <<'EOM') ;
+package ${block} ;
+use Filter::Util::Call ;
+ 
+EOM
+sub import
+{ 
+    my ($type) = shift ;
+    my (@strings) = @_ ;
+
+  
+    filter_add (bless [@strings] )
+}
+ 
+sub filter
+{
+    my ($self) = @_ ;
+    my ($status) ;
+    my ($pattern) ;
+ 
+    filter_read(20)  ;
+}
+ 
+1 ;
+EOM
+
+$string = <<'EOM' ;
+print "hello mum\n" ;
+$x = 'me ' x 3 ;
+print "Who wants it?\n$x\n" ;
+EOM
+
+
+writeFile($filename, <<EOM, $string ) ;
+use $block ;
+EOM
+ 
+$a = `$Perl -I. $Inc $filename  2>&1` ;
+ok(17, ($? >>8) == 0) ;
+ok(18, $a eq <<EOM) ;
+hello mum
+Who wants it?
+me me me 
+EOM
+
+# use in the filter
+####################
+
+writeFile("${block}.pm", <<EOM, <<'EOM') ;
+package ${block} ;
+use Filter::Util::Call ;
+ 
+EOM
+use Cwd ;
+
+sub import
+{ 
+    my ($type) = shift ;
+    my (@strings) = @_ ;
+
+  
+    filter_add(bless [@strings] )
+}
+ 
+sub filter
+{
+    my ($self) = @_ ;
+    my ($status) ;
+    my ($here) = getcwd ;
+ 
+    if (($status = filter_read()) > 0) {
+        s/DIR/$here/g
+    }
+    $status ;
+}
+ 
+1 ;
+EOM
+
+writeFile($filename, <<EOM, <<'EOM') ;
+use $block ;
+EOM
+print "We are in DIR\n" ;
+EOM
+ 
+$a = `$Perl -I. $Inc $filename  2>&1` ;
+ok(19, ($? >>8) == 0) ;
+ok(20, $a eq <<EOM) ;
+We are in $here
+EOM
+
+
+# filter_del
+#############
+ 
+writeFile("${block}.pm", <<EOM, <<'EOM') ;
+package ${block} ;
+use Filter::Util::Call ;
+ 
+EOM
+ 
+sub import
+{
+    my ($type) = shift ;
+    my ($count) = @_ ;
+ 
+ 
+    filter_add(bless \$count )
+}
+ 
+sub filter
+{
+    my ($self) = @_ ;
+    my ($status) ;
+ 
+    s/HERE/THERE/g
+        if ($status = filter_read()) > 0 ;
+
+    -- $$self ;
+    filter_del() if $$self <= 0 ;
+
+    $status ;
+}
+ 
+1 ;
+EOM
+ 
+writeFile($filename, <<EOM, <<'EOM') ;
+use $block (3) ;
+EOM
+print "
+HERE I am
+I am HERE
+HERE today gone tomorrow\n" ;
+EOM
+ 
+$a = `$Perl -I. $Inc $filename  2>&1` ;
+ok(21, ($? >>8) == 0) ;
+ok(22, $a eq <<EOM) ;
+
+THERE I am
+I am THERE
+HERE today gone tomorrow
+EOM
+
+
+# filter_read_exact
+####################
+ 
+writeFile("${block}.pm", <<EOM, <<'EOM') ;
+package ${block} ;
+use Filter::Util::Call ;
+ 
+EOM
+ 
+sub import
+{
+    my ($type) = shift ;
+ 
+    filter_add(bless [] )
+}
+ 
+sub filter
+{
+    my ($self) = @_ ;
+    my ($status) ;
+ 
+    if (($status = filter_read_exact(9)) > 0) {
+        s/HERE/THERE/g
+    }
+ 
+    $status ;
+}
+ 
+1 ;
+EOM
+ 
+writeFile($filenamebin, <<EOM, <<'EOM') ;
+use $block ;
+EOM
+print "
+HERE I am
+I'm HERE
+HERE today gone tomorrow\n" ;
+EOM
+ 
+$a = `$Perl -I. $Inc $filenamebin  2>&1` ;
+ok(23, ($? >>8) == 0) ;
+ok(24, $a eq <<EOM) ;
+
+HERE I am
+I'm THERE
+THERE today gone tomorrow
+EOM
+
+{
+
+# Check __DATA__
+####################
+ 
+writeFile("${block}.pm", <<EOM, <<'EOM') ;
+package ${block} ;
+use Filter::Util::Call ;
+ 
+EOM
+ 
+sub import
+{
+    my ($type) = shift ;
+ 
+    filter_add(bless [] )
+}
+ 
+sub filter
+{
+    my ($self) = @_ ;
+    my ($status) ;
+ 
+    if (($status = filter_read()) > 0) {
+        s/HERE/THERE/g
+    }
+ 
+    $status ;
+}
+ 
+1 ;
+EOM
+ 
+writeFile($filename, <<EOM, <<'EOM') ;
+use $block ;
+EOM
+print "HERE HERE\n";
+@a = <DATA>;
+print @a;
+__DATA__
+HERE I am
+I'm HERE
+HERE today gone tomorrow
+EOM
+ 
+$a = `$Perl -I. $Inc $filename  2>&1` ;
+ok(25, ($? >>8) == 0) ;
+ok(26, $a eq <<EOM) ;
+THERE THERE
+HERE I am
+I'm HERE
+HERE today gone tomorrow
+EOM
+
+}
+
+{
+
+# Check __END__
+####################
+ 
+writeFile("${block}.pm", <<EOM, <<'EOM') ;
+package ${block} ;
+use Filter::Util::Call ;
+ 
+EOM
+ 
+sub import
+{
+    my ($type) = shift ;
+ 
+    filter_add(bless [] )
+}
+ 
+sub filter
+{
+    my ($self) = @_ ;
+    my ($status) ;
+ 
+    if (($status = filter_read()) > 0) {
+        s/HERE/THERE/g
+    }
+ 
+    $status ;
+}
+ 
+1 ;
+EOM
+ 
+writeFile($filename, <<EOM, <<'EOM') ;
+use $block ;
+EOM
+print "HERE HERE\n";
+@a = <DATA>;
+print @a;
+__END__
+HERE I am
+I'm HERE
+HERE today gone tomorrow
+EOM
+ 
+$a = `$Perl -I. $Inc $filename  2>&1` ;
+ok(27, ($? >>8) == 0) ;
+ok(28, $a eq <<EOM) ;
+THERE THERE
+HERE I am
+I'm HERE
+HERE today gone tomorrow
+EOM
+
+}
+
+END {
+    unlink $filename ;
+    unlink $filenamebin ;
+    unlink "${module}.pm" ;
+    unlink "${module2}.pm" ;
+    unlink "${module3}.pm" ;
+    unlink "${module4}.pm" ;
+    unlink "${module5}.pm" ;
+    unlink $nested ;
+    unlink "${block}.pm" ;
+}
+
+
diff --git a/t/lib/io_sock.t b/t/lib/io_sock.t
index 5a8e16c313..4ac4e352ce 100755
--- a/t/lib/io_sock.t
+++ b/t/lib/io_sock.t
@@ -70,17 +70,15 @@ if($pid = fork()) {
 
 } elsif(defined $pid) {
 
-    # This can fail if localhost is undefined or the
-    # special 'loopback' address 127.0.0.1 is not configured
-    # on your system. (/etc/rc.config.d/netconfig on HP-UX.)
-    # As a shortcut (not recommended) you could change 'localhost'
-    # here to be the name of this machine eg 'myhost.mycompany.com'.
-
     $sock = IO::Socket::INET->new(PeerPort => $port,
 				  Proto => 'tcp',
 				  PeerAddr => 'localhost'
 				 )
-	or die "$! (maybe your system does not have the 'localhost' address defined)";
+         || IO::Socket::INET->new(PeerPort => $port,
+				  Proto => 'tcp',
+				  PeerAddr => '127.0.0.1'
+				 )
+	or die "$! (maybe your system does not have a localhost at all, 'localhost' or 127.0.0.1)";
 
     $sock->autoflush(1);
 
@@ -114,7 +112,8 @@ if($pid = fork()) {
     $listen->close;
 } elsif (defined $pid) {
     # child, try various ways to connect
-    $sock = IO::Socket::INET->new("localhost:$port");
+    $sock = IO::Socket::INET->new("localhost:$port")
+         || IO::Socket::INET->new("127.0.0.1:$port");
     if ($sock) {
 	print "not " unless $sock->connected;
 	print "ok 6\n";
@@ -151,10 +150,14 @@ if($pid = fork()) {
     sleep(1);
 
     $sock = IO::Socket->new(Domain => AF_INET,
-                            PeerAddr => "localhost:$port");
+                            PeerAddr => "localhost:$port")
+         || IO::Socket->new(Domain => AF_INET,
+                            PeerAddr => "127.0.0.1:$port");
     if ($sock) {
        $sock->print("ok 11\n");
        $sock->print("quit\n");
+    } else {
+       print "not ok 11\n";
     }
     $sock = undef;
     sleep(1);
@@ -166,7 +169,10 @@ if($pid = fork()) {
 # Then test UDP sockets
 $server = IO::Socket->new(Domain => AF_INET,
                           Proto  => 'udp',
-                          LocalAddr => 'localhost');
+                          LocalAddr => 'localhost')
+       || IO::Socket->new(Domain => AF_INET,
+                          Proto  => 'udp',
+                          LocalAddr => '127.0.0.1');
 $port = $server->sockport;
 
 if ($^O eq 'mpeix') {
@@ -179,7 +185,9 @@ if ($^O eq 'mpeix') {
     } elsif (defined($pid)) {
         #child
         $sock = IO::Socket::INET->new(Proto => 'udp',
-                                      PeerAddr => "localhost:$port");
+                                      PeerAddr => "localhost:$port")
+             || IO::Socket::INET->new(Proto => 'udp',
+                                      PeerAddr => "127.0.0.1:$port");
         $sock->send("ok 12\n");
         sleep(1);
         $sock->send("ok 12\n");  # send another one to be sure
diff --git a/t/lib/io_udp.t b/t/lib/io_udp.t
index 9df62cfbaf..d63a5dcf7b 100755
--- a/t/lib/io_udp.t
+++ b/t/lib/io_udp.t
@@ -57,19 +57,15 @@ print "1..7\n";
 use Socket;
 use IO::Socket qw(AF_INET SOCK_DGRAM INADDR_ANY);
 
-    # This can fail if localhost is undefined or the
-    # special 'loopback' address 127.0.0.1 is not configured
-    # on your system. (/etc/rc.config.d/netconfig on HP-UX.)
-    # As a shortcut (not recommended) you could change 'localhost'
-    # here to be the name of this machine eg 'myhost.mycompany.com'.
-
 $udpa = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost')
-    or die "$! (maybe your system does not have the 'localhost' address defined)";
+     || IO::Socket::INET->new(Proto => 'udp', LocalAddr => '127.0.0.1')
+    or die "$! (maybe your system does not have a localhost at all, 'localhost' or 127.0.0.1)";
 
 print "ok 1\n";
 
 $udpb = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost')
-    or die "$! (maybe your system does not have the 'localhost' address defined)";
+     || IO::Socket::INET->new(Proto => 'udp', LocalAddr => '127.0.0.1')
+    or die "$! (maybe your system does not have a localhost at all, 'localhost' or 127.0.0.1)";
 
 print "ok 2\n";
 
diff --git a/t/op/re_tests b/t/op/re_tests
index 102157c842..8aa6933d46 100644
--- a/t/op/re_tests
+++ b/t/op/re_tests
@@ -779,3 +779,5 @@ tt+$	xxxtt	y	-	-
 ^(a\1?){4}$	aaaaaa	y	$1	aa
 ^(0+)?(?:x(1))?	x1	y	-	-
 ^([0-9a-fA-F]+)(?:x([0-9a-fA-F]+)?)(?:x([0-9a-fA-F]+))?	012cxx0190	y	-	-
+^(b+?|a){1,2}c	bbbac	y	$1	a
+^(b+?|a){1,2}c	bbbbac	y	$1	a
diff --git a/t/pragma/warn/pp_hot b/t/pragma/warn/pp_hot
index 426820550c..698255c064 100644
--- a/t/pragma/warn/pp_hot
+++ b/t/pragma/warn/pp_hot
@@ -151,6 +151,7 @@ open (FH, ">./xcv") ;
 my $a = <FH> ;
 no warnings 'io' ;
 $a = <FH> ;
+close (FH) ;
 unlink $file ;
 EXPECT
 Filehandle FH opened only for output at - line 5.