Tcl Source Code

Check-in [c903f22fde]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Rename [oxor] to [or] and [oxand] to [and], also [oxjoin] to [oxfordJoin]
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | amg-array-enum-c-api
Files: files | file ages | folders
SHA1: c903f22fde25b684b527831f9dd384ad11f8c061
User & Date: andy 2016-12-02 22:10:39
Context
2016-12-03
00:42
Add more failure cases to test suite, gonna have to do non-error cases one of these days check-in: d046004a15 user: andy tags: amg-array-enum-c-api
2016-12-02
22:10
Rename [oxor] to [or] and [oxand] to [and], also [oxjoin] to [oxfordJoin] check-in: c903f22fde user: andy tags: amg-array-enum-c-api
21:18
Merge trunk check-in: 02df281049 user: andy tags: amg-array-enum-c-api
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to tests/array.test.

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
# - (no filter)
# - (default)
# - -exact
# - -glob
# - -regexp
# - -regexp (with invalid regexp pattern)

# oxjoin --
# oxand --
# oxor --
# Joins a list by commas, a connector word, or both, using Oxford comma rules,
# matching Tcl's internal algorithm for displaying lists in error messages.
proc oxjoin {connector list} {
    if {[llength $list] > 1} {
        lset list end "$connector [lindex $list end]"
    }
    if {[llength $list] < 3} {
        join $list " "
    } else {
        join $list ", "
    }
}
interp alias {} oxand {} oxjoin and
interp alias {} oxor {} oxjoin or

# samples --
# Produces a list of sample arguments, given a list of parameters.
proc samples {params} {
    lmap param $params {dict get {
        arrayName   a
        searchId    s-1-a
        ?mode?      -exact
        ?pattern?   hello
        list        {hello world}
    } $param}
}

# test --
# Wrapper around [::tcltest::test] with additional features:
#
# - Single-argument design gives a cleaner visual presentation.
# - All script execution is performed in a new stack frame.
# - Script variables are shared across scripts via a temporary namespace.
# - All definition values (except scripts) are [subst]'ed.
#
# The $def argument is a dict which defines the test.  Its possible keys are:
#
# - name | desc







|
|
|
|

|

|







|
|
















|







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
# - (no filter)
# - (default)
# - -exact
# - -glob
# - -regexp
# - -regexp (with invalid regexp pattern)

# oxfordJoin --
# and --
# or --
# Joins a list by commas, a conjunction, or both, using Oxford comma rules,
# matching Tcl's internal algorithm for displaying lists in error messages.
proc oxfordJoin {conjunction list} {
    if {[llength $list] > 1} {
        lset list end "$conjunction [lindex $list end]"
    }
    if {[llength $list] < 3} {
        join $list " "
    } else {
        join $list ", "
    }
}
interp alias {} and {} oxfordJoin and
interp alias {} or {} oxfordJoin or

# samples --
# Produces a list of sample arguments, given a list of parameters.
proc samples {params} {
    lmap param $params {dict get {
        arrayName   a
        searchId    s-1-a
        ?mode?      -exact
        ?pattern?   hello
        list        {hello world}
    } $param}
}

# test --
# Wrapper around [::tcltest::test] with additional features:
#
# - Single-argument block design gives a cleaner visual presentation.
# - All script execution is performed in a new stack frame.
# - Script variables are shared across scripts via a temporary namespace.
# - All definition values (except scripts) are [subst]'ed.
#
# The $def argument is a dict which defines the test.  Its possible keys are:
#
# - name | desc
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
            lappend command -$key [dict get $def $key]
            dict unset def $key
        }
    }

    # Complain if there are any invalid test definition keys.
    if {[dict size $def]} {
        error "bad test definition key(s): [oxand [dict keys $def]]"
    }

    # Run the Tcltest command.
    tailcall {*}$command
}

# Formal parameters for each array subcommand.







|







177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
            lappend command -$key [dict get $def $key]
            dict unset def $key
        }
    }

    # Complain if there are any invalid test definition keys.
    if {[dict size $def]} {
        error "bad test definition key(s): [and [dict keys $def]]"
    }

    # Run the Tcltest command.
    tailcall {*}$command
}

# Formal parameters for each array subcommand.
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
    result {wrong # args: should be "array subcommand ?arg ...?"}
}
test {
    name array-1.2
    desc {empty subcommand}
    body {array {}}
    returnCodes error
    result {unknown or ambiguous subcommand "": must be [oxor $commands]}
}
test {
    name array-1.3
    desc {invalid subcommand}
    body {array BAD&CMD}
    returnCodes error
    result {unknown or ambiguous subcommand "BAD&CMD": must be [oxor $commands]}
}
foreach cmd $ambig {
    test {
        name array-1.4.$cmd
        desc {ambiguous subcommand: \[array $cmd\]}
        {scalar cmd} $cmd
        body {array $cmd}
        returnCodes error
        result {unknown or ambiguous subcommand "$cmd":\
            must be [oxor $commands]}
    }
}
foreach cmd $commands {
    test {
        name array-1.5.$cmd
        desc {formal parameter lists: \[array $cmd\]}
        {scalar cmd} $cmd







|






|








|
<







232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255

256
257
258
259
260
261
262
    result {wrong # args: should be "array subcommand ?arg ...?"}
}
test {
    name array-1.2
    desc {empty subcommand}
    body {array {}}
    returnCodes error
    result {unknown or ambiguous subcommand "": must be [or $commands]}
}
test {
    name array-1.3
    desc {invalid subcommand}
    body {array BAD&CMD}
    returnCodes error
    result {unknown or ambiguous subcommand "BAD&CMD": must be [or $commands]}
}
foreach cmd $ambig {
    test {
        name array-1.4.$cmd
        desc {ambiguous subcommand: \[array $cmd\]}
        {scalar cmd} $cmd
        body {array $cmd}
        returnCodes error
        result {unknown or ambiguous subcommand "$cmd": must be [or $commands]}

    }
}
foreach cmd $commands {
    test {
        name array-1.5.$cmd
        desc {formal parameter lists: \[array $cmd\]}
        {scalar cmd} $cmd
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
        test {
            name array-2.2.$cmd
            desc {ambiguous mode: \[array $cmd\]"}
            {scalar cmd} $cmd
            {array a} {}
            body {array $cmd a {} {}}
            returnCodes error
            result {ambiguous option "": must be [oxor $modes]}
        }
        test {
            name array-2.3.$cmd
            desc {invalid mode: \[array $cmd\]}
            {scalar cmd} $cmd
            {array a} {}
            body {array $cmd a INVALID {}}
            returnCodes error
            result {bad option "INVALID": must be [oxor $modes]}
        }
        test {
            name array-2.4.$cmd
            desc {invalid regexp: \[array $cmd\]}
            {scalar cmd} $cmd
            {array a} {e 1}
            body {array $cmd a -regexp *}







|








|







281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
        test {
            name array-2.2.$cmd
            desc {ambiguous mode: \[array $cmd\]"}
            {scalar cmd} $cmd
            {array a} {}
            body {array $cmd a {} {}}
            returnCodes error
            result {ambiguous option "": must be [or $modes]}
        }
        test {
            name array-2.3.$cmd
            desc {invalid mode: \[array $cmd\]}
            {scalar cmd} $cmd
            {array a} {}
            body {array $cmd a INVALID {}}
            returnCodes error
            result {bad option "INVALID": must be [or $modes]}
        }
        test {
            name array-2.4.$cmd
            desc {invalid regexp: \[array $cmd\]}
            {scalar cmd} $cmd
            {array a} {e 1}
            body {array $cmd a -regexp *}