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'
12 ######################### We start with some black magic to print on failure.
14 # Change 1..1 below to 1..last_test_to_print .
15 # (It may become useful if the test is moved to ./t subdirectory.)
17 BEGIN { $| = 1; print "1..89\n"; }
18 END {print "not ok 1\n" unless $loaded;}
19 use Text::Balanced qw ( extract_quotelike );
23 use vars qw( $DEBUG );
25 sub debug { print "\t>>>",@_ if $DEBUG }
27 ######################### End of black magic.
32 while (defined($str = <DATA>))
35 if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; }
36 elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; }
37 elsif (!$str || $str =~ /\A#/) { $neg = 0; next }
38 debug "\tUsing: $cmd\n";
39 debug "\t on: [$str]\n";
44 eval qq{\@res = $cmd; };
45 debug "\t got:\n" . join "", map { $res[$_]=~s/\n/\\n/g; "\t\t\t$_: [$res[$_]]\n"} (0..$#res);
46 debug "\t left: " . (map { s/\n/\\n/g; "[$_]\n" } my $cpy1 = $str)[0];
47 debug "\t pos: " . (map { s/\n/\\n/g; "[$_]\n" } my $cpy2 = substr($str,pos($str)))[0] . "...]\n";
48 print "not " if (substr($str,pos($str),1) eq ';')==$neg;
49 print "ok ", $count++;
53 debug "\tUsing: scalar $cmd\n";
54 debug "\t on: [$str]\n";
56 print " ($@)" if $@ && $DEBUG;
57 $var = "<undef>" unless defined $var;
58 debug "\t scalar got: " . (map { s/\n/\\n/g; "[$_]\n" } $var)[0];
59 debug "\t scalar left: " . (map { s/\n/\\n/g; "[$_]\n" } $str)[0];
60 print "not " if ($str =~ '\A;')==$neg;
61 print "ok ", $count++;
67 # USING: extract_quotelike($str);
75 <<EOHERE; done();\nline1\nline2\nEOHERE\n; next;
76 <<EOHERE; done();\nline1\nline2\nEOHERE\n; next;
77 <<"EOHERE"; done()\nline1\nline2\nEOHERE\n and next
78 <<`EOHERE`; done()\nline1\nline2\nEOHERE\n and next
79 <<'EOHERE'; done()\nline1\n'line2'\nEOHERE\n and next
80 <<'EOHERE;'; done()\nline1\nline2\nEOHERE;\n and next
81 <<" EOHERE"; done() \nline1\nline2\n EOHERE\nand next
82 <<""; done()\nline1\nline2\n\n and next
83 <<; done()\nline1\nline2\n\n and next
86 "this is a nested $var[$x] {";
99 qq{a nested { and } are okay as are () and <> pairs and escaped \}'s };
115 s<$self->{pat}>{$self->{sub}}; # CAN'T HANDLE '>' in '->'
116 s-$self->{pap}-$self->{sub}-; # CAN'T HANDLE '-' in '->'
117 <<EOHERE; done();\nline1\nline2\nEOHERE;\n; next; # RDEL HAS NO ';'
118 <<'EOHERE'; done();\nline1\nline2\nEOHERE;\n; next; # RDEF HAS NO ';'
119 << EOTHERE; done();\nline1\nline2\n EOTHERE\n; next; # RDEL IS "" (!)