开源软件构建与测试

_service:tar_scm:perl-Text-Balanced.spec Changed

_service Changed

_service:tar_scm:Text-Balanced-2.04.tar.gz/Changes -> _service:tar_scm:Text-Balanced-2.06.tar.gz/Changes Changed

@@ -1,5 +1,56 @@
 Revision history for Perl distribution Text-Balanced.
 
+2.06 2022-06-05
+
+    - Released with no further code changes.
+
+2.05_01 2022-05-29
+
+    - Fix direct use of _match_codeblock by e.g. Switch.  mohawk2, CPAN
+      RT#142923
+
+    - Fix resetting of whether "/" or "?" allowed to open regex.  mohawk2, CPAN
+      RT#142922
+
+    - Fix false negative on /.../ regex after "and".  mohawk2, GH#7
+
+2.05 2022-05-22
+
+    - Released with no further code changes.
+
+2.04_02 2022-03-09
+
+    - Fix missed case of spotting expression ending ")" or "".  mohawk2
+
+    - Fix too-loosely allowing ?...? as RE (often actually conditional op).
+      mohawk2
+
+2.04_01 2022-03-05
+
+    - Performance optimizations.  mohawk2, PR#5
+
+    - Fix "<<=" being seen as heredoc, misparsing of "y=>".  mohawk2, PR#6
+
+    - Update documentation to clarify extract_tagged() takes regexes.  Jay
+      Hannah, GH#3
+
+    - Modernize tests.  mohawk2, GH#2
+
+    - Fix extract_variable() not recognising ${var} end of string.  Ed J, CPAN
+      RT#70007
+
+    - Fix string-comparing $@ causing exception.  Ed J, CPAN RT#74994)
+
+    - Update documentation to correct CSV example.  djerius@cpan.org, CPAN
+      RT#140408
+
+    - Fix extract_codeblock() being confused by //.  Ed J, CPAN RT#78313
+
+    - Improve here-doc detection.  Ed J, CPAN RT#74714
+
+    - Fix extract_multiple() to track whether to allow /.../ as quotelike.
+      Ed J, CPAN RT#5722
+
 2.04 2020-12-11
 
     - Fixed INSTALLDIRS to account for the @INC reordering change in Perl 5.12.

_service:tar_scm:Text-Balanced-2.04.tar.gz/META.json -> _service:tar_scm:Text-Balanced-2.06.tar.gz/META.json Changed

_service:tar_scm:Text-Balanced-2.04.tar.gz/META.yml -> _service:tar_scm:Text-Balanced-2.06.tar.gz/META.yml Changed

_service:tar_scm:Text-Balanced-2.04.tar.gz/Makefile.PL -> _service:tar_scm:Text-Balanced-2.06.tar.gz/Makefile.PL Changed

_service:tar_scm:Text-Balanced-2.04.tar.gz/README -> _service:tar_scm:Text-Balanced-2.06.tar.gz/README Changed

_service:tar_scm:Text-Balanced-2.04.tar.gz/lib/Text/Balanced.pm -> _service:tar_scm:Text-Balanced-2.06.tar.gz/lib/Text/Balanced.pm Changed

@@ -1,6 +1,7 @@
 # Copyright (C) 1997-2001 Damian Conway.  All rights reserved.
 # Copyright (C) 2009 Adam Kennedy.
-# Copyright (C) 2015 Steve Hay.  All rights reserved.
+# Copyright (C) 2015, 2022 Steve Hay and other contributors.  All rights
+# reserved.
 
 # This module is free software; you can redistribute it and/or modify it under
 # the same terms as Perl itself, i.e. under the terms of either the GNU General
