# -*- tcl -*- # Tests for the HTML parser # # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # # Copyright (c) 2001-2005 by ActiveState Tool Corp. # All rights reserved. # # RCS: @(#) $Id: htmlparse.test,v 1.27 2012/08/02 22:21:54 andreas_kupries Exp $ # ------------------------------------------------------------------------- source [file join \ [file dirname [file dirname [file join [pwd] [info script]]]] \ devtools testutilities.tcl] testsNeedTcl 8.3 ; # htmlparse itself is 8.2+, however struct::* need 8.3+ testsNeedTcltest 1.0 support { use struct/list.tcl struct::list useAccel [useTcllibC] struct/tree.tcl struct::tree TestAccelInit struct::tree use struct/queue.tcl struct::queue use struct/stack.tcl struct::stack use cmdline/cmdline.tcl cmdline } testing { useLocal htmlparse.tcl htmlparse } # ------------------------------------------------------------------------- set html1 {
burble} set html2 {
burble
burble
} # Simple remembering callback ... proc cb {args} {global tags ; lappend tags $args} proc tlist {t n} { set tt [list] foreach c [$t children $n] { lappend tt [$t get $c synth] } $t set $n -key synth [list [$t get $n type] $tt] } # ------------------------------------------------------------------------- test htmlparse-1.0 {basic errors} { catch {htmlparse::parse} msg set msg } {::htmlparse::parse : html string missing} test htmlparse-1.2 {basic errors} { catch {htmlparse::parse -cmd "" -split -1 -incvar "" -vroot "" -queue "" a b} msg set msg } {::htmlparse::parse : -cmd illegal argument (empty)} test htmlparse-1.3 {basic errors} { catch {htmlparse::parse -split -1 -incvar "" -vroot "" -queue "" a b} msg set msg } {::htmlparse::parse : -split illegal argument (<= 0)} test htmlparse-1.4 {basic errors} { catch {htmlparse::parse -incvar "" -vroot "" -queue "" a b} msg set msg } {::htmlparse::parse : -incvar illegal argument (empty)} test htmlparse-1.5 {basic errors} { catch {htmlparse::parse -vroot "" -queue "" a b} msg set msg } {::htmlparse::parse : -vroot illegal argument (empty)} test htmlparse-1.6 {basic errors} { catch {htmlparse::parse -queue "" a b} msg set msg } {::htmlparse::parse : -queue illegal argument (empty)} test htmlparse-1.7 {basic errors} { catch {htmlparse::parse a b} msg set msg } {::htmlparse::parse : to many arguments behind the options, expected one} test htmlparse-1.8 {basic errors} { catch {htmlparse::parse -foo a} msg set msg } {::htmlparse::parse : Illegal option "-foo"} test htmlparse-1.9 {parsing errors} { catch {htmlparse::parse -cmd cb $html2} msg set msg } {::htmlparse::parse : HTML is incomplete, option -incvar is missing} test htmlparse-2.0 {normal parsing} { set tags [list] htmlparse::parse -cmd cb -vroot foo $html1 set tags } [list \ [list foo {} {} {}] \ [list html {} {} {}] \ [list head {} {} {}] \ [list title {} {} foo] \ [list title / {} {}] \ [list meta {} {name="..."} {}] \ [list head / {} {}] \ [list body {} {} {}] \ [list h2 {} {} Header] \ [list p {} {} burble] \ [list body / {} {}] \ [list html / {} {}] \ [list foo / {} {}] \ ] test htmlparse-2.1 {normal parsing} { set tags [list] htmlparse::parse -cmd {cb @} -vroot foo $html1 set tags } [list \ [list @ foo {} {} {}] \ [list @ html {} {} {}] \ [list @ head {} {} {}] \ [list @ title {} {} foo] \ [list @ title / {} {}] \ [list @ meta {} {name="..."} {}] \ [list @ head / {} {}] \ [list @ body {} {} {}] \ [list @ h2 {} {} Header] \ [list @ p {} {} burble] \ [list @ body / {} {}] \ [list @ html / {} {}] \ [list @ foo / {} {}] \ ] test htmlparse-2.2 {normal parsing} { set tags [list] set incomplete "" htmlparse::parse -cmd cb -incvar incomplete -vroot foo $html2 list $tags $incomplete } [list [list \ [list foo {} {} {}] \ [list html {} {} {}] \ [list head {} {} {}] \ [list title {} {} foo] \ [list title / {} {}] \ [list meta {} {name="..."} {}] \ [list head / {} {}] \ [list body {} {} {}] \ [list h2 {} {} Header] \ [list p {} {} burble] \ [list foo / {} {}] \ ] "} lappend lines {\\
" set tags } [list \ [list html {} {} {}] \ [list p {} {} {\}] \ [list p / {} {}] \ [list html / {} {}] ] test htmlparse-6.2 {More backslashes in content} { set tags [list] htmlparse::parse -cmd cb -vroot html "\\abcde
" set tags } [list \ [list html {} {} {}] \ [list p {} {} {\abcde}] \ [list p / {} {}] \ [list html / {} {}] ] test htmlparse-6.3 {Substitutions from backslashes in content} { htmlparse::mapEscapes {\abcde} } {\abcde} test htmlparse-6.4 {$ in content} { set tags [list] htmlparse::parse -cmd cb -vroot html {$abcde
} set tags } [list \ [list html {} {} {}] \ [list p {} {} {$abcde}] \ [list p / {} {}] \ [list html / {} {}] ] test htmlparse-6.5 {Substitutions from $ in content} { htmlparse::mapEscapes {$abcde} } {$abcde} test htmlparse-6.6 {Braces in content} { set tags [list] htmlparse::parse -cmd cb -vroot html "\{\}
" set tags } [list \ [list html {} {} {}] \ [list p {} {} {{}}] \ [list p / {} {}] \ [list html / {} {}] ] test htmlparse-6.7 {More braces in content} { set tags [list] htmlparse::parse -cmd cb -vroot html "\{abcde\}
" set tags } [list \ [list html {} {} {}] \ [list p {} {} {{abcde}}] \ [list p / {} {}] \ [list html / {} {}] ] test htmlparse-6.8 {Substitutions from braces in content} { htmlparse::mapEscapes {{abcde}} } {{abcde}} # Tcllib SF Bug 861287 - Processing of comments. test htmlparse-7.1 {html comments} { set tags [list] htmlparse::parse -cmd cb -vroot html "&" set tags } [list \ [list html {} {} {}] \ [list pre {} {} &] \ [list pre / {} {}] \ [list html / {} {}] ] test htmlparse-7.2 {html comments} { set tags [list] htmlparse::parse -cmd cb -vroot html "
&" set tags } [list \ [list html {} {} {}] \ [list pre {} {} &] \ [list pre / {} {}] \ [list html / {} {}] ] test htmlparse-7.3 {html comments} { set tags [list] htmlparse::parse -cmd cb -vroot html "
&" set tags } [list \ [list html {} {} {}] \ [list pre {} {} &] \ [list pre / {} {}] \ [list html / {} {}] ] test htmlparse-7.4 {html comments} { set tags [list] htmlparse::parse -cmd cb -vroot html "
&" set tags } [list \ [list html {} {} {}] \ [list pre {} {} {&<-- no comment -->}] \ [list pre / {} {}] \ [list html / {} {}] ] test htmlparse-8.2 {html comments} { set tags [list] htmlparse::parse -cmd cb -vroot html "
&<-- no comment -->" set tags } [list \ [list html {} {} {}] \ [list pre {} {} &] \ [list pre / {} {<-- no comment -->}] \ [list html / {} {}] ] test htmlparse-8.3 {html comments} { set tags [list] htmlparse::parse -cmd cb -vroot html "<-- no comment -->
&" set tags } [list \ [list html {} {} {<-- no comment -->}] \ [list pre {} {} &] \ [list pre / {} {}] \ [list html / {} {}] ] test htmlparse-8.4 {html comments} { set tags [list] htmlparse::parse -cmd cb -vroot html "
&<-- no comment -- >" set tags } [list \ [list html {} {} {}] \ [list pre {} {} {&<-- no comment -- >}] \ [list pre / {} {}] \ [list html / {} {}] ] test htmlparse-8.5 {html comments} { set tags [list] htmlparse::parse -cmd cb -vroot html "
&<-- no comment -- >" set tags } [list \ [list html {} {} {}] \ [list pre {} {} &] \ [list pre / {} {<-- no comment -- >}] \ [list html / {} {}] ] test htmlparse-8.6 {html comments} { set tags [list] htmlparse::parse -cmd cb -vroot html "<-- no comment -- >
&" set tags } [list \ [list html {} {} {<-- no comment -- >}] \ [list pre {} {} &] \ [list pre / {} {}] \ [list html / {} {}] ] test htmlparse-9.0 {handle empty tags} { set tags [list] htmlparse::parse -cmd cb -vroot html "" set tags } [list \ [list html {} {} {}] \ [list b {} {} {}] \ [list a {} {} {}] \ [list a / {} {}] \ [list b / {} {}] \ [list html / {} {}] ] test htmlparse-9.1 {handle empty tags, attributes} { set tags [list] htmlparse::parse -cmd cb -vroot html "" set tags } [list \ [list html {} {} {}] \ [list b {} {} {}] \ [list a {} {href="b"} {}] \ [list a / {} {}] \ [list b / {} {}] \ [list html / {} {}] ] test htmlparse-9.2 {handle empty tags, text coming after} { set tags [list] htmlparse::parse -cmd cb -vroot html "xx" set tags } [list \ [list html {} {} {}] \ [list b {} {} {}] \ [list a {} {} {}] \ [list a / {} xx] \ [list b / {} {}] \ [list html / {} {}] ] test htmlparse-9.3 {handle empty tags, text coming before} { set tags [list] htmlparse::parse -cmd cb -vroot html "xx" set tags } [list \ [list html {} {} {}] \ [list b {} {} xx] \ [list a {} {} {}] \ [list a / {} {}] \ [list b / {} {}] \ [list html / {} {}] ] test htmlparse-10.0 {bad html, raising error} { set tags [list] htmlparse::parse -cmd cb -vroot html ">" set tags } [list \ [list html {} {} {}] \ [list a}] \ [list html / {} {}] ] test htmlparse-10.1 {bad html, varying argument counts} { set tags [list] htmlparse::parse -cmd cb -vroot html {} set tags } [list \ [list html {} {} {}] \ [list a {} {b="x} set tags } [list \ [list $extraarg html {} {} {}] \ [list $extraarg a {} {b="a"} {x}] \ [list $extraarg a / {} {}] \ [list $extraarg html / {} {}] ] # ------------------------------------------------------------------------- # In this section we run all the tests depending on a struct::tree, # and thus have to test all the available implementations. set tests [file join [file dirname [info script]] htmlparse.tree_testsuite] catch {memory validate on} TestAccelDo struct::tree impl { # The global variable 'impl' is part of the public API the # testsuit (in htmlparse_tree.testsuite) can expect from the # environment. namespace import -force struct::tree set usec [time {source $tests} 1] #puts "$impl:\t$usec" } catch {memory validate off} unset usec unset tests # ------------------------------------------------------------------------- # Take a look at the cache. #parray ::htmlparse::splitdata TestAccelExit struct::tree testsuiteCleanup return