1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
|
#============================================================= -*-perl-*-
#
# t/compile3.t
#
# Third test in the compile<n>.t trilogy. Checks that modifications
# to a source template result in a re-compilation of the template.
#
# Written by Andy Wardley <abw@kfs.org>
#
# Copyright (C) 1996-2000 Andy Wardley. All Rights Reserved.
# Copyright (C) 1998-2000 Canon Research Centre Europe Ltd.
#
# This is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#
# $Id: compile3.t,v 2.6 2003/12/02 13:14:30 abw Exp $
#
#========================================================================
use strict;
use lib qw( ./lib ../lib );
use Template::Test;
use File::Copy;
$^W = 1;
#ntests(13);
# declare extra test to follow test_expect();
$Template::Test::EXTRA = 1;
#$Template::Parser::DEBUG = 1;
# script may be being run in distribution root or 't' directory
my $dir = -d 't' ? 't/test/src' : 'test/src';
my $ttcfg = {
POST_CHOMP => 1,
INCLUDE_PATH => $dir,
COMPILE_EXT => '.ttc',
};
# test process fails when EVAL_PERL not set
my $tt = Template->new($ttcfg);
my $out;
ok( ! $tt->process("evalperl", { }, \$out) );
match( $tt->error->type, 'perl' );
match( $tt->error->info, 'EVAL_PERL not set' );
# ensure we can run compiled templates without loading parser
# (fix for "Can't locate object method "TIEHANDLE" via package
# Template::String..." bug)
$ttcfg->{ EVAL_PERL } = 1;
$tt = Template->new($ttcfg);
ok( $tt->process("evalperl", { }, \$out) )
|| match( $tt->error(), "" );
my $file = "$dir/complex";
# check compiled template file exists and grab modification time
ok( -f "$file.ttc" );
my $mod = (stat(_))[9];
# save copy of the source file because we're going to try to break it
copy($file, "$file.org") || die "failed to copy $file to $file.org\n";
# sleep for a couple of seconds to ensure clock has ticked
sleep(2);
# append a harmless newline to the end of the source file to change
# its modification time
append_file("\n");
# define 'bust_it' to append a lone "[% TRY %]" onto the end of the
# source file to cause re-compilation to fail
my $replace = {
bust_it => sub { append_file('[% TRY %]') },
};
test_expect(\*DATA, $ttcfg, $replace );
ok( (stat($file))[9] > $mod );
# restore original source file
copy("$file.org", $file) || die "failed to copy $file.org to $file\n";
#------------------------------------------------------------------------
sub append_file {
local *FP;
sleep(2); # ensure file time stamps are different
open(FP, ">>$file") || die "$file: $!\n";
print FP @_;
close(FP);
}
#------------------------------------------------------------------------
__DATA__
-- test --
[% META author => 'albert' version => 'emc2' %]
[% INCLUDE complex %]
-- expect --
This is the header, title: Yet Another Template Test
This is a more complex file which includes some BLOCK definitions
This is the footer, author: albert, version: emc2
- 3 - 2 - 1
-- test --
[%# we want to break 'compile' to check that errors get reported -%]
[% CALL bust_it -%]
[% TRY; INCLUDE complex; CATCH; "$error"; END %]
-- expect --
file error - parse error - complex line 18: unexpected end of input
|
