[Templates-cvs] cvs commit: TT3/t scanner.t
cvs@template-toolkit.org
cvs@template-toolkit.org
Thu, 11 Nov 2004 11:52:37 +0000
cvs 04/11/11 11:52:37
Modified: t scanner.t
Log:
* fixed up/added new tests for more complex tag matching
Revision Changes Path
1.10 +242 -230 TT3/t/scanner.t
Index: scanner.t
===================================================================
RCS file: /template-toolkit/TT3/t/scanner.t,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- scanner.t 2004/11/10 18:27:18 1.9
+++ scanner.t 2004/11/11 11:52:36 1.10
@@ -2,14 +2,14 @@
#
# t/scanner.t
#
-# Test the Template::TT3::Scanner.pm module.
+# Test the Template::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.9 2004/11/10 18:27:18 abw Exp $
+# $Id: scanner.t,v 1.10 2004/11/11 11:52:36 abw Exp $
#
# TODO
# - fix for new scanner module
@@ -25,10 +25,10 @@
use Template::Scanner;
use Template::Handler;
use Template::Tag;
-#use Template::Tagset::TT3;
+use Template::Tagset::TT;
use Template::Test;
-plan(53);
+plan(126);
my $DEBUG =
$Template::Scanner::DEBUG =
@@ -38,6 +38,7 @@
my $handpkg = 'Template::Handler';
my $scanpkg = 'Template::Scanner';
+my ($tags, $tag);
@@ -152,6 +153,37 @@
is( $expr->[2], $text, "$message (text matches)" );
}
+sub is_xxx_expr {
+ my ($type, $start, $expr, $lines, $text, $message, $end) = @_;
+ $message ||= $text;
+ $end = '>' unless defined $end;
+ is( $expr->[0], $start, "$message (start)" );
+ is( $expr->[1], $lines, "$message ($lines)" );
+ is( ${$expr->[2]}, $text, "$message (body matches)" );
+ is( $expr->[3], $end, "$message (tag end)" );
+}
+
+sub is_foo_expr {
+ is_xxx_expr( foo => '<foo:', @_ );
+}
+
+sub is_bar_expr {
+ is_xxx_expr( bar => '<bar:', @_ );
+}
+
+sub is_baz_expr {
+ is_xxx_expr( baz => '<baz:', @_ );
+}
+
+sub is_foobar_expr {
+ is_xxx_expr( foobar => '<foobar:', @_ );
+}
+
+sub is_foobarbaz_expr {
+ is_xxx_expr( foobarbaz => '<foobarbaz:', @_ );
+}
+
+
is( $body->[0], 'test', 'body is a test' );
$body = $body->[1];
is( scalar @$body, 9, 'nine elements in body' );
@@ -212,73 +244,59 @@
);
-__END__
#------------------------------------------------------------------------
# test the tagset() method
#------------------------------------------------------------------------
-$scanner = $scanpkg->new()
- || die $scanpkg->error();
-
-my $tagsetpkg = 'Template::TT3::Tagset::TT3';
+my $tagsetpkg = 'Template::Tagset::TT';
my $tagset = $tagsetpkg->new( interpolate => 1 )
|| die $tagsetpkg->error();
ok( $tagset, 'created a tagset' );
-ok( $scanner->tagset($tagset), 'set tagset' );
-my $tags = $tagset->tags();
+$scanner = $scanpkg->new( tagset => $tagsetpkg )
+ || die $scanpkg->error();
+
+$tags = $tagset->tags();
ok( $tags, 'got tagset tags' );
-is( ref $tags, 'ARRAY', 'array of custom tagset tags' );
-is( scalar @$tags, 4, 'four tags' );
+is( ref $tags, 'HASH', 'hash of two tagset tags' );
+is( scalar keys %$tags, 2, 'two tags' );
-my $tag = $tags->[0];
-is( $tag->name(), 'directive', 'tag zero is a directive' );
+$tag = $tagset->tag('directive');
is( $tag->start(), '[%', 'directive tag start' );
is( $tag->end(), '%]', 'directive tag end' );
-$tag = $tags->[1];
-is( $tag->name(), 'variable', 'tag one is a variable' );
+$tag = $tagset->tag('interpolate.variable');
is( $tag->start(), '$', 'variable tag start' );
ok( ! $tag->end(), 'variable tag has no end' );
-$tag = $tags->[2];
-is( $tag->name(), 'embedded', 'tag two is embedded' );
+$tag = $tagset->tag('interpolate.embedded');
is( $tag->start(), '${', 'embedded tag start' );
is( $tag->end(), '}', 'embedded tag end' );
-$tag = $tags->[3];
-is( $tag->name(), 'escape', 'tag three is escape' );
+$tag = $tagset->tag('interpolate.escape');
is( ref $tag->start(), 'Regexp', 'escape tag regex' );
-__END__
-
-
-
-
-#========================================================================
-
#------------------------------------------------------------------------
# another subclass tag for testing regex tags
#------------------------------------------------------------------------
package Template::Test::Tag2;
-use base qw( Template::TT3::Tag );
+use base qw( Template::Tag::Closed );
#my $DEBUG = $main::DEBUG;
sub parse {
- my ($self, $textref, $document) = @_;
- my $match = $self->{ match };
- my $locn = $match->{ size } ? "$match->{ line }-" .
- ($match->{ line } + $match->{ size }) : $match->{ line };
- $document->body([ $match->{ start }, $textref, $locn,
- $match->{ end } ]);
- return $document;
+ my ($self, $textref, $handler, $match) = @_;
+ $handler->expr([ $match->{ start },
+ $self->location(),
+ $textref,
+ $match->{ end } ]);
+ return $handler;
}
package main;
@@ -290,67 +308,83 @@
end => qr/\/?>/,
});
-$scanner = $scanpkg->new( tags => $regtag );
+$scanner = $scanpkg->new({
+ tags => [ foobarbaz => $regtag ],
+ text => $texttag,
+});
ok( $scanner, 'created a regex scanner' );
-$doctext = "This is the first line of text
+$doctext =<<EOF;
+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";
+the end
+EOF
-$document = $docpkg->new( name => 'testdoc', text => $doctext );
-ok( $document, 'created a regex test document' );
-ok( $document->scan($scanner), 'scanned document' );
+$handler = $handpkg->new( type => 'test' );
+ok( $handler, 'created handler' );
-$body = $document->body();
-ok( $body, 'got document body' );
-is( ref $body, 'ARRAY', 'body is an ARRAY' );
+$handler = $scanner->scan(\$doctext, $handler)
+ || die $scanner->error();
+
+$body = $handler->end()
+ || die $handler->error();
+
+ok( $body, 'got a result' );
+
+print $scanner->dump_item($body) if $DEBUG;
+
+is ( $body->[0], 'test', 'body type test' );
+$body = $body->[1];
+
is( scalar @$body, 8, 'eight elements in body' );
+
+is_text_expr( $body->[0],
+ 'lines 1-2',
+ "This is the first line of text\nThe second line has ",
+ 'first body text OK' );
+
+is_foo_expr( $body->[1],
+ 'line 2',
+ 'embedded foo directive',
+ 'second body text OK' );
+
+is_text_expr( $body->[2],
+ 'lines 2-3',
+ " and\nthe next line has an ",
+ 'third body text OK' );
+
+is_bar_expr( $body->[3],
+ 'lines 3-6',
+ "embedded bar directive\nthat spans\nseveral\nlines",
+ 'fourth body text OK' );
-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' );
+is_text_expr( $body->[4],
+ 'lines 6-7',
+ " before going back to text.\n",
+ 'fifth body text OK' );
+
+is_foo_expr( $body->[5],
+ 'line 7',
+ "at the start",
+ 'sixth body text OK',
+ '/>' );
+
+is_baz_expr( $body->[6],
+ 'line 7',
+ "at the end",
+ 'seventh body text OK',
+ '/>' );
+
+is_text_expr( $body->[7],
+ 'lines 7-9',
+ "\nthe end\n",
+ 'eighth body text OK' );
@@ -358,74 +392,88 @@
# same again, but using similar regexes to attempt to confuse the scanner
#------------------------------------------------------------------------
-$footagobj = $tagpkg->new({
- name => 'footag',
- start => qr/<foo/,
- end => qr/\/>?/,
+$footag = $tagpkg->new({
+ start => qr/<foo:/,
+ end => qr/\/?>/,
});
-$bartagobj = $tagpkg->new({
- name => 'foobar',
- start => '<foobar',
+$bartag = $tagpkg->new({
+ start => '<foobar:',
end => '>',
});
-$baztagobj = $tagpkg->new({
- name => 'foobarbaz',
- start => '<foobarbaz',
+$baztag = $tagpkg->new({
+ start => '<foobarbaz:',
end => '>',
});
-$scanner = $scanpkg->new( tags => [ $footagobj, $bartagobj, $baztagobj ] );
+$scanner = $scanpkg->new({
+ tags => [ foo => $footag, bar => $bartag, baz => $baztag ],
+ text => $texttag,
+});
ok( $scanner, 'created a multiway scanner' );
-$doctext = "Hello <foo the foo directive/> and
-then <foobar the foo bar directive
+$doctext =<<EOF;
+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";
+<foobarbaz: the foo bar baz directive> the end
+EOF
+
+$handler = $handpkg->new( type => 'test' );
+ok( $handler, 'created handler' );
-$document = $docpkg->new( name => 'testdoc', text => $doctext );
-ok( $document, 'created a multi regex test document' );
-ok( $document->scan($scanner), 'scanned document' );
+$handler = $scanner->scan(\$doctext, $handler)
+ || die $scanner->error();
+$body = $handler->end()
+ || die $handler->error();
-$body = $document->body();
-ok( $body, 'got document body' );
-is( ref $body, 'ARRAY', 'body is an ARRAY' );
+ok( $body, 'got a result' );
+
+print $scanner->dump_item($body) if $DEBUG;
+
+is ( $body->[0], 'test', 'body type test' );
+$body = $body->[1];
+
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_text_expr( $body->[0],
+ 'line 1',
+ "Hello ",
+ 'first body text OK' );
+
+is_foo_expr( $body->[1],
+ 'line 1',
+ ' the foo directive',
+ 'foo 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' );
+is_text_expr( $body->[2],
+ 'lines 1-2',
+ " and\nthen ",
+ 'third body text OK' );
+
+is_foobar_expr( $body->[3],
+ 'lines 2-3',
+ " the foo bar directive\nthat spans two lines",
+ 'foobar text OK' );
+is_text_expr( $body->[4],
+ 'lines 3-4',
+ " then back to text.\n",
+ 'fifth body text OK' );
+
+is_foobarbaz_expr( $body->[5],
+ 'line 4',
+ " the foo bar baz directive",
+ 'sixth body text OK' );
+
+is_text_expr( $body->[6],
+ 'lines 4-5',
+ " the end\n",
+ 'seventh body text OK' );
+
@@ -434,23 +482,20 @@
#------------------------------------------------------------------------
package Template::Test::Tag3;
-use base qw( Template::TT3::Tag );
+use base qw( Template::Tag::Closed );
sub parse {
- my ($self, $textref, $document) = @_;
- my $match = $self->{ match };
- my $locn = $match->{ size } ? "$match->{ line }-" .
- ($match->{ line } + $match->{ size }) : $match->{ line };
-
- $document->body([ $self->{ name }, $textref, $locn,
- $match->{ start }, $match->{ end } ]);
- return $document;
+ my ($self, $textref, $handler, $match) = @_;
+ $handler->expr([ $match->{ start },
+ $self->location(),
+ $textref,
+ $match->{ end } ]);
+ return $handler;
}
package main;
-@$deftags = ();
-$scanpkg = 'Template::TT3::Scanner';
+$scanpkg = 'Template::Scanner';
$tagpkg = 'Template::Test::Tag3';
my $podtag = $tagpkg->new({
@@ -459,16 +504,30 @@
end => qr/(?m:^=cut\s)/,
});
-my $texttag = $tagpkg->new({
- name => 'greedy',
+my $greedytag = $tagpkg->new({
+ name => 'text',
start => qr/(?m:^=text\s*)/,
end => qr/$/,
});
-$scanner = $scanpkg->new( tags => [ $texttag, $podtag ] );
+$scanner = $scanpkg->new({
+ tags => [ greedy => $greedytag, pod => $podtag ],
+ text => $texttag,
+});
ok( $scanner, 'created a text/pod scanner' );
+
-$doctext = "Hello
+sub is_pod_tag {
+ is_xxx_expr( pod => '=pod ', @_, "=cut\n" );
+}
+
+sub is_text_tag {
+ is_xxx_expr( text => '=text ', @_, '' );
+}
+
+
+$doctext =<<EOF;
+Hello
=pod this is pod
more pod
=cut
@@ -478,97 +537,50 @@
continues to the
=pod end
=cut makes no difference
-still plain text";
+still plain text
+EOF
-$document = $docpkg->new( name => 'textpod', text => $doctext );
-ok( $document, 'created a text / pod test document' );
-ok( $document->scan($scanner), 'scanned text / pod document' );
+chomp $doctext;
-$body = $document->body();
-ok( $body, 'got document body' );
+$handler = $handpkg->new( type => 'test' );
+ok( $handler, 'created handler' );
-dump_body($body) if $DEBUG;
+$handler = $scanner->scan(\$doctext, $handler)
+ || die $scanner->error();
-is( ref $body, 'ARRAY', 'body is an ARRAY' );
-is( scalar @$body, 4, 'four elements in body' );
+$body = $handler->end()
+ || die $handler->error();
-is( $body->[0]->[0], 'text', 'first body is text' );
-is( $body->[1]->[0], 'pod', 'second body is pod' );
-is( $body->[2]->[0], 'text', 'third body is text' );
-is( $body->[3]->[0], 'greedy', 'fourth body is greedy' );
-
-is( ${ $body->[0]->[1] }, "Hello\n", 'first body text OK' );
-is( ${ $body->[1]->[1] }, "this is pod\nmore pod\n", 'second body text OK' );
-is( ${ $body->[2]->[1] }, "some regular text\n", 'third body text OK' );
-is( ${ $body->[3]->[1] }, "now a text\nsection which\ncontinues to the\n=pod end\n=cut makes no difference\nstill plain text", 'fourth body text OK' );
-
-is( $body->[1]->[2], "2-5", 'second line OK' );
-is( $body->[1]->[3], "=pod ", 'second start OK' );
-is( $body->[1]->[4], "=cut\n", 'second end OK' );
-
-is( $body->[3]->[2], "6-11", 'fourth line OK' );
-is( $body->[3]->[3], "=text ", 'fourth start OK' );
-is( $body->[3]->[4], "", 'fourth end OK' );
+ok( $body, 'got a result' );
+print $scanner->dump_item($body) if $DEBUG;
-#========================================================================
+is ( $body->[0], 'test', 'body type test' );
+$body = $body->[1];
-exit(0);
+is( ref $body, 'ARRAY', 'body is an ARRAY' );
+is( scalar @$body, 4, 'four elements in body' );
-#========================================================================
+is_text_expr( $body->[0],
+ 'lines 1-2',
+ "Hello\n",
+ 'first pod body is text' );
+
+is_pod_tag( $body->[1],
+ 'lines 2-5',
+ "this is pod\nmore pod\n",
+ 'second pod body is pod');
+
+is_text_expr( $body->[2],
+ 'lines 5-6',
+ "some regular text\n",
+ 'third pod body is text' );
+
+is_text_tag( $body->[3],
+ 'lines 6-11',
+ "now a text\nsection which\ncontinues to the\n=pod end\n=cut makes no difference\nstill plain text",
+ 'fourth pod body is text' );
-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' );
-
-
-sub dump_body {
- my $body = shift;
-
- foreach my $b (@$body) {
- my ($type, $text, $posn) = @$b;
- if ($type eq 'text') {
- print STDERR "text at $posn [", short_text($$text), "]\n";
- }
- else {
- print STDERR "$type at $posn [$text]\n"; #", short_text($$text),"] at $posn\n",
- }
- }
-}
-
-sub short_text {
- my $text = shift;
- my $newtext = $text;
- $newtext =~ s/\n/\\n/g;
- $newtext = substr($newtext, 0, 132);
- $newtext .= '...' if length($text) > length($newtext);
- return $newtext;
-}
-__END__