1#!perl
2#
3# Tests for user-specified delimiter functions
4# These tests first appeared in version 1.20.
5
6use strict;
7use warnings;
8use Test::More tests => 19;
9
10use_ok 'Text::Template' or exit 1;
11
12# (1) Try a simple delimiter: <<..>>
13# First with the delimiters specified at object creation time
14our $V = $V = 119;
15my $template  = q{The value of $V is <<$V>>.};
16my $result    = q{The value of $V is 119.};
17my $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
23my $text = $template1->fill_in();
24is $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 => [ '<<', '>>' ]);
29is $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();
41is $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 => [ '[', ']' ]);
46is $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.
51my @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
72while (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}
84