The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!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;