| #!perl |
| # |
| # Tests for user-specified delimiter functions |
| # These tests first appeared in version 1.20. |
| |
| use Text::Template; |
| |
| die "This is the test program for Text::Template version 1.46. |
| You are using version $Text::Template::VERSION instead. |
| That does not make sense.\n |
| Aborting" |
| unless $Text::Template::VERSION == 1.46; |
| |
| print "1..18\n"; |
| $n = 1; |
| |
| # (1) Try a simple delimiter: <<..>> |
| # First with the delimiters specified at object creation time |
| $V = $V = 119; |
| $template = q{The value of $V is <<$V>>.}; |
| $result = q{The value of $V is 119.}; |
| $template1 = Text::Template->new(TYPE => STRING, |
| SOURCE => $template, |
| DELIMITERS => ['<<', '>>'] |
| ) |
| or die "Couldn't construct template object: $Text::Template::ERROR; aborting"; |
| $text = $template1->fill_in(); |
| print +($text eq $result ? '' : 'not '), "ok $n\n"; |
| $n++; |
| |
| # (2) Now with delimiter choice deferred until fill-in time. |
| $template1 = Text::Template->new(TYPE => STRING, SOURCE => $template); |
| $text = $template1->fill_in(DELIMITERS => ['<<', '>>']); |
| print +($text eq $result ? '' : 'not '), "ok $n\n"; |
| $n++; |
| |
| # (3) Now we'll try using regex metacharacters |
| # First with the delimiters specified at object creation time |
| $template = q{The value of $V is [$V].}; |
| $template1 = Text::Template->new(TYPE => STRING, |
| SOURCE => $template, |
| DELIMITERS => ['[', ']'] |
| ) |
| or die "Couldn't construct template object: $Text::Template::ERROR; aborting"; |
| $text = $template1->fill_in(); |
| print +($text eq $result ? '' : 'not '), "ok $n\n"; |
| $n++; |
| |
| # (4) Now with delimiter choice deferred until fill-in time. |
| $template1 = Text::Template->new(TYPE => STRING, SOURCE => $template); |
| $text = $template1->fill_in(DELIMITERS => ['[', ']']); |
| print +($text eq $result ? '' : 'not '), "ok $n\n"; |
| $n++; |
| |
| |
| |
| # (5-18) Make sure \ is working properly |
| # (That is to say, it is ignored.) |
| # These tests are similar to those in 01-basic.t. |
| my @tests = ('{""}' => '', # (5) |
| |
| # Backslashes don't matter |
| '{"}"}' => undef, |
| '{"\\}"}' => undef, # One backslash |
| '{"\\\\}"}' => undef, # Two backslashes |
| '{"\\\\\\}"}' => undef, # Three backslashes |
| '{"\\\\\\\\}"}' => undef, # Four backslashes (10) |
| '{"\\\\\\\\\\}"}' => undef, # Five backslashes |
| |
| # Backslashes are always passed directly to Perl |
| '{"x20"}' => 'x20', |
| '{"\\x20"}' => ' ', # One backslash |
| '{"\\\\x20"}' => '\\x20', # Two backslashes |
| '{"\\\\\\x20"}' => '\\ ', # Three backslashes (15) |
| '{"\\\\\\\\x20"}' => '\\\\x20', # Four backslashes |
| '{"\\\\\\\\\\x20"}' => '\\\\ ', # Five backslashes |
| '{"\\x20\\}"}' => undef, # (18) |
| ); |
| |
| my $i; |
| for ($i=0; $i<@tests; $i+=2) { |
| my $tmpl = Text::Template->new(TYPE => 'STRING', |
| SOURCE => $tests[$i], |
| DELIMITERS => ['{', '}'], |
| ); |
| my $text = $tmpl->fill_in; |
| my $result = $tests[$i+1]; |
| my $ok = (! defined $text && ! defined $result |
| || $text eq $result); |
| unless ($ok) { |
| print STDERR "($n) expected .$result., got .$text.\n"; |
| } |
| print +($ok ? '' : 'not '), "ok $n\n"; |
| $n++; |
| } |
| |
| |
| exit; |
| |