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'
11 ######################### We start with some black magic to print on failure.
13 # Change 1..1 below to 1..last_test_to_print .
14 # (It may become useful if the test is moved to ./t subdirectory.)
16 BEGIN { $| = 1; print "1..89\n"; }
17 END {print "not ok 1\n" unless $loaded;}
18 use Text::Balanced qw ( extract_quotelike );
22 use vars qw( $DEBUG );
24 sub debug { print "\t>>>",@_ if $DEBUG }
26 ######################### End of black magic.
31 while (defined($str = <DATA>))
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";
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++;
52 debug "\tUsing: scalar $cmd\n";
53 debug "\t on: [$str]\n";
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++;
66 # USING: extract_quotelike($str);
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
85 "this is a nested $var[$x] {";
98 qq{a nested { and } are okay as are () and <> pairs and escaped \}'s };
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 "" (!)