safe.t 3.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135
  1. #!perl
  2. #
  3. # test apparatus for Text::Template module
  4. # still incomplete.
  5. use strict;
  6. use warnings;
  7. use Test::More;
  8. unless (eval { require Safe; 1 }) {
  9. plan skip_all => 'Safe.pm is required for this test';
  10. }
  11. else {
  12. plan tests => 20;
  13. }
  14. use_ok 'Text::Template' or exit 1;
  15. my ($BADOP, $FAILURE);
  16. if ($^O eq 'MacOS') {
  17. $BADOP = qq{};
  18. $FAILURE = q{};
  19. }
  20. else {
  21. $BADOP = qq{kill 0};
  22. $FAILURE = q{Program fragment at line 1 delivered error ``kill trapped by operation mask''};
  23. }
  24. our $v = 119;
  25. my $c = Safe->new or die;
  26. my $goodtemplate = q{This should succeed: { $v }};
  27. my $goodoutput = q{This should succeed: 119};
  28. my $template1 = Text::Template->new(type => 'STRING', source => $goodtemplate);
  29. my $template2 = Text::Template->new(type => 'STRING', source => $goodtemplate);
  30. my $text1 = $template1->fill_in();
  31. ok defined $text1;
  32. my $text2 = $template1->fill_in(SAFE => $c);
  33. ok defined $text2;
  34. my $text3 = $template2->fill_in(SAFE => $c);
  35. ok defined $text3;
  36. # (4) Safe and non-safe fills of different template objects with the
  37. # same template text should yield the same result.
  38. # print +($text1 eq $text3 ? '' : 'not '), "ok $n\n";
  39. # (4) voided this test: it's not true, because the unsafe fill
  40. # uses package main, while the safe fill uses the secret safe package.
  41. # We could alias the secret safe package to be identical to main,
  42. # but that wouldn't be safe. If you want the aliasing, you have to
  43. # request it explicitly with `PACKAGE'.
  44. # (5) Safe and non-safe fills of the same template object
  45. # should yield the same result.
  46. # (5) voided this test for the same reason as #4.
  47. # print +($text1 eq $text2 ? '' : 'not '), "ok $n\n";
  48. # (6) Make sure the output was actually correct
  49. is $text1, $goodoutput;
  50. my $badtemplate = qq{This should fail: { $BADOP; 'NOFAIL' }};
  51. my $badnosafeoutput = q{This should fail: NOFAIL};
  52. my $badsafeoutput =
  53. q{This should fail: Program fragment delivered error ``kill trapped by operation mask at template line 1.''};
  54. $template1 = Text::Template->new('type' => 'STRING', 'source' => $badtemplate);
  55. isa_ok $template1, 'Text::Template';
  56. $template2 = Text::Template->new('type' => 'STRING', 'source' => $badtemplate);
  57. isa_ok $template2, 'Text::Template';
  58. # none of these should fail
  59. $text1 = $template1->fill_in();
  60. ok defined $text1;
  61. $text2 = $template1->fill_in(SAFE => $c);
  62. ok defined $text2;
  63. $text3 = $template2->fill_in(SAFE => $c);
  64. ok defined $text3;
  65. my $text4 = $template1->fill_in();
  66. ok defined $text4;
  67. # (11) text1 and text4 should be the same (using safe in between
  68. # didn't change anything.)
  69. is $text1, $text4;
  70. # (12) text2 and text3 should be the same (same template text in different
  71. # objects
  72. is $text2, $text3;
  73. # (13) text1 should yield badnosafeoutput
  74. is $text1, $badnosafeoutput;
  75. # (14) text2 should yield badsafeoutput
  76. $text2 =~ s/'kill'/kill/; # 5.8.1 added quote marks around the op name
  77. is $text2, $badsafeoutput;
  78. my $template = q{{$x=1}{$x+1}};
  79. $template1 = Text::Template->new('type' => 'STRING', 'source' => $template);
  80. isa_ok $template1, 'Text::Template';
  81. $template2 = Text::Template->new('type' => 'STRING', 'source' => $template);
  82. isa_ok $template2, 'Text::Template';
  83. $text1 = $template1->fill_in();
  84. $text2 = $template1->fill_in(SAFE => Safe->new);
  85. # (15) Do effects persist in safe compartments?
  86. is $text1, $text2;
  87. # (16) Try the BROKEN routine in safe compartments
  88. sub my_broken {
  89. my %a = @_;
  90. $a{error} =~ s/ at.*//s;
  91. "OK! text:$a{text} error:$a{error} lineno:$a{lineno} arg:$a{arg}";
  92. }
  93. my $templateB = Text::Template->new(TYPE => 'STRING', SOURCE => '{die}');
  94. isa_ok $templateB, 'Text::Template';
  95. $text1 = $templateB->fill_in(
  96. BROKEN => \&my_broken,
  97. BROKEN_ARG => 'barg',
  98. SAFE => Safe->new);
  99. my $result1 = qq{OK! text:die error:Died lineno:1 arg:barg};
  100. is $text1, $result1;