1use 5.008001;
2
3use strict;
4use warnings;
5use Test::More;
6use Text::Balanced qw ( extract_delimited extract_multiple );
7
8our $DEBUG;
9sub debug { print "\t>>>",@_ if $DEBUG }
10
11## no critic (BuiltinFunctions::ProhibitStringyEval)
12
13my $cmd = "print";
14my $neg = 0;
15my $str;
16while (defined($str = <DATA>))
17{
18    chomp $str;
19    if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; }
20    elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; }
21    elsif (!$str || $str =~ /\A#/) { $neg = 0; next }
22    my $orig_str = $str;
23    $str =~ s/\\n/\n/g;
24    debug "\tUsing: $cmd\n";
25    debug "\t   on: [$str]\n";
26
27    my $var = eval "() = $cmd";
28    is $@, '', 'no error';
29    debug "\t list got: [$var]\n";
30    debug "\t list left: [$str]\n";
31    ($neg ? \&isnt : \&is)->(substr($str,pos($str)||0,1), ';', "$orig_str matched list");
32
33    pos $str = 0;
34    $var = eval $cmd;
35    is $@, '', 'no error';
36    $var = "<undef>" unless defined $var;
37    debug "\t scalar got: [$var]\n";
38    debug "\t scalar left: [$str]\n";
39    ($neg ? \&unlike : \&like)->( $str, qr/\A;/, "$orig_str matched scalar");
40}
41
42my $text = 'while($a == "test"){ print "true";}';
43my ($extracted, $remainder) = extract_delimited($text, '#');
44ok '' ne $@, 'string overload should not crash';
45
46$text = "a,'x b',c";
47my @fields = extract_multiple($text,
48 [
49   sub { extract_delimited($_[0],q{'"}) },
50   qr/([^,]+)/,
51 ],
52 undef,1);
53is_deeply \@fields, ['a', "'x b'", 'c'] or diag 'got: ', explain \@fields;
54
55done_testing;
56
57__DATA__
58# USING: extract_delimited($str,'/#$',undef,'/#$');
59/a/;
60/a///;
61#b#;
62#b###;
63$c$;
64$c$$$;
65
66# TEST EXTRACTION OF DELIMITED TEXT WITH ESCAPES
67# USING: extract_delimited($str,'/#$',undef,'\\');
68/a/;
69/a\//;
70#b#;
71#b\##;
72$c$;
73$c\$$;
74
75# TEST EXTRACTION OF DELIMITED TEXT
76# USING: extract_delimited($str);
77'a';
78"b";
79`c`;
80'a\'';
81'a\\';
82'\\a';
83"a\\";
84"\\a";
85"b\'\"\'";
86`c '\`abc\`'`;
87
88# TEST EXTRACTION OF DELIMITED TEXT
89# USING: extract_delimited($str,'/#$','-->');
90-->/a/;
91-->#b#;
92-->$c$;
93
94# THIS SHOULD FAIL
95$c$;
96