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