Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
tree: 2259a9579a
Fetching contributors…

Cannot retrieve contributors at this time

132 lines (111 sloc) 3.838 kB
#============================================================= -*-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
Jump to Line
Something went wrong with that request. Please try again.