# me_util.test: tests for the AST utilities -*- tcl -*- # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 2005 Andreas Kupries # All rights reserved. # # RCS: @(#) $Id: me_util.test,v 1.7 2007/08/01 22:49:26 andreas_kupries Exp $ # ------------------------------------------------------------------------- source [file join \ [file dirname [file dirname [file join [pwd] [info script]]]] \ devtools testutilities.tcl] testsNeedTcl 8.4 testsNeedTcltest 2.1 support { useAccel [useTcllibC] struct/tree.tcl struct::tree TestAccelInit struct::tree } testing { useLocal me_util.tcl grammar::me::util } # ------------------------------------------------------------------------- # ------------------------------------------------------------------------- ## Pre-requisites. An AST value and various serializations of plain ## and extended tree representations of the same AST. Plus helper ## commands for the checking of trees for structural equality. set ast {a 0 56 {{} 3 15} {b 16 40 {d 16 20} {{} 21 40}} {c 41 56}} set serial_0 { root {} {} node0 0 {type nonterminal detail a range {0 56}} node1 3 {type terminal range {3 15}} node2 3 {type nonterminal detail b range {16 40}} node3 3 {type nonterminal detail c range {41 56}} node4 9 {type nonterminal detail d range {16 20}} node5 9 {type terminal range {21 40}} } set serial_0a { node0 {} {type nonterminal detail a range {0 56}} node1 0 {type terminal range {3 15}} node2 0 {type nonterminal detail b range {16 40}} node3 0 {type nonterminal detail c range {41 56}} node4 6 {type nonterminal detail d range {16 20}} node5 6 {type terminal range {21 40}} } set serial_1 { root {} {} foo 0 {} node0 3 {type nonterminal detail a range {0 56}} node1 6 {type terminal range {3 15}} node2 6 {type nonterminal detail b range {16 40}} node3 6 {type nonterminal detail c range {41 56}} node4 12 {type nonterminal detail d range {16 20}} node5 12 {type terminal range {21 40}} } set serial_2 { root {} {} node0 0 {type nonterminal detail a range {0 56} range_lc {{l0 c0} {l56 c56}}} node1 3 {type terminal range {3 15} range_lc {{l3 c3} {l15 c15}} detail {{T3 l3 c3 L3} {T4 l4 c4 L4} {T5 l5 c5 L5} {T6 l6 c6 L6} {T7 l7 c7 L7} {T8 l8 c8 L8} {T9 l9 c9 L9} {T10 l10 c10 L10} {T11 l11 c11 L11} {T12 l12 c12 L12} {T13 l13 c13 L13} {T14 l14 c14 L14} {T15 l15 c15 L15}}} node2 3 {type nonterminal detail b range {16 40} range_lc {{l16 c16} {l40 c40}}} node3 3 {type nonterminal detail c range {41 56} range_lc {{l41 c41} {l56 c56}}} node4 9 {type nonterminal detail d range {16 20} range_lc {{l16 c16} {l20 c20}}} node5 9 {type terminal range {21 40} range_lc {{l21 c21} {l40 c40}} detail {{T21 l21 c21 L21} {T22 l22 c22 L22} {T23 l23 c23 L23} {T24 l24 c24 L24} {T25 l25 c25 L25} {T26 l26 c26 L26} {T27 l27 c27 L27} {T28 l28 c28 L28} {T29 l29 c29 L29} {T30 l30 c30 L30} {T31 l31 c31 L31} {T32 l32 c32 L32} {T33 l33 c33 L33} {T34 l34 c34 L34} {T35 l35 c35 L35} {T36 l36 c36 L36} {T37 l37 c37 L37} {T38 l38 c38 L38} {T39 l39 c39 L39} {T40 l40 c40 L40}}} } set serial_2a { node0 {} {type nonterminal detail a range {0 56}} node1 0 {type terminal range {3 15}} node2 0 {type nonterminal detail b range {16 40}} node3 0 {type nonterminal detail c range {41 56}} node4 6 {type nonterminal detail d range {16 20}} node5 6 {type terminal range {21 40}} } set serial_3 { root {} {} foo 0 {} node0 3 {type nonterminal detail a range {0 56} range_lc {{l0 c0} {l56 c56}}} node1 6 {type terminal range {3 15} range_lc {{l3 c3} {l15 c15}} detail {{T3 l3 c3 L3} {T4 l4 c4 L4} {T5 l5 c5 L5} {T6 l6 c6 L6} {T7 l7 c7 L7} {T8 l8 c8 L8} {T9 l9 c9 L9} {T10 l10 c10 L10} {T11 l11 c11 L11} {T12 l12 c12 L12} {T13 l13 c13 L13} {T14 l14 c14 L14} {T15 l15 c15 L15}}} node2 6 {type nonterminal detail b range {16 40} range_lc {{l16 c16} {l40 c40}}} node3 6 {type nonterminal detail c range {41 56} range_lc {{l41 c41} {l56 c56}}} node4 12 {type nonterminal detail d range {16 20} range_lc {{l16 c16} {l20 c20}}} node5 12 {type terminal range {21 40} range_lc {{l21 c21} {l40 c40}} detail {{T21 l21 c21 L21} {T22 l22 c22 L22} {T23 l23 c23 L23} {T24 l24 c24 L24} {T25 l25 c25 L25} {T26 l26 c26 L26} {T27 l27 c27 L27} {T28 l28 c28 L28} {T29 l29 c29 L29} {T30 l30 c30 L30} {T31 l31 c31 L31} {T32 l32 c32 L32} {T33 l33 c33 L33} {T34 l34 c34 L34} {T35 l35 c35 L35} {T36 l36 c36 L36} {T37 l37 c37 L37} {T38 l38 c38 L38} {T39 l39 c39 L39} {T40 l40 c40 L40}}} } proc tree_equal {ta tb} { set tna [llength [$ta nodes]] set tnb [llength [$tb nodes]] if {$tna != $tnb} { puts "sizes: $ta n = $tna != $tnb = $tb n" return 0 } node_equal $ta $tb [$ta rootname] [$tb rootname] } proc node_equal {ta tb na nb} { if {[dictsort [$ta getall $na]] ne [dictsort [$tb getall $nb]]} { puts "attr delta $ta $na: [dictsort [$ta getall $na]]\n $tb $nb: [dictsort [$tb getall $nb]]" return 0 } if {[$ta numchildren $na] != [$tb numchildren $nb]} { puts "#c $na / $nb: [$ta numchildren $na] != [$tb numchildren $nb]" return 0 } foreach ca [$ta children $na] cb [$tb children $nb] { if {![node_equal $ta $tb $ca $cb]} { return 0 } } return 1 } proc tsdump {ser} { set line {} foreach {a b c} $ser { lappend line [list $a $b $c] } return \t[join $line \n\t] } # ------------------------------------------------------------------------- # 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]] me_util.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 # ------------------------------------------------------------------------- ## Cleanup and statistics. rename tree_equal {} rename node_equal {} rename tsdump {} TestAccelExit struct::tree testsuiteCleanup