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