# Features covered: comments # # This file contains a collection of tests for the TclXML parser. # This file tests the parser's performance on comments. # Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright (c) 1998-2000 Zveno Pty Ltd. # # $Id: comment.test,v 1.4 2001/02/06 07:29:51 doss Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } if { ![llength [info commands ::xml::parser]] } { catch {puts stderr "You havent loaded a valid parser class before running this test"} return } catch {unset result} proc pcdata data { append ::result $data } proc comment data { append ::comment $data } proc Estart {tagName attrList} { switch -- $tagName { test - Test { } default { incr ::element } } } proc EStop tagname { } test comment-1.1 {Simple comment} { set ::result {} set ::comment {} set ::element 0 catch {rename xml::comment-1.1 {}} set parser [xml::parser comment-1.1 \ -elementstartcommand Estart \ -elementendcommand EStop \ -characterdatacommand pcdata \ -commentcommand comment] $parser parse { } list $::comment $::result $::element } {{ This is a comment } {} 0} test comment-1.2 {Simple comment, no white space} { set ::result {} set ::comment {} set ::element 0 catch {rename xml::comment-1.2 {}} set parser [xml::parser comment-1.2 \ -elementstartcommand Estart \ -elementendcommand EStop \ -characterdatacommand pcdata \ -commentcommand comment] $parser parse { } list $::comment $::result $::element } {{This is a comment} {} 0} test comment-1.3 {Simple comment, within PCDATA} { set ::result {} set ::comment {} set ::element 0 catch {rename xml::comment-1.3 {}} set parser [xml::parser comment-1.3 \ -elementstartcommand Estart \ -elementendcommand EStop \ -characterdatacommand pcdata \ -commentcommand comment] $parser parse { surrounding PCDATA } list $::comment $::result $::element } {{This is a comment} {surrounding PCDATA} 0} test comment-1.4 {Simple comment, no white space} { set ::result {} set ::comment {} set ::element 0 catch {rename xml::comment-1.4 {}} set parser [xml::parser comment-1.4 \ -elementstartcommand Estart \ -elementendcommand EStop \ -characterdatacommand pcdata \ -commentcommand comment] $parser parse { } list $::comment $::result $::element } {comment {} 0} test comment-1.5 {comment, with nested element} { set ::result {} set ::comment {} set ::element 0 catch {rename xml::comment-1.5 {}} set parser [xml::parser comment-1.5 \ -elementstartcommand Estart \ -elementendcommand EStop \ -characterdatacommand pcdata \ -commentcommand comment] $parser parse { } list $::comment $::result $::element } {{ comment } {} 0} test comment-2.1 {comment with an angle bracket} { set ::result {} set ::comment {} set ::element 0 catch {rename xml::comment-2.1 {}} set parser [xml::parser comment-2.1 \ -elementstartcommand Estart \ -elementendcommand EStop \ -characterdatacommand pcdata \ -commentcommand comment] $parser parse { } list $::comment $::result $::element } {{ This is a > greater than sign } {} 0} test comment-2.2 {comment with multiple angle brackets} { set ::result {} set ::comment {} set ::element 0 catch {rename xml::comment-2.2 {}} set parser [xml::parser comment-2.2 \ -elementstartcommand Estart \ -elementendcommand EStop \ -characterdatacommand pcdata \ -commentcommand comment] $parser parse { } list $::comment $::result $::element } {{ } {} 0} set comment_2_3 [format {
} \}] test comment-2.3 {comment with entities} { set ::result {} set ::comment {} set ::element 0 catch {rename xml::comment-2.3 {}} set parser [xml::parser comment-2.3 \ -elementstartcommand Estart \ -elementendcommand EStop \ -characterdatacommand pcdata \ -commentcommand comment] $parser parse " " list [expr ![string compare $::comment ${comment_2_3}]] [string trim $::result] $::element } [list 0 {} 2] # cleanup ::tcltest::cleanupTests return