# Features covered:  Parser functions
#
# This file tests the parser's basic functions.
#
#    parser-1.*: parser creation
#    parser-2.*: return code 'break' from callback
#    parser-3.*: return code 'continue' from callback
#    parser-4.*: return code 'error' from callback
#    parser-5.*: parse input from channel
#    parser-6.*: reuse parser 
#
# Copyright (c) 1999-2000 Zveno Pty Ltd.
# Copyright (c) 2002-2003 Rolf Ade
#
# $Id: parser.test,v 1.8 2003/11/24 10:08:19 rolf Exp $

source [file join [file dir [info script]] loadtdom.tcl]

proc parray arrayName {
    upvar #0 $arrayName arr
    foreach key [lsort [array names $arrayName]] {
	lappend result $key $arr($key)
    }
    return $result
}

catch {unset count} 
proc Count {args} {
    if {![info exists ::count]} {
        set ::count 1
    } else {
        incr ::count
    }
}

catch {unset started}
proc Start {name atList args} {
    array set opts $args
    array set atts $atList

    if {![info exists ::started($name)]} {
	set ::started($name) 1
    } else {
	incr ::started($name)
    }
    if {[info exists atts(class)]} {
	switch $atts(class) {
	    continue {
		return -code continue
	    }
	    break {
		return -code break
	    }
	    error {
		return -code error "error condition in callback"
	    }
	    default {
		return -code $atts(class) 
	    }
	}
    }
}
catch {unset ended}
proc End {name args} {
    array set opts $args
    if {![info exists ::ended($name)]} {
	set ::ended($name) 1
    } else {
	incr ::ended($name)
    }
}
proc PI {name args} {
    return -code $name
}

catch {unset elList}
proc ElStart {name atList args} {
    array set opts {-empty 0}
    array set opts $args
    lappend ::elList start $name $opts(-empty)
}
proc ElEnd {name args} {
    array set opts {-empty 0}
    array set opts $args
    lappend ::elList end $name $opts(-empty)
}

test parser-1.1 {parser creation} {
    set p [::xml::parser]
    regexp {^xmlparser[0-9]+$} $p
} 1

test parser-1.2 {parser creation, only options} {
    set p [::xml::parser -elementstartcommand Start]
    regexp {^xmlparser[0-9]+$} $p
} 1

test parser-1.3 {parser creation, named} {
    catch {rename parser-1.3 {}}
    ::xml::parser parser-1.3
} parser-1.3

test parser-1.4 {parser creation, named with options} {
    catch {rename parser-1.4 {}}
    ::xml::parser parser-1.4 -elementstartcommand Start
} parser-1.4

test parser-1.5 {parser freeing, wrong nr of args} {
    set p [expat]
    if {[set result [catch {$p free wrongarg}]]} {
        $p free
    }
    set result
} 1

test parser-1.6 {parser create syntax check} {
    set result [catch {set parser [expat -paramentityparsing wrong]} errMsg]
    lappend result $errMsg
} {1 {bad value "wrong": must be always, never, or notstandalone}}

