File: 40parse.t

package info (click to toggle)
libmail-box-perl 2.117-1
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 3,828 kB
  • ctags: 1,564
  • sloc: perl: 23,381; makefile: 2
file content (89 lines) | stat: -rw-r--r-- 2,199 bytes parent folder | download | duplicates (3)
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
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
#!/usr/bin/env perl
#
# Test processing of general parsing of fields
#

use strict;
use warnings;

package Mail::Message::Field::Full;   # define package name
package main;

use lib qw(. .. tests);
use Tools;

use Test::More;

BEGIN {
   if($] < 5.007003)
   {   plan skip_all => "Requires module Encode which requires Perl 5.7.3";
       exit 0;
   }

   eval 'require Mail::Message::Field::Full';
   if($@)
   {
warn $@;
       plan skip_all => 'Extended attributes not available (install Encode?)';
       exit 0;
   }
   else
   {   plan 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>'            => [ undef, '((a)b(c) <tux>' ]
 , '(a\(b) <tux>'              => [ 'a(b', ' <tux>' ]
 , '(a <tux>'                  => [ undef, '(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);
}

#