This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add Text::Balanced 1.83.
[perl5.git] / t / lib / tb-xquot.t
CommitLineData
3270c621
JH
1#!./perl -ws
2
3BEGIN {
4 chdir 't' if -d 't';
5 @INC = '../lib';
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
16BEGIN { $| = 1; print "1..89\n"; }
17END {print "not ok 1\n" unless $loaded;}
18use Text::Balanced qw ( extract_quotelike );
19$loaded = 1;
20print "ok 1\n";
21$count=2;
22use vars qw( $DEBUG );
23# $DEBUG=1;
24sub debug { print "\t>>>",@_ if $DEBUG }
25
26######################### End of black magic.
27
28
29$cmd = "print";
30$neg = 0;
31while (defined($str = <DATA>))
32{
33 chomp $str;
34 if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; }
35 elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; }
36 elsif (!$str || $str =~ /\A#/) { $neg = 0; next }
37 debug "\tUsing: $cmd\n";
38 debug "\t on: [$str]\n";
39 $str =~ s/\\n/\n/g;
40 my $orig = $str;
41
42 my @res;
43 eval qq{\@res = $cmd; };
44 debug "\t got:\n" . join "", map { $res[$_]=~s/\n/\\n/g; "\t\t\t$_: [$res[$_]]\n"} (0..$#res);
45 debug "\t left: " . (map { s/\n/\\n/g; "[$_]\n" } my $cpy1 = $str)[0];
46 debug "\t pos: " . (map { s/\n/\\n/g; "[$_]\n" } my $cpy2 = substr($str,pos($str)))[0] . "...]\n";
47 print "not " if (substr($str,pos($str),1) eq ';')==$neg;
48 print "ok ", $count++;
49 print "\n";
50
51 $str = $orig;
52 debug "\tUsing: scalar $cmd\n";
53 debug "\t on: [$str]\n";
54 $var = eval $cmd;
55 print " ($@)" if $@ && $DEBUG;
56 $var = "<undef>" unless defined $var;
57 debug "\t scalar got: " . (map { s/\n/\\n/g; "[$_]\n" } $var)[0];
58 debug "\t scalar left: " . (map { s/\n/\\n/g; "[$_]\n" } $str)[0];
59 print "not " if ($str =~ '\A;')==$neg;
60 print "ok ", $count++;
61 print "\n";
62}
63
64__DATA__
65
66# USING: extract_quotelike($str);
67'';
68"";
69"a";
70'b';
71`cc`;
72
73
74<<EOHERE; done();\nline1\nline2\nEOHERE\n; next;
75 <<EOHERE; done();\nline1\nline2\nEOHERE\n; next;
76<<"EOHERE"; done()\nline1\nline2\nEOHERE\n and next
77<<`EOHERE`; done()\nline1\nline2\nEOHERE\n and next
78<<'EOHERE'; done()\nline1\n'line2'\nEOHERE\n and next
79<<'EOHERE;'; done()\nline1\nline2\nEOHERE;\n and next
80<<" EOHERE"; done() \nline1\nline2\n EOHERE\nand next
81<<""; done()\nline1\nline2\n\n and next
82<<; done()\nline1\nline2\n\n and next
83
84
85"this is a nested $var[$x] {";
86/a/gci;
87m/a/gci;
88
89q(d);
90qq(e);
91qx(f);
92qr(g);
93qw(h i j);
94q{d};
95qq{e};
96qx{f};
97qr{g};
98qq{a nested { and } are okay as are () and <> pairs and escaped \}'s };
99q/slash/;
100q # slash #;
101qr qw qx;
102
103s/x/y/;
104s/x/y/cgimsox;
105s{a}{b};
106s{a}\n {b};
107s(a){b};
108s(a)/b/;
109s/'/\\'/g;
110tr/x/y/;
111y/x/y/;
112
113# THESE SHOULD FAIL
114s<$self->{pat}>{$self->{sub}}; # CAN'T HANDLE '>' in '->'
115s-$self->{pap}-$self->{sub}-; # CAN'T HANDLE '-' in '->'
116<<EOHERE; done();\nline1\nline2\nEOHERE;\n; next; # RDEL HAS NO ';'
117<<'EOHERE'; done();\nline1\nline2\nEOHERE;\n; next; # RDEF HAS NO ';'
118 << EOTHERE; done();\nline1\nline2\n EOTHERE\n; next; # RDEL IS "" (!)