1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
|
#!/usr/bin/env perl
#
# Test processing of general parsing of fields
#
use strict;
use warnings;
use Mail::Message::Test;
use Mail::Message::Field::Full;
use Test::More tests => 38;
my $mmff = 'Mail::Message::Field::Full';
#
# Test consuming phrases
#
my @tests =
( 'hi! this is me <tux>' => ['hi! this is me', '<tux>' ]
, ' aap, noot <tux>' => ['aap', ', noot <tux>' ]
, '" aap, noot " <tux>' => [' aap, noot ', ' <tux>' ]
, '"aap", "noot"' => ['aap', ', "noot"' ]
, '"a\\"b\\"c" d' => ['a"b"c', ' d' ]
, '"\\"b\\"" d' => ['"b"', ' d' ]
, '"a\\)b\\(c" d' => ['a\\)b\\(c', ' d' ]
, '<tux>' => [ undef, '<tux>' ]
, ' <tux>' => [ undef, '<tux>' ]
, '" " <tux>' => [ ' ', ' <tux>' ]
);
while(@tests)
{ my ($from, $to) = (shift @tests, shift @tests);
my ($exp_phrase, $exp_rest) = @$to;
my ($phrase, $rest) = $mmff->consumePhrase($from);
is($phrase, $exp_phrase, $from);
is($rest, $exp_rest, $from);
}
#
# Test consuming comments
#
@tests =
( '(this is a comment) <tux>' => [ 'this is a comment', ' <tux>' ]
, '(this)' => [ 'this', '' ]
, 'this' => [ undef, 'this' ]
, ' (a(b)c) <tux>' => [ 'a(b)c', ' <tux>' ]
, '((a)b(c)) <tux>' => [ '(a)b(c)', ' <tux>' ]
, '((a)b(c) <tux>' => [ '(a)b(c', ' <tux>' ]
, '(a\(b) <tux>' => [ 'a(b', ' <tux>' ]
, '(a <tux>' => [ 'a <tux>', '' ]
, 'a) <tux>' => [ undef, 'a) <tux>' ]
);
while(@tests)
{ my ($from, $to) = (shift @tests, shift @tests);
my ($exp_comment, $exp_rest) = @$to;
my ($comment, $rest) = $mmff->consumeComment($from);
is($comment, $exp_comment, $from);
is($rest, $exp_rest, $from);
}
#
|
