Commit | Line | Data |
3270c621 |
1 | #!./perl -ws |
2 | |
3 | BEGIN { |
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 | |
16 | BEGIN { $| = 1; print "1..89\n"; } |
17 | END {print "not ok 1\n" unless $loaded;} |
18 | use Text::Balanced qw ( extract_quotelike ); |
19 | $loaded = 1; |
20 | print "ok 1\n"; |
21 | $count=2; |
22 | use vars qw( $DEBUG ); |
23 | # $DEBUG=1; |
24 | sub debug { print "\t>>>",@_ if $DEBUG } |
25 | |
26 | ######################### End of black magic. |
27 | |
28 | |
29 | $cmd = "print"; |
30 | $neg = 0; |
31 | while (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; |
87 | m/a/gci; |
88 | |
89 | q(d); |
90 | qq(e); |
91 | qx(f); |
92 | qr(g); |
93 | qw(h i j); |
94 | q{d}; |
95 | qq{e}; |
96 | qx{f}; |
97 | qr{g}; |
98 | qq{a nested { and } are okay as are () and <> pairs and escaped \}'s }; |
99 | q/slash/; |
100 | q # slash #; |
101 | qr qw qx; |
102 | |
103 | s/x/y/; |
104 | s/x/y/cgimsox; |
105 | s{a}{b}; |
106 | s{a}\n {b}; |
107 | s(a){b}; |
108 | s(a)/b/; |
109 | s/'/\\'/g; |
110 | tr/x/y/; |
111 | y/x/y/; |
112 | |
113 | # THESE SHOULD FAIL |
114 | s<$self->{pat}>{$self->{sub}}; # CAN'T HANDLE '>' in '->' |
115 | s-$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 "" (!) |