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