# Features covered: tnc interface. # # This file contains a collection of tests of the tnc command. This tests # are primary there to test the tcl interface of the tnc command and the # validation commands. # # tnc-1.*: Basics # tnc-2.*: Parsing with tnc enabled # tnc-3.*: ValidationCmds # tnc-4.*: parser uses -useForeignDTD # # Copyright (c) 2003 Rolf Ade. set testDir [file dir [info script]] source [file join $testDir loadtnc.tcl] set xml { ]> texttextmore text } test tnc-1.1 {tnc enable} { set parser [expat] tnc $parser enable $parser free set result "" } {} test tnc-1.2 {tnc enable} { expat parser tnc parser enable parser free set result "" } {} test tnc-1.3 {try to enable tnc for an already tnc enabled parser} { set parser [expat] tnc $parser enable set result [catch {tnc $parser enable}] $parser free set result } {1} test tnc-1.4 {tnc - first arg isn't a parser} { set errMsg "" set result [catch {tnc foo enable} errMsg] list $result $errMsg } {1 {First argument has to be a expat parser object}} test tnc-1.5 {tnc - wrong method name (second arg)} { set parser [expat] set errMsg "" set result [catch {tnc $parser foobaz} errMsg] $parser free list $result $errMsg } {1 {bad method "foobaz": must be enable, remove, or getValidateCmd}} test tnc-2.1 {parse with tnc enabled} { set parser [expat] tnc $parser enable set result [catch {$parser parse $xml}] $parser free set result } {0} test tnc-2.2 {parse with tnc enabled} { set parser [expat] tnc $parser enable set result [catch {$parser parse $xml}] $parser free set result } {0} test tnc-2.3 {parse with tnc enabled} { set parser [expat] tnc $parser enable set result [catch {$parser parse $xml}] $parser free set result } {0} # This is like $xml, only with wrong root element set xmlWrong { ]> texttextmore text } test tnc-2.4 {parse with tnc enable - wrong document element} { set parser [expat] tnc $parser enable set errMsg "" set result [catch {$parser parse $xmlWrong} errMsg] $parser free lappend result $errMsg } {1 {Validation error at line 6, character 0: No declaration for this element.}} test tnc-2.5 {invalid DTD} { set parser [expat] tnc $parser enable set result [catch {$parser parse { ]> texttextmore text }}] $parser free set result } {1} test tnc-2.6 {invalid document} { set parser [expat] tnc $parser enable set errMsg "" set result [catch {$parser parse { ]> }} errMsg] $parser free set result } {1} test tnc-2.7 {not valid document} { set parser [expat] tnc $parser enable set result [catch {$parser parse { ]> text}} errMsg] $parser free set errMsg } {Validation error at line 6, character 17: Element can not end here (required element(s) missing).} proc 2.8-resolver {base systemId publicId} { switch $publicId { "-//W3C//DTD Specification V2.0//EN" { set fd [open [file join [file dir [info script]] \ ../../../tests/data/xmlspec-v20.dtd]] set xmlspec [read $fd] close $fd return [list "string" "" $xmlspec] } default { puts stderr "Unexpected systemId '$systemId'" return "" } } } test tnc-2.8 {Validate REC-xslt-19991116.xml} { set ::tDOM::extRefHandlerDebug 1 set parser [expat -externalentitycommand 2.8-resolver \ -paramentityparsing always] tnc $parser enable $parser parsefile [file join [file dir [info script]] \ ../../../tests/data/REC-xslt-19991116.xml] $parser free } {} test tnc-2.9 {check #PCDATA only element} { set parser [expat] tnc $parser enable set result [catch {$parser parse { ]> texttext}} errMsg] $parser free set errMsg } {Validation error at line 6, character 13: Element is not allowed here.} test tnc-3.1 {validate cmd} { set parser [expat] tnc $parser enable set result [catch {$parser parse $xml}] set validator [tnc $parser getValidateCmd] rename $validator {} $parser free set result } {0} test tnc-3.2 {validate cmd} { set parser [expat] tnc $parser enable set result [catch {$parser parse $xml}] set validator [tnc $parser getValidateCmd] $parser free rename $validator {} set result } {0} test tnc-3.3 {validate cmd} { set parser [expat] tnc $parser enable set result [catch {$parser parse $xml}] set validator [tnc $parser getValidateCmd] $parser reset lappend result [catch {$parser parse $xml}] rename $validator {} $parser free set result } {0 0} test tnc-3.4 {validate cmd} { set parser [expat] tnc $parser enable tdom $parser enable $parser parse $xml set validator [tnc $parser getValidateCmd] set doc [tdom $parser getdoc] $parser free set result [catch {$validator validateTree [$doc documentElement]} errMsg] rename $validator {} $doc delete if {$result} { set errMsg } else { set result } } {0} test tnc-3.5 {validate cmd} { set parser [expat] tnc $parser enable tdom $parser enable $parser parse $xml set validator [tnc $parser getValidateCmd] tnc $parser remove $parser reset $parser parse $xml set doc [tdom $parser getdoc] $parser free set result [catch {$validator validateTree [$doc documentElement]} errMsg] rename $validator {} $doc delete if {$result} { set errMsg } else { set result } } {0} test tnc-3.6 {validate cmd} { set parser [expat] tnc $parser enable tdom $parser enable $parser parse $xml set validator [tnc $parser getValidateCmd] tnc $parser remove $parser reset $parser parse $xml set doc [tdom $parser getdoc] $parser free set root [$doc documentElement] set result [catch {$validator validateTree $root}] foreach child [$root childNodes] { if {[$child nodeType] == "ELEMENT_NODE"} { lappend result [catch {$validator validateTree $child}] } } rename $validator {} $doc delete set result } {0 0 0} test tnc-3.7 {validate cmd} { set parser [expat] tnc $parser enable set result [catch {$parser parse $xmlWrong}] set validator [tnc $parser getValidateCmd] $parser free set doc [dom parse $xml] set root [$doc documentElement] lappend result [catch {$validator validateTree $root}] lappend result [catch {$validator validateDocument $doc}] $validator delete $doc delete set result } {1 0 0} test tnc-3.8 {validator cmd generated from not-wellformed document with well-formed DTD} { set parser [expat] tnc $parser enable set errMsg "" catch {$parser parse { ]> }} tnc $parser getValidateCmd validator set doc [dom parse $xml] set result [validator validateDocument $doc] $parser free validator delete $doc delete set result } {1} test tnc-3.9 {validator cmd - validation error info} { set parser [expat] tnc $parser enable $parser parse $xml tnc $parser getValidateCmd validator $parser free set doc [dom parse $xml] set result [validator validateDocument $doc errInfo] validator delete $doc delete set result lappend result $errInfo } {1 {}} test tnc-3.10 {validator cmd - validation error info} { set parser [expat] tnc $parser enable $parser parse $xml tnc $parser getValidateCmd validator $parser free set doc [dom parse $xml] set errInfo "something" set result [validator validateDocument $doc errInfo] validator delete $doc delete set result lappend result $errInfo } {1 {}} test tnc-3.11 {validator cmd - validation error info} { set parser [expat] tnc $parser enable $parser parse $xml tnc $parser getValidateCmd validator $parser free set doc [dom parse $xmlWrong] set result [validator validateDocument $doc errInfo] validator delete $doc delete set result lappend result $errInfo } {0 {Root element doesn't match DOCTYPE name.}} test tnc-3.12 {validator cmd - validation error info} { set parser [expat] tnc $parser enable $parser parse $xml tnc $parser getValidateCmd validator $parser free set doc [dom parse $xml] set root [$doc documentElement] $root appendChild [$doc createElement wrong] set result [validator validateDocument $doc errInfo] lappend result $errInfo lappend result [validator validateTree $root errInfo] lappend result $errInfo validator delete $doc delete set result } {0 {No declaration for this element.} 0 {No declaration for this element.}} set xmlID { ]> } test tnc-3.13 {validator cmd - validateDocument with ID's} { set parser [expat] tnc $parser enable tdom $parser enable $parser parse $xmlID set validator [tnc $parser getValidateCmd] set doc [tdom $parser getdoc] $parser free set result [$validator validateDocument $doc errInfo] lappend result $errInfo set root [$doc documentElement] $root setAttribute id "id1" lappend result [$validator validateTree $root errInfo] lappend result $errInfo lappend result [$validator validateDocument $doc errInfo] lappend result $errInfo $doc delete $validator delete set result } {1 {} 0 {ID attribute values must be unique within the document.} 0 {ID attribute values must be unique within the document.}} test tnc-3.14 {validator cmd - validateAttributes} { set parser [expat] tnc $parser enable tdom $parser enable $parser parse $xmlID set validator [tnc $parser getValidateCmd] set doc [tdom $parser getdoc] $parser free set root [$doc documentElement] $root setAttribute wrongAtt "id1" set result [$validator validateAttributes $root errInfo] lappend result $errInfo $doc delete $validator delete set result } {0 {Unknown attribute for this element.}} proc extrefhandler-4.1 {base systemId publicId} { if {$systemId == ""} { return [list "string" $base { }] } else { error "error in tnc-4.1" } } test tnc-4.1 {document has no DTD, DTD provided via -useForeignDTD} { set parser [expat -externalentitycommand extrefhandler-4.1 \ -paramentityparsing always \ -useForeignDTD 1] tnc $parser enable $parser parse { texttextmore text } $parser free set result 1 } {1} proc extrefhandler-4.2 {base systemId publicId} { global parser if {$systemId == ""} { tnc $parser remove return [list string $base ""] } else { error "error in tnc-4.2" } } test tnc-4.2 {remove tnc from parser in extrefhandler} { set parser [expat -externalentitycommand extrefhandler-4.2 \ -paramentityparsing always \ -useForeignDTD 1] tnc $parser enable $parser parse $parser free set result 1 } {1} # cleanup ::tcltest::cleanupTests return