source: vbox/trunk/src/libs/openssl-1.1.1k/external/perl/Text-Template-1.46/t/10-delimiters.t@ 90293

#!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;