10-delimiters.t 3.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899
  1. #!perl
  2. #
  3. # Tests for user-specified delimiter functions
  4. # These tests first appeared in version 1.20.
  5. use Text::Template;
  6. die "This is the test program for Text::Template version 1.46.
  7. You are using version $Text::Template::VERSION instead.
  8. That does not make sense.\n
  9. Aborting"
  10. unless $Text::Template::VERSION == 1.46;
  11. print "1..18\n";
  12. $n = 1;
  13. # (1) Try a simple delimiter: <<..>>
  14. # First with the delimiters specified at object creation time
  15. $V = $V = 119;
  16. $template = q{The value of $V is <<$V>>.};
  17. $result = q{The value of $V is 119.};
  18. $template1 = Text::Template->new(TYPE => STRING,
  19. SOURCE => $template,
  20. DELIMITERS => ['<<', '>>']
  21. )
  22. or die "Couldn't construct template object: $Text::Template::ERROR; aborting";
  23. $text = $template1->fill_in();
  24. print +($text eq $result ? '' : 'not '), "ok $n\n";
  25. $n++;
  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 => ['<<', '>>']);
  29. print +($text eq $result ? '' : 'not '), "ok $n\n";
  30. $n++;
  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(TYPE => STRING,
  35. SOURCE => $template,
  36. DELIMITERS => ['[', ']']
  37. )
  38. or die "Couldn't construct template object: $Text::Template::ERROR; aborting";
  39. $text = $template1->fill_in();
  40. print +($text eq $result ? '' : 'not '), "ok $n\n";
  41. $n++;
  42. # (4) Now with delimiter choice deferred until fill-in time.
  43. $template1 = Text::Template->new(TYPE => STRING, SOURCE => $template);
  44. $text = $template1->fill_in(DELIMITERS => ['[', ']']);
  45. print +($text eq $result ? '' : 'not '), "ok $n\n";
  46. $n++;
  47. # (5-18) Make sure \ is working properly
  48. # (That is to say, it is ignored.)
  49. # These tests are similar to those in 01-basic.t.
  50. my @tests = ('{""}' => '', # (5)
  51. # Backslashes don't matter
  52. '{"}"}' => undef,
  53. '{"\\}"}' => undef, # One backslash
  54. '{"\\\\}"}' => undef, # Two backslashes
  55. '{"\\\\\\}"}' => undef, # Three backslashes
  56. '{"\\\\\\\\}"}' => undef, # Four backslashes (10)
  57. '{"\\\\\\\\\\}"}' => undef, # Five backslashes
  58. # Backslashes are always passed directly to Perl
  59. '{"x20"}' => 'x20',
  60. '{"\\x20"}' => ' ', # One backslash
  61. '{"\\\\x20"}' => '\\x20', # Two backslashes
  62. '{"\\\\\\x20"}' => '\\ ', # Three backslashes (15)
  63. '{"\\\\\\\\x20"}' => '\\\\x20', # Four backslashes
  64. '{"\\\\\\\\\\x20"}' => '\\\\ ', # Five backslashes
  65. '{"\\x20\\}"}' => undef, # (18)
  66. );
  67. my $i;
  68. for ($i=0; $i<@tests; $i+=2) {
  69. my $tmpl = Text::Template->new(TYPE => 'STRING',
  70. SOURCE => $tests[$i],
  71. DELIMITERS => ['{', '}'],
  72. );
  73. my $text = $tmpl->fill_in;
  74. my $result = $tests[$i+1];
  75. my $ok = (! defined $text && ! defined $result
  76. || $text eq $result);
  77. unless ($ok) {
  78. print STDERR "($n) expected .$result., got .$text.\n";
  79. }
  80. print +($ok ? '' : 'not '), "ok $n\n";
  81. $n++;
  82. }
  83. exit;