# urn.test - Copyright (C) 2001 Pat Thoyts <Pat.Thoyts@bigfoot.com>
#
# Provide a set of tests to excercise the urn-scheme package.
#
# @(#)$Id: urn.test,v 1.5 2004/08/03 09:25:10 patthoyts 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 uri::urn
package forget uri
catch {
    namespace delete ::uri::urn
    namespace delete ::uri
}
if {[catch {source [file join [file dirname [info script]] uri.tcl]} msg]} {
    puts "skipped [file tail [info script]]: $msg"
    return
}
if {[catch {source [file join [file dirname [info script]] urn-scheme.tcl]} msg]} {
    puts "skipped [file tail [info script]]: $msg"
    return
}

# -------------------------------------------------------------------------
# Setup any constraints
#

# -------------------------------------------------------------------------
# Now the package specific tests....
# -------------------------------------------------------------------------

package require struct
puts "- uri::urn [package present uri::urn]"
puts "- uri [package present uri]"

# -------------------------------------------------------------------------

# Takes a dictionary, returns a list containing the same dictionary,
# however the keys are sorted alphabetically. This allows for a true
# comparison of dictionary results.

proc dictsort {dict} {
    array set a $dict
    set out [list]
    foreach key [lsort [array names a]] {
	lappend out $key $a($key)
    }
    return $out
}

# -------------------------------------------------------------------------

# Tests to check for valid urn sections.

test urn-1.1 {Check basic split} {
    catch {uri::split urn:tcl:test} result
    dictsort $result
} {nid tcl nss test scheme urn}

test urn-1.2 {Check basic join} {
    catch {uri::join scheme urn nid tcl nss test} result
    set result
} {urn:tcl:test}

test urn-1.3 {Split permissible NID} {
    catch {uri::split urn:tcl-TCL-0123456789:test} result
    dictsort $result
} {nid tcl-TCL-0123456789 nss test scheme urn}

test urn-1.4 {Join permissible NID} {
    catch {uri::join scheme urn nid tcl-TCL-0123456789 nss test} result
    set result
} {urn:tcl-TCL-0123456789:test}

test urn-1.5 {Split permissible NSS} {
    catch {uri::split {urn:tcl:Test-0123456789()+,-.:=@;$_!*'}} result
    dictsort $result
} {nid tcl nss {Test-0123456789()+,-.:=@;$_!*'} scheme urn}

test urn-1.6 {Join permissible NSS} {
    catch {uri::join scheme urn nid tcl nss {Test-0123456789()+,-.:=@;$_!*'}} result
    set result
} {urn:tcl:Test-0123456789()+,-.:=@;$_!*'}

# -------------------------------------------------------------------------
# Now some tests that should fail.

test urn-2.1 {NID too long} {
    set nid ThisURNNIDparthastoomanycharacters
    set nss test
    if {[catch {uri:split urn:$nid:$nss} result]} {
        set result ok
    }
    set result
} {ok}

test urn-2.2 {NID too long} {
    set nid ThisURNNIDparthastoomanycharacters
    set nss test
    if {[catch {uri:join scheme urn nid $nid nss $nss} result]} {
        set result ok
    }
    set result
} {ok}

test urn-2.3 {NID containing invalid characters} {
    set nid {This-NID//notOK}
    set nss test
    if {[catch {uri::join scheme urn nid $nid nss $nss} result]} {
        set result ok
    }
    set result
} {ok}

test urn-2.4 {NID containing no characters} {
    set nid {}
    set nss test
    if {[catch {uri::join scheme urn nid $nid nss $nss} result]} {
        set result ok
    }
    set result
} {ok}

test urn-2.5 {NID beginning with hyphen} {
    set nid {-notvalid}
    set nss test
    if {[catch {uri::join scheme urn nid $nid nss $nss} result]} {
        set result ok
    }
    set result
} {ok}


# Check the Namespace Specific String.

test urn-3.1 {NSS containing reserved characters} {
    set nid {tcl}
    set nss {%}
    catch {uri::join scheme urn nid $nid nss $nss} result
    set result
} {urn:tcl:%25}

test urn-3.2 {NSS containing reserved characters} {
    set nid {tcl}
    set nss {/?#}
    catch {uri::join scheme urn nid $nid nss $nss} result
    set result
} {urn:tcl:%2F%3F%23}

test urn-3.3 {NSS containing reserved characters} {
    set nid {tcl}
    set nss {urn-test}
    catch {uri::join scheme urn nid $nid nss $nss} result
    set result
} {urn:tcl:urn-test}

test urn-3.4 {NSS containing illegal characters} {
    set nid {tcl}
    set nss "\u00" ;# 0 is the only character explicitly denied.
    if {[catch {uri::join scheme urn nid $nid nss $nss} result]} {
        set result ok
    }
    set result
} {ok}

# -------------------------------------------------------------------------
# Quoting checks - various UTF-8 representations for 'coffee' (RFC 2324)
#
set data \
    [list \
         "coffee"                           "coffee" \
         "\x4B\x61\x66\x66\x65\x65"         "Kaffee" \
         "\x71\xC3\xA6\x68\x76\xC3\xA6"     "q%C3%A6hv%C3%A6" \
         "\xD9\x82\xD9\x87\xD9\x88\xD8\xA9" "%D9%82%D9%87%D9%88%D8%A9" \
         "\xCE\xBA\xCE\xB1\xCF\x86\xCE\xAD" "%CE%BA%CE%B1%CF%86%CE%AD" \
         "\xE0\xA4\x95\xE0\xA5\x8C\xE0\xA4\xAB\xE0\xA5\x80" \
                                "%E0%A4%95%E0%A5%8C%E0%A4%AB%E0%A5%80" \
        ]

set n 0
foreach {utf8 quoted} $data {
    test urn-4.[incr n] [list quote utf8 string] {
        list [catch {uri::urn::quote $utf8} msg] $msg
    } [list 0 $quoted]
}

set n 0
foreach {utf8 quoted} $data {
    test urn-5.[incr n] [list unquote utf8 string] {
        list [catch {uri::urn::unquote $quoted} msg] $msg
    } [list 0 $utf8]
}

# -------------------------------------------------------------------------
# Clean up the tests

::tcltest::cleanupTests
return

# Local variables:
#    mode: tcl
#    indent-tabs-mode: nil
# End: