1BEGIN { 2 if ($ENV{PERL_CORE}) { 3 chdir('t') if -d 't'; 4 @INC = qw(../lib); 5 } 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 16BEGIN { $| = 1; print "1..45\n"; } 17END {print "not ok 1\n" unless $loaded;} 18use Text::Balanced qw ( extract_delimited ); 19$loaded = 1; 20print "ok 1\n"; 21$count=2; 22use vars qw( $DEBUG ); 23sub debug { print "\t>>>",@_ if $DEBUG } 24 25######################### End of black magic. 26 27 28$cmd = "print"; 29$neg = 0; 30while (defined($str = <DATA>)) 31{ 32 chomp $str; 33 if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; } 34 elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } 35 elsif (!$str || $str =~ /\A#/) { $neg = 0; next } 36 $str =~ s/\\n/\n/g; 37 debug "\tUsing: $cmd\n"; 38 debug "\t on: [$str]\n"; 39 40 $var = eval "() = $cmd"; 41 debug "\t list got: [$var]\n"; 42 debug "\t list left: [$str]\n"; 43 print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg; 44 print "ok ", $count++; 45 print " ($@)" if $@ && $DEBUG; 46 print "\n"; 47 48 pos $str = 0; 49 $var = eval $cmd; 50 $var = "<undef>" unless defined $var; 51 debug "\t scalar got: [$var]\n"; 52 debug "\t scalar left: [$str]\n"; 53 print "not " if ($str =~ '\A;')==$neg; 54 print "ok ", $count++; 55 print " ($@)" if $@ && $DEBUG; 56 print "\n"; 57} 58 59__DATA__ 60# USING: extract_delimited($str,'/#$',undef,'/#$'); 61/a/; 62/a///; 63#b#; 64#b###; 65$c$; 66$c$$$; 67 68# TEST EXTRACTION OF DELIMITED TEXT WITH ESCAPES 69# USING: extract_delimited($str,'/#$',undef,'\\'); 70/a/; 71/a\//; 72#b#; 73#b\##; 74$c$; 75$c\$$; 76 77# TEST EXTRACTION OF DELIMITED TEXT 78# USING: extract_delimited($str); 79'a'; 80"b"; 81`c`; 82'a\''; 83'a\\'; 84'\\a'; 85"a\\"; 86"\\a"; 87"b\'\"\'"; 88`c '\`abc\`'`; 89 90# TEST EXTRACTION OF DELIMITED TEXT 91# USING: extract_delimited($str,'/#$','-->'); 92-->/a/; 93-->#b#; 94-->$c$; 95 96# THIS SHOULD FAIL 97$c$; 98