summaryrefslogtreecommitdiff
path: root/external/perl/Text-Template-1.56/t/delimiters.t
blob: f7185c693ba20b3f7c8eee8b4c47cf9c5cd050ed (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
#!perl
#
# Tests for user-specified delimiter functions
# These tests first appeared in version 1.20.

use strict;
use warnings;
use Test::More tests => 19;

use_ok 'Text::Template' or exit 1;

# (1) Try a simple delimiter: <<..>>
# First with the delimiters specified at object creation time
our $V = $V = 119;
my $template  = q{The value of $V is <<$V>>.};
my $result    = q{The value of $V is 119.};
my $template1 = Text::Template->new(
    TYPE       => 'STRING',
    SOURCE     => $template,
    DELIMITERS => [ '<<', '>>' ])
        or die "Couldn't construct template object: $Text::Template::ERROR; aborting";

my $text = $template1->fill_in();
is $text, $result;

# (2) Now with delimiter choice deferred until fill-in time.
$template1 = Text::Template->new(TYPE => 'STRING', SOURCE => $template);
$text = $template1->fill_in(DELIMITERS => [ '<<', '>>' ]);
is $text, $result;

# (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();
is $text, $result;

# (4) Now with delimiter choice deferred until fill-in time.
$template1 = Text::Template->new(TYPE => 'STRING', SOURCE => $template);
$text = $template1->fill_in(DELIMITERS => [ '[', ']' ]);
is $text, $result;

# (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)
);

while (my ($test, $result) = splice @tests, 0, 2) {
    my $tmpl = Text::Template->new(
        TYPE       => 'STRING',
        SOURCE     => $test,
        DELIMITERS => [ '{', '}' ]);

    my $text = $tmpl->fill_in;

    my $ok = (!defined $text && !defined $result || $text eq $result);

    ok($ok) or diag "expected .$result., got .$text.";
}