# Features covered:  Entities
#
# This file contains a collection of tests for the TclXML parser.
# This file tests the parser's performance on entities.
# Sourcing this file into Tcl runs the tests and generates output
# for errors.  No output means no errors were found.
#
# Copyright (c) 1999-2000 Zveno Pty Ltd.
#
# $Id: entity.test,v 1.8 2001/08/02 05:11:53 balls Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

set testlibdir [file dirname [file dirname [file join [pwd] [info script]]]]
if {[lsearch $auto_path $testlibdir] < 0} {
    lappend auto_path $testlibdir
}

if { ![llength [info commands ::xml::parser]] } {
     catch {puts stderr "You havent loaded a valid parser class before running this test"}
     return
}

proc Start {name attrList args} {
    incr ::elements
}

proc pcdata text {
    append ::result $text
}

proc EntityRef name {
    lappend ::references $name
    append ::result ##entityreference##
    return {}
}

test entity-1.1 {parameter entity in document entity} {
    set ::result {}

    catch {rename xml::entity-1.1 {}}
    set parser [xml::parser entity-1.1 \
	-characterdatacommand pcdata]
    $parser parse {<!DOCTYPE Test [
<!ENTITY % Wrong "This is wrong">
]>
<Test>%wrong;</Test>}
    set ::result
} {%wrong;}

test entity-1.2 {character entities in hex} {
    set ::result {}

    catch {rename xml::entity-1.2 {}}
    set parser [xml::parser entity-1.2 \
	-characterdatacommand pcdata]
    $parser parse {<Test>&#x41;&#x3C;&#x3e;&#x24;&#x5B;&#x5D;</Test>}
    set ::result
} {A<>$[]}

test entity-1.3 {character entities in decimal} {
    set ::result {}

    catch {rename xml::entity-1.3 {}}
    set parser [xml::parser entity-1.3 \
	-characterdatacommand pcdata]
    $parser parse {<Test>&#65;&#60;&#62;&#36;&#91;&#93;</Test>}
    set ::result
} {A<>$[]}

test entity-1.4 {illegal character entity} {
    set ::result {}

    catch {rename xml::entity-1.4 {}}
    set parser [xml::parser entity-1.4 \
	-characterdatacommand pcdata]
    set err [catch {$parser parse {<Test>&#blah;</Test>}}]
    list $err $::result
} {1 {}}

test entity-2.1 {predefined general entities} {
    set ::result {}

    catch {rename xml::entity-2.1 {}}
    set parser [xml::parser entity-2.1 \
	-characterdatacommand pcdata]
    $parser parse {<Test>&lt;&gt;&amp;&quot;&apos;</Test>}
    set ::result
} {<>&"'}

test entity-2.2 {undefined general entities - no callback} {
    set ::result {}

    catch {rename xml::entity-2.2 {}}
    set parser [xml::parser entity-2.2 \
	-characterdatacommand pcdata]
    set errcode [catch {
	$parser parse {<Test>&undefined;</Test>}
    } msg]
    list $errcode [regexp {undefined entity} $msg] $::result
} {1 1 {}}

test entity-2.3 {undefined general entities - with callback} {
    set ::result {}
    set ::references {}

    catch {rename xml::entity-2.3 {}}
    set parser [xml::parser entity-2.3 \
	-characterdatacommand pcdata \
	-entityreferencecommand EntityRef \
	]
    set errcode [catch {
	$parser parse {<Test>&undefined;</Test>}
    } msg]
    list $::result $::references $errcode $msg
} {##entityreference## undefined 0 {}}

# This example is from the XML Recommendation, Appendix D p. 29.

set example1_p_content {An ampersand (&) may be escaped
numerically (&#38;) or with a general entity
(&amp;).}

test entity-3.1 {replacement text with element markup} {

    set ::result {}
    catch {unset ::elements}
    set ::elements 0

    catch {rename xml::entity-3.1 {}}
    set parser [xml::parser entity-3.1 \
	-elementstartcommand Start \
	-characterdatacommand pcdata]
    $parser parse {<!DOCTYPE Test [
    <!ENTITY example "<p>An ampersand (&#38;#38;) may be escaped
numerically (&#38;#38;#38;) or with a general entity
(&amp;amp;).</p>">
]>
<Test>&example;</Test>}
    list $::result $::elements
} [list $example1_p_content 2]

test entity-4.1 {entity references} {
    set ::result {}
    set ::references {}

    catch {rename xml::entity-4.1 {}}
    set parser [xml::parser entity-4.1 \
	-characterdatacommand pcdata \
	-entityreferencecommand EntityRef]
    $parser parse {<Test>undefined &myentity; reference</Test>}
    list $::result $::references
} {{undefined ##entityreference## reference} myentity}

# Test case from bug #431353 submitted by Shaun Lowry

#puts stderr "\n\n***   TEST 5.1\n\n"

test entity-5.1 {entity references w/- Tcl special characters} {
    set ::result {}

    catch {rename xml::entity-5.1 {}}
    set parser [xml::parser entity-5.1 \
	-characterdatacommand pcdata]
    $parser parse [format {<?xml version="1.0" standalone="no"?>
<!DOCTYPE MyDoc>
<MyDoc>
&amp; %s
</MyDoc>} \{]
    set ::result
} [format {
& %s
} \{]

test entity-5.2 {entity references w/- Tcl special characters} {
    set ::result {}

    catch {rename xml::entity-5.2 {}}
    set parser [xml::parser entity-5.2 \
	-characterdatacommand pcdata]
    $parser parse [format {<?xml version="1.0" standalone="no"?>
<!DOCTYPE MyDoc>
<MyDoc>
&amp; %s
</MyDoc>} \[]
    set ::result
} [format {
& %s
} \[]

test entity-5.3 {entity references w/- Tcl special characters} {
    set ::result {}

    catch {rename xml::entity-5.3 {}}
    set parser [xml::parser entity-5.3 \
	-characterdatacommand pcdata]
    $parser parse [format {<?xml version="1.0" standalone="no"?>
<!DOCTYPE MyDoc>
<MyDoc>
&amp; %s
</MyDoc>} \\]
    set ::result
} [format {
& %s
} \\]

test entity-5.4 {entity references w/- Tcl special characters} {
    set ::result {}

    catch {rename xml::entity-5.4 {}}
    set parser [xml::parser entity-5.4 \
	-characterdatacommand pcdata]
    $parser parse [format {<?xml version="1.0" standalone="no"?>
<!DOCTYPE MyDoc>
<MyDoc>
&amp; %s%s
</MyDoc>} \\ \{]
    set ::result
} [format {
& %s%s
} \\ \{]

# cleanup
::tcltest::cleanupTests
return