Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Changes In Branch RELEASES
Excluding Merge-Ins
This is equivalent to a diff from
fa1c30b7da
to a9e81e3240
2002-01-21
| | |
17:55 |
|
Closed-Leaf
check-in: 7be1f3035d user: andreas_kupries tags: tcllib-1-2-0
|
17:54 |
|
check-in: 915b11324a user: andreas_kupries tags: trunk
|
2002-01-20
| | |
20:09 |
|
Closed-Leaf
check-in: a9e81e3240 user: andreas_kupries tags: RELEASES
|
2002-01-19
| | |
01:35 |
|
check-in: fa1c30b7da user: dgp tags: trunk
|
01:32 |
|
check-in: 7c27d2b113 user: dgp tags: trunk
|
| | |
Changes to ChangeLog.
1
2
3
4
5
6
7
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
|
+
+
+
+
+
+
+
+
+
+
+
+
|
2002-01-20 Andreas Kupries <[email protected]>
* 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 <[email protected]>
* Bumped version to 1.2, new release. Summary of changes here. See
the individual Changelogs to see the detailed changes in each
module.
New modules: calendar, crc, doctools, irc, smtpd, and stooop.
|
︙ | | |
| | | | | | | | | | | |
Deleted modules/control/rswitch.tcl.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
|
|
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
|
# rswitch.tcl -
# Originally written: 2001 Nov 2
# Original author: Don Porter <[email protected]>
#
# 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.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
|
|
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
|
# rswitch.test - Copyright (C) 2001 Pat Thoyts <[email protected]>
#
# 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:
|