Check-ins Using Download Hex

Artifact 5a1dc3bee6353700186d12f0d11b15914849c6be:

  • File tests/cdata.test — part of check-in [87dde9d70b] at 2003-09-16 22:58:15 on branch trunk — Added a few tests related to the new flexibility of the -elementstartcommand, -elementendcommand and -characterdatacommand scripts. (user: rolf size: 7827) 
# 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[<!-- ]]>-->]]&gt;</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 &lt;references&gt;]]></Test>}
    list $::result $::element
} {{no entity &lt;references&gt;} 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
Fossil 2.15.2 [818f40f62f] 2021-06-15 10:03:05
This page was generated in about 0.005s