This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
threads - stack size support
[perl5.git] / lib / Text / Balanced / t / extqlk.t
CommitLineData
a7602084
JH
1BEGIN {
2 if ($ENV{PERL_CORE}) {
3 chdir('t') if -d 't';
4 @INC = qw(../lib);
5 }
6}
7
55a1c97c 8#! /usr/local/bin/perl -ws
3270c621
JH
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
ce3ac4b6 17BEGIN { $| = 1; print "1..95\n"; }
3270c621
JH
18END {print "not ok 1\n" unless $loaded;}
19use Text::Balanced qw ( extract_quotelike );
20$loaded = 1;
21print "ok 1\n";
22$count=2;
23use vars qw( $DEBUG );
24# $DEBUG=1;
25sub debug { print "\t>>>",@_ if $DEBUG }
ce3ac4b6 26sub esc { my $x = shift; $x =~ s/\n/\\n/gs; $x }
3270c621
JH
27
28######################### End of black magic.
29
30
31$cmd = "print";
32$neg = 0;
33while (defined($str = <DATA>))
34{
35 chomp $str;
ce3ac4b6 36 if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; }
3270c621 37 elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; }
ce3ac4b6
DM
38 elsif (!$str || $str =~ /\A#/) { $neg = 0; next }
39 my $setup_cmd = ($str =~ s/\A\{(.*)\}//) ? $1 : '';
40 my $tests = 'sl';
3270c621
JH
41 $str =~ s/\\n/\n/g;
42 my $orig = $str;
43
ce3ac4b6
DM
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 }
3270c621
JH
72}
73
ce3ac4b6
DM
74# fails in Text::Balanced 1.95
75$_ = qq(s{}{});
76my @z = extract_quotelike();
77print "not " if $z[0] eq '';
78print "ok ", $count++;
79print "\n";
80
81
3270c621
JH
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
ce3ac4b6
DM
101# fails in Text::Balanced 1.95
102<<EOHERE;\nEOHERE\n;
103# fails in Text::Balanced 1.95
104<<"*";\n\n*\n;
3270c621
JH
105
106"this is a nested $var[$x] {";
107/a/gci;
108m/a/gci;
109
110q(d);
111qq(e);
112qx(f);
113qr(g);
114qw(h i j);
115q{d};
116qq{e};
117qx{f};
118qr{g};
119qq{a nested { and } are okay as are () and <> pairs and escaped \}'s };
120q/slash/;
121q # slash #;
122qr qw qx;
123
124s/x/y/;
125s/x/y/cgimsox;
126s{a}{b};
127s{a}\n {b};
128s(a){b};
129s(a)/b/;
130s/'/\\'/g;
131tr/x/y/;
132y/x/y/;
133
ce3ac4b6
DM
134# fails on Text-Balanced-1.95
135{ $tests = 'l'; pos($str)=6 }012345<<E;\n\nE\n
136
3270c621
JH
137# THESE SHOULD FAIL
138s<$self->{pat}>{$self->{sub}}; # CAN'T HANDLE '>' in '->'
139s-$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 "" (!)