1#!perl 2# 3# Tests for user-specified delimiter functions 4# These tests first appeared in version 1.20. 5 6use Text::Template; 7 8die "This is the test program for Text::Template version 1.46. 9You are using version $Text::Template::VERSION instead. 10That does not make sense.\n 11Aborting" 12 unless $Text::Template::VERSION == 1.46; 13 14print "1..18\n"; 15$n = 1; 16 17# (1) Try a simple delimiter: <<..>> 18# First with the delimiters specified at object creation time 19$V = $V = 119; 20$template = q{The value of $V is <<$V>>.}; 21$result = q{The value of $V is 119.}; 22$template1 = Text::Template->new(TYPE => STRING, 23 SOURCE => $template, 24 DELIMITERS => ['<<', '>>'] 25 ) 26 or die "Couldn't construct template object: $Text::Template::ERROR; aborting"; 27$text = $template1->fill_in(); 28print +($text eq $result ? '' : 'not '), "ok $n\n"; 29$n++; 30 31# (2) Now with delimiter choice deferred until fill-in time. 32$template1 = Text::Template->new(TYPE => STRING, SOURCE => $template); 33$text = $template1->fill_in(DELIMITERS => ['<<', '>>']); 34print +($text eq $result ? '' : 'not '), "ok $n\n"; 35$n++; 36 37# (3) Now we'll try using regex metacharacters 38# First with the delimiters specified at object creation time 39$template = q{The value of $V is [$V].}; 40$template1 = Text::Template->new(TYPE => STRING, 41 SOURCE => $template, 42 DELIMITERS => ['[', ']'] 43 ) 44 or die "Couldn't construct template object: $Text::Template::ERROR; aborting"; 45$text = $template1->fill_in(); 46print +($text eq $result ? '' : 'not '), "ok $n\n"; 47$n++; 48 49# (4) Now with delimiter choice deferred until fill-in time. 50$template1 = Text::Template->new(TYPE => STRING, SOURCE => $template); 51$text = $template1->fill_in(DELIMITERS => ['[', ']']); 52print +($text eq $result ? '' : 'not '), "ok $n\n"; 53$n++; 54 55 56 57# (5-18) Make sure \ is working properly 58# (That is to say, it is ignored.) 59# These tests are similar to those in 01-basic.t. 60my @tests = ('{""}' => '', # (5) 61 62 # Backslashes don't matter 63 '{"}"}' => undef, 64 '{"\\}"}' => undef, # One backslash 65 '{"\\\\}"}' => undef, # Two backslashes 66 '{"\\\\\\}"}' => undef, # Three backslashes 67 '{"\\\\\\\\}"}' => undef, # Four backslashes (10) 68 '{"\\\\\\\\\\}"}' => undef, # Five backslashes 69 70 # Backslashes are always passed directly to Perl 71 '{"x20"}' => 'x20', 72 '{"\\x20"}' => ' ', # One backslash 73 '{"\\\\x20"}' => '\\x20', # Two backslashes 74 '{"\\\\\\x20"}' => '\\ ', # Three backslashes (15) 75 '{"\\\\\\\\x20"}' => '\\\\x20', # Four backslashes 76 '{"\\\\\\\\\\x20"}' => '\\\\ ', # Five backslashes 77 '{"\\x20\\}"}' => undef, # (18) 78 ); 79 80my $i; 81for ($i=0; $i<@tests; $i+=2) { 82 my $tmpl = Text::Template->new(TYPE => 'STRING', 83 SOURCE => $tests[$i], 84 DELIMITERS => ['{', '}'], 85 ); 86 my $text = $tmpl->fill_in; 87 my $result = $tests[$i+1]; 88 my $ok = (! defined $text && ! defined $result 89 || $text eq $result); 90 unless ($ok) { 91 print STDERR "($n) expected .$result., got .$text.\n"; 92 } 93 print +($ok ? '' : 'not '), "ok $n\n"; 94 $n++; 95} 96 97 98exit; 99 100