• Home
  • Line#
  • Scopes#
  • Navigate#
  • Raw
  • Download
1#!perl
2#
3# test apparatus for Text::Template module
4# still incomplete.
5
6use Text::Template;
7
8BEGIN {
9  eval "use Safe";
10  if ($@) {
11    print "1..0\n";
12    exit 0;
13  }
14}
15
16die "This is the test program for Text::Template version 1.46.
17You are using version $Text::Template::VERSION instead.
18That does not make sense.\n
19Aborting"
20  unless $Text::Template::VERSION == 1.46;
21
22print "1..16\n";
23
24if ($^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.
52print +(defined $text1 ? '' : 'not '), "ok $n\n";
53$n++;
54print +(defined $text2 ? '' : 'not '), "ok $n\n";
55$n++;
56print +(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'.
67print "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";
74print "ok $n\n";
75$n++;
76
77# (6) Make sure the output was actually correct
78print +($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.
99print +(defined $text1 ? '' : 'not '), "ok $n\n";
100$n++;
101print +(defined $text2 ? '' : 'not '), "ok $n\n";
102$n++;
103print +(defined $text3 ? '' : 'not '), "ok $n\n";
104$n++;
105print +(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.)
110print +($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
115print +($text2 eq $text3 ? '' : 'not '), "ok $n\n";
116$n++;
117
118# (13) text1 should yield badnosafeoutput
119print +($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
124print "# expected: <$badsafeoutput>\n# got     : <$text2>\n";
125print +($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?
140print +($text1 eq $text2 ? '' : 'not '), "ok $n\n";
141$n++;
142
143# (16) Try the BROKEN routine in safe compartments
144sub 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};
155print +($text1 eq $result1 ? '' : 'not '), "ok $n\n";
156$n++;
157
158
159
160exit;
161
162