[Templates-cvs] cvs commit: TT3/t document.t scanner.t tag.t
cvs@template-toolkit.org
cvs@template-toolkit.org
Wed, 10 Dec 2003 14:17:50 +0000
cvs 03/12/10 14:17:49
Added: t document.t scanner.t tag.t
Log:
added test files for tag scanner and document
Revision Changes Path
1.1 TT3/t/document.t
Index: document.t
===================================================================
#============================================================= -*-perl-*-
#
# t/document.t
#
# Test the Template::TT3::Document.pm module.
#
# Written by Andy Wardley <abw@wardley.org>
#
# This is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#
# $Id: document.t,v 1.1 2003/12/10 14:17:49 abw Exp $
#
#========================================================================
use strict;
use warnings;
use lib qw( ./lib ../lib );
use Template::TT3::Base;
use Template::TT3::Document;
use Test::More tests => 29;
my $DEBUG = grep /^--?d(ebug)?$/, @ARGV;
$Template::TT3::Document::DEBUG = $DEBUG;
my $pkg = 'Template::TT3::Document';
my $doc = $pkg->new( name => 'testdoc' );
# test document creation and initial setup
ok( $doc, 'created document' );
is( $doc->name(), 'testdoc', 'name is testdoc' );
is( $doc->line(), 1, 'on line 1' );
is( $doc->position(), 1, 'position line 1' );
is( $doc->location(), 'testdoc line 1', 'location testdoc line 1' );
# now start feeding text in to check line number tracking
ok( $doc->text('The cat sat on the mat'), 'feline location' );
is( $doc->line(), 1, 'still on line 1' );
ok( $doc->text(" and shat\n"), 'feline defecation' );
is( $doc->line(), 2, 'now on line 2' );
ok( $doc->text("The dog\nsat on\nthe log\n"), 'canine location' );
is( $doc->line(), 5, 'now on line 5' );
is( $doc->position(), 5, 'position is 5' );
# the size() method allows the caller to indicate the number
# of lines in the forthcoming block so that the position is
# reported as "nn-nn" rather than just "nn"
is( $doc->size(10), 10, 'set size to 10' );
is( $doc->line(), 5, 'still on line 5' );
is( $doc->position(), '5-15', 'position is 5-15' );
# size() doesn't update the line number unless we call move(),
# so check that adding more text takes us back to where we
# left off
ok( $doc->text("and kissed\nthe frog\n"), 'canine affection' );
is( $doc->line(), 7, 'now on line 7' );
is( $doc->position(), '7', 'position is 7' );
# now try setting a size() and then call move()
is( $doc->size(2), 2, 'set size to 2' );
is( $doc->line(), 7, 'still on line 7' );
is( $doc->position(), '7-9', 'position is 7-9' );
is( $doc->move(), 9, 'moved to 9' );
is( $doc->line(), 9, 'now on line 9' );
is( $doc->position(), '9', 'position is 9' );
#------------------------------------------------------------------------
package Template::Test::Tag;
use base qw( Template::TT3::Base );
#------------------------------------------------------------------------
package main;
# read text from __DATA__ section for new document
local $/ = undef;
my $text = <DATA>;
$doc = $pkg->new( name => 'testdata', text => $text );
# test document scanning
ok( $doc, 'created testdata doc' );
is( $doc->name(), 'testdata', 'name is testdata' );
is( $doc->line(), 1, 'testdata line 1' );
is( $doc->position(), 1, 'testdata position line 1' );
is( $doc->location(), 'testdata line 1', 'location testdata line 1' );
__END__
This is the first line
this include a $variable and then continues
1.1 TT3/t/scanner.t
Index: scanner.t
===================================================================
#============================================================= -*-perl-*-
#
# t/scanner.t
#
# Test the Template::TT3::Scanner.pm module.
#
# Written by Andy Wardley <abw@wardley.org>
#
# This is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#
# $Id: scanner.t,v 1.1 2003/12/10 14:17:49 abw Exp $
#
#========================================================================
use strict;
use warnings;
use lib qw( ./lib ../lib );
use Template::TT3::Base;
use Template::TT3::Document;
use Template::TT3::Scanner;
use Template::TT3::Tag;
use Test::More tests => 152;
my $DEBUG = grep /^--?d(ebug)?$/, @ARGV;
$Template::TT3::Scanner::DEBUG = $DEBUG;
my $docpkg = 'Template::TT3::Document';
my $tagpkg = 'Template::TT3::Tag';
my $scanpkg = 'Template::TT3::Scanner';
my $deftags = $Template::TT3::Scanner::TAGS;
# define some alternate tags
my $footag = {
name => 'foo',
start => '<foo:',
end => '>',
};
my $bartag = {
name => 'bar',
start => '<bar:',
end => '>',
};
my $baztag = {
name => 'baz',
start => '<baz:',
end => '>',
};
my $footagobj = $tagpkg->new($footag);
my $bartagobj = $tagpkg->new($bartag);
my $baztagobj = $tagpkg->new($baztag);
ok( $footagobj, 'created foo tag' );
ok( $bartagobj, 'created bar tag' );
ok( $baztagobj, 'created baz tag' );
my $alttags = [ $footagobj, $bartagobj ];
my $tags;
# need to save tag objects in package var for later...
use vars qw( $FOO $BAR $BAZ );
($FOO, $BAR, $BAZ) = ($footagobj, $bartagobj, $baztagobj);
#------------------------------------------------------------------------
# test the basic
#------------------------------------------------------------------------
# test class pkgtags() method
my $pkgtags = $scanpkg->pkgtags();
ok( $pkgtags, 'got class package tags' );
is( ref $pkgtags, 'ARRAY', 'an ARRAY of package tags' );
is( scalar @$pkgtags, 0, 'containing nothing' );
# create default scanner object
my $scanner = $scanpkg->new() || die $scanpkg->error();
ok( $scanner, 'created a scanner' );
my $scantags = $scanner->tags();
ok( $scantags, 'got scanner tags' );
is( ref $scantags, 'ARRAY', 'an ARRAY of scanner tags' );
is( scalar @$scantags, 0, 'no scanner tags' );
# test object pkgtags() method
$pkgtags = $scanner->pkgtags();
ok( $pkgtags, 'got object package tags' );
is( ref $pkgtags, 'ARRAY', 'an ARRAY of object package tags' );
is( scalar @$pkgtags, 0, 'still containing nothing' );
# create scanner specifying tags
$scanner = $scanpkg->new( tags => $alttags ) || die $scanpkg->error();
ok( $scanner, 'created a custom scanner' );
$scantags = $scanner->tags();
ok( $scantags, 'got custom scanner tags' );
is( ref $scantags, 'ARRAY', 'an ARRAY of custom scanner tags' );
is( scalar @$scantags, 2, 'two scanner tags' );
is( $scantags->[0]->name(), 'foo', 'custom scanner foo tag' );
is( $scantags->[1]->name(), 'bar', 'custom scanner bar tag' );
# create scanner specifying TAGS
$scanner = $scanpkg->new( TAGS => $alttags ) || die $scanpkg->error();
ok( $scanner, 'created a custom TAGS scanner' );
$scantags = $scanner->tags();
ok( $scantags, 'got custom scanner TAGS' );
is( ref $scantags, 'ARRAY', 'an ARRAY of custom scanner TAGS' );
is( scalar @$scantags, 2, 'two scanner TAGS' );
is( $scantags->[0]->name(), 'foo', 'custom scanner foo TAG' );
is( $scantags->[1]->name(), 'bar', 'custom scanner bar TAG' );
#------------------------------------------------------------------------
# update package tags and try again
#------------------------------------------------------------------------
@$deftags = @$alttags;
# test class pkgtags() method
$pkgtags = $scanpkg->pkgtags();
ok( $pkgtags, 'got class package tags again' );
is( ref $pkgtags, 'ARRAY', 'still an ARRAY of package tags' );
is( scalar @$pkgtags, 2, 'now containing two items' );
is( $pkgtags->[0]->name(), 'foo', 'foo tag' );
is( $pkgtags->[1]->name(), 'bar', 'bar tag' );
# create default scanner object
$scanner = $scanpkg->new() || die $scanpkg->error();
ok( $scanner, 'created another scanner' );
$scantags = $scanner->tags();
ok( $scantags, 'got another scanner tags' );
is( ref $scantags, 'ARRAY', 'an ARRAY of another scanner tags' );
is( scalar @$scantags, 2, 'has two scanner tags' );
is( $scantags->[0]->name(), 'foo', 'another foo tag' );
is( $scantags->[1]->name(), 'bar', 'another bar tag' );
# test object pkgtags() method
$pkgtags = $scanner->pkgtags();
ok( $pkgtags, 'got another object package tags' );
is( ref $pkgtags, 'ARRAY', 'another ARRAY of another object package tags' );
is( scalar @$scantags, 2, 'still has two scanner tags' );
is( $pkgtags->[0]->name(), 'foo', 'yet another foo tag' );
is( $pkgtags->[1]->name(), 'bar', 'yet another bar tag' );
# create scanner specifying list of tag(s)
$scanner = $scanpkg->new( tags => [ $baztagobj ]) || die $scanpkg->error();
ok( $scanner, 'created a baz scanner' );
$scantags = $scanner->tags();
ok( $scantags, 'got baz scanner tags' );
is( ref $scantags, 'ARRAY', 'an ARRAY of baz scanner tags' );
is( scalar @$scantags, 3, 'three baz scanner tags' );
is( $scantags->[0]->name(), 'foo', 'baz scanner foo tag' );
is( $scantags->[1]->name(), 'bar', 'baz scanner bar tag' );
is( $scantags->[2]->name(), 'baz', 'baz scanner baz tag' );
# create scanner specifying tags as single item
$scanner = $scanpkg->new( tags => $baztagobj) || die $scanpkg->error();
ok( $scanner, 'created a single baz scanner' );
$scantags = $scanner->tags();
ok( $scantags, 'got single baz scanner tags' );
is( ref $scantags, 'ARRAY', 'an ARRAY of single baz scanner tags' );
is( scalar @$scantags, 3, 'three single baz scanner tags' );
is( $scantags->[0]->name(), 'foo', 'single baz scanner foo tag' );
is( $scantags->[1]->name(), 'bar', 'single baz scanner bar tag' );
is( $scantags->[2]->name(), 'baz', 'single baz scanner baz tag' );
#------------------------------------------------------------------------
# define a scanner subclass which inherits $TAGS from base class
#------------------------------------------------------------------------
package Template::Test::Scanner1;
use base qw( Template::TT3::Scanner );
package main;
$scanpkg = 'Template::Test::Scanner1';
# create subclass scanner object
$scanner = $scanpkg->new() || die $scanpkg->error();
ok( $scanner, 'created a subclass scanner1' );
$scantags = $scanner->tags();
ok( $scantags, 'got scanner1 tags' );
is( ref $scantags, 'ARRAY', 'an ARRAY of scanner1 tags' );
is( scalar @$scantags, 2, 'scanner1 has two scanner tags' );
is( $scantags->[0]->name(), 'foo', 'scanner1 foo tag' );
is( $scantags->[1]->name(), 'bar', 'scanner1 bar tag' );
#------------------------------------------------------------------------
# another scanner subclass which defines its own $TAGS
#------------------------------------------------------------------------
package Template::Test::Scanner2;
use base qw( Template::TT3::Scanner );
use vars qw( $TAGS );
$TAGS = [ $main::BAZ, $main::FOO ];
package main;
$scanpkg = 'Template::Test::Scanner2';
# create subclass scanner object
$scanner = $scanpkg->new() || die $scanpkg->error();
ok( $scanner, 'created a subclass scanner2' );
$scantags = $scanner->tags();
ok( $scantags, 'got scanner2 tags' );
is( ref $scantags, 'ARRAY', 'an ARRAY of scanner2 tags' );
is( scalar @$scantags, 2, 'scanner2 has two scanner tags' );
is( $scantags->[0]->name(), 'baz', 'scanner2 baz tag' );
is( $scantags->[1]->name(), 'foo', 'scanner2 foo tag' );
#------------------------------------------------------------------------
# define a subclass tag for testing the scanner scan() method
#------------------------------------------------------------------------
package Template::Test::Tag1;
use base qw( Template::TT3::Tag );
sub parse {
my ($self, $textref, $document) = @_;
my $size = ($$textref =~ tr/\n//);
$document->size($size) if $size;
$document->body([ $self->{ name }, $textref, $document->position() ]);
$document->move() if $size;
return 1;
}
package main;
@$deftags = ();
$scanpkg = 'Template::TT3::Scanner';
$tagpkg = 'Template::Test::Tag1';
$footagobj = $tagpkg->new($footag);
$bartagobj = $tagpkg->new($bartag);
$baztagobj = $tagpkg->new($baztag);
$scanner = $scanpkg->new( tags => [ $footagobj, $bartagobj, $baztagobj ]);
ok( $footagobj, 'created scanning foo tag' );
ok( $bartagobj, 'created scanning bar tag' );
ok( $baztagobj, 'created scanning baz tag' );
ok( $scanner, 'created a scanning scanner' );
my $doctext = "This is the first line of text
The second line has <foo:embedded foo directive> and
the next line has an <bar:embedded bar directive
that spans
several
lines> before going back to text.
<foo:at the start><baz:at the end>
the end";
my $document = $docpkg->new( name => 'testdoc', text => $doctext );
ok( $document, 'created a test document' );
ok( $document->scan($scanner), 'scanned document' );
my $body = $document->body();
ok( $body, 'got document body' );
is( ref $body, 'ARRAY', 'body is an ARRAY' );
is( scalar @$body, 8, 'eight elements in body' );
is( $body->[0]->[0], 'text', 'first body is text' );
is( ${ $body->[0]->[1] }, "This is the first line of text\nThe second line has ",
'first body text OK' );
is( $body->[1]->[0], 'foo', 'second body is foo' );
is( $body->[1]->[2], '2', 'second body is at line 2' );
is( ${ $body->[1]->[1] }, 'embedded foo directive',
'second body text OK' );
is( $body->[2]->[0], 'text', 'third body is text' );
is( ${ $body->[2]->[1] }, " and\nthe next line has an ",
'third body text OK' );
is( $body->[3]->[0], 'bar', 'fourth body is bar' );
is( ${ $body->[3]->[1] }, "embedded bar directive\nthat spans\nseveral\nlines",
'fourth body text OK' );
is( $body->[3]->[2], '3-6', 'fourth body is at line 3-6' );
is( $body->[4]->[0], 'text', 'fifth body is text' );
is( ${ $body->[4]->[1] }, " before going back to text.\n",
'fifth body text OK' );
is( $body->[5]->[0], 'foo', 'sixth body is foo' );
is( $body->[5]->[2], '7', 'sixth body is at line 7' );
is( ${ $body->[5]->[1] }, "at the start",
'sixth body text OK' );
is( $body->[6]->[0], 'baz', 'seventh body is baz' );
is( $body->[6]->[2], '7', 'seventh body is at line 7' );
is( ${ $body->[6]->[1] }, "at the end",
'seventh body text OK' );
is( $body->[7]->[0], 'text', 'eight body is text' );
is( ${ $body->[7]->[1] }, "\nthe end",
'eighth body text OK' );
#------------------------------------------------------------------------
# another subclass tag for testing regex tags
#------------------------------------------------------------------------
package Template::Test::Tag2;
use base qw( Template::TT3::Tag );
#my $DEBUG = $main::DEBUG;
sub parse {
my ($self, $textref, $document) = @_;
my $size = ($$textref =~ tr/\n//);
$document->size($size) if $size;
$document->body([ $self->{ start_match }, $textref, $document->position(),
$self->{ end_match } ]);
$document->move() if $size;
return 1;
}
package main;
$tagpkg = 'Template::Test::Tag2';
my $regtag = $tagpkg->new({
name => 'foobarbaz',
start => qr/<(?:foo|bar|baz):/,
end => qr/\/?>/,
});
$scanner = $scanpkg->new( tags => $regtag );
ok( $scanner, 'created a regex scanner' );
$doctext = "This is the first line of text
The second line has <foo:embedded foo directive> and
the next line has an <bar:embedded bar directive
that spans
several
lines> before going back to text.
<foo:at the start/><baz:at the end/>
the end";
$document = $docpkg->new( name => 'testdoc', text => $doctext );
ok( $document, 'created a regex test document' );
ok( $document->scan($scanner), 'scanned document' );
$body = $document->body();
ok( $body, 'got document body' );
is( ref $body, 'ARRAY', 'body is an ARRAY' );
is( scalar @$body, 8, 'eight elements in body' );
is( $body->[0]->[0], 'text', 'first body is text' );
is( ${ $body->[0]->[1] }, "This is the first line of text\nThe second line has ",
'first body text OK' );
is( $body->[1]->[0], '<foo:', 'second body is <foo:' );
is( $body->[1]->[2], '2', 'second body is at line 2' );
is( ${ $body->[1]->[1] }, 'embedded foo directive',
'second body text OK' );
is( $body->[1]->[3], '>', 'closing foo tag' );
is( $body->[2]->[0], 'text', 'third body is text' );
is( ${ $body->[2]->[1] }, " and\nthe next line has an ",
'third body text OK' );
is( $body->[3]->[0], '<bar:', 'fourth body is <bar:' );
is( ${ $body->[3]->[1] }, "embedded bar directive\nthat spans\nseveral\nlines",
'fourth body text OK' );
is( $body->[3]->[2], '3-6', 'fourth body is at line 3-6' );
is( $body->[3]->[3], '>', 'closing bar tag' );
is( $body->[4]->[0], 'text', 'fifth body is text' );
is( ${ $body->[4]->[1] }, " before going back to text.\n",
'fifth body text OK' );
is( $body->[5]->[0], '<foo:', 'sixth body is foo' );
is( $body->[5]->[2], '7', 'sixth body is at line 7' );
is( ${ $body->[5]->[1] }, "at the start",
'sixth body text OK' );
is( $body->[5]->[3], '/>', 'closing bar tag' );
is( $body->[6]->[0], '<baz:', 'seventh body is baz' );
is( $body->[6]->[2], '7', 'seventh body is at line 7' );
is( ${ $body->[6]->[1] }, "at the end",
'seventh body text OK' );
is( $body->[6]->[3], '/>', 'closing baz tag' );
is( $body->[7]->[0], 'text', 'eight body is text' );
is( ${ $body->[7]->[1] }, "\nthe end",
'eighth body text OK' );
#------------------------------------------------------------------------
# same again, but using similar regexes to attempt to confuse the scanner
#------------------------------------------------------------------------
$footagobj = $tagpkg->new({
name => 'footag',
start => qr/<foo/,
end => qr/\/>?/,
});
$bartagobj = $tagpkg->new({
name => 'foobar',
start => '<foobar',
end => '>',
});
$baztagobj = $tagpkg->new({
name => 'foobarbaz',
start => '<foobarbaz',
end => '>',
});
$scanner = $scanpkg->new( tags => [ $footagobj, $bartagobj, $baztagobj ] );
ok( $scanner, 'created a multiway scanner' );
$doctext = "Hello <foo the foo directive/> and
then <foobar the foo bar directive
that spans two lines> then back to text.
<foobarbaz the foo bar baz directive> the end";
$document = $docpkg->new( name => 'testdoc', text => $doctext );
ok( $document, 'created a multi regex test document' );
ok( $document->scan($scanner), 'scanned document' );
$body = $document->body();
ok( $body, 'got document body' );
is( ref $body, 'ARRAY', 'body is an ARRAY' );
is( scalar @$body, 7, 'seven elements in body' );
is( $body->[0]->[0], 'text', 'first body is text' );
is( ${ $body->[0]->[1] }, "Hello ", 'first body text OK' );
is( $body->[1]->[0], '<foo', 'second body is <foo' );
is( $body->[1]->[2], '1', 'second body is at line 1' );
is( ${ $body->[1]->[1] }, ' the foo directive',
'second body text OK' );
is( $body->[1]->[3], '/>', 'closing foo tag' );
is( $body->[2]->[0], 'text', 'third body is text' );
is( ${ $body->[2]->[1] }, " and\nthen ", 'third body text OK' );
is( $body->[3]->[0], '<foobar', 'fourth body is <foobar' );
is( ${ $body->[3]->[1] }, " the foo bar directive\nthat spans two lines",
'fourth body text OK' );
is( $body->[3]->[2], '2-3', 'fourth body is at line 2-3' );
is( $body->[3]->[3], '>', 'closing foobar tag' );
is( $body->[4]->[0], 'text', 'fifth body is text' );
is( ${ $body->[4]->[1] }, " then back to text.\n",
'fifth body text OK' );
is( $body->[5]->[0], '<foobarbaz', 'sixth body is foobarbaz' );
is( $body->[5]->[2], '4', 'sixth body is at line 4' );
is( ${ $body->[5]->[1] }, " the foo bar baz directive",
'sixth body text OK' );
is( $body->[5]->[3], '>', 'closing bar tag' );
is( $body->[6]->[0], 'text', 'seventh body is text' );
is( ${ $body->[6]->[1] }, " the end",
'seventh body text OK' );
__END__
1.1 TT3/t/tag.t
Index: tag.t
===================================================================
#============================================================= -*-perl-*-
#
# t/tag.t
#
# Test the Template::TT3::Tag.pm module.
#
# Written by Andy Wardley <abw@wardley.org>
#
# This is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#
# $Id: tag.t,v 1.1 2003/12/10 14:17:49 abw Exp $
#
#========================================================================
use strict;
use warnings;
use lib qw( ./lib ../lib );
use Template::TT3::Base;
use Template::TT3::Tag;
use Test::More tests => 72;
my $DEBUG = grep /^--?d(ebug)?$/, @ARGV;
$Template::TT3::Tag::DEBUG = $DEBUG;
my $tag;
my $pkg = 'Template::TT3::Tag';
my $def = $Template::TT3::Tag::TAG;
my $alt = {
start => '<*',
end => '*>',
name => 'angle_star',
};
# test class pkgtag() method
my $pkgtag = $pkg->pkgtag();
ok( $pkgtag, 'got class package tag' );
is( $pkgtag->{ start }, $def->{ start }, 'class package tag start' );
is( $pkgtag->{ end }, $def->{ end }, 'class package tag end' );
is( $pkgtag->{ name }, $def->{ name }, 'class package tag name' );
# create default tag object
$tag = $pkg->new() || die $pkg->error();
ok( $tag, 'created a tag' );
is( $tag->start(), $def->{ start }, "start tag is $def->{ start }" );
is( $tag->end(), $def->{ end }, "end tag is $def->{ end }" );
is( $tag->name(), $def->{ name }, "tag name is $def->{ name }" );
# test object pkgtag() method
$pkgtag = $tag->pkgtag();
ok( $pkgtag, 'got object package tag' );
is( $pkgtag->{ start }, $def->{ start }, 'object package tag start' );
is( $pkgtag->{ end }, $def->{ end }, 'object package tag end' );
is( $pkgtag->{ name }, $def->{ name }, 'object package tag name' );
# update start/end tags and name
is( $tag->start($alt->{ start }), $alt->{ start }, 'set start tag' );
is( $tag->end($alt->{ end }), $alt->{ end }, 'set end tag' );
is( $tag->start(), $alt->{ start }, "start tag is $alt->{ start }" );
is( $tag->end(), $alt->{ end }, "end tag is $alt->{ end }" );
is( $tag->name('frank'), 'frank', 'set tag name to frank' );
is( $tag->name(), 'frank', 'tag name is now frank' );
# create custom tag object
$tag = $pkg->new($alt) || die $pkg->error();
ok( $tag, 'created alt tag' );
is( $tag->start(), $alt->{ start }, "custom start tag is $alt->{ start }" );
is( $tag->end(), $alt->{ end }, "custom end tag is $alt->{ end }" );
is( $tag->name(), $alt->{ name }, "custom tag name is $alt->{ name }" );
is( $tag->name('frank'), 'frank', "set custom tag name to frank" );
is( $tag->name(), 'frank', 'custom tag name is now frank' );
#------------------------------------------------------------------------
# define tag subclass inheriting tags from base class
#------------------------------------------------------------------------
package Template::Test::Tag1;
use base qw( Template::TT3::Tag );
package main;
$pkg = 'Template::Test::Tag1';
# test class pkgtag() method
$pkgtag = $pkg->pkgtag();
ok( $pkgtag, 'got Tag1 package tag' );
is( $pkgtag->{ start }, $def->{ start }, 'Tag1 class package tag start' );
is( $pkgtag->{ end }, $def->{ end }, 'Tag1 class package tag end' );
is( $pkgtag->{ name }, $def->{ name }, 'Tag1 class package tag name' );
# create default tag object
$tag = $pkg->new() || die $pkg->error();
ok( $tag, 'created a Tag1 tag' );
is( $tag->start(), $def->{ start }, "Tag1 start tag is $def->{ start }" );
is( $tag->end(), $def->{ end }, "Tag1 end tag is $def->{ end }" );
is( $tag->name(), $def->{ name }, "Tag1 name is $def->{ name }" );
# test object pkgtag() method
$pkgtag = $tag->pkgtag();
ok( $pkgtag, 'got Tag1 object package tag' );
is( $pkgtag->{ start }, $def->{ start }, 'Tag1 object package tag start' );
is( $pkgtag->{ end }, $def->{ end }, 'Tag1 object package tag end' );
is( $pkgtag->{ name }, $def->{ name }, 'Tag1 package tag name' );
# update start/end tags
is( $tag->start($alt->{ start }), $alt->{ start }, 'set Tag1 start tag' );
is( $tag->end($alt->{ end }), $alt->{ end }, 'set Tag1 end tag' );
is( $tag->start(), $alt->{ start }, "Tag1 start tag is $alt->{ start }" );
is( $tag->end(), $alt->{ end }, "Tag1 end tag is $alt->{ end }" );
is( $tag->name('barry'), 'barry', 'set tag name to barry' );
is( $tag->name(), 'barry', 'tag name is now barry' );
# create custom tag object
$tag = $pkg->new($alt) || die $pkg->error();
ok( $tag, 'created alt Tag1 tag' );
is( $tag->start(), $alt->{ start }, "custom Tag1 start tag is $alt->{ start }" );
is( $tag->end(), $alt->{ end }, "custom Tag1 end tag is $alt->{ end }" );
is( $tag->name(), $alt->{ name }, "custom Tag1 name is $alt->{ name }" );
is( $tag->name('eric'), 'eric', "set Tag1 name to eric" );
is( $tag->name(), 'eric', 'Tag1 name is now eric' );
#------------------------------------------------------------------------
# define tag subclass with custom tags
#------------------------------------------------------------------------
package Template::Test::Tag2;
use base qw( Template::TT3::Tag );
use vars qw( $TAG @PARSED );
$TAG = {
start => '[[',
end => ']]',
name => 'squares',
};
package main;
$pkg = 'Template::Test::Tag2';
$def = $Template::Test::Tag2::TAG;
# test class pkgtag() method
$pkgtag = $pkg->pkgtag();
ok( $pkgtag, 'got Tag2 package tag' );
is( $pkgtag->{ start }, $def->{ start }, 'Tag2 class package tag start' );
is( $pkgtag->{ end }, $def->{ end }, 'Tag2 class package tag end' );
is( $pkgtag->{ name }, $def->{ name }, 'Tag2 class package tag name' );
# create default tag object
$tag = $pkg->new() || die $pkg->error();
ok( $tag, 'created a tag' );
is( $tag->start(), $def->{ start }, "Tag2 start tag is $def->{ start }" );
is( $tag->end(), $def->{ end }, "Tag2 end tag is $def->{ end }" );
is( $tag->name(), $def->{ name }, "Tag2 name is $def->{ name }" );
# test object pkgtag() method
$pkgtag = $tag->pkgtag();
ok( $pkgtag, 'got Tag2 object package tag' );
is( $pkgtag->{ start }, $def->{ start }, 'Tag2 object package tag start' );
is( $pkgtag->{ end }, $def->{ end }, 'Tag2 object package tag end' );
is( $pkgtag->{ name }, $def->{ name }, 'Tag2 package tag name' );
# update start/end tags and name
is( $tag->start($alt->{ start }), $alt->{ start }, 'set subclass start tag' );
is( $tag->end($alt->{ end }), $alt->{ end }, 'set subclass end tag' );
is( $tag->start(), $alt->{ start }, "subclass start tag is $alt->{ start }" );
is( $tag->end(), $alt->{ end }, "subclass end tag is $alt->{ end }" );
is( $tag->name('mandy'), 'mandy', 'set tag name to mandy' );
is( $tag->name(), 'mandy', 'tag name is now mandy' );
# create custom tag object
$tag = $pkg->new($alt) || die $pkg->error();
ok( $tag, 'created alt subclass tag' );
is( $tag->start(), $alt->{ start }, "custom subclass start tag is $alt->{ start }" );
is( $tag->end(), $alt->{ end }, "custom subclass end tag is $alt->{ end }" );
is( $tag->name(), $alt->{ name }, "custom Tag2 name is $alt->{ name }" );
is( $tag->name('doris'), 'doris', "set Tag2 name to doris" );
is( $tag->name(), 'doris', 'Tag2 name is now doris' );
__END__