# Features covered: CDATA sections
#
# This file tests the parser's performance on CDATA sections.
# 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$
source [file join [file dir [info script]] loadtdom.tcl]
catch {unset result}
proc pcdata data {
append ::result $data
}
proc Estart {tagName attrList} {
switch -- $tagName {
Test {
}
default {
incr ::element
}
}
}
proc EStop tagname {
}
test cdata-1.1 {Simple CDATA section} {
set ::result {}
set ::element 0
catch {rename xml::cdata-1.1 {}}
set parser [xml::parser cdata-1.1 \
-elementstartcommand Estart \
-elementendcommand EStop \
-characterdatacommand pcdata]
$parser parse {<?xml version="1.0"?>
<!DOCTYPE Test>
<Test><![CDATA[This is CDATA]]></Test>
}
list $::result $::element
} {{This is CDATA} 0}
test cdata-1.2 {CDATA test contributed by Richard Emberson (emberson@netintouch.com)} {
set ::result {}
set ::element 0
catch {rename xml::cdata-1.2 {}}
set parser [xml::parser cdata-1.2 \
-elementstartcommand Estart \
-elementendcommand EStop \
-characterdatacommand pcdata]
$parser parse {<?xml version="1.0"?>
<TOP>
<![CDATA[928806871035]]>
</TOP>
}
list $::result $::element
} {{
928806871035
} 1}
# Test bug: ']]>' is not valid character data (XML Rec. subsect. 2.4) -
# this should produce a warning.
test cdata-2.0 {CDATA section interpersed with comment} {
set ::result {}
set ::element 0
catch {rename xml::cdata-2.0 {}}
set parser [xml::parser cdata-2.0 \
-elementstartcommand Estart \
-elementendcommand EStop \
-characterdatacommand pcdata]
$parser parse {<?xml version="1.0"?>
<!DOCTYPE Test>
<Test><![CDATA[<!-- This is not a comment -->]]>
<!-- This is a comment <![CDATA[This is not CDATA]]>-->
<![CDATA[<!-- ]]>-->]]></Test>}
list $::result $::element
} {{<!-- This is not a comment -->
<!-- -->]]>} 0}
test cdata-2.1 {CDATA section with an angle bracket} {
set ::result {}
set ::element 0
catch {rename xml::cdata-2.1 {}}
set parser [xml::parser cdata-2.1 \
-elementstartcommand Estart \
-elementendcommand EStop \
-characterdatacommand pcdata]
$parser parse {<?xml version="1.0"?>
<!DOCTYPE Test>
<Test><![CDATA[This is a > greater than sign]]></Test>
}
list $::result $::element
} {{This is a > greater than sign} 0}
# Test case contributed by Marshall Rose (mrose@dbc.mtview.ca.us)
test cdata-2.2 {CDATA section with multiple angle brackets} {
set ::result {}
set ::element 0
catch {rename xml::cdata-2.2 {}}
set parser [xml::parser cdata-2.2 \
-elementstartcommand Estart \
-elementendcommand EStop \
-characterdatacommand pcdata]
$parser parse {<?xml version="1.0" ?>
<!DOCTYPE Test>
<Test>
<artwork><![CDATA[
<?xml version="1.0">
<!DOCTYPE rfc SYSTEM "rfcXXXX.dtd">
<rfc>
...
</rfc>
]]></artwork>
</Test>}
list $::result $::element
} {{
<?xml version="1.0">
<!DOCTYPE rfc SYSTEM "rfcXXXX.dtd">
<rfc>
...
</rfc>
} 1}
# Test case contributed by J. Linnenkohl (jlinnen@c-s-k.de)
test cdata-2.3 {CDATA section with square brackets and curly braces} {
set ::result {}
set ::element 0
catch {rename xml::cdata-2.3 {}}
set parser [xml::parser cdata-2.3 \
-elementstartcommand Estart \
-elementendcommand EStop \
-characterdatacommand pcdata]
$parser parse {<?xml version="1.0" ?>
<Tcl>
<![CDATA[
proc arithmetic_add {groups inputs outputs atts} {
set ret_val ""
set t "Hello World"
set l [string length $t]
return $ret_val
}
]]>
</Tcl>
}
list $::result $::element
} {{
proc arithmetic_add {groups inputs outputs atts} {
set ret_val ""
set t "Hello World"
set l [string length $t]
return $ret_val
}
} 1}
test cdata-2.4 {CDATA section with angle brackets and curly braces} {
set ::result {}
set ::element 0
catch {rename xml::cdata-2.4 {}}
set parser [xml::parser cdata-2.4 \
-elementstartcommand Estart \
-elementendcommand EStop \
-characterdatacommand pcdata]
$parser parse {<?xml version="1.0" ?>
<Tcl>
<![CDATA[
proc arithmetic_add {groups inputs outputs atts} {
set ret_val [expr 1 > 2]
set t "Hello World"
set l [string length $t]
return $ret_val
}
]]>
</Tcl>
}
list $::result $::element
} {{
proc arithmetic_add {groups inputs outputs atts} {
set ret_val [expr 1 > 2]
set t "Hello World"
set l [string length $t]
return $ret_val
}
} 1}
test cdata-2.5 {CDATA section with angle brackets, Tcl specials trailing CDATA section} {
set ::result {}
set ::element 0
catch {rename xml::cdata-2.5 {}}
set parser [xml::parser cdata-2.5 \
-elementstartcommand Estart \
-elementendcommand EStop \
-characterdatacommand pcdata]
$parser parse {<?xml version="1.0" ?>
<Tcl>
<![CDATA[
proc arithmetic_add {groups inputs outputs atts} {
set ret_val [expr 1 > 2]
set t "Hello World"
set l [string length $t]
return $ret_val
}
]]> that is {jolly} $good
</Tcl>
}
list $::result $::element
} {{
proc arithmetic_add {groups inputs outputs atts} {
set ret_val [expr 1 > 2]
set t "Hello World"
set l [string length $t]
return $ret_val
}
that is {jolly} $good
} 1}
# Test case contributed by Marshall Rose (mrose@dbc.mtview.ca.us)
test cdata-3.1 {CDATA section with PI and Tcl special characters} {
set ::result {}
set ::element 0
catch {rename xml::cdata-3.1 {}}
set parser [xml::parser cdata-3.1 \
-elementstartcommand Estart \
-elementendcommand EStop \
-characterdatacommand pcdata]
$parser parse {<?xml version="1.0"?>
<?xml2rfc toc="yes"?>
<!DOCTYPE Test>
<Test>
<t>this is a \ test</t>
<artwork><![CDATA[
<date month="December" year="1998"/>
]]></artwork>
</Test>}
list $::result $::element
} {{
this is a \ test
<date month="December" year="1998"/>
} 2}
test cdata-4.1 {CDATA section with entity reference} {
set ::result {}
set ::element 0
catch {rename xml::cdata-4.1 {}}
set parser [xml::parser cdata-4.1 \
-elementstartcommand Estart \
-elementendcommand EStop \
-characterdatacommand pcdata]
$parser parse {<?xml version="1.0"?>
<!DOCTYPE Test>
<Test><![CDATA[no entity <references>]]></Test>}
list $::result $::element
} {{no entity <references>} 0}
test cdata-5.1 {CDATA section whiteCDATAs} {
set ::result {}
set ::cdata {}
catch {rename xml::cdata-5.1 {}}
set parser [xml::parser cdata-5.1 \
-ignorewhitecdata 1 \
-characterdatacommand pcdata]
$parser parse {<root>
<test>foo</test>
</root>}
list $::result
} {foo}
test cdata-5.2 {CDATA section whiteCDATAs} {
set ::result {}
set ::cdata {}
catch {rename xml::cdata-5.2 {}}
set parser [xml::parser cdata-5.2 \
-characterdatacommand pcdata]
$parser parse {<root> <test>foo</test> </root>}
list $::result
} {{ foo }}
proc cdh-6.1 {suppliedData data} {
if {$suppliedData == "first arg"} {
set ::result 1
} else {
set ::result 0
}
}
test cdata-6.1 {CDATA script} {
set ::result 0
set p [xml::parser -characterdatacommand [list cdh-6.1 "first arg"]]
$p parse {<root>pcdata</root>}
$p free
set ::result
} {1}
test cdata-6.2 {declare handler proc later} {
catch {rename cdh-6.2 {}}
catch {unset ::cdata}
set p [xml::parser -characterdatacommand cdh-6.2]
proc cdh-6.2 {data} {
append ::cdata $data
}
$p parse {<root>foo<a/>data<b>more data</b></root>}
$p free
set ::cdata
} {foodatamore data}
foreach parser [info commands cdata-*] {
$parser free
}
# cleanup
::tcltest::cleanupTests
return