Index: ChangeLog ================================================================== --- ChangeLog +++ ChangeLog @@ -1,5 +1,17 @@ +2002-01-20 Andreas Kupries + + * Tagging branch tcllib-1-2-0 as subbranch of RELEASES now. + This fixes the release. + + * Tagged branch RELEASES. control/rswitch is not officially + released according to Don Porter, and thus not part of this + branch. Additional documentation about its usage will be added + to the HEAD branch. + + * control 0.1 was never released, bumping version back to this. + 2002-01-18 Andreas Kupries * Bumped version to 1.2, new release. Summary of changes here. See the individual Changelogs to see the detailed changes in each module. DELETED modules/control/rswitch.tcl Index: modules/control/rswitch.tcl ================================================================== --- modules/control/rswitch.tcl +++ /dev/null @@ -1,92 +0,0 @@ -# rswitch.tcl - -# Originally written: 2001 Nov 2 -# Original author: Don Porter -# -# This software was developed at the National Institute of Standards -# and Technology by employees of the Federal Government in the course -# of their official duties. Pursuant to title 17 Section 105 of the -# United States Code this software is not subject to copyright -# protection and is in the public domain. -# -# The [rswitch] command of the package "control". -# Inspired by TIP 70. Amended to the syntax: -# -# rswitch $formatString { -# $sub1 $body1 -# ... -# $subN $bodyN -# } -# -# See documentation in control.n -# ------------------------------------------------------------------------- -# -# RCS: @(#) $Id: rswitch.tcl,v 1.3 2001/11/07 21:59:24 dgp Exp $ - -namespace eval ::control { - - namespace export rswitch - - proc rswitch {formatString actionList} { - if {[catch {llength $actionList} actionListLength]} { - return -code error $actionListLength - } - if {$actionListLength % 2} { - return -code error "extra substitution with no body" - } - # Check for final "default" arm - set hasDefault [string equal default [lindex $actionList end-1]] - if {$hasDefault} { - set defaultBody [lindex $actionList end] - set actionList [lrange $actionList 0 end-2] - } - set evalBody 0 - foreach {sub body} $actionList { - if {!$evalBody} { - if {[catch {linsert $sub 0 ::format $formatString} cmd]} { - return -code error -errorinfo "$cmd\n (\"$sub\"\ - arm substitution)" -errorcode $::errorCode $cmd - } - if {[catch {eval $cmd} expression]} { - return -code error -errorcode $::errorCode -errorinfo \ - "$expression\n (\"$sub\" arm substitution)" \ - $expression - } - set cmd [list ::expr $expression] - eval [CommandAsCaller cmd evalBody [format "%s\n%s" \ - {\"$sub\" arm expression)} \ - { (expression: \"$expression\"}]] - if {![string is boolean -strict $evalBody]} { - set msg "non-boolean expression" - return -code error -errorcode $::errorCode -errorinfo \ - [format "%s\n%s\n%s" $msg \ - " (\"$sub\" arm expression)" \ - " (expression: \"$expression\")"] $msg - } - if {!$evalBody} { - continue - } - set match $sub - } - # We've found a successful expression. - # Evaluate the corresponding body. - if {[string equal - $body]} { - continue - } - eval [BodyAsCaller body result code {\"$match\" arm}] - return -code $code $result - } - if {!$hasDefault && !$evalBody} { - return - } - if {!$evalBody} { - set match default - } - if {!$hasDefault || [string equal - $defaultBody]} { - return -code error \ - "no body specified for substitution \"$match\"" - } - eval [BodyAsCaller defaultBody result code {\"$match\" arm}] - return -code $code $result - } - -} DELETED modules/control/rswitch.test Index: modules/control/rswitch.test ================================================================== --- modules/control/rswitch.test +++ /dev/null @@ -1,136 +0,0 @@ -# rswitch.test - Copyright (C) 2001 Pat Thoyts -# -# Provide a set of tests to excercise the control::rswitch command of -# tcllib. -# -# @(#)$Id: rswitch.test,v 1.3 2001/11/07 05:31:42 dgp Exp $ - -# Initialize the required packages -if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest - namespace import -force ::tcltest::test ::tcltest::cleanupTests -} - -package forget control -catch {namespace delete control} - -# Direct loading of provide script -- support testing even -# when not installed. And be sure we test the local copy -# and not some later version that may be installed. -source [file join [file dirname [info script]] control.tcl] -namespace import ::control::rswitch - -# ------------------------------------------------------------------------- - -# Test simple numeric relational switching. -proc rsinteger {value} { - rswitch {$value %s} { - <5 {set result <5} - ==5 {set result 5} - >5 {set result >5} - default {set result default} - } - return $result -} - -test rswitch-1.1 {switch < 5} { - catch {rsinteger 0} result - set result -} {<5} - -test rswitch-1.2 {switch == 5} { - catch {rsinteger 5} result - set result -} {5} - -test rswitch-1.3 {switch > 5} { - catch {rsinteger 10} result - set result -} {>5} - -test rswitch-1.4 {switch non numeric} { - catch {rsinteger A} result - set result -} {>5} - -# ------------------------------------------------------------------------- - -proc rs:compare {lhs rhs} { - rswitch {$lhs %s $rhs} { - < {return <} - == {return ==} - > {return >} - } -} - -test rswitch-2.1 {switch string comparison} { - catch {rs:compare "hello" "world"} result - set result -} {<} - -test rswitch-2.2 {switch string comparison} { - catch {rs:compare "hello" "hello"} result - set result -} {==} - -test rswitch-2.3 {switch string comparison} { - catch {rs:compare "hello" "all"} result - set result -} {>} - -# ------------------------------------------------------------------------- -# Here are the test cases I used when developing [rswitch] to check on -# its errorInfo management. They should be converted to proper tests, -# preferably checking ::errorInfo. OK, I'll do the first one: - -test rswitch-3.0 {rswitch argument checking} { - list [catch {rswitch 1 \{} msg] $msg $::errorInfo -} {1 {unmatched open brace in list} {unmatched open brace in list - while executing -"rswitch 1 \{"}} - -#rswitch {1 %s} { -# {{>[string length]}} {string length} -# }} msg] $msg] -#} -#rswitch 1 foo -#rswitch {1 %s} { -# {{&& ([string length a] -# || -# [string length]}} {string length} -#} -#rswitch {1 %s} { -# {{&& ([string length a] -# || -# [string length])}} {string length} -#} -#rswitch {1 %s} { -# {{&& ([string length] -# || -# [string length])}} {string length} -#} -#rswitch {1 %s 1} { -# == { -# set a 1 -# string length -# set b 2 -# } -#} -#rswitch {1 %s 1} { -# == { -# set a 1 -# expr {[string length]} -# set b 2 -# } -#} - -# ------------------------------------------------------------------------- -# Clean up the tests - -::tcltest::cleanupTests -return - -# Local variables: -# mode: tcl -# indent-tabs-mode: nil -# End: