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
|
# dns.test - Copyright (C) 2002 Pat Thoyts <patthoyts@users.sourceforge.net>
#
# Tests for the Tcllib dns package
#
# -------------------------------------------------------------------------
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# -------------------------------------------------------------------------
# RCS: @(#) $Id: dns.test,v 1.3 2004/01/15 06:36:12 andreas_kupries Exp $
# -------------------------------------------------------------------------
# Initialise the test package
#
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import ::tcltest::*
}
# -------------------------------------------------------------------------
# Ensure we test _this_ local copy and one installed somewhere else.
#
package forget dns
catch {namespace delete ::dns}
if {[catch {source [file join [file dirname [info script]] dns.tcl]} msg]} {
puts "skipped [file tail [info script]]: $msg"
return
}
# -------------------------------------------------------------------------
# Helpers
# -------------------------------------------------------------------------
proc ::OrderedArrayGet {arrayName} {
upvar $arrayName a
set result {}
foreach name [lsort [array names a]] {
lappend result $name $a($name)
}
return $result
}
# -------------------------------------------------------------------------
# Tests
# -------------------------------------------------------------------------
# Test the dns uri scheme split and join methods.
set urls {
1 dns:www.example.org
{class {} nameserver {} port {} query www.example.org scheme dns type {}}
2 dns://nameserver/www.example.org
{class {} nameserver nameserver port {} query www.example.org scheme dns type {}}
3 dns://nameserver:53/www.example.org
{class {} nameserver nameserver port 53 query www.example.org scheme dns type {}}
4 dns:www.example.org?class=IN
{class IN nameserver {} port {} query www.example.org scheme dns type {}}
5 dns:www.example.org?type=MX
{class {} nameserver {} port {} query www.example.org scheme dns type MX}
6 dns:www.example.org?class=IN;type=A
{class IN nameserver {} port {} query www.example.org scheme dns type A}
7 dns:www.example.org?type=A;class=IN
{class IN nameserver {} port {} query www.example.org scheme dns type A}
}
foreach {ndx url check} $urls {
test dns-1.$ndx [list uri::split $url] {
if {![catch {uri::split $url} result]} {
if {![catch {array set URL $result} result]} {
set result [OrderedArrayGet URL]
}
}
set result
} $check
}
foreach {ndx url check} $urls {
if {$ndx == 6} continue; # this test is bogus for join.
test dns-2.$ndx [list uri::join $url] {
catch {eval [list uri::join] $check} result
set result
} $url
}
# -------------------------------------------------------------------------
rename ::OrderedArrayGet {}
::tcltest::cleanupTests
# Local Variables:
# mode: tcl
# indent-tabs-mode: nil
# End:
|
