1#!/bin/sh 2#\ 3exec tclsh8.1 "$0" "$@" 4 5# This tests the function of the error facility 6 7lappend auto_path [file dirname [info script]] 8package require expat 9 10proc element {tag name {attrs {}}} { 11 array set at $attrs 12 if {[info exists at(class)]} { 13 switch $at(class) { 14 continue { 15 return -code continue 16 } 17 break { 18 return -code break 19 } 20 error { 21 return -code error "error condition in XML" 22 } 23 } 24 } 25} 26proc pcdata pcdata { 27 if {[string length [string trim $pcdata]]} { 28 puts $pcdata 29 } 30} 31 32set data(error) {<?xml version="1.0"?> 33<!DOCTYPE Test SYSTEM "test.dtd"> 34<Test> 35<Element>Should see this data</Element> 36<Element class="error">Should not see this data</Element> 37<Element>Should not see this data</Element> 38</Test>} 39 40set parser [expat xmlparser \ 41 -elementstartcommand {element start} \ 42 -elementendcommand {element end} \ 43 -characterdatacommand pcdata \ 44 -final yes \ 45] 46 47puts {*** Test error} 48if {[catch {$parser parse $data(error)} err]} { 49 if {$err ne "error condition in XML" } { 50 puts [list test failed, incorrect error message: $err] 51 } else { 52 puts [list test passed] 53 } 54} else { 55 puts [list test failed, no error returned] 56} 57 58exit 0