@@ -17,7 +18,7 @@
 
 use vars qw { $VERSION @ISA %EXPORT_TAGS };
 BEGIN {
-    $VERSION     = '2.04';
+    $VERSION     = '2.06';
     @ISA         = 'Exporter';
     %EXPORT_TAGS = (
         ALL =>  qw{
@@ -37,14 +38,22 @@
 
 Exporter::export_ok_tags('ALL');
 
-## no critic (Subroutines::ProhibitSubroutinePrototypes)
-
-# PROTOTYPES
-
-sub _match_bracketed($$$$$$);
-sub _match_variable($$);
-sub _match_codeblock($$$$$$$);
-sub _match_quotelike($$$$);
+our $RE_PREREGEX_PAT = qr#(
+    !=~
+    | split|grep|map
+    | not|and|or|xor
+)#x;
+our $RE_EXPR_PAT = qr#(
+    (?:\*\*|&&|\|\||<<|>>|//|-+*x%^&|.)=?
+    | /(?:^/)
+    | =(?!>)
+    | return
+    | \(\
+)#x;
+our $RE_NUM = qr/\s*+\-.0-9+\-.0-9e*/i; # numerical constant
+
+our %ref2slashvalid; # is quotelike /.../ pattern valid here for given textref?
+our %ref2qmarkvalid; # is quotelike ?...? pattern valid here for given textref?
 
 # HANDLE RETURN VALUES IN VARIOUS CONTEXTS
 
@@ -99,6 +108,7 @@
 }
 
 # BUILD A PATTERN MATCHING A SIMPLE DELIMITED STRING
+## no critic (Subroutines::ProhibitSubroutinePrototypes)
 
 sub gen_delimited_pat($;$)  # ($delimiters;$escapes)
 {
@@ -132,6 +142,7 @@
 sub extract_delimited (;$$$$)
 {
     my $textref = defined $_0 ? \$_0 : \$_;
+    $ref2slashvalid{$textref} = 1, $ref2qmarkvalid{$textref} = 0 if !pos($$textref); # reset
     my $wantarray = wantarray;
     my $del  = defined $_1 ? $_1 : qq{\'\"\`};
     my $pre  = defined $_2 ? $_2 : '\s*';
@@ -149,33 +160,45 @@
                     $startpos, $prelen;                         # PREFIX
 }
 
-sub extract_bracketed (;$$$)
-{
-    my $textref = defined $_0 ? \$_0 : \$_;
-    my $ldel = defined $_1 ? $_1 : '{(<';
-    my $pre  = defined $_2 ? $_2 : '\s*';
-    my $wantarray = wantarray;
+my %eb_delim_cache;
+sub _eb_delims {
+    my ($ldel_orig) = @_;
+    return @{ $eb_delim_cache{$ldel_orig} } if $eb_delim_cache{$ldel_orig};
     my $qdel = "";
     my $quotelike;
+    my $ldel = $ldel_orig;
     $ldel =~ s/'//g and $qdel .= q{'};
     $ldel =~ s/"//g and $qdel .= q{"};
     $ldel =~ s/`//g and $qdel .= q{`};
     $ldel =~ s/q//g and $quotelike = 1;
     $ldel =~ tr/(){}<>\0-\377/(({{<</ds;
     my $rdel = $ldel;
-    unless ($rdel =~ tr/({</)}>/)
+    return @{ $eb_delim_cache{$ldel_orig} =  } unless $rdel =~ tr/({</)}>/;
+    my $posbug = pos;
+    $ldel = join('|', map { quotemeta $_ } split('', $ldel));
+    $rdel = join('|', map { quotemeta $_ } split('', $rdel));
+    pos = $posbug;
+    @{ $eb_delim_cache{$ldel_orig} = 
+        qr/\G($ldel)/, $qdel && qr/\G($qdel)/, $quotelike, qr/\G($rdel)/
+     };
+}
+sub extract_bracketed (;$$$)
+{
+    my $textref = defined $_0 ? \$_0 : \$_;
+    $ref2slashvalid{$textref} = 1, $ref2qmarkvalid{$textref} = 0 if !pos($$textref); # reset
+    my $ldel = defined $_1 ? $_1 : '{(<';
+    my $pre  = defined $_2 ? qr/\G$_2/ : qr/\G\s*/;
+    my $wantarray = wantarray;
+    my @ret = _eb_delims($ldel);
+    unless (@ret)
     {
         return _fail $wantarray, $textref,
                      "Did not find a suitable bracket in delimiter: \"$_1\"",
                      0;
     }
-    my $posbug = pos;
-    $ldel = join('|', map { quotemeta $_ } split('', $ldel));
-    $rdel = join('|', map { quotemeta $_ } split('', $rdel));
-    pos = $posbug;
 
     my $startpos = pos $$textref || 0;
-    my @match = _match_bracketed($textref,$pre, $ldel, $qdel, $quotelike, $rdel);
+    my @match = _match_bracketed($textref, $pre, @ret);
 
     return _fail ($wantarray, $textref) unless @match;
 
@@ -186,11 +209,11 @@
                     );
 }
 
-sub _match_bracketed($$$$$$)    # $textref, $pre, $ldel, $qdel, $quotelike, $rdel
+sub _match_bracketed    # $textref, $pre, $ldel, $qdel, $quotelike, $rdel
 {
     my ($textref, $pre, $ldel, $qdel, $quotelike, $rdel) = @_;
     my ($startpos, $ldelpos, $endpos) = (pos $$textref = pos $$textref||0);
-    unless ($$textref =~ m/\G$pre/gc)
+    unless ($$textref =~ m/$pre/gc)
     {
         _failmsg "Did not find prefix: /$pre/", $startpos;
         return;
@@ -198,7 +221,7 @@
 
     $ldelpos = pos $$textref;
 
-    unless ($$textref =~ m/\G($ldel)/gc)
+    unless ($$textref =~ m/$ldel/gc)
     {
         _failmsg "Did not find opening bracket after prefix: \"$pre\"",
                  pos $$textref;
@@ -212,11 +235,11 @@
     {
         next if $$textref =~ m/\G\\./gcs;
 
-        if ($$textref =~ m/\G($ldel)/gc)
+        if ($$textref =~ m/$ldel/gc)
         {
             push @nesting, $1;
         }
-        elsif ($$textref =~ m/\G($rdel)/gc)
+        elsif ($$textref =~ m/$rdel/gc)
         {
             my ($found, $brackettype) = ($1, $1);
             if ($#nesting < 0)
@@ -237,7 +260,7 @@
             }
             last if $#nesting < 0;
         }
-        elsif ($qdel && $$textref =~ m/\G($qdel)/gc)
+        elsif ($qdel && $$textref =~ m/$qdel/gc)
         {
             $$textref =~ m/\G^\\$1*(?:\\.^\\$1*)*(\Q$1\E)/gsc and next;
             _failmsg "Unmatched embedded quote ($1)",
@@ -245,8 +268,9 @@
             pos $$textref = $startpos;
             return;
         }
-        elsif ($quotelike && _match_quotelike($textref,"",1,0))
+        elsif ($quotelike && _match_quotelike($textref,qr/\G()/,$ref2slashvalid{$textref},$ref2qmarkvalid{$textref}))
         {
+            $ref2slashvalid{$textref} = $ref2qmarkvalid{$textref} = 1; # back-compat
             next;
         }
 
@@ -281,12 +305,14 @@
 
 my $XMLNAME = q{a-zA-Z_:a-zA-Z0-9_:.-*};
 
+my $et_default_ldel = '<\w+(?:' . gen_delimited_pat(q{'"}) . '|^>)*>';
 sub extract_tagged (;$$$$$) # ($text, $opentag, $closetag, $pre, \%options)
 {
     my $textref = defined $_0 ? \$_0 : \$_;
+    $ref2slashvalid{$textref} = 1, $ref2qmarkvalid{$textref} = 0 if !pos($$textref); # reset
     my $ldel    = $_1;
     my $rdel    = $_2;
-    my $pre     = defined $_3 ? $_3 : '\s*';
+    my $pre     = defined $_3 ? qr/\G$_3/ : qr/\G\s*/;
     my %options = defined $_4 ? %{$_4} : ();
     my $omode   = defined $options{fail} ? $options{fail} : '';
     my $bad     = ref($options{reject}) eq 'ARRAY' ? join('|', @{$options{reject}})
@@ -298,7 +324,7 @@
                 :                                    ''
                 ;

_service:tar_scm:Text-Balanced-2.04.tar.gz/t/01_compile.t -> _service:tar_scm:Text-Balanced-2.06.tar.gz/t/01_compile.t Changed

_service:tar_scm:Text-Balanced-2.04.tar.gz/t/02_extbrk.t -> _service:tar_scm:Text-Balanced-2.06.tar.gz/t/02_extbrk.t Changed

@@ -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..19\n"; }
-END {print "not ok 1\n" unless $loaded;}
+use Test::More;
 use Text::Balanced qw ( extract_bracketed );
-$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,6 +19,7 @@
     if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; }
     elsif ($str =~ /\A# THEISE? 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";
@@ -41,22 +27,20 @@
     my $var = eval "() = $cmd";
     debug "\t list got: $var\n";
     debug "\t list left: $str\n";
-    print "not " if (substr($str,pos($str),1) eq ';')==$neg;
-    print "ok ", $count++;
-    print " ($@)" if $@ && $DEBUG;
-    print "\n";
+    ($neg ? \&isnt : \&is)->(substr($str,pos($str)||0,1), ';', "$orig_str matched list");
+    diag $@ if $@ && $DEBUG;
 
     pos $str = 0;
     $var = eval $cmd;
     $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");
+    diag $@ if $@ && $DEBUG;
 }
 
+done_testing;
+
 __DATA__
 
 # USING: extract_bracketed($str);

_service:tar_scm:Text-Balanced-2.04.tar.gz/t/03_extcbk.t -> _service:tar_scm:Text-Balanced-2.06.tar.gz/t/03_extcbk.t Changed

@@ -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 @@
     if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; }
     elsif ($str =~ /\A# THEISE? 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 @@
 
 # USING: extract_codeblock($str);
 { $data4 =~ /'"/; };
+{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 @@
 # 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};

_service:tar_scm:Text-Balanced-2.04.tar.gz/t/04_extdel.t -> _service:tar_scm:Text-Balanced-2.06.tar.gz/t/04_extdel.t Changed

@@ -1,28 +1,13 @@
-# 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;
+use Test::More;
+use Text::Balanced qw ( extract_delimited extract_multiple );
 
-######################### 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..45\n"; }
-END {print "not ok 1\n" unless $loaded;}
-use Text::Balanced qw ( extract_delimited );
-$loaded = 1;
-print "ok 1\n";
-my $count=2;
-use vars qw( $DEBUG );
+our $DEBUG;
 sub debug { print "\t>>>",@_ if $DEBUG }
 
-######################### End of black magic.
-
 ## no critic (BuiltinFunctions::ProhibitStringyEval)
 
 my $cmd = "print";
@@ -34,29 +19,41 @@
     if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; }
     elsif ($str =~ /\A# THEISE? 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 $var = eval "() = $cmd";
+    is $@, '', 'no error';
     debug "\t list got: $var\n";
     debug "\t list left: $str\n";
-    print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg;
-    print "ok ", $count++;
-    print " ($@)" if $@ && $DEBUG;
-    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 $text = 'while($a == "test"){ print "true";}';
+my ($extracted, $remainder) = extract_delimited($text, '#');
+ok '' ne $@, 'string overload should not crash';
+
+$text = "a,'x b',c";
+my @fields = extract_multiple($text,
+ 
+   sub { extract_delimited($_0,q{'"}) },
+   qr/(^,+)/,
+ ,
+ undef,1);
+is_deeply \@fields, 'a', "'x b'", 'c' or diag 'got: ', explain \@fields;
+
+done_testing;
+
 __DATA__
 # USING: extract_delimited($str,'/#$',undef,'/#$');
 /a/;

_service:tar_scm:Text-Balanced-2.04.tar.gz/t/05_extmul.t -> _service:tar_scm:Text-Balanced-2.06.tar.gz/t/05_extmul.t Changed

@@ -1,54 +1,20 @@
-# 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..86\n"; }
-END {print "not ok 1\n" unless $loaded;}
+use Test::More;
 use Text::Balanced qw ( :ALL );
-$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 }
 
 sub expect
 {
-    local $^W;
     my ($l1, $l2) = @_;
-
-    if (@$l1 != @$l2)
-    {
-        print "\@l1: ", join(", ", @$l1), "\n";
-        print "\@l2: ", join(", ", @$l2), "\n";
-        print "not ";
-    }
-    else
-    {
-        for (my $i = 0; $i < @$l1; $i++)
-        {
-            if ($l1->$i ne $l2->$i)
-            {
-                print "field $i: '$l1->$i' ne '$l2->$i'\n";
-                print "not ";
-                last;
-            }
-        }
-    }
-
-    print "ok $count\n";
-    $count++;
+    is_deeply $l1, $l2 or do {
+        diag 'got:', explain $l1;
+        diag 'expected:', explain $l2;
+    };
 }
 
 sub divide
@@ -66,10 +32,8 @@
 
 }
 
-
 my $stdtext1 = q{$var = do {"val" && $val;};};
 
-# TESTS 2-4
 my $text = $stdtext1;
 expect  extract_multiple($text,undef,1) ,
         divide $stdtext1 => 4 ;
@@ -77,7 +41,6 @@
 expect  pos $text,  4 ;
 expect  $text ,  $stdtext1 ;
 
-# TESTS 5-7
 $text = $stdtext1;
 expect  scalar extract_multiple($text,undef,1) ,
         divide $stdtext1 => 4 ;
@@ -86,7 +49,6 @@
 expect  $text ,  substr($stdtext1,4) ;
 
 
-# TESTS 8-10
 $text = $stdtext1;
 expect  extract_multiple($text,undef,2) ,
         divide($stdtext1 => 4, 10) ;
@@ -94,7 +56,6 @@
 expect  pos $text,  10 ;
 expect  $text ,  $stdtext1 ;
 
-# TESTS 11-13
 $text = $stdtext1;
 expect  eval{local$^W;scalar extract_multiple($text,undef,2)} ,
         substr($stdtext1,0,4) ;
@@ -103,7 +64,6 @@
 expect  $text ,  substr($stdtext1,4) ;
 
 
-# TESTS 14-16
 $text = $stdtext1;
 expect  extract_multiple($text,undef,3) ,
         divide($stdtext1 => 4, 10, 26) ;
@@ -111,7 +71,6 @@
 expect  pos $text,  26 ;
 expect  $text ,  $stdtext1 ;
 
-# TESTS 17-19
 $text = $stdtext1;
 expect  eval{local$^W;scalar extract_multiple($text,undef,3)} ,
         substr($stdtext1,0,4) ;
@@ -120,7 +79,6 @@
 expect  $text ,  substr($stdtext1,4) ;
 
 
-# TESTS 20-22
 $text = $stdtext1;
 expect  extract_multiple($text,undef,4) ,
         divide($stdtext1 => 4, 10, 26, 27) ;
@@ -128,7 +86,6 @@
 expect  pos $text,  27 ;
 expect  $text ,  $stdtext1 ;
 
-# TESTS 23-25
 $text = $stdtext1;
 expect  eval{local$^W;scalar extract_multiple($text,undef,4)} ,
         substr($stdtext1,0,4) ;
@@ -137,7 +94,6 @@
 expect  $text ,  substr($stdtext1,4) ;
 
 
-# TESTS 26-28
 $text = $stdtext1;
 expect  extract_multiple($text,undef,5) ,
         divide($stdtext1 => 4, 10, 26, 27) ;
@@ -146,7 +102,6 @@
 expect  $text ,  $stdtext1 ;
 
 
-# TESTS 29-31
 $text = $stdtext1;
 expect  eval{local$^W;scalar extract_multiple($text,undef,5)} ,
         substr($stdtext1,0,4) ;
@@ -156,7 +111,6 @@
 
 
 
-# TESTS 32-34
 my $stdtext2 = q{$var = "val" && (1,2,3);};
 
 $text = $stdtext2;
@@ -166,7 +120,6 @@
 expect  pos $text,  24 ;
 expect  $text ,  $stdtext2 ;
 
-# TESTS 35-37
 $text = $stdtext2;
 expect  scalar extract_multiple($text) ,
         substr($stdtext2,0,4) ;
@@ -175,7 +128,6 @@
 expect  $text ,  substr($stdtext2,4) ;
 
 
-# TESTS 38-40
 $text = $stdtext2;
 expect  extract_multiple($text,\&extract_bracketed) ,
         substr($stdtext2,0,16), substr($stdtext2,16,7), substr($stdtext2,23) ;
@@ -183,7 +135,6 @@
 expect  pos $text,  24 ;
 expect  $text ,  $stdtext2 ;
 
-# TESTS 41-43
 $text = $stdtext2;
 expect  scalar extract_multiple($text,\&extract_bracketed) ,
         substr($stdtext2,0,16) ;
@@ -192,7 +143,6 @@
 expect  $text ,  substr($stdtext2,15) ;
 
 
-# TESTS 44-46
 $text = $stdtext2;
 expect  extract_multiple($text,\&extract_variable) ,
         substr($stdtext2,0,4), substr($stdtext2,4) ;
@@ -200,7 +150,6 @@
 expect  pos $text,  length($text) ;
 expect  $text ,  $stdtext2 ;
 
-# TESTS 47-49
 $text = $stdtext2;
 expect  scalar extract_multiple($text,\&extract_variable) ,
         substr($stdtext2,0,4) ;
@@ -209,7 +158,6 @@
 expect  $text ,  substr($stdtext2,4) ;
 
 
-# TESTS 50-52
 $text = $stdtext2;
 expect  extract_multiple($text,\&extract_quotelike) ,

_service:tar_scm:Text-Balanced-2.04.tar.gz/t/06_extqlk.t -> _service:tar_scm:Text-Balanced-2.06.tar.gz/t/06_extqlk.t Changed

@@ -1,30 +1,13 @@
-#! /usr/local/bin/perl -ws
-# 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..95\n"; }
-END {print "not ok 1\n" unless $loaded;}
+use Test::More;
 use Text::Balanced qw ( extract_quotelike );
-$loaded = 1;
-print "ok 1\n";
-my $count=2;
-use vars qw( $DEBUG );
-#$DEBUG=1;
-sub debug { print "\t>>>",@_ if $ENV{DEBUG} }
-sub esc   { my $x = shift||'<undef>'; $x =~ s/\n/\\n/gs; $x }
 
-######################### End of black magic.
+our $DEBUG;
+sub debug { print "\t>>>",@_ if $DEBUG }
+sub esc   { my $x = shift||'<undef>'; $x =~ s/\n/\\n/gs; $x }
 
 ## no critic (BuiltinFunctions::ProhibitStringyEval)
 
@@ -39,46 +22,49 @@
     elsif (!$str || $str =~ /\A#/)              { $neg = 0; next }
     my $setup_cmd = ($str =~ s/\A\{(.*)\}//) ? $1 : '';
     my $tests = 'sl';
+    my $orig_str = $str;
     $str =~ s/\\n/\n/g;
     my $orig = $str;
 
     eval $setup_cmd if $setup_cmd ne '';
+    is $@, '', 'no error';
     if($tests =~ /l/) {
         debug "\tUsing: $cmd\n";
         debug "\t   on: " . esc($setup_cmd) . "" . esc($str) . "\n";
         my @res;
         eval qq{\@res = $cmd; };
+        is $@, '', 'no error';
         debug "\t  got:\n" . join "", map { "\t\t\t$_: " . esc($res$_) . "\n"} (0..$#res);
         debug "\t left: " . esc($str) . "\n";
         debug "\t  pos: " . esc(substr($str,pos($str))) . "...\n";
-        print "not " if (substr($str,pos($str),1) eq ';')==$neg;
-        print "ok ", $count++;
-        print "\n";
+        ($neg ? \&isnt : \&is)->(substr($str,pos($str)||0,1), ';', "$orig_str matched list");
     }
 
     eval $setup_cmd if $setup_cmd ne '';
+    is $@, '', 'no error';
     if($tests =~ /s/) {
         $str = $orig;
         debug "\tUsing: scalar $cmd\n";
         debug "\t   on: " . esc($str) . "\n";
         my $var = eval $cmd;
-        print " ($@)" if $@ && $DEBUG;
         $var = "<undef>" unless defined $var;
         debug "\t scalar got: " . esc($var) . "\n";
         debug "\t scalar left: " . esc($str) . "\n";
-        print "not " if ($str =~ '\A;')==$neg;
-        print "ok ", $count++;
-        print "\n";
+        ($neg ? \&unlike : \&like)->( $str, qr/\A;/, "$orig_str matched scalar");
     }
 }
 
 # fails in Text::Balanced 1.95
 $_ = qq(s{}{});
 my @z = extract_quotelike();
-print "not " if $z0 eq '';
-print "ok ", $count++;
-print "\n";
+isnt $z0, '';
 
+@z = extract_quotelike("<<, 1; done()\nline1\nline2\n\n and next");
+like $z1, qr/\A,/, 'implied heredoc with ,' or do {
+  diag "error: '$@'\ngot: ", explain \@z;
+};
+
+done_testing;
 
 __DATA__
 
@@ -89,7 +75,6 @@
 'b';
 `cc`;
 
-
 <<EOHERE; done();\nline1\nline2\nEOHERE\n; next;
      <<EOHERE; done();\nline1\nline2\nEOHERE\n; next;
 <<"EOHERE"; done()\nline1\nline2\nEOHERE\n and next

_service:tar_scm:Text-Balanced-2.04.tar.gz/t/07_exttag.t -> _service:tar_scm:Text-Balanced-2.06.tar.gz/t/07_exttag.t Changed

@@ -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..53\n"; }
-END {print "not ok 1\n" unless $loaded;}
+use Test::More;
 use Text::Balanced qw ( extract_tagged gen_extract_tagged );
-$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,29 @@
     if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; }
     elsif ($str =~ /\A# THEISE? 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";
+    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 " ($@)" if $@ && $DEBUG;
-    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");
 }
 
+done_testing;
+
 __DATA__
 # USING: gen_extract_tagged("BEGIN(A-Z+)",'END$1',"(?s).*?(?=BEGIN)")->($str);
     ignore\n this and then BEGINHERE at the ENDHERE;

_service:tar_scm:Text-Balanced-2.04.tar.gz/t/08_extvar.t -> _service:tar_scm:Text-Balanced-2.06.tar.gz/t/08_extvar.t Changed

@@ -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..183\n"; }
-END {print "not ok 1\n" unless $loaded;}
+use Test::More;
 use Text::Balanced qw ( extract_variable );
-$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,32 @@
     if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; }
     elsif ($str =~ /\A# THEISE? 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";
+    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 " ($@)" if $@ && $DEBUG;
-    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 @res = extract_variable('${a}');
+is $res0, '${a}' or diag "error was: $@";
+
+done_testing;
+
 __DATA__
 
 # USING: extract_variable($str);

_service:tar_scm:Text-Balanced-2.04.tar.gz/t/09_gentag.t -> _service:tar_scm:Text-Balanced-2.06.tar.gz/t/09_gentag.t Changed

@@ -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..37\n"; }
-END {print "not ok 1\n" unless $loaded;}
 use Text::Balanced qw ( gen_extract_tagged );
-$loaded = 1;
-print "ok 1\n";
-my $count=2;
-use vars qw( $DEBUG );
-sub debug { print "\t>>>",@_ if $DEBUG }
+use Test::More;
 
-######################### End of black magic.
+our $DEBUG;
+sub debug { print "\t>>>",@_ if $DEBUG }
 
 ## no critic (BuiltinFunctions::ProhibitStringyEval)
 
@@ -31,6 +16,7 @@
 while (defined($str = <DATA>))
 {
     chomp $str;
+    my $orig_str = $str;
     $str =~ s/\\n/\n/g;
     if ($str =~ s/\A# USING://)
     {
@@ -41,6 +27,7 @@
                 local $SIG{__WARN__} = sub { push @warnings, shift; };
                 *f = eval $str || die;
         };
+        is $@, '', 'no error';
         next;
     }
     elsif ($str =~ /\A# THEISE? SHOULD FAIL/) { $neg = 1; next; }
@@ -51,24 +38,22 @@
 
     my @res;
     my $var = eval { @res = f($str) };
+    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 " ($@)" if $@ && $DEBUG;
-    print "\n";
+    ($neg ? \&isnt : \&is)->(substr($str,pos($str)||0,1), ';', "$orig_str matched list");
 
     pos $str = 0;
     $var = eval { scalar f($str) };
+    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");
 }
 
+done_testing;
+
 __DATA__
 
 # USING: gen_extract_tagged('{','}');

Changes of Revision 2