external/perl/Text-Template-1.46/t/04-safe.t

   1 #!perl
   2 #
   3 # test apparatus for Text::Template module
   4 # still incomplete.
   5
   6 use Text::Template;
   7
   8 BEGIN {
   9   eval "use Safe";
  10   if ($@) {
  11     print "1..0\n";
  12     exit 0;
  13   }
  14 }
  15
  16 die "This is the test program for Text::Template version 1.46.
  17 You are using version $Text::Template::VERSION instead.
  18 That does not make sense.\n
  19 Aborting"
  20   unless $Text::Template::VERSION == 1.46;
  21
  22 print "1..16\n";
  23
  24 if ($^O eq 'MacOS') {
  25   $BADOP = qq{};
  26   $FAILURE = q{};
  27 } else {
  28   $BADOP = qq{kill 0};
  29   $FAILURE = q{Program fragment at line 1 delivered error ``kill trapped by operation mask''};
  30 }
  31
  32 $n=1;
  33 $v = $v = 119;
  34
  35 $c = new Safe or die;
  36
  37 $goodtemplate = q{This should succeed: { $v }};
  38 $goodoutput   = q{This should succeed: 119};
  39
  40 $template1 = new Text::Template ('type' => 'STRING', 'source' => $goodtemplate)
  41   or die;
  42 $template2 = new Text::Template ('type' => 'STRING', 'source' => $goodtemplate)
  43   or die;
  44
  45 $text1 = $template1->fill_in();
  46 $text2 = $template1->fill_in(SAFE => $c);
  47 $ERR2 = $@;
  48 $text3 = $template2->fill_in(SAFE => $c);
  49 $ERR3 = $@;
  50
  51 # (1)(2)(3) None of these should have failed.
  52 print +(defined $text1 ? '' : 'not '), "ok $n\n";
  53 $n++;
  54 print +(defined $text2 ? '' : 'not '), "ok $n\n";
  55 $n++;
  56 print +(defined $text3 ? '' : 'not '), "ok $n\n";
  57 $n++;
  58
  59 # (4) Safe and non-safe fills of different template objects with the
  60 # same template text should yield the same result.
  61 # print +($text1 eq $text3 ? '' : 'not '), "ok $n\n";
  62 # (4) voided this test:  it's not true, because the unsafe fill
  63 # uses package main, while the safe fill uses the secret safe package.
  64 # We could alias the secret safe package to be identical to main,
  65 # but that wouldn't be safe.  If you want the aliasing, you have to
  66 # request it explicitly with `PACKAGE'.
  67 print "ok $n\n";
  68 $n++;
  69
  70 # (5) Safe and non-safe fills of the same template object
  71 # should yield the same result.
  72 # (5) voided this test for the same reason as #4.
  73 # print +($text1 eq $text2 ? '' : 'not '), "ok $n\n";
  74 print "ok $n\n";
  75 $n++;
  76
  77 # (6) Make sure the output was actually correct
  78 print +($text1 eq $goodoutput ? '' : 'not '), "ok $n\n";
  79 $n++;
  80
  81
  82 $badtemplate     = qq{This should fail: { $BADOP; 'NOFAIL' }};
  83 $badnosafeoutput = q{This should fail: NOFAIL};
  84 $badsafeoutput   = q{This should fail: Program fragment delivered error ``kill trapped by operation mask at template line 1.''};
  85
  86 $template1 = new Text::Template ('type' => 'STRING', 'source' => $badtemplate)
  87   or die;
  88 $template2 = new Text::Template ('type' => 'STRING', 'source' => $badtemplate)
  89   or die;
  90
  91 $text1 = $template1->fill_in();
  92 $text2 = $template1->fill_in(SAFE => $c);
  93 $ERR2 = $@;
  94 $text3 = $template2->fill_in(SAFE => $c);
  95 $ERR3 = $@;
  96 $text4 = $template1->fill_in();
  97
  98 # (7)(8)(9)(10) None of these should have failed.
  99 print +(defined $text1 ? '' : 'not '), "ok $n\n";
 100 $n++;
 101 print +(defined $text2 ? '' : 'not '), "ok $n\n";
 102 $n++;
 103 print +(defined $text3 ? '' : 'not '), "ok $n\n";
 104 $n++;
 105 print +(defined $text4 ? '' : 'not '), "ok $n\n";
 106 $n++;
 107
 108 # (11) text1 and text4 should be the same (using safe in between
 109 # didn't change anything.)
 110 print +($text1 eq $text4 ? '' : 'not '), "ok $n\n";
 111 $n++;
 112
 113 # (12) text2 and text3 should be the same (same template text in different
 114 # objects
 115 print +($text2 eq $text3 ? '' : 'not '), "ok $n\n";
 116 $n++;
 117
 118 # (13) text1 should yield badnosafeoutput
 119 print +($text1 eq $badnosafeoutput ? '' : 'not '), "ok $n\n";
 120 $n++;
 121
 122 # (14) text2 should yield badsafeoutput
 123 $text2 =~ s/'kill'/kill/;  # 5.8.1 added quote marks around the op name
 124 print "# expected: <$badsafeoutput>\n# got     : <$text2>\n";
 125 print +($text2 eq $badsafeoutput ? '' : 'not '), "ok $n\n";
 126 $n++;
 127
 128
 129 $template = q{{$x=1}{$x+1}};
 130
 131 $template1 = new Text::Template ('type' => 'STRING', 'source' => $template)
 132   or die;
 133 $template2 = new Text::Template ('type' => 'STRING', 'source' => $template)
 134   or die;
 135
 136 $text1 = $template1->fill_in();
 137 $text2 = $template1->fill_in(SAFE => new Safe);
 138
 139 # (15) Do effects persist in safe compartments?
 140 print +($text1 eq $text2 ? '' : 'not '), "ok $n\n";
 141 $n++;
 142
 143 # (16) Try the BROKEN routine in safe compartments
 144 sub my_broken {
 145   my %a = @_; $a{error} =~ s/ at.*//s;
 146   "OK! text:$a{text} error:$a{error} lineno:$a{lineno} arg:$a{arg}" ;
 147 }
 148 $templateB = new Text::Template (TYPE => 'STRING', SOURCE => '{die}')
 149     or die;
 150 $text1 = $templateB->fill_in(BROKEN => \&my_broken,
 151                              BROKEN_ARG => 'barg',
 152                              SAFE => new Safe,
 153                              );
 154 $result1 = qq{OK! text:die error:Died lineno:1 arg:barg};
 155 print +($text1 eq $result1 ? '' : 'not '), "ok $n\n";
 156 $n++;
 157
 158
 159
 160 exit;
 161