This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to Text-Balanced-1.98
[perl5.git] / lib / Text / Balanced / t / extdel.t
1 BEGIN {
2     if ($ENV{PERL_CORE}) {
3         chdir('t') if -d 't';
4         @INC = qw(../lib);
5     }
6 }
7
8 # Before `make install' is performed this script should be runnable with
9 # `make test'. After `make install' it should work as `perl test.pl'
10
11 ######################### We start with some black magic to print on failure.
12
13 # Change 1..1 below to 1..last_test_to_print .
14 # (It may become useful if the test is moved to ./t subdirectory.)
15
16 BEGIN { $| = 1; print "1..45\n"; }
17 END {print "not ok 1\n" unless $loaded;}
18 use Text::Balanced qw ( extract_delimited );
19 $loaded = 1;
20 print "ok 1\n";
21 $count=2;
22 use vars qw( $DEBUG );
23 sub debug { print "\t>>>",@_ if $DEBUG }
24
25 ######################### End of black magic.
26
27
28 $cmd = "print";
29 $neg = 0;
30 while (defined($str = <DATA>))
31 {
32         chomp $str;
33         if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; }
34         elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; }
35         elsif (!$str || $str =~ /\A#/) { $neg = 0; next }
36         $str =~ s/\\n/\n/g;
37         debug "\tUsing: $cmd\n";
38         debug "\t   on: [$str]\n";
39
40         $var = eval "() = $cmd";
41         debug "\t list got: [$var]\n";
42         debug "\t list left: [$str]\n";
43         print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg;
44         print "ok ", $count++;
45         print " ($@)" if $@ && $DEBUG;
46         print "\n";
47
48         pos $str = 0;
49         $var = eval $cmd;
50         $var = "<undef>" unless defined $var;
51         debug "\t scalar got: [$var]\n";
52         debug "\t scalar left: [$str]\n";
53         print "not " if ($str =~ '\A;')==$neg;
54         print "ok ", $count++;
55         print " ($@)" if $@ && $DEBUG;
56         print "\n";
57 }
58
59 __DATA__
60 # USING: extract_delimited($str,'/#$',undef,'/#$');
61 /a/;
62 /a///;
63 #b#;
64 #b###;
65 $c$;
66 $c$$$;
67
68 # TEST EXTRACTION OF DELIMITED TEXT WITH ESCAPES
69 # USING: extract_delimited($str,'/#$',undef,'\\');
70 /a/;
71 /a\//;
72 #b#;
73 #b\##;
74 $c$;
75 $c\$$;
76
77 # TEST EXTRACTION OF DELIMITED TEXT
78 # USING: extract_delimited($str);
79 'a';
80 "b";
81 `c`;
82 'a\'';
83 'a\\';
84 '\\a';
85 "a\\";
86 "\\a";
87 "b\'\"\'";
88 `c '\`abc\`'`;
89
90 # TEST EXTRACTION OF DELIMITED TEXT
91 # USING: extract_delimited($str,'/#$','-->');
92 -->/a/;
93 -->#b#;
94 -->$c$;
95
96 # THIS SHOULD FAIL
97 $c$;