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