# 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