[Templates-cvs] cvs commit: TT3/t tagset.t
cvs@template-toolkit.org
cvs@template-toolkit.org
Mon, 08 Nov 2004 18:47:25 +0000
cvs 04/11/08 18:47:25
Modified: t tagset.t
Log:
* updated tests for Template::Tagset module
Revision Changes Path
1.5 +350 -109 TT3/t/tagset.t
Index: tagset.t
===================================================================
RCS file: /template-toolkit/TT3/t/tagset.t,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- tagset.t 2004/03/29 16:41:16 1.4
+++ tagset.t 2004/11/08 18:47:24 1.5
@@ -2,14 +2,14 @@
#
# t/tagset.t
#
-# Test the Template::TT3::Tagset.pm module.
+# Test the Template::Tagset.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: tagset.t,v 1.4 2004/03/29 16:41:16 abw Exp $
+# $Id: tagset.t,v 1.5 2004/11/08 18:47:24 abw Exp $
#
#========================================================================
@@ -17,41 +17,46 @@
use warnings;
use lib qw( ./lib ../lib );
-use Test::More skip_all => 'all tests: sorry, these tests are broken';
-use Template::TT3::Tagset;
-use Template::TT3::Tagset::TT3;
-use Template::TT3::Tag;
-use Test::More tests => 168;
+use Template::Tag;
+use Template::Tagset;
+#use Template::Tagset::TT;
+use Template::Test;
+plan(139);
+
my $DEBUG =
-$Template::TT3::Tagset::DEBUG =
-$Template::TT3::Tagset::TT3::DEBUG =
-$Template::TT3::Tag::DEBUG =
+$Template::Tagset::DEBUG =
+#$Template::Tagset::TT3::DEBUG =
+$Template::Tag::DEBUG =
grep /^--?d(ebug)?$/, @ARGV;
-my $tagpkg = 'Template::TT3::Tag';
-my $tagsetpkg = 'Template::TT3::Tagset';
-my $deftags = $Template::TT3::Tagset::TAGS;
+my $tagpkg = 'Template::Tag';
+my $tagsetpkg = 'Template::Tagset';
+my $deftags = $Template::Tagset::TAGS;
# define some alternate tags
+
+my $start = {
+ foo => '<foo:',
+ bar => '<bar:',
+ bam => qr/(?i:<bam:)/,
+ baz => '<baz:',
+};
+
my $footag = {
- name => 'foo',
- start => '<foo:',
+ start => $start->{ foo },
end => '>',
};
my $bartag = {
- name => 'bar',
- start => '<bar:',
+ start => $start->{ bar },
end => '>',
};
my $bamtag = {
- name => 'bam',
- start => qr/(?i:<bam:)/,
+ start => $start->{ bam },
end => '>',
};
my $baztag = {
- name => 'baz',
- start => '<baz:',
+ start => $start->{ baz },
end => '>',
};
my $footagobj = $tagpkg->new($footag);
@@ -62,8 +67,15 @@
ok( $bartagobj, 'created bar tag' );
ok( $bamtagobj, 'created bam tag' );
ok( $baztagobj, 'created baz tag' );
-my $alttags = [ $footagobj, $bartagobj ];
-my $mixtags = [ $footagobj, $bartagobj, $bamtagobj ];
+my $alttags = {
+ foo => $footagobj,
+ bar => $bartagobj,
+};
+my $mixtags = {
+ foo => $footagobj,
+ bar => $bartagobj,
+ bam => $bamtagobj,
+};
my ($tags, $tag);
# need to save tag objects in package var for later...
@@ -76,82 +88,89 @@
#------------------------------------------------------------------------
# test class pkgtags() method
-my $pkgtags = $tagsetpkg->pkgtags();
+my $pkgtags = $tagsetpkg->pkgvar('TAGS');
ok( $pkgtags, 'got class package tags' );
-is( ref $pkgtags, 'ARRAY', 'an ARRAY of package tags' );
-is( scalar @$pkgtags, 0, 'containing nothing' );
+is( ref $pkgtags, 'HASH', 'a HASH of package tags' );
+is( scalar keys %$pkgtags, 0, 'containing nothing' );
# create default tagset object
my $tagset = $tagsetpkg->new() || die $tagsetpkg->error();
ok( $tagset, 'created a tagset' );
my $tagtags = $tagset->tags();
ok( $tagtags, 'got tagset tags' );
-is( ref $tagtags, 'ARRAY', 'an ARRAY of tagset tags' );
-is( scalar @$tagtags, 0, 'no tagset tags' );
+is( ref $tagtags, 'HASH', 'a HASH of tagset tags' );
+is( scalar keys %$tagtags, 0, 'no tagset tags' );
# test object pkgtags() method
$pkgtags = $tagset->pkgtags();
ok( $pkgtags, 'got object package tags' );
-is( ref $pkgtags, 'ARRAY', 'an ARRAY of object package tags' );
-is( scalar @$pkgtags, 0, 'still containing nothing' );
+is( ref $pkgtags, 'HASH', 'a HASH of object package tags' );
+is( scalar keys %$pkgtags, 0, 'still containing nothing' );
# create tagset specifying tags
$tagset = $tagsetpkg->new( tags => $alttags ) || die $tagsetpkg->error();
ok( $tagset, 'created a custom tagset' );
$tagtags = $tagset->tags();
ok( $tagtags, 'got custom tagset tags' );
-is( ref $tagtags, 'ARRAY', 'an ARRAY of custom tagset tags' );
-is( scalar @$tagtags, 2, 'two tagset tags' );
-is( $tagtags->[0]->name(), 'foo', 'custom tagset foo tag' );
-is( $tagtags->[1]->name(), 'bar', 'custom tagset bar tag' );
+is( ref $tagtags, 'HASH', 'a HASH of custom tagset tags' );
+is( scalar keys %$tagtags, 2, 'two tagset tags' );
+is( $tagtags->{ foo }, $footagobj, 'custom tagset foo tag' );
+is( $tagtags->{ bar }, $bartagobj, 'custom tagset bar tag' );
-# create tagset specifying TAGS
-$tagset = $tagsetpkg->new( TAGS => $mixtags ) || die $tagsetpkg->error();
+$tagset = $tagsetpkg->new( tags => $mixtags ) || die $tagsetpkg->error();
ok( $tagset, 'created a custom TAGS tagset' );
$tagtags = $tagset->tags();
ok( $tagtags, 'got custom tagset TAGS' );
-is( ref $tagtags, 'ARRAY', 'an ARRAY of custom tagset TAGS' );
-is( scalar @$tagtags, 3, 'three tagset TAGS' );
-is( $tagtags->[0]->name(), 'foo', 'custom tagset foo TAG' );
-is( $tagtags->[1]->name(), 'bar', 'custom tagset bar TAG' );
-is( $tagtags->[2]->name(), 'bam', 'custom tagset bam TAG' );
-
-# fetch tags by name
-ok( $tag = $tagset->tag( name => 'foo' ), 'got tag name foo' );
-is( $tag->{ name }, 'foo', 'the right foo tag' );
-ok( $tag = $tagset->tag( named => 'bar' ), 'got tag named bar' );
-is( $tag->{ name }, 'bar', 'the right bar tag' );
-ok( $tag = $tagset->tag_named( 'bam' ), 'got tag_named bam' );
-is( $tag->{ name }, 'bam', 'the right bam tag' );
-ok( ! defined $tagset->tag_named('baz'), 'no baz tag' );
-is( $tagset->error(), "no tag named 'baz'", 'no tag error' );
+is( ref $tagtags, 'HASH', 'a HASH of custom tagset TAGS' );
+is( scalar keys %$tagtags, 3, 'three tagset TAGS' );
+is( $tagtags->{ foo }, $footagobj, 'custom tagset foo TAG' );
+is( $tagtags->{ bar }, $bartagobj, 'custom tagset bar TAG' );
+is( $tagtags->{ bam }, $bamtagobj, 'custom tagset bam TAG' );
+
+# fetch tags using tags() and tag() methods
+ok( $tag = $tagset->tags('foo'), 'got tag name foo' );
+is( $tag, $footagobj, 'the right foo tag' );
+ok( $tag = $tagset->tag('bar'), 'got tag named bar' );
+is( $tag, $bartagobj, 'the right bar tag' );
+ok( $tag = $tagset->tag('bam'), 'got tag_named bam' );
+is( $tag, $bamtagobj, 'the right bam tag' );
+ok( ! defined $tagset->tag('baz'), 'no baz tag' );
+is( $tagset->error(), "no such tag defined: baz", 'no tag error' );
+
+
+
+#------------------------------------------------------------------------
+# tagmap()
+#------------------------------------------------------------------------
-# fetch tag map
-my $tagmap = $tagset->tag_map();
+# fetch tagset map
+my $tagmap = $tagset->tagmap();
ok( $tagmap, 'got a tag map' );
-is( scalar keys %$tagmap, 2, 'two items in tag map' );
-is( $tagmap->{'<foo:'}->name(), 'foo', 'foo tag map' );
-is( $tagmap->{'<bar:'}->name(), 'bar', 'bar tag map' );
+is( scalar keys %{ $tagmap->{ fixed_start } }, 2,
+ 'two items in tag map start' );
+is( $tagmap->{ fixed_start }->{'<foo:'}, $footagobj, 'foo tag map' );
+is( $tagmap->{ fixed_start }->{'<bar:'}, $bartagobj, 'bar tag map' );
# fetch tags by token
-ok( $tag = $tagset->tag( start => '<foo:' ), 'got tag start foo' );
-is( $tag->{ name }, 'foo', 'the right foo start tag' );
-ok( $tag = $tagset->tag( starting => '<bar:' ), 'got tag starting bar' );
-is( $tag->{ name }, 'bar', 'the right bar starting tag' );
-ok( $tag = $tagset->tag_starting( '<bam:' ), 'got tag_starting bam' );
-is( $tag->{ name }, 'bam', 'the right bam starting tag' );
-ok( $tag = $tagset->tag_starting( '<BAM:' ), 'got tag_starting BAM' );
-is( $tag->{ name }, 'bam', 'the right BAM starting tag' );
+ok( $tag = $tagset->match('<foo:'), 'got tag start foo' );
+is( $tag, $footagobj, 'the right foo start tag' );
+ok( $tag = $tagset->match('<bar:'), 'got tag starting bar' );
+is( $tag, $bartagobj, 'the right bar starting tag' );
+ok( $tag = $tagset->match( '<bam:' ), 'got tag_starting bam' );
+is( $tag, $bamtagobj, 'the right bam starting tag' );
+ok( $tag = $tagset->match( '<BAM:' ), 'got tag_starting BAM' );
+is( $tag, $bamtagobj, 'the right BAM starting tag' );
# check updates to to tag map
-is( scalar keys %$tagmap, 4, 'four items in tag map' );
-is( $tagmap->{'<foo:'}->name(), 'foo', 'foo tag map' );
-is( $tagmap->{'<bar:'}->name(), 'bar', 'bar tag map' );
-is( $tagmap->{'<bam:'}->name(), 'bam', 'bam tag map' );
-is( $tagmap->{'<BAM:'}->name(), 'bam', 'BAM tag map' );
+is( scalar keys %{ $tagmap->{ fixed_start } }, 4,
+ 'four items in tag map start' );
+is( $tagmap->{ fixed_start }->{'<foo:'}, $footagobj, 'foo tag map' );
+is( $tagmap->{ fixed_start }->{'<bar:'}, $bartagobj, 'bar tag map' );
+is( $tagmap->{ fixed_start }->{'<bam:'}, $bamtagobj, 'bam tag map' );
+is( $tagmap->{ fixed_start }->{'<BAM:'}, $bamtagobj, 'BAM tag map' );
-my $regex = $tagset->regex();
-ok( $regex, 'got tagset regex' );
+my $regex = $tagmap->{ regex };
+ok( $regex, 'got tag map regex' );
ok( "blah <foo:plonk> blah" =~ $regex, 'regex matched foo' );
ok( "blah <bar:plonk> blah" =~ $regex, 'regex matched bar' );
ok( "blah <bam:plonk> blah" =~ $regex, 'regex matched bam' );
@@ -160,58 +179,72 @@
#------------------------------------------------------------------------
+# regex()
+#------------------------------------------------------------------------
+
+$regex = $tagset->regex();
+ok( $regex, 'got tag map regex()' );
+ok( "blah <foo:plonk> blah" =~ $regex, 'regex() matched foo' );
+ok( "blah <bar:plonk> blah" =~ $regex, 'regex() matched bar' );
+ok( "blah <bam:plonk> blah" =~ $regex, 'regex() matched bam' );
+ok( "blah <BAM:plonk> blah" =~ $regex, 'regex() matched BAM' );
+ok( "blah blah blah" !~ $regex, 'regex() matched nothing' );
+
+
+#------------------------------------------------------------------------
# update package tags and try again
#------------------------------------------------------------------------
-@$deftags = @$alttags;
+%$deftags = %$alttags;
# test class pkgtags() method
$pkgtags = $tagsetpkg->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' );
+is( ref $pkgtags, 'HASH', 'still a HASH of package tags' );
+is( scalar keys %$pkgtags, 2, 'now containing two items' );
+is( $pkgtags->{ foo }, $footagobj, 'foo tag' );
+is( $pkgtags->{ bar }, $bartagobj, 'bar tag' );
# create default tagset object
$tagset = $tagsetpkg->new() || die $tagsetpkg->error();
ok( $tagset, 'created another tagset' );
$tagtags = $tagset->tags();
ok( $tagtags, 'got another tagset tags' );
-is( ref $tagtags, 'ARRAY', 'an ARRAY of another tagset tags' );
-is( scalar @$tagtags, 2, 'has two tagset tags' );
-is( $tagtags->[0]->name(), 'foo', 'another foo tag' );
-is( $tagtags->[1]->name(), 'bar', 'another bar tag' );
+is( ref $pkgtags, 'HASH', 'a HASH of another tagset tags' );
+is( scalar keys %$pkgtags, 2, 'has two tagset items' );
+is( $pkgtags->{ foo }, $footagobj, 'another foo tag' );
+is( $pkgtags->{ bar }, $bartagobj, 'another bar tag' );
# test object pkgtags() method
$pkgtags = $tagset->pkgtags();
ok( $pkgtags, 'got another object package tags' );
-is( ref $pkgtags, 'ARRAY', 'another ARRAY of another object package tags' );
-is( scalar @$tagtags, 2, 'still has two tagset tags' );
-is( $pkgtags->[0]->name(), 'foo', 'yet another foo tag' );
-is( $pkgtags->[1]->name(), 'bar', 'yet another bar tag' );
+is( ref $pkgtags, 'HASH', 'another HASH of another object package tags' );
+is( scalar keys %$tagtags, 2, 'still has two tagset tags' );
+is( $pkgtags->{ foo }, $footagobj, 'yet another foo tag' );
+is( $pkgtags->{ bar }, $bartagobj, 'yet another bar tag' );
# create tagset specifying list of tag(s)
-$tagset = $tagsetpkg->new( tags => [ $baztagobj ]) || die $tagsetpkg->error();
+$tagset = $tagsetpkg->new( tags => { baz => $baztagobj } ) ||
+ die $tagsetpkg->error();
ok( $tagset, 'created a baz tagset' );
$tagtags = $tagset->tags();
ok( $tagtags, 'got baz tagset tags' );
-is( ref $tagtags, 'ARRAY', 'an ARRAY of baz tagset tags' );
-is( scalar @$tagtags, 3, 'three baz tagset tags' );
-is( $tagtags->[0]->name(), 'foo', 'baz tagset foo tag' );
-is( $tagtags->[1]->name(), 'bar', 'baz tagset bar tag' );
-is( $tagtags->[2]->name(), 'baz', 'baz tagset baz tag' );
+is( ref $tagtags, 'HASH', 'a HASH of baz tagset tags' );
+is( scalar keys %$tagtags, 3, 'three baz tagset tags' );
+is( $tagtags->{ foo }, $footagobj, 'baz tagset foo tag' );
+is( $tagtags->{ bar }, $bartagobj, 'baz tagset bar tag' );
+is( $tagtags->{ baz }, $baztagobj, 'baz tagset baz tag' );
-# create tagset specifying tags as single item
-$tagset = $tagsetpkg->new( tags => $baztagobj) || die $tagsetpkg->error();
+# create tagset specifying tags as single pair
+$tagset = $tagsetpkg->new( baz => $baztagobj ) || die $tagsetpkg->error();
ok( $tagset, 'created a single baz tagset' );
$tagtags = $tagset->tags();
ok( $tagtags, 'got single baz tagset tags' );
-is( ref $tagtags, 'ARRAY', 'an ARRAY of single baz tagset tags' );
-is( scalar @$tagtags, 3, 'three single baz tagset tags' );
-is( $tagtags->[0]->name(), 'foo', 'single baz tagset foo tag' );
-is( $tagtags->[1]->name(), 'bar', 'single baz tagset bar tag' );
-is( $tagtags->[2]->name(), 'baz', 'single baz tagset baz tag' );
+is( ref $tagtags, 'HASH', 'a HASH of single baz tagset tags' );
+is( scalar keys %$tagtags, 3, 'three single baz tagset tags' );
+is( $tagtags->{ foo }, $footagobj, 'single baz tagset foo tag' );
+is( $tagtags->{ bar }, $bartagobj, 'single baz tagset bar tag' );
+is( $tagtags->{ baz }, $baztagobj, 'single baz tagset baz tag' );
#------------------------------------------------------------------------
@@ -219,7 +252,7 @@
#------------------------------------------------------------------------
package Template::Test::Tagset1;
-use base qw( Template::TT3::Tagset );
+use base qw( Template::Tagset );
package main;
@@ -230,10 +263,10 @@
ok( $tagset, 'created a subclass tagset1' );
$tagtags = $tagset->tags();
ok( $tagtags, 'got tagset1 tags' );
-is( ref $tagtags, 'ARRAY', 'an ARRAY of tagset1 tags' );
-is( scalar @$tagtags, 2, 'tagset1 has two tagset tags' );
-is( $tagtags->[0]->name(), 'foo', 'tagset1 foo tag' );
-is( $tagtags->[1]->name(), 'bar', 'tagset1 bar tag' );
+is( ref $tagtags, 'HASH', 'a HASH of tagset1 tags' );
+is( scalar keys %$tagtags, 2, 'tagset1 has two tagset tags' );
+is( $tagtags->{ foo }, $footagobj, 'tagset1 foo tag' );
+is( $tagtags->{ bar }, $bartagobj, 'tagset1 bar tag' );
#------------------------------------------------------------------------
@@ -241,10 +274,13 @@
#------------------------------------------------------------------------
package Template::Test::Tagset2;
-use base qw( Template::TT3::Tagset );
+use base qw( Template::Tagset );
use vars qw( $TAGS );
-$TAGS = [ $main::BAZ, $main::FOO ];
+$TAGS = {
+ wam => $main::FOO,
+ bam => $main::BAR,
+};
package main;
@@ -255,17 +291,221 @@
ok( $tagset, 'created a subclass tagset2' );
$tagtags = $tagset->tags();
ok( $tagtags, 'got tagset2 tags' );
-is( ref $tagtags, 'ARRAY', 'an ARRAY of tagset2 tags' );
-is( scalar @$tagtags, 2, 'tagset2 has two tagset tags' );
-is( $tagtags->[0]->name(), 'baz', 'tagset2 baz tag' );
-is( $tagtags->[1]->name(), 'foo', 'tagset2 foo tag' );
+is( ref $tagtags, 'HASH', 'a HASH of tagset1 tags' );
+is( scalar keys %$tagtags, 2, 'tagset2 has two tagset tags' );
+is( $tagtags->{ wam }, $footagobj, 'tagset2 wam tag' );
+is( $tagtags->{ bam }, $bartagobj, 'tagset2 bam tag' );
+
+
+#------------------------------------------------------------------------
+# test tags() method handling nested items.
+# note that some define 'tags' explicitly, others provide them
+# implicitly as either a hash ref or list of named tags
+#------------------------------------------------------------------------
+$tagset = $tagsetpkg->new({
+ # explicit 'tags' config item
+ tags => {
+ one => $tagsetpkg->new({
+ # assume all config items in hash are tags
+ foo => $footagobj,
+ two => $tagsetpkg->new(
+ # same for list of named params (non-hashref)
+ bar => $bartagobj,
+ tre => $tagsetpkg->new({
+ tags => {
+ baz => $baztagobj,
+ },
+ disabled => 1,
+ }),
+ ),
+ }),
+ bam => $bamtagobj,
+ },
+});
+
+ok( $tagset, 'created nested tagset' );
+
+# fetch tag using various delimiters and via array ref
+is( $tagset->tag('bam'), $bamtagobj,
+ 'got nested bam' );
+is( $tagset->tag('one.foo'), $footagobj,
+ 'got nested one.foo' );
+is( $tagset->tag('one/two/bar'), $bartagobj,
+ 'got nested one/two/bar' );
+is( $tagset->tag('one two tre baz'), $baztagobj,
+ 'got nested one two tre baz' );
+is( $tagset->tag([qw(one two tre baz)]), $baztagobj,
+ 'got nested [qw(one two tre baz)]' );
#------------------------------------------------------------------------
-# test the TT3 tagset
+# enable(), enabled(), disable() and disabled()
#------------------------------------------------------------------------
+
+# check that the tre tagset is disabled
+ok( $tagset->tag('one.two.tre')->disabled(), 'tre is disabled' );
+
+# fetch tagset map
+$tagmap = $tagset->tagmap();
+ok( $tagmap, 'got tag map from nested tagset' );
+
+# check tag map does not include disabled tags
+is( scalar keys %{ $tagmap->{ fixed_start } }, 2,
+ 'two items in nested tag map start' );
+is( $tagmap->{ fixed_start }->{'<foo:'}, $footagobj, 'nested foo tag map' );
+is( $tagmap->{ fixed_start }->{'<bar:'}, $bartagobj, 'nested bar tag map' );
+is( $tagmap->{ regex_start }->[0]->{ tag }, $bamtagobj, 'nested bam tag map' );
+
+# enable tre tagset and check again
+# note that calling tags() removes cached tagset map
+ok( $tagset->tags('one.two.tre')->enable(), 'enabled tre' );
+
+# tag map should now include baz, nested in tre
+$tagmap = $tagset->tagmap();
+ok( $tagmap, 'got tag map from nested tagset with tre enabled' );
+
+is( scalar keys %{ $tagmap->{ fixed_start } }, 3,
+ 'three items in nested tag map start' );
+is( $tagmap->{ fixed_start }->{'<foo:'}, $footagobj,
+ 'nested foo tag map again' );
+is( $tagmap->{ fixed_start }->{'<bar:'}, $bartagobj,
+ 'nested bar tag map again' );
+is( $tagmap->{ fixed_start }->{'<baz:'}, $baztagobj,
+ 'nested baz tag map' );
+is( $tagmap->{ regex_start }->[0]->{ tag }, $bamtagobj,
+ 'nested bam tag map again' );
+
+
+# disable bam
+$tagset->tag('bam')->disable();
+$tagmap = $tagset->tagmap();
+ok( $tagmap, 'got tag map from nested tagset with bam disabled' );
+is( scalar keys %{ $tagmap->{ fixed_start } }, 3,
+ 'three items in nested tag map start' );
+is( $tagmap->{ fixed_start }->{'<foo:'}, $footagobj,
+ 'nested foo tag map again' );
+is( $tagmap->{ fixed_start }->{'<bar:'}, $bartagobj,
+ 'nested bar tag map again' );
+is( $tagmap->{ fixed_start }->{'<baz:'}, $baztagobj,
+ 'nested baz tag map' );
+is( scalar @{$tagmap->{ regex_start }}, 0, 'no items in map match' );
+
+
+
+#------------------------------------------------------------------------
+# test the 'order' configuration item
+#------------------------------------------------------------------------
+
+sub expected_regex {
+ my $order = shift;
+ my $combo = join('|', map {
+ ref $start->{$_} ? $start->{$_} : quotemeta($start->{$_});
+ } @$order);
+ return qr/ \G (.*?) ($combo) /sx;
+}
+
+sub is_expected_regex {
+ my $tagset = shift;
+ my $expect = expected_regex($tagset->order());
+ is( $tagset->tagmap()->{ regex }, $expect,
+ shift || 'tagset regex is correct' );
+}
+
+sub is_tagset_order {
+ my $tagset = shift;
+ my $expect = shift;
+ is( join(', ', @{ $tagset->order() }), $expect,
+ shift || 'tagset order is correct: $expect' );
+}
+
+$tagsetpkg = 'Template::Tagset';
+$Template::Tagset::TAGS = { };
+
+$footagobj = $tagpkg->new($footag);
+$bartagobj = $tagpkg->new($bartag);
+$bamtagobj = $tagpkg->new($bamtag);
+$baztagobj = $tagpkg->new($baztag);
+
+# hash of $tags with explicit (but partial) order
+$tagset = $tagsetpkg->new({
+ tags => {
+ foo => $footagobj,
+ bar => $bartagobj,
+ baz => $baztagobj,
+ bam => $bamtagobj,
+ },
+ order => 'bam bar baz'
+});
+
+is_tagset_order( $tagset, 'bam, bar, baz, foo',
+ 'explicit order correct' );
+is_expected_regex( $tagset, 'explicit order regex' );
+
+
+# list of tags with implicit order
+$tagset = $tagsetpkg->new({
+ tags => [
+ foo => $footagobj,
+ bar => $bartagobj,
+ baz => $baztagobj,
+ bam => $bamtagobj,
+ ],
+}) || die $tagsetpkg->error();
+
+is_tagset_order( $tagset, 'foo, bar, baz, bam',
+ 'implicit order correct' );
+is_expected_regex( $tagset );
+
+
+# defined some tags in the package $TAGS
+$Template::Tagset::TAGS = [
+ bar => $bartagobj,
+ foo => $footagobj,
+];
+
+# list of tags with implicit order
+$tagset = $tagsetpkg->new({
+ tags => [
+ baz => $baztagobj,
+ bam => $bamtagobj,
+ foo => $footagobj,
+ ],
+}) || die $tagsetpkg->error();
+
+is_tagset_order( $tagset, 'bar, foo, baz, bam',
+ 'mixed implicit order correct' );
+is_expected_regex( $tagset );
+
+
+# list of tags with explicit order
+$tagset = $tagsetpkg->new({
+ tags => [
+ baz => $baztagobj,
+ bam => $bamtagobj,
+ foo => $footagobj,
+ ],
+ order => [ qw( foo bar bam baz ) ],
+}) || die $tagsetpkg->error();
+
+is_tagset_order( $tagset, 'foo, bar, bam, baz',
+ 'mixed explicit order correct' );
+is_expected_regex( $tagset );
+
+
+
+
+
+
+
+__END__
+
+
+#------------------------------------------------------------------------
+# test the TT3 tagset: TODO (not yet implemented)
+#------------------------------------------------------------------------
+
# create a tagset
$tagpkg = 'Template::TT3::Tagset::TT3';
$tagset = $tagpkg->new( )
@@ -315,6 +555,7 @@
$tag = $tags->[3];
is( $tag->name(), 'escape', 'tag three is escape' );
is( ref $tag->start(), 'Regexp', 'escape tag regex' );
+
#------------------------------------------------------------------------