05-safe2.t 2.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105
  1. #!perl
  2. #
  3. # test apparatus for Text::Template module
  4. # still incomplete.
  5. use Text::Template;
  6. BEGIN {
  7. eval "use Safe";
  8. if ($@) {
  9. print "1..0\n";
  10. exit 0;
  11. }
  12. }
  13. die "This is the test program for Text::Template version 1.46.
  14. You are using version $Text::Template::VERSION instead.
  15. That does not make sense.\n
  16. Aborting"
  17. unless $Text::Template::VERSION == 1.46;
  18. print "1..12\n";
  19. $n = 1;
  20. $c = new Safe or die;
  21. # Test handling of packages and importing.
  22. $c->reval('$P = "safe root"');
  23. $P = $P = 'main';
  24. $Q::P = $Q::P = 'Q';
  25. # How to effectively test the gensymming?
  26. $t = new Text::Template TYPE => 'STRING', SOURCE => 'package is {$P}'
  27. or die;
  28. # (1) Default behavior: Inherit from calling package, `main' in this case.
  29. $text = $t->fill_in();
  30. print +($text eq 'package is main' ? '' : 'not '), "ok $n\n";
  31. $n++;
  32. # (2) When a package is specified, we should use that package instead.
  33. $text = $t->fill_in(PACKAGE => 'Q');
  34. print +($text eq 'package is Q' ? '' : 'not '), "ok $n\n";
  35. $n++;
  36. # (3) When no package is specified in safe mode, we should use the
  37. # default safe root.
  38. $text = $t->fill_in(SAFE => $c);
  39. print +($text eq 'package is safe root' ? '' : 'not '), "ok $n\n";
  40. $n++;
  41. # (4) When a package is specified in safe mode, we should use the
  42. # default safe root, after aliasing to the specified package
  43. $text = $t->fill_in(SAFE => $c, PACKAGE => Q);
  44. print +($text eq 'package is Q' ? '' : 'not '), "ok $n\n";
  45. $n++;
  46. # Now let's see if hash vars are installed properly into safe templates
  47. $t = new Text::Template TYPE => 'STRING', SOURCE => 'hash is {$H}'
  48. or die;
  49. # (5) First in default mode
  50. $text = $t->fill_in(HASH => {H => 'good5'} );
  51. print +($text eq 'hash is good5' ? '' : 'not '), "ok $n\n";
  52. $n++;
  53. # (6) Now in packages
  54. $text = $t->fill_in(HASH => {H => 'good6'}, PACKAGE => 'Q' );
  55. print +($text eq 'hash is good6' ? '' : 'not '), "ok $n\n";
  56. $n++;
  57. # (7) Now in the default root of the safe compartment
  58. $text = $t->fill_in(HASH => {H => 'good7'}, SAFE => $c );
  59. print +($text eq 'hash is good7' ? '' : 'not '), "ok $n\n";
  60. $n++;
  61. # (8) Now in the default root after aliasing to a package that
  62. # got the hash stuffed in
  63. $text = $t->fill_in(HASH => {H => 'good8'}, SAFE => $c, PACKAGE => 'Q2' );
  64. print +($text eq 'hash is good8' ? '' : 'not '), "ok $n\n";
  65. $n++;
  66. # Now let's make sure that none of the packages leaked on each other.
  67. # (9) This var should NOT have been installed into the main package
  68. print +(defined $H ? 'not ' : ''), "ok $n\n";
  69. $H=$H;
  70. $n++;
  71. # (10) good6 was overwritten in test 7, so there's nothing to test for here.
  72. print "ok $n\n";
  73. $n++;
  74. # (11) this value overwrote the one from test 6.
  75. print +($Q::H eq 'good7' ? '' : 'not '), "ok $n\n";
  76. $Q::H = $Q::H;
  77. $n++;
  78. # (12)
  79. print +($Q2::H eq 'good8' ? '' : 'not '), "ok $n\n";
  80. $Q2::H = $Q2::H;
  81. $n++;