« back to all changes in this revision
Viewing changes to t/base.t
- browse files at revision 1
- compare with another revision
- download diff
- download tarball
- view history from revision 1
- Committer: Bazaar Package Importer
- Author(s): Sam Johnston
- Date: 2004-02-18 17:44:54 UTC
- Revision ID: james.westby@ubuntu.com-20040218174454-hgevegftws121kgv
Tags: upstream-0.71
Import upstream version 0.71
- files added:
- lib
- lib/Text
- t
added
removed
t/base.t
1
#!/usr/bin/perl -w
2
3
BEGIN
4
{
5
chdir 't' if -d 't';
6
use lib '../lib', '../blib/lib';
7
}
8
9
use strict;
10
11
use Test::More tests => 26;
12
13
my $module = 'Text::WikiFormat';
14
use_ok( $module ) or exit;
15
16
can_ok( $module, 'start_block' );
17
my $text =<<END_WIKI;
18
= heading =
19
20
* unordered item
21
1. ordered item
22
23
some code
24
25
a normal paragraph
26
27
END_WIKI
28
29
sub fetchsub
30
{
31
return $module->can( $_[0] );
32
}
33
34
my $tags = \%Text::WikiFormat::tags;
35
local *Text::WikiFormat::tags = $tags;
36
37
my $sb = fetchsub( 'start_block' );
38
my ($result) = $sb->( '= heading =', $tags );
39
40
is_deeply( $result,
41
{ type => 'header', args => [ '=', 'heading' ],
42
text => '', level => 0 },
43
'start_block() should find headings' );
44
45
($result) = $sb->( ' * unordered item', $tags );
46
is_deeply( $result,
47
{ type => 'unordered', args => [], text => 'unordered item', level => 2 },
48
'... and unordered list' );
49
50
($result) = $sb->( ' 6. ordered item', $tags );
51
is_deeply( $result,
52
{ type => 'ordered', args => [ 6 ], text => 'ordered item', level => 2 },
53
'... and ordered list' );
54
55
($result) = $sb->( ' some code', $tags );
56
is_deeply( $result,
57
{ type => 'code', args => [], text => 'some code', level => 0 },
58
'... and code' );
59
60
($result) = $sb->( 'paragraph', $tags );
61
is_deeply( $result,
62
{ type => 'paragraph', args => [], text => 'paragraph', level => 0 },
63
'... and paragraph' );
64
65
can_ok( $module, 'merge_blocks' );
66
my $mb = fetchsub( 'merge_blocks' );
67
my @result = $mb->(
68
[{ type => 'code', text => 'a', level => 1 },
69
{ type => 'code', text => 'b', level => 1 },
70
], $tags
71
);
72
is( @result, 1, 'merge_blocks() should merge identical blocks together' );
73
is_deeply( $result[0]{text}, [qw( a b )], '... merging their text' );
74
75
@result = $mb->([
76
{ type => 'unordered', text => 'foo', level => 1 },
77
{ type => 'unordered', text => 'bar', level => 1 },
78
], $tags);
79
is( @result, 1, '... merging unordered blocks' );
80
is_deeply( $result[0]{text}, [qw( foo bar)], '... and their text' );
81
82
@result = $mb->([
83
{ type => 'ordered', text => 'foo', level => 2 },
84
{ type => 'ordered', text => 'bar', level => 3 },
85
], $tags);
86
is( @result, 2, '... not merging blocks at different levels' );
87
88
can_ok( $module, 'process_blocks' );
89
my $pb = fetchsub( 'process_blocks' );
90
@result = $pb->(
91
[{ type => 'header', text => [ '' ], level => 0,
92
args => [[ '==', 'my header' ]] },
93
{ type => 'paragraph', text => [qw( my lines of text )], level => 0 },
94
{ type => 'ordered', text => [qw( my ordered lines ),
95
{ type => 'unordered', text => [qw( my unordered lines )], level => 2 },
96
], level => 1, args => [[ 2 ], [ 3 ], [ 5 ]] },
97
], $tags
98
);
99
100
is( @result, 1, 'process_blocks() should return processed text' );
101
$result = $result[0];
102
like( $result, qr!<h2>my header</h2>!, '... marking header' );
103
like( $result, qr!<p>my<br />.+text</p>\n!s, '... paragraph' );
104
like( $result, qr!<li value="2">my</li>.+5">lines!s, '... ordered list' );
105
like( $result, qr!<ul>\n<li>my</li>!m, '... and unordered list' );
106
like( $result, qr!</li>\n</ul>\n</li>\n</ol>!, '... nesting properly' );
107
108
my $f = fetchsub( 'format' );
109
my $fullresult = $f->(<<END_WIKI, $tags);
110
== my header ==
111
112
my
113
lines
114
of
115
text
116
117
2. my
118
3. ordered
119
5. lines
120
* my
121
* unordered
122
* lines
123
END_WIKI
124
125
is( $fullresult, $result, 'format() should give same results' );
126
127
$fullresult = $f->(<<END_WIKI, $tags);
128
= heading =
129
130
* aliases can expire
131
* use the Expires directive
132
* no messages sent after the expiration date
133
* aliases can be closed
134
* use the Closed directive
135
* messages allowed only from people on the list
136
* aliases can auto-add people
137
* use the Auto-add directive
138
* anyone in the Cc line is added to the alias
139
* they won't get duplicates
140
* makes "just reply to alias" easier
141
142
END_WIKI
143
144
like( $fullresult, qr!expire<ul>!, 'nested list should start immediately' );
145
like( $fullresult, qr!date</li>\n</ul>!, '... ending after last nested item' );
146
147
can_ok( $module, 'check_blocks' );
148
149
my @warnings;
150
local $SIG{__WARN__} = sub {
151
push @warnings, shift;
152
};
153
154
my $cb = \&Text::WikiFormat::check_blocks;
155
my $newtags = {
156
blocks => { foo => 1, bar => 1, baz => 1 },
157
blockorder => [qw( bar baz )],
158
};
159
$cb->( $newtags );
160
my $warning = shift @warnings;
161
like( $warning, qr/No order specified for blocks 'foo'/,
162
'check_blocks() should warn if block is not ordered' );
163
164
$newtags->{blockorder} = [ 'baz' ];
165
$cb->( $newtags );
166
$warning = shift @warnings;
167
ok( $warning =~ /foo/ && $warning =~ /bar/, '... for all missing blocks' )
168
or diag( $warning );
Loggerhead is a web-based interface for Breezy
Version: 2.0.1