File: test_addrlist.tcl

package info (click to toggle)
tkrat 1%3A2.2cvs20100105-true-dfsg-6.1
  • links: PTS, VCS
  • area: main
  • in suites: stretch
  • size: 10,340 kB
  • ctags: 9,259
  • sloc: ansic: 96,057; tcl: 25,667; makefile: 1,638; sh: 282
file content (96 lines) | stat: -rw-r--r-- 2,830 bytes parent folder | download | duplicates (4)
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
90
91
92
93
94
95
96
puts "$HEAD Test addrlist"

namespace eval test_addrlist {
}

# Test one explicit mapping request
proc test_addrlist::test_match {match max expected} {
    global verbose
    variable addresses

    StartTest "Matching '$match'"
    set ret [GetMatchingAddrs $match $max]
    set mismatch 0
    if {[llength $ret] != [llength $expected]} {
        set mismatch 1
    }
    for {set i 0} {0 == $mismatch && $i < [llength $ret]} {incr i} {
        if {[lindex $ret $i] != [lindex $addresses [lindex $expected $i]]} {
            set mismatch 1
        }
    }
    if {$mismatch} {
        ReportError "Bad result"
        if {$verbose} {
            puts "Got [llength $ret] element(s)"
            foreach e $ret {
                puts "  $e"
            }
            puts "Expected [llength $expected] element(s)"
            foreach ei $expected {
                puts "  [lindex $addresses $ei]"
            }
        }
    }
}

# Test the address list
proc test_addrlist::test_addrlist {} {
    global option
    variable addresses

    AddrListAdd "Apple Core <applet@tkrat.org>"
    AddrListAdd "apa@tkrat.org, adam@tkrat.org (Adam Somebody)"
    AddrListAdd "Martin Forssen <maf@tkrat.org>"
    
    set addresses [list \
                       "Martin Forssen <maf@tkrat.org>" \
                       "apa@tkrat.org" \
                       "Adam Somebody <adam@tkrat.org>" \
                       "Apple Core <applet@tkrat.org>"]

    test_match m 10 {0}
    test_match ma 10 {0}
    test_match a 10 {1 2 3}
    test_match ap 10 {1 3}
    test_match a 1 {1}

    AddrListAdd "Apple Core <applet@tkrat.org>"
    test_match a 10 {3 1 2}
}

# Test parsing of addresses
proc test_addrlist::test_addrparse {} {
    global option

    # Setup roles
    set option(tr0,from) test@foo.com
    set option(tr1,from) test@bar.com

    # Setup tests
    set tests {
        {"rcpt" "rcpt@foo.com" "rcpt@bar.com" "rcpt"}
        {"rcpt@foo.com" "rcpt@foo.com" "rcpt@foo.com" "rcpt@foo.com"}
        {"rcpt@bar.com" "rcpt@bar.com" "rcpt@bar.com" "rcpt@bar.com"}
        {"rcpt@apa.com" "rcpt@apa.com" "rcpt@apa.com" "rcpt@apa.com"}
    }

    foreach t $tests {
        StartTest "Parsing [lindex $t 0]"
        set a [RatCreateAddress [lindex $t 0] tr0]
        if {[$a get mail] != [lindex $t 1]} {
            ReportError "tr0: got '[$a get mail]' expected '[lindex $t 1]'"
        }
        set a [RatCreateAddress [lindex $t 0] tr1]
        if {[$a get mail] != [lindex $t 2]} {
            ReportError "tr1: got '[$a get mail]' expected '[lindex $t 2]'"
        }
        set a [RatCreateAddress -nodomain [lindex $t 0]]
        if {[$a get mail] != [lindex $t 3]} {
            ReportError "nodomain: got '[$a get mail]' expected '[lindex $t 3]'"
        }
    }
}

test_addrlist::test_addrlist
test_addrlist::test_addrparse