# Features covered:  Parser functions
#
# This file tests the parser's basic functions.
# 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: parser.test,v 1.6 2003/04/09 20:05:26 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 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

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 {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}}


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

# cleanup
::tcltest::cleanupTests
return