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
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
#============================================================= -*-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$
#
#========================================================================
use strict;
use warnings;
use lib qw( ./lib ../lib );
use Template::Test;
use File::Copy;
use File::Spec;
#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' ? qw(t test src) : qw(test src);
my $dir = File::Spec->catfile(@dir);
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 %]') },
near_line => sub {
my ($warning, $n) = @_;
if ($warning =~ s/line (\d+)/line ${n}ish/) {
my $diff = abs($1 - $n);
if ($diff < 4) {
# That's close enough for rock'n'roll. The line
# number reported appears to vary from one version of
# Perl to another
return $warning;
}
else {
return $warning . " (where 'ish' means $diff!)";
}
}
else {
return "no idea what line number that is\n";
}
}
};
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; near_line("$error", 18); END %]
-- expect --
file error - parse error - complex line 18ish: unexpected end of input
|