test parser-1.7 {parser cget syntax} {
    catch {rename parser-1.7 {}}
    set parser [expat parser-1.7]
    set result [catch {$parser cget} errMsg]
    lappend result $errMsg
} {1 {wrong # args: should be "parser-1.7 cget ?-handlerset handlersetname? switch"}}

test parser-1.8 {parser cget syntax} {
    catch {rename parser-1.8 {}}
    set parser [expat parser-1.8]
    set result [catch {$parser cget -handlerset -final} errMsg]
    lappend result $errMsg
} {1 {wrong # args: should be "?-handlerset handlersetname? switch"}}

test parser-1.9 {parser cget syntax} {
    catch {rename parser-1.9 {}}
    set parser [expat parser-1.9]
    set result [catch {$parser cget -handlerset dontexist -baseurl} errMsg]
    lappend result $errMsg
} {1 {invalid handlerset name: dontexist}}

test parser-1.10 {parser cget syntax} {
    catch {rename parser-1.10 {}}
    set parser [expat parser-1.10]
    set result [$parser cget -handlerset default -baseurl]
} {}

test parser-1.11 {parser cget syntax} {
    catch {rename parser-1.11 {}}
    set parser [expat parser-1.11 -baseurl http://foo.org/]
    set result [$parser cget -handlerset default -baseurl]
} {http://foo.org/}

# Test break return code from callback

test parser-2.1 {break in callback} {
    catch {unset ::started}

    catch {rename parser-2.1 {}}
    set p [::xml::parser parser-2.1 -elementstartcommand Start]
    $p parse {<?xml version="1.0"?>
<Test>
<Element id="el1">Should see this data</Element>
<Element class="break" id="el2">Should not see this data<Element id="el3"/></Element>
<Element id='el4'>Should not see this data</Element>
</Test>
}
    set ::started(Element)
} 2

test parser-2.2 {break in callback} {
    catch {unset ::started}

    catch {rename parser-2.2 {}}
    set p [::xml::parser parser-2.2 -elementstartcommand Start]
    $p parse {<?xml version="1.0"?>
<Test>
<Element>Should see this data</Element>
<Element>Should see this data<Element class="break"/></Element>
<Element>Should not see this data</Element>
</Test>
}
    set ::started(Element)
} 3

test parser-2.3 {break in callback} {
    catch {unset ::started}

    catch {rename parser-2.3 {}}
    set p [::xml::parser parser-2.3 -elementstartcommand Start]
    $p parse {<?xml version="1.0"?>
<Test>
<Element>Should see this data</Element>
<Element>Should see this data
  <?break?>
</Element>
<Element>Should not see this data</Element>
</Test>
}
    set ::started(Element)
} 3

test parser-3.1 {continue in callback} {
    catch {unset ::started}

    catch {rename parser-3.1 {}}
    set p [::xml::parser parser-3.1 -elementstartcommand Start]
    $p parse {<?xml version="1.0"?>
<Test>
<Element id='el1'>Should see this data</Element>
<Element class="continue" id='el2'>Should not see this data
  <Element id='el3'/>
</Element>
<Element id='el4'>Should see this data</Element>
</Test>
}
    set ::started(Element)
} 3

test parser-3.2 {continue in callback} {
    catch {unset ::started}

    catch {rename parser-3.2 {}}
    set p [::xml::parser parser-3.2 -elementstartcommand Start]
    $p parse {<?xml version="1.0"?>
<Test>
<Element>Should see this data</Element>
<Element>Should see this data
  <Element class="continue">
    Should not see this data
    <Element/>
  </Element>
  Should see this data
  <Element/>
</Element>
<Element>Should see this data</Element>
</Test>
}
    set ::started(Element)
} 5

test parser-3.3 {continue in callback} {
    catch {unset ::started}

    catch {rename parser-3.3 {}}
    set p [::xml::parser parser-3.3 -elementstartcommand Start]
    $p parse {<?xml version="1.0"?>
<Test>
<Element>Should see this data</Element>
<Element>Should see this data
  <Element class="continue">
    Should not see this data
    <Element class="break"/>
    break will have no effect
  </Element>
  Should see this data
  <Element/>
</Element>
<Element>Should see this data</Element>
</Test>
}
    set ::started(Element)
} 5

proc esh-3.4 {name attList} {
    incr ::eshcounter
    return -code continue
}

proc eeh-3.4 {name} {
    incr ::eehcounter
}

proc cdh-3.4 {data} {
    incr ::cdhcounter
}

test parser-3.4 {continue} {
    set ::eshcounter 0
    set ::eehcounter 0
    set ::cdhcounter 0
    set p [expat -elementstartcommand esh-3.4 -elementendcommand eeh-3.4 \
              -characterdatacommand chd-3.4]
    $p parse {<root><a/>foo<a>foo<b><c/>foo</b></a></root>}
    $p free
    list $::eshcounter $::eehcounter $::cdhcounter
} {1 1 0}

proc esh-3.5 {name attList} {
    incr ::eshcounter2
}

proc eeh-3.5 {name} {
    incr ::eehcounter2
}

proc cdh-3.5 {data} {
    incr ::cdhcounter2
}

test parser-3.5 {continue with more than one handlerset} {
    set ::eshcounter 0
    set ::eehcounter 0
    set ::cdhcounter 0
    set ::eshcounter2 0
    set ::eehcounter2 0
    set ::cdhcounter2 0
    set p [expat -elementstartcommand esh-3.4 -elementendcommand eeh-3.4 \
              -characterdatacommand chd-3.4 -handlerset second \
              -elementstartcommand esh-3.5 -elementendcommand eeh-3.5 \
              -characterdatacommand cdh-3.5]
    $p parse {<root><a/>foo<a>foo<b><c/>foo</b></a></root>}
    $p free
    list $::eshcounter $::eehcounter $::cdhcounter \
        $::eshcounter2 $::eehcounter2 $::cdhcounter2
} {1 1 0 5 5 3}

test parser-4.1 {error in callback} {
    catch {unset ::started}

    catch {rename parser-4.1 {}}
    set p [::xml::parser parser-4.1 -elementstartcommand Start]
    set errcode [catch {$p parse {<?xml version="1.0"?>
<Test>
<Element>Should see this data</Element>
<Element class="error"/>
<Element>Should not see this data</Element>
</Test>
}} result]
    list $errcode $::started(Element)
} {1 2}

test parser-4.2 {error in callback} {
    catch {unset ::started}

    catch {rename parser-4.2 {}}
    set p [::xml::parser parser-4.2 -elementstartcommand Start]
    set errcode [catch {$p parse {<?xml version="1.0"?>
<Test>
<Element>Should see this data</Element>
<Element class="13"/>
<Element>Should not see this data</Element>
</Test>
}} result]
    list $::errcode $::started(Element)
} {13 2}

test parser-5.1 {parse channel input} {
    catch {unset ::count}

    catch {rename parser-5.1 {}}
    set parser [::xml::parser parser-5.1 -elementstartcommand Count]
    set fd [open [file join [pwd] [file dir [info script]] data/books.xml]]
    $parser parsechannel $fd
    close $fd
    list $::count
} {42}

test parser-6.1 {reuse parser} {
    catch {rename parser-6.1 {}}
    set parser [expat parser-6.1 -baseurl file:///foo/bar]
    set result [$parser cget -baseurl]
    $parser parse <data/>
    lappend result [$parser cget -baseurl]
    $parser configure -baseurl file:///bar/foo
    lappend result [$parser cget -baseurl]
    $parser parse <otherdata/>
    lappend result [$parser cget -baseurl]
    set result
} {file:///foo/bar {} file:///bar/foo {}}

foreach parser [info commands xmlparser*] {
    $parser free
}
foreach parser [info commands parser-*] {
    $parser free
}

# cleanup
::tcltest::cleanupTests
return