1 files changed, 38 insertions, 33 deletions

diff --git a/gnu/usr.bin/perl/cpan/Text-Balanced/t/03_extcbk.t b/gnu/usr.bin/perl/cpan/Text-Balanced/t/03_extcbk.t
index 398d2771bac..7cbc9fca272 100755
--- a/gnu/usr.bin/perl/cpan/Text-Balanced/t/03_extcbk.t
+++ b/gnu/usr.bin/perl/cpan/Text-Balanced/t/03_extcbk.t
@@ -1,27 +1,12 @@
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl test.pl'
-
 use 5.008001;
 
 use strict;
 use warnings;
-
-######################### We start with some black magic to print on failure.
-
-# Change 1..1 below to 1..last_test_to_print .
-# (It may become useful if the test is moved to ./t subdirectory.)
-
-my $loaded = 0;
-BEGIN { $| = 1; print "1..41\n"; }
-END {print "not ok 1\n" unless $loaded;}
+use Test::More;
 use Text::Balanced qw ( extract_codeblock );
-$loaded = 1;
-print "ok 1\n";
-my $count=2;
-use vars qw( $DEBUG );
-sub debug { print "\t>>>",@_ if $DEBUG }
 
-######################### End of black magic.
+our $DEBUG;
+sub debug { print "\t>>>",@_ if $DEBUG }
 
 ## no critic (BuiltinFunctions::ProhibitStringyEval)
 
@@ -34,30 +19,47 @@ while (defined($str = <DATA>))
     if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; }
     elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; }
     elsif (!$str || $str =~ /\A#/) { $neg = 0; next }
+    my $orig_str = $str;
     $str =~ s/\\n/\n/g;
     debug "\tUsing: $cmd\n";
     debug "\t   on: [$str]\n";
 
     my @res;
     my $var = eval "\@res = $cmd";
-    debug "\t   Failed: $@ at " . $@+0 .")" if $@;
+    is $@, '', 'no error';
     debug "\t list got: [" . join("|", map {defined $_ ? $_ : '<undef>'} @res) . "]\n";
     debug "\t list left: [$str]\n";
-    print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg;
-    print "ok ", $count++;
-    print "\n";
+    ($neg ? \&isnt : \&is)->(substr($str,pos($str)||0,1), ';', "$orig_str matched list");
 
     pos $str = 0;
     $var = eval $cmd;
+    is $@, '', 'no error';
     $var = "<undef>" unless defined $var;
     debug "\t scalar got: [$var]\n";
     debug "\t scalar left: [$str]\n";
-    print "not " if ($str =~ '\A;')==$neg;
-    print "ok ", $count++;
-    print " ($@)" if $@ && $DEBUG;
-    print "\n";
+    ($neg ? \&unlike : \&like)->( $str, qr/\A;/, "$orig_str matched scalar");
 }
 
+my $grammar = <<'EOF';
+given 2 { when __ < 1 { ok(0) } else { ok(1) } }
+EOF
+pos $grammar = 8;
+my ($out) = Text::Balanced::_match_codeblock(\$grammar,qr/\s*/,qr/\{/,qr/\}/,qr/\{/,qr/\}/,undef);
+ok $out, 'Switch error from calling _match_codeblock';
+
+$grammar = <<'EOF';
+comment:  m/a/
+enum_list: (/b/)
+EOF
+pos $grammar = 10;
+($out) = Text::Balanced::extract_quotelike($grammar);
+is $out, 'm/a/', 'PRD error (setup for real error)';
+pos $grammar = 26;
+($out) = extract_codeblock($grammar,'{([',undef,'(',1);
+is $out, '(/b/)', 'PRD error';
+
+done_testing;
+
 __DATA__
 
 # USING: extract_codeblock($str,'(){}',undef,'()');
@@ -65,6 +67,13 @@ __DATA__
 
 # USING: extract_codeblock($str);
 { $data[4] =~ /['"]/; };
+{1<<2};
+{1<<2};\n
+{1<<2};\n\n
+{ $a = /\}/; };
+{ sub { $_[0] /= $_[1] } };  # / here
+{ 1; };
+{ $a = 1; };
 
 # USING: extract_codeblock($str,'<>');
 < %x = ( try => "this") >;
@@ -77,13 +86,9 @@ __DATA__
 # THIS SHOULD FAIL
 < %x = do { $try > 10 } >;
 
-# USING: extract_codeblock($str);
-
-{ $a = /\}/; };
-{ sub { $_[0] /= $_[1] } };  # / here
-{ 1; };
-{ $a = 1; };
-
+# USING: extract_codeblock($str, '()');
+(($x || 2)); split /z/, $y
+(($x // 2)); split /z/, $y
 
 # USING: extract_codeblock($str,undef,'=*');
 ========{$a=1};