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