cmdr
Check-in [e756a91488]
Not logged in
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

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

Overview
Comment:Second charge of renaming "xo" to "cmdr". Plus tweak to processing of optional list arguments, preventing ahead-processing of options. They are made part of the splat.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: e756a914880c64d581548fe3b2f958f1a59fb612
User & Date: aku 2013-04-04 05:00:48
Context
2013-04-04
05:23
Parsing tweak. When encountering a bad option see if it can be handled as regular argument before bailing out. check-in: e6db958b51 user: aku tags: trunk
05:00
Second charge of renaming "xo" to "cmdr". Plus tweak to processing of optional list arguments, preventing ahead-processing of options. They are made part of the splat. check-in: e756a91488 user: aku tags: trunk
04:46
Renamed everything from "xo" to "cmdr". Easier to speak and more direct connection between name and purpose of the package. check-in: 91f2eaba78 user: aku tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to actor.tcl.

1
2
3
4
5
6
7
8
9
10
...
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## XO - Actor - Command execution. Base.
##              Actors know how to do something.

## Two types:
## - Privates know to do one thing, exactly, and nothing more.
##   They can process their command line to extract/validate
##   the inputs they need for their action from the arguments.
#
................................................................................
	    return [dict get $mystore $key]
	}
	# ... then ask in the chain of command ...
	if {$mysuper ne {}} {
	    return [$mysuper get $key]
	}
	# ... and fail if we are at the top.
	return -code error -errorcode {XO STORE UNKNOWN} \
	    "Expected known key for get, got \"$key\""
    }

    method set {key data} {
	dict set mystore $key $data
	return
    }

|







 







|







1
2
3
4
5
6
7
8
9
10
...
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## CMDR - Actor - Command execution. Base.
##              Actors know how to do something.

## Two types:
## - Privates know to do one thing, exactly, and nothing more.
##   They can process their command line to extract/validate
##   the inputs they need for their action from the arguments.
#
................................................................................
	    return [dict get $mystore $key]
	}
	# ... then ask in the chain of command ...
	if {$mysuper ne {}} {
	    return [$mysuper get $key]
	}
	# ... and fail if we are at the top.
	return -code error -errorcode {CMDR STORE UNKNOWN} \
	    "Expected known key for get, got \"$key\""
    }

    method set {key data} {
	dict set mystore $key $data
	return
    }

Changes to config.tcl.

1
2
3
4
5
6
7
8
9
10
...
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
...
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
...
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
...
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
...
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
...
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
...
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
....
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## XO - Config - Collection of argument values for a private.

## - The config manages the argument values, and can parse
##   a command line against the definition, filling values,
##   issuing errors on mismatches, etc.

# # ## ### ##### ######## ############# #####################
## Requisites
................................................................................
    method public      {} { return [dict keys $mypub] }
    method arguments   {} { return $myargs }
    method options     {} { return [dict keys $myoption] }

    method lookup {name} {
	if {![dict exists $mymap $name]} {
	    set names [linsert [join [lsort -dict [my names]] {, }] end-1 or]
	    return -code error -errorcode {XO CONFIG PARAMETER UNKNOWN} \
		"Got \"$name\", expected parameter name, one of $names"
	}
	return [dict get $mymap $name]
    }

    method lookup-option {name} {
	if {![dict exists $myoption $name]} {
	    set names [linsert [join [lsort -dict [my options]] {, }] end-1 or]
	    return -code error -errorcode {XO CONFIG PARAMETER UNKNOWN} \
		"Got \"$name\", expected option name, one of $names"
	}
	return [dict get $myoption $name]
    }

    method force {} {
	# Define the values of all parameters.
................................................................................

    method DefineParameter {
	order cmdline required
	name desc {spec {}}
    } {
	upvar 1 splat splat
	if {$splat && $order} {
	    return -code error -errorcode {XO CONFIG SPLAT ORDER} \
		"A splat must be the last argument in the specification"
	}

	my ValidateAsUnknown $name

	# Create and initialize handler.
	set para [cmdr::parameter create param_$name [self] \
................................................................................
	# in 'force'.
	lappend mynames $name
	return
    }

    method ValidateAsUnknown {name} {
	if {![dict exists $mymap $name]} return
	return -code error -errorcode {XO CONFIG KNOWN} \
	    "Duplicate parameter \"[context fullname]: $name\", already specified."
    }

    # # ## ### ##### ######## #############
    ## Command completion. This is the entry point for recursion from
    ## the higher level officers, delegated to config from cmdr::private

................................................................................
	if {[regexp {^(-[^=]+)=(.*)$} $option --> option value]} {
	    P unget $value
	}

	# Validate existence of the option
	if {![dict exists $myfullopt $option]} {
	    return -code error \
		-errorcode {XO CONFIG BAD OPTION} \
		"Unknown option $option"
	}

	# Map from option prefix to full option
	set options [dict get $myfullopt $option]
	if {[llength $options] > 1} {
	    return -code error \
		-errorcode {XO CONFIG AMBIGUOUS OPTION} \
		"Ambiguous option prefix $option, matching [join $options {, }]"
	}

	# Now map the fully expanded option name to its handler and
	# let it deal with the remaining things, including retrieval
	# of the option argument (if any), validation, etc.

	[dict get $myoption [lindex $options 0]] process $option $mypq
	return
    }

    method tooMany {} {
	return -code error \
	    -errorcode {XO CONFIG WRONG-ARGS TOO-MANY} \
	    "wrong#args, too many"
    }

    method notEnough {} {
	return -code error \
	    -errorcode {XO CONFIG WRONG-ARGS NOT-ENOUGH} \
	    "wrong#args, not enough"
    }

    # # ## ### ##### ######## #############

    variable mymap mypub myoption myfullopt myargs mynames \
	myaq mypq mycchain myreplexit myreplok myreplcommit \
................................................................................
	set myreplcommit 0 ; # Flag: We are not asked to commit yet.

	my ShowState

	$shell history 1
	try {
	    $shell repl
	} trap {XO CONFIG INTERACT CANCEL} {e o} {
	    return 0
	} trap {XO CONFIG INTERACT OK} {e o} {
	    if {!$myreplok} {
		# Bad commit with incomplete data.
		return -code error \
		    -errorcode {XO CONFIG COMMIT FAIL} \
		    "Unable to perform \"[context fullname]\", incomplete or bad arguments"
	    }
	    return 1
	} finally {
	    $shell destroy
	}
	return
................................................................................
	# Note: The lookup accepts the undocumented parameters as
	#       well, despite them not shown by ShowState, nor
	#       available for completion.

	set para [my lookup $cmd]

	if {[$para presence] && ([llength $words] != 0)} {
	    return -code error -errorcode {XO CONFIG WRONG ARGS} \
		"wrong \# args: should be \"$cmd\""
	} elseif {[llength $words] != 1} {
	    return -code error -errorcode {XO CONFIG WRONG ARGS} \
		"wrong \# args: should be \"$cmd value\""
	}

	# cmd is option => Add the nessary dashes? No. Only needed for
	# boolean special form, and direct interaction does not allow
	# that.

................................................................................
	}
	return
    }

    method report {what data} {
	if {$myreplexit} {
	    if {$myreplcommit} {
		return -code error -errorcode {XO CONFIG INTERACT OK} ""
	    } else {
		return -code error -errorcode {XO CONFIG INTERACT CANCEL} ""
	    }
	}

	my ShowState
	switch -exact -- $what {
	    ok {
		if {$data eq {}} return
................................................................................
	    set defined  [$para defined?]

	    try {
		set value [$para value]
		if {$value eq {}} {
		    set value ${mycyan}<<epsilon>>${myreset}
		}
	    } trap {XO PARAMETER UNDEFINED} {e o} {
		# Mandatory argument, without user-specified value.
		set value "${mycyan}(undefined)$myreset"
	    } trap {XO VALIDATE} {e o} {
		# Any argument with a bad value.
		set value "[$para string] ${mycyan}($e)$myreset"
		set somebad 1
	    }

	    append text {    }


|







 







|








|







 







|







 







|







 







|







|













|





|







 







|

|



|







 







|


|







 







|

|







 







|


|







1
2
3
4
5
6
7
8
9
10
...
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
...
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
...
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
...
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
...
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
...
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
...
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
....
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## CMDR - Config - Collection of argument values for a private.

## - The config manages the argument values, and can parse
##   a command line against the definition, filling values,
##   issuing errors on mismatches, etc.

# # ## ### ##### ######## ############# #####################
## Requisites
................................................................................
    method public      {} { return [dict keys $mypub] }
    method arguments   {} { return $myargs }
    method options     {} { return [dict keys $myoption] }

    method lookup {name} {
	if {![dict exists $mymap $name]} {
	    set names [linsert [join [lsort -dict [my names]] {, }] end-1 or]
	    return -code error -errorcode {CMDR CONFIG PARAMETER UNKNOWN} \
		"Got \"$name\", expected parameter name, one of $names"
	}
	return [dict get $mymap $name]
    }

    method lookup-option {name} {
	if {![dict exists $myoption $name]} {
	    set names [linsert [join [lsort -dict [my options]] {, }] end-1 or]
	    return -code error -errorcode {CMDR CONFIG PARAMETER UNKNOWN} \
		"Got \"$name\", expected option name, one of $names"
	}
	return [dict get $myoption $name]
    }

    method force {} {
	# Define the values of all parameters.
................................................................................

    method DefineParameter {
	order cmdline required
	name desc {spec {}}
    } {
	upvar 1 splat splat
	if {$splat && $order} {
	    return -code error -errorcode {CMDR CONFIG SPLAT ORDER} \
		"A splat must be the last argument in the specification"
	}

	my ValidateAsUnknown $name

	# Create and initialize handler.
	set para [cmdr::parameter create param_$name [self] \
................................................................................
	# in 'force'.
	lappend mynames $name
	return
    }

    method ValidateAsUnknown {name} {
	if {![dict exists $mymap $name]} return
	return -code error -errorcode {CMDR CONFIG KNOWN} \
	    "Duplicate parameter \"[context fullname]: $name\", already specified."
    }

    # # ## ### ##### ######## #############
    ## Command completion. This is the entry point for recursion from
    ## the higher level officers, delegated to config from cmdr::private

................................................................................
	if {[regexp {^(-[^=]+)=(.*)$} $option --> option value]} {
	    P unget $value
	}

	# Validate existence of the option
	if {![dict exists $myfullopt $option]} {
	    return -code error \
		-errorcode {CMDR CONFIG BAD OPTION} \
		"Unknown option $option"
	}

	# Map from option prefix to full option
	set options [dict get $myfullopt $option]
	if {[llength $options] > 1} {
	    return -code error \
		-errorcode {CMDR CONFIG AMBIGUOUS OPTION} \
		"Ambiguous option prefix $option, matching [join $options {, }]"
	}

	# Now map the fully expanded option name to its handler and
	# let it deal with the remaining things, including retrieval
	# of the option argument (if any), validation, etc.

	[dict get $myoption [lindex $options 0]] process $option $mypq
	return
    }

    method tooMany {} {
	return -code error \
	    -errorcode {CMDR CONFIG WRONG-ARGS TOO-MANY} \
	    "wrong#args, too many"
    }

    method notEnough {} {
	return -code error \
	    -errorcode {CMDR CONFIG WRONG-ARGS NOT-ENOUGH} \
	    "wrong#args, not enough"
    }

    # # ## ### ##### ######## #############

    variable mymap mypub myoption myfullopt myargs mynames \
	myaq mypq mycchain myreplexit myreplok myreplcommit \
................................................................................
	set myreplcommit 0 ; # Flag: We are not asked to commit yet.

	my ShowState

	$shell history 1
	try {
	    $shell repl
	} trap {CMDR CONFIG INTERACT CANCEL} {e o} {
	    return 0
	} trap {CMDR CONFIG INTERACT OK} {e o} {
	    if {!$myreplok} {
		# Bad commit with incomplete data.
		return -code error \
		    -errorcode {CMDR CONFIG COMMIT FAIL} \
		    "Unable to perform \"[context fullname]\", incomplete or bad arguments"
	    }
	    return 1
	} finally {
	    $shell destroy
	}
	return
................................................................................
	# Note: The lookup accepts the undocumented parameters as
	#       well, despite them not shown by ShowState, nor
	#       available for completion.

	set para [my lookup $cmd]

	if {[$para presence] && ([llength $words] != 0)} {
	    return -code error -errorcode {CMDR CONFIG WRONG ARGS} \
		"wrong \# args: should be \"$cmd\""
	} elseif {[llength $words] != 1} {
	    return -code error -errorcode {CMDR CONFIG WRONG ARGS} \
		"wrong \# args: should be \"$cmd value\""
	}

	# cmd is option => Add the nessary dashes? No. Only needed for
	# boolean special form, and direct interaction does not allow
	# that.

................................................................................
	}
	return
    }

    method report {what data} {
	if {$myreplexit} {
	    if {$myreplcommit} {
		return -code error -errorcode {CMDR CONFIG INTERACT OK} ""
	    } else {
		return -code error -errorcode {CMDR CONFIG INTERACT CANCEL} ""
	    }
	}

	my ShowState
	switch -exact -- $what {
	    ok {
		if {$data eq {}} return
................................................................................
	    set defined  [$para defined?]

	    try {
		set value [$para value]
		if {$value eq {}} {
		    set value ${mycyan}<<epsilon>>${myreset}
		}
	    } trap {CMDR PARAMETER UNDEFINED} {e o} {
		# Mandatory argument, without user-specified value.
		set value "${mycyan}(undefined)$myreset"
	    } trap {CMDR VALIDATE} {e o} {
		# Any argument with a bad value.
		set value "[$para string] ${mycyan}($e)$myreset"
		set somebad 1
	    }

	    append text {    }

Changes to examples/example.

1
2
3
4
5
6
7
8
9
10
11
12
13
#!/usr/bin/env tclsh
# -*- tcl -*-
package require Tcl 8.5
package require xo

xo create cmdline cmdline {

    private scissors {
	state  s XXX {}
	option o YYY {}
	input  a AAA { }
	input  b BBB { optional }
	input  c CCC { list }


|

|







1
2
3
4
5
6
7
8
9
10
11
12
13
#!/usr/bin/env tclsh
# -*- tcl -*-
package require Tcl 8.5
package require cmdr

cmdr create cmdline cmdline {

    private scissors {
	state  s XXX {}
	option o YYY {}
	input  a AAA { }
	input  b BBB { optional }
	input  c CCC { list }

Changes to examples/examplep.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
#!/usr/bin/env tclsh
# -*- tcl -*-
package require Tcl 8.5
package require xo

xo create cmdline cmdline {

    private scissors {
	state  state  XXX
	option option YYY
	option debug DDD { undocumented }
	input  alpha  AAA
	input  beta   BBB { optional }
	input  gamma  CCC { list }
    } ::cut
}

[cmdline lookup scissors] interact
exit


|

|













1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
#!/usr/bin/env tclsh
# -*- tcl -*-
package require Tcl 8.5
package require cmdr

cmdr create cmdline cmdline {

    private scissors {
	state  state  XXX
	option option YYY
	option debug DDD { undocumented }
	input  alpha  AAA
	input  beta   BBB { optional }
	input  gamma  CCC { list }
    } ::cut
}

[cmdline lookup scissors] interact
exit

Changes to help.tcl.

1
2
3
4
5
6
7
8
9
10
## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## XO - Help - Help support.

# # ## ### ##### ######## ############# #####################
## Requisites

package require Tcl 8.5
package require textutil::adjust
package require cmdr::util

|







1
2
3
4
5
6
7
8
9
10
## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## CMDR - Help - Help support.

# # ## ### ##### ######## ############# #####################
## Requisites

package require Tcl 8.5
package require textutil::adjust
package require cmdr::util

Changes to officer.tcl.

1
2
3
4
5
6
7
8
9
10
..
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
...
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
...
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
...
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
...
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## XO - Officer - Command execution. Dispatcher.
##                An actor.

## - Officers can learn to do many things, by delegating things to the
##   privates actually able to perform it.

# # ## ### ##### ######## ############# #####################
## Requisites
................................................................................
	my Setup
	return [dict get $mymap default]
    }

    method lookup {name} {
	my Setup
	if {![dict exists $mymap a,$name]} {
	    return -code error -errorcode {XO ACTION UNKNOWN} \
		"Expected action name, got \"$name\""
	}
	return [dict get $mymap a,$name]
    }

    method has {name} {
	my Setup
................................................................................
    forward Private my DefineAction private
    forward Officer my DefineAction officer

    method Default {{name {}}} {
	if {[llength [info level 0]] == 2} {
	    set name [my Last]
	} elseif {![dict exists $mymap a,$name]} {
	    return -code error -errorcode {XO ACTION UNKNOWN} \
		"Unable to set default, expected action, got \"$name\""
	}
	dict set mymap default $name
	return
    }

    method Alias {name args} {
................................................................................
	dict set mymap   a,$name $handler
	lappend mycommands $name
	return
    }

    method ValidateAsUnknown {name} {
	if {![dict exists $mymap a,$name]} return
	return -code error -errorcode {XO ACTION KNOWN} \
	    "Unable to learn $name, already specified."
    }

    method Last {} {
	if {![dict exists $mymap last]} {
	    return -code error -errorcode {XO ACTION NO-LAST} \
		"Cannot be used as first command"
	}
	return [dict get $mymap last]
    }

    method Known {name} {
	return [dict exists $mymap a,$name]
................................................................................
	try {
	    # Empty command. Delegate to the default, if we have any.
	    # Otherwise fail.
	    if {![llength $args]} {
		if {[my hasdefault]} {
		    return [[my lookup [my default]] do]
		}
		return -code error -errorcode {XO DO EMPTY} \
		    "No command found."
	    }

	    # Split into command and arguments
	    set remainder [lassign $args cmd]

	    # Delegate to the handler for a known command.
................................................................................
	    # The command word is not known. Delegate the full command to
	    # the default, if we have any. Otherwise fail.

	    if {[my hasdefault]} {
		return [[my lookup [my default]] do {*}$args]
	    }

	    return -code error -errorcode {XO DO UNKNOWN} \
		"No command found, have \"$cmd\""
	} finally {
	    if {$reset} {
		my unset .command
	    }
	}
    }

|







 







|







 







|







 







|





|







 







|







 







|







1
2
3
4
5
6
7
8
9
10
..
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
...
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
...
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
...
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
...
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## CMDR - Officer - Command execution. Dispatcher.
##                An actor.

## - Officers can learn to do many things, by delegating things to the
##   privates actually able to perform it.

# # ## ### ##### ######## ############# #####################
## Requisites
................................................................................
	my Setup
	return [dict get $mymap default]
    }

    method lookup {name} {
	my Setup
	if {![dict exists $mymap a,$name]} {
	    return -code error -errorcode {CMDR ACTION UNKNOWN} \
		"Expected action name, got \"$name\""
	}
	return [dict get $mymap a,$name]
    }

    method has {name} {
	my Setup
................................................................................
    forward Private my DefineAction private
    forward Officer my DefineAction officer

    method Default {{name {}}} {
	if {[llength [info level 0]] == 2} {
	    set name [my Last]
	} elseif {![dict exists $mymap a,$name]} {
	    return -code error -errorcode {CMDR ACTION UNKNOWN} \
		"Unable to set default, expected action, got \"$name\""
	}
	dict set mymap default $name
	return
    }

    method Alias {name args} {
................................................................................
	dict set mymap   a,$name $handler
	lappend mycommands $name
	return
    }

    method ValidateAsUnknown {name} {
	if {![dict exists $mymap a,$name]} return
	return -code error -errorcode {CMDR ACTION KNOWN} \
	    "Unable to learn $name, already specified."
    }

    method Last {} {
	if {![dict exists $mymap last]} {
	    return -code error -errorcode {CMDR ACTION NO-LAST} \
		"Cannot be used as first command"
	}
	return [dict get $mymap last]
    }

    method Known {name} {
	return [dict exists $mymap a,$name]
................................................................................
	try {
	    # Empty command. Delegate to the default, if we have any.
	    # Otherwise fail.
	    if {![llength $args]} {
		if {[my hasdefault]} {
		    return [[my lookup [my default]] do]
		}
		return -code error -errorcode {CMDR DO EMPTY} \
		    "No command found."
	    }

	    # Split into command and arguments
	    set remainder [lassign $args cmd]

	    # Delegate to the handler for a known command.
................................................................................
	    # The command word is not known. Delegate the full command to
	    # the default, if we have any. Otherwise fail.

	    if {[my hasdefault]} {
		return [[my lookup [my default]] do {*}$args]
	    }

	    return -code error -errorcode {CMDR DO UNKNOWN} \
		"No command found, have \"$cmd\""
	} finally {
	    if {$reset} {
		my unset .command
	    }
	}
    }

Changes to parameter.tcl.

1
2
3
4
5
6
7
8
9
10
..
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
..
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
...
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
...
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
...
700
701
702
703
704
705
706

707
708













709
710
711
712
713
714
715
...
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
...
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
...
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
...
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
...
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## XO - Value - Definition of command parameters (for a private).

## Reference "doc/notes_parameter.txt". The Rnnn and Cnnn tags are
## links into this document.

# # ## ### ##### ######## ############# #####################
## Requisites

................................................................................
	# Note: my == my of the class, not the instance.
	set n [my LocateConfig] ; incr n -1
	return [uplevel $n [list config {*}$args]]
    }

    classmethod undefined {name} {
	return -code error \
	    -errorcode {XO PARAMETER UNDEFINED} \
	    "Undefined: $name"
    }

    classmethod LocateConfig {} {
	set n 3
	set max [info level]
	while {$n < $max} {
................................................................................
	    #set c [info object class $o]
	    #puts |$n|$max|$ns|$o|$c||||[::info commands ${ns}::*]|\n
	    if {[llength [::info commands ${ns}::config]]} {
		return $n
	    }
	    incr n
	}
	return -code error -errorcode {XO PARAMETER BAD CONTEXT} \
	    "Bad context, no config found in the stack."
    }

    # # ## ### ##### ######## #############
    ## Lifecycle.

    constructor {theconfig order cmdline required name desc valuespec} {
................................................................................
    # # ## ### ##### ######## #############
    ## Internal: DSL support. General helpers.

    method Assert {expr msg} {
	# Note: list is a local command, we want the builtin
	if {[uplevel 1 [::list expr $expr]]} return
	return -code error \
	    -errorcode {XO PARAMETER CONSTRAINT VIOLATION} \
	    [string map [::list @ $myname] $msg]
    }

    method FillMissingValidation {} {
	# Ignore when the user specified a validation type
	# Note: 'presence' has set 'boolean'.
	if {[llength $myvalidate]} return
................................................................................
	}
	return
    }

    method Locked {} {
	if {$mylocker eq {}} return
	return -code error \
	    -errorcode {XO PARAMETER LOCKED} \
	    "You cannot use \"[my name]\" together with \"$mylocker\"."
    }

    method process {detail queue} {
	# detail = actual flag (option)
	#        = parameter name (argument)

................................................................................
    }

    method Take {queue} {
	#puts "$myname take $mythreshold"

	if {$mythreshold >= 0} {
	    # Choose by checking argument count against a threshold.

	    # For this to work correctly we now have to process all
	    # the remaining options first.














	    config parse-options

	    if {[$queue size] <= $mythreshold} {
		#puts "$myname (Q[$queue size] <=  T$mythreshold)? pass"
		# Not enough values left, pass.
		return 0
................................................................................

	    # If that was ok it has to be released also!
	    # XXX Or should we maybe immediately cache it for 'value'?
	    try {
		my ValueRelease \
		    [{*}$myvalidate validate \
			 [$queue peek]]
	    } trap {XO VALIDATE} {e o} {
		#puts "$myname (type mismatch, pass, $e)"
		# Type mismatch, pass.
		return 0
	    } ; # internal errors bubble further
	} else {
	    # peek+test mode, nothing to peek at, pass.
	    #puts "$myname (no argument, pass)"
................................................................................
    # - retrieve user string
    # - retrieve validated value, internal representation.
    # - query if a value is defined.

    method string {} {
	if {!$myhasstring} {
	    return -code error \
		-errorcode {XO PARAMETER UNDEFINED} \
		"Undefined: $myname"
	}
	return $mystring
    }

    method defined? {} {
	return $myhasstring
................................................................................
			    return {*}$o $e
			}
		    }
		    if {!$continue} break
		    set take 1
		    try {
			set thevalue [{*}$myvalidate validate $thevalue]
		    } trap {XO VALIDATE} {e o} {
			set take 0
			puts "$e, ignored"
		    }
		    if {$take} {
			lappend thelist $thevalue
		    }
		}
................................................................................
		while {$continue} {
		    set continue 0
		    set thevalue [linenoise prompt \
				      -prompt $myprompt \
				      -complete [::list {*}$myvalidate complete]]
		    try {
			set thevalue [{*}$myvalidate validate $thevalue]
		    } trap {XO VALIDATE} {e o} {
			set continue 1
		    }
		}
		my Value: $thevalue
	    }
	    # TODO: prompt to enter value, or cmdloop to enter a list.
	    # Note: ^C for prompt aborts system.
................................................................................
	}

	if {!$myisrequired} {
	    my Value: {}
	}

	return -code error \
	    -errorcode {XO PARAMETER UNDEFINED} \
	    "Undefined: $myname"
    }

    # # ## ### ##### ######## #############

    method Value: {v} {
	if {[llength $mywhendef]} {

|







 







|







 







|







 







|







 







|







 







>

|
>
>
>
>
>
>
>
>
>
>
>
>
>







 







|







 







|







 







|







 







|







 







|







1
2
3
4
5
6
7
8
9
10
..
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
..
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
...
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
...
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
...
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
...
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
...
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
...
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
...
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
...
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## CMDR - Value - Definition of command parameters (for a private).

## Reference "doc/notes_parameter.txt". The Rnnn and Cnnn tags are
## links into this document.

# # ## ### ##### ######## ############# #####################
## Requisites

................................................................................
	# Note: my == my of the class, not the instance.
	set n [my LocateConfig] ; incr n -1
	return [uplevel $n [list config {*}$args]]
    }

    classmethod undefined {name} {
	return -code error \
	    -errorcode {CMDR PARAMETER UNDEFINED} \
	    "Undefined: $name"
    }

    classmethod LocateConfig {} {
	set n 3
	set max [info level]
	while {$n < $max} {
................................................................................
	    #set c [info object class $o]
	    #puts |$n|$max|$ns|$o|$c||||[::info commands ${ns}::*]|\n
	    if {[llength [::info commands ${ns}::config]]} {
		return $n
	    }
	    incr n
	}
	return -code error -errorcode {CMDR PARAMETER BAD CONTEXT} \
	    "Bad context, no config found in the stack."
    }

    # # ## ### ##### ######## #############
    ## Lifecycle.

    constructor {theconfig order cmdline required name desc valuespec} {
................................................................................
    # # ## ### ##### ######## #############
    ## Internal: DSL support. General helpers.

    method Assert {expr msg} {
	# Note: list is a local command, we want the builtin
	if {[uplevel 1 [::list expr $expr]]} return
	return -code error \
	    -errorcode {CMDR PARAMETER CONSTRAINT VIOLATION} \
	    [string map [::list @ $myname] $msg]
    }

    method FillMissingValidation {} {
	# Ignore when the user specified a validation type
	# Note: 'presence' has set 'boolean'.
	if {[llength $myvalidate]} return
................................................................................
	}
	return
    }

    method Locked {} {
	if {$mylocker eq {}} return
	return -code error \
	    -errorcode {CMDR PARAMETER LOCKED} \
	    "You cannot use \"[my name]\" together with \"$mylocker\"."
    }

    method process {detail queue} {
	# detail = actual flag (option)
	#        = parameter name (argument)

................................................................................
    }

    method Take {queue} {
	#puts "$myname take $mythreshold"

	if {$mythreshold >= 0} {
	    # Choose by checking argument count against a threshold.

	    # For this to work correctly we now have to process all
	    # the remaining options first. Except for list
	    # arguments. These are last, and thus will always
	    # take whatever where is. Ok, we pass on an empty
	    # queue.

	    if {$myislist} {
		if {[$queue size]} {
		    #puts "$myname (list, take)"
		    return 1
		} else {
		    #puts "$myname (list, pass empty)"
		    return 0
		}
	    }

	    config parse-options

	    if {[$queue size] <= $mythreshold} {
		#puts "$myname (Q[$queue size] <=  T$mythreshold)? pass"
		# Not enough values left, pass.
		return 0
................................................................................

	    # If that was ok it has to be released also!
	    # XXX Or should we maybe immediately cache it for 'value'?
	    try {
		my ValueRelease \
		    [{*}$myvalidate validate \
			 [$queue peek]]
	    } trap {CMDR VALIDATE} {e o} {
		#puts "$myname (type mismatch, pass, $e)"
		# Type mismatch, pass.
		return 0
	    } ; # internal errors bubble further
	} else {
	    # peek+test mode, nothing to peek at, pass.
	    #puts "$myname (no argument, pass)"
................................................................................
    # - retrieve user string
    # - retrieve validated value, internal representation.
    # - query if a value is defined.

    method string {} {
	if {!$myhasstring} {
	    return -code error \
		-errorcode {CMDR PARAMETER UNDEFINED} \
		"Undefined: $myname"
	}
	return $mystring
    }

    method defined? {} {
	return $myhasstring
................................................................................
			    return {*}$o $e
			}
		    }
		    if {!$continue} break
		    set take 1
		    try {
			set thevalue [{*}$myvalidate validate $thevalue]
		    } trap {CMDR VALIDATE} {e o} {
			set take 0
			puts "$e, ignored"
		    }
		    if {$take} {
			lappend thelist $thevalue
		    }
		}
................................................................................
		while {$continue} {
		    set continue 0
		    set thevalue [linenoise prompt \
				      -prompt $myprompt \
				      -complete [::list {*}$myvalidate complete]]
		    try {
			set thevalue [{*}$myvalidate validate $thevalue]
		    } trap {CMDR VALIDATE} {e o} {
			set continue 1
		    }
		}
		my Value: $thevalue
	    }
	    # TODO: prompt to enter value, or cmdloop to enter a list.
	    # Note: ^C for prompt aborts system.
................................................................................
	}

	if {!$myisrequired} {
	    my Value: {}
	}

	return -code error \
	    -errorcode {CMDR PARAMETER UNDEFINED} \
	    "Undefined: $myname"
    }

    # # ## ### ##### ######## #############

    method Value: {v} {
	if {[llength $mywhendef]} {

Changes to private.tcl.

1
2
3
4
5
6
7
8
9
10
..
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## XO - Private - Command execution. Simple case.
##                An actor.

## - Privates know to do one thing, exactly, and nothing more.
##   They can process their command line to extract/validate
##   the inputs they need for their action from the arguments.

# # ## ### ##### ######## ############# #####################
................................................................................
	    my Run $args
	}
    }

    method Run {words} {
	try {
	    config parse {*}$words
	} trap {XO CONFIG WRONG-ARGS NOT-ENOUGH} {e o} {
	    # Prevent interaction if globally suppressed, or just for
	    # this actor.
	    if {![cmdr interactive?] ||
		![config interactive]} {
		return {*}$o $e
	    }
	    if {![config interact]} return

|







 







|







1
2
3
4
5
6
7
8
9
10
..
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## CMDR - Private - Command execution. Simple case.
##                An actor.

## - Privates know to do one thing, exactly, and nothing more.
##   They can process their command line to extract/validate
##   the inputs they need for their action from the arguments.

# # ## ### ##### ######## ############# #####################
................................................................................
	    my Run $args
	}
    }

    method Run {words} {
	try {
	    config parse {*}$words
	} trap {CMDR CONFIG WRONG-ARGS NOT-ENOUGH} {e o} {
	    # Prevent interaction if globally suppressed, or just for
	    # this actor.
	    if {![cmdr interactive?] ||
		![config interactive]} {
		return {*}$o $e
	    }
	    if {![config interact]} return

Changes to tests/help.tests.

1
2
3
4
5
6
7
8
9
10
11
12
...
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
...
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
...
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
...
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
...
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
# -*- tcl -*- Include file for xo.test.
# # ## ### ##### ######## ############# #####################
## Help structure generation.

test xo-help-1.0 {help structure} -body {
    cmdr create x foo {
	description TEST
	officer bar {
	    private aloha {
		description hawaii
		option lulu loop {}
		input yoyo height
................................................................................
		Activate full form of the help.
	    }} arguments {cmdname {code ?* desc {
	    The entire command line, the name of the
	    command to get help for. This can be several
	    words.
	}}}}}

test xo-help-1.1 {help structure, inverted boolean option} -body {
    cmdr create x foo {
	description TEST
	private nail {
	    description workbench
	    option no-driver force { list ; alias force }
	} ::wall
    }
................................................................................
	    The entire command line, the name of the
	    command to get help for. This can be several
	    words.
	}}}}}

# # ## ### ##### ######## ############# #####################

test xo-help-2.0 {full - formatting help structure} -body {
    HelpLarge full
} -result {bar aloha [OPTIONS] yoyo ?jump? run...
    hawaii

    --lulu    loop
    --no-lulu Complementary alias of --lulu.

................................................................................
    --full  Activate full form of the help.

    cmdname The entire command line, the name of
            the command to get help for. This can
            be several words.
}

test xo-help-2.1 {full formatting - help structure, inverted boolean option} -body {
    HelpSmall full
} -result {nail [OPTIONS]
    workbench

    --driver    Complementary alias of
                --no-driver.
    --force     Alias of --no-driver.
................................................................................
    cmdname The entire command line, the name of
            the command to get help for. This can
            be several words.
}

# # ## ### ##### ######## ############# #####################

test xo-help-3.0 {short - formatting help structure} -body {
    HelpLarge short
} -result {bar aloha [OPTIONS] yoyo ?jump? run...
    hawaii

bar help [OPTIONS] ?cmdname...?
    Retrieve help for a command or command set.
    Without arguments help for all commands is
................................................................................

help [OPTIONS] ?cmdname...?
    Retrieve help for a command or command set.
    Without arguments help for all commands is
    given. The default format is --full.
}

test xo-help-3.1 {short formatting - help structure, inverted boolean option} -body {
    HelpSmall short
} -result {nail [OPTIONS]
    workbench

help [OPTIONS] ?cmdname...?
    Retrieve help for a command or command set.
    Without arguments help for all commands is
    given. The default format is --full.
}

# # ## ### ##### ######## ############# #####################

test xo-help-4.0 {list - formatting help structure} -body {
    HelpLarge list
} -result {    bar aloha [OPTIONS] yoyo ?jump? run...
    bar help [OPTIONS] ?cmdname...?
    snafu aloha [OPTIONS] yoyo ?jump? run...
    snafu help [OPTIONS] ?cmdname...?
    tool pliers help [OPTIONS] ?cmdname...?
    tool hammer nail [OPTIONS] ?supply...?
    tool hammer help [OPTIONS] ?cmdname...?
    tool help [OPTIONS] ?cmdname...?
    hammer nail [OPTIONS] ?supply...?
    hammer help [OPTIONS] ?cmdname...?
    help [OPTIONS] ?cmdname...?}

test xo-help-4.1 {list formatting - help structure, inverted boolean option} -body {
    HelpSmall list
} -result {    nail [OPTIONS]
    help [OPTIONS] ?cmdname...?}

# # ## ### ##### ######## ############# #####################
return
|



|







 







|







 







|







 







|







 







|







 







|












|













|






1
2
3
4
5
6
7
8
9
10
11
12
...
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
...
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
...
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
...
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
...
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
# -*- tcl -*- Include file for cmdr.test.
# # ## ### ##### ######## ############# #####################
## Help structure generation.

test cmdr-help-1.0 {help structure} -body {
    cmdr create x foo {
	description TEST
	officer bar {
	    private aloha {
		description hawaii
		option lulu loop {}
		input yoyo height
................................................................................
		Activate full form of the help.
	    }} arguments {cmdname {code ?* desc {
	    The entire command line, the name of the
	    command to get help for. This can be several
	    words.
	}}}}}

test cmdr-help-1.1 {help structure, inverted boolean option} -body {
    cmdr create x foo {
	description TEST
	private nail {
	    description workbench
	    option no-driver force { list ; alias force }
	} ::wall
    }
................................................................................
	    The entire command line, the name of the
	    command to get help for. This can be several
	    words.
	}}}}}

# # ## ### ##### ######## ############# #####################

test cmdr-help-2.0 {full - formatting help structure} -body {
    HelpLarge full
} -result {bar aloha [OPTIONS] yoyo ?jump? run...
    hawaii

    --lulu    loop
    --no-lulu Complementary alias of --lulu.

................................................................................
    --full  Activate full form of the help.

    cmdname The entire command line, the name of
            the command to get help for. This can
            be several words.
}

test cmdr-help-2.1 {full formatting - help structure, inverted boolean option} -body {
    HelpSmall full
} -result {nail [OPTIONS]
    workbench

    --driver    Complementary alias of
                --no-driver.
    --force     Alias of --no-driver.
................................................................................
    cmdname The entire command line, the name of
            the command to get help for. This can
            be several words.
}

# # ## ### ##### ######## ############# #####################

test cmdr-help-3.0 {short - formatting help structure} -body {
    HelpLarge short
} -result {bar aloha [OPTIONS] yoyo ?jump? run...
    hawaii

bar help [OPTIONS] ?cmdname...?
    Retrieve help for a command or command set.
    Without arguments help for all commands is
................................................................................

help [OPTIONS] ?cmdname...?
    Retrieve help for a command or command set.
    Without arguments help for all commands is
    given. The default format is --full.
}

test cmdr-help-3.1 {short formatting - help structure, inverted boolean option} -body {
    HelpSmall short
} -result {nail [OPTIONS]
    workbench

help [OPTIONS] ?cmdname...?
    Retrieve help for a command or command set.
    Without arguments help for all commands is
    given. The default format is --full.
}

# # ## ### ##### ######## ############# #####################

test cmdr-help-4.0 {list - formatting help structure} -body {
    HelpLarge list
} -result {    bar aloha [OPTIONS] yoyo ?jump? run...
    bar help [OPTIONS] ?cmdname...?
    snafu aloha [OPTIONS] yoyo ?jump? run...
    snafu help [OPTIONS] ?cmdname...?
    tool pliers help [OPTIONS] ?cmdname...?
    tool hammer nail [OPTIONS] ?supply...?
    tool hammer help [OPTIONS] ?cmdname...?
    tool help [OPTIONS] ?cmdname...?
    hammer nail [OPTIONS] ?supply...?
    hammer help [OPTIONS] ?cmdname...?
    help [OPTIONS] ?cmdname...?}

test cmdr-help-4.1 {list formatting - help structure, inverted boolean option} -body {
    HelpSmall list
} -result {    nail [OPTIONS]
    help [OPTIONS] ?cmdname...?}

# # ## ### ##### ######## ############# #####################
return

Changes to tests/main.tests.

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
# -*- tcl -*- Include file for xo.test.
# # ## ### ##### ######## ############# #####################
## Basic wrong#args checks.

test xo-main-1.0 {new, wrong num args, not enough} -body {
    cmdr new
} -returnCodes error \
    -result {wrong # args: should be "cmdr new name spec"}

test xo-main-1.1 {new, wrong num args, too many} -body {
    cmdr new NAME
} -returnCodes error \
    -result {wrong # args: should be "cmdr new name spec"}

test xo-main-1.2 {new, wrong num args, too many} -body {
    cmdr new NAME SPEC X
} -returnCodes error \
    -result {wrong # args: should be "cmdr new name spec"}

test xo-main-1.3 {create, wrong num args, not enough} -body {
    cmdr create
} -returnCodes error \
    -result {wrong # args: should be "cmdr create obj name spec"}

test xo-main-1.4 {create, wrong num args, not enough} -body {
    cmdr create OBJ
} -returnCodes error \
    -result {wrong # args: should be "cmdr create obj name spec"}

test xo-main-1.5 {create, wrong num args, not enough} -body {
    cmdr create OBJ NAME
} -returnCodes error \
    -result {wrong # args: should be "cmdr create obj name spec"}

test xo-main-1.6 {new, wrong num args, too many} -body {
    cmdr create OBJ NAME SPEC X
} -returnCodes error \
    -result {wrong # args: should be "cmdr create obj name spec"}

# # ## ### ##### ######## ############# #####################
## Basic officer, knows nothing. create/new with proper arguments.

test xo-main-2.0 {new, nothing but auto-help} -setup {
    set x [cmdr new foo {}]
} -body {
    list [$x known] [$x hasdefault]
} -cleanup {
    $x destroy
    unset x
} -result {help 0}

test xo-main-2.1 {create, nothing but auto-help} -setup {
    cmdr create x foo {}
} -body {
    list [x known] [x hasdefault]
} -cleanup {
    x destroy
} -result {help 0}

# # ## ### ##### ######## ############# #####################
return
|



|




|




|




|




|




|




|







|








|









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
# -*- tcl -*- Include file for cmdr.test.
# # ## ### ##### ######## ############# #####################
## Basic wrong#args checks.

test cmdr-main-1.0 {new, wrong num args, not enough} -body {
    cmdr new
} -returnCodes error \
    -result {wrong # args: should be "cmdr new name spec"}

test cmdr-main-1.1 {new, wrong num args, too many} -body {
    cmdr new NAME
} -returnCodes error \
    -result {wrong # args: should be "cmdr new name spec"}

test cmdr-main-1.2 {new, wrong num args, too many} -body {
    cmdr new NAME SPEC X
} -returnCodes error \
    -result {wrong # args: should be "cmdr new name spec"}

test cmdr-main-1.3 {create, wrong num args, not enough} -body {
    cmdr create
} -returnCodes error \
    -result {wrong # args: should be "cmdr create obj name spec"}

test cmdr-main-1.4 {create, wrong num args, not enough} -body {
    cmdr create OBJ
} -returnCodes error \
    -result {wrong # args: should be "cmdr create obj name spec"}

test cmdr-main-1.5 {create, wrong num args, not enough} -body {
    cmdr create OBJ NAME
} -returnCodes error \
    -result {wrong # args: should be "cmdr create obj name spec"}

test cmdr-main-1.6 {new, wrong num args, too many} -body {
    cmdr create OBJ NAME SPEC X
} -returnCodes error \
    -result {wrong # args: should be "cmdr create obj name spec"}

# # ## ### ##### ######## ############# #####################
## Basic officer, knows nothing. create/new with proper arguments.

test cmdr-main-2.0 {new, nothing but auto-help} -setup {
    set x [cmdr new foo {}]
} -body {
    list [$x known] [$x hasdefault]
} -cleanup {
    $x destroy
    unset x
} -result {help 0}

test cmdr-main-2.1 {create, nothing but auto-help} -setup {
    cmdr create x foo {}
} -body {
    list [x known] [x hasdefault]
} -cleanup {
    x destroy
} -result {help 0}

# # ## ### ##### ######## ############# #####################
return

Changes to tests/officer.tests.

1
2
3
4
5
6
7
8
9
10
11
12
..
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
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
# -*- tcl -*- Include file for xo.test.
# # ## ### ##### ######## ############# #####################
## Hierarchy of actions, aliases, defaults.

test xo-officer-1.0 {hierarchy: defaults, aliases, descriptions, commons} -body {
    cmdr create x foo {
	common K D
	description TEST
	officer bar {}
	default
	alias snafu
	officer tool {
................................................................................
        help --> help
    }
}

# # ## ### ##### ######## ############# #####################
## Error cases of the action DSL.

test xo-officer-2.0 {officer/action DSL, officer, wrong\#args} -setup {
    cmdr create x foo {
	officer
    }
} -body {
    x known
} -cleanup {
    x destroy
} -returnCodes error \
    -result "wrong # args: should be \"officer name ...\""

test xo-officer-2.1 {officer/action DSL, officer, wrong\#args} -setup {
    cmdr create x foo {
	officer foo
    }
} -body {
    x known
} -cleanup {
    x destroy
} -returnCodes error -match glob \
    -result "wrong # args: should be \"cmdr::officer create ::oo::*::officer_foo super name actions\""

test xo-officer-2.2 {officer/action DSL, officer, wrong\#args} -setup {
    cmdr create x foo {
	officer foo {} x
    }
} -body {
    x known
} -cleanup {
    x destroy
} -returnCodes error -match glob \
    -result "wrong # args: should be \"cmdr::officer create ::oo::*::officer_foo super name actions\""

# # ## ### ##### ######## ############# #####################

test xo-officer-3.0 {officer/action DSL, default, missing previous definition} -setup {
    cmdr create x foo {
	default
    }
} -body {
    x known
} -cleanup {
    x destroy
} -returnCodes error \
    -result {Cannot be used as first command}

test xo-officer-3.1 {officer/action DSL, default, wrong\#args} -setup {
    cmdr create x foo {
	default x y
    }
} -body {
    x known
} -cleanup {
    x destroy
} -returnCodes error \
    -result {wrong # args: should be "default ?name?"}

test xo-officer-3.2 {officer/action DSL, default, unknown action} -setup {
    cmdr create x foo {
	default x
    }
} -body {
    x known
} -cleanup {
    x destroy
} -returnCodes error \
    -result {Unable to set default, expected action, got "x"}

# # ## ### ##### ######## ############# #####################

test xo-officer-4.0 {officer/action DSL, alias, wrong\#args} -setup {
    cmdr create x foo {
	alias
    }
} -body {
    x known
} -cleanup {
    x destroy
} -returnCodes error \
    -result "wrong # args: should be \"alias name ...\""

test xo-officer-4.1 {officer/action DSL, alias, wrong\#args} -setup {
    cmdr create x foo {
	alias x =
    }
} -body {
    x known
} -cleanup {
    x destroy
} -returnCodes error \
    -result "wrong#args: should be \"name ?= cmd ?word...??\""

test xo-officer-4.2 {officer/action DSL, alias, wrong\#args} -setup {
    cmdr create x foo {
	alias x + a
    }
} -body {
    x known
} -cleanup {
    x destroy
} -returnCodes error \
    -result "wrong#args: should be \"name ?= cmd ?word...??\""

test xo-officer-4.3 {officer/action DSL, alias, missing previous definition} -setup {
    cmdr create x foo {
	alias x
    }
} -body {
    x known
} -cleanup {
    x destroy
} -returnCodes error \
    -result {Cannot be used as first command}

test xo-officer-4.4 {officer/action DSL, alias, missing definition} -setup {
    cmdr create x foo {
	alias x = y
    }
} -body {
    x known
} -cleanup {
    x destroy
} -returnCodes error \
    -result {Expected action name, got "y"}

# # ## ### ##### ######## ############# #####################

test xo-officer-5.1 {officer/action DSL, description, wrong\#args} -setup {
    cmdr create x foo {
	description
    }
} -body {
    x known
} -cleanup {
    x destroy
} -returnCodes error \
    -result "wrong # args: should be \"description text\""

test xo-officer-5.2 {officer/action DSL, description, wrong\#args} -setup {
    cmdr create x foo {
	description a b
    }
} -body {
    x known
} -cleanup {
    x destroy
} -returnCodes error \
    -result "wrong # args: should be \"description text\""

# # ## ### ##### ######## ############# #####################

test xo-officer-6.1 {officer/action DSL, common, wrong\#args} -setup {
    cmdr create x foo {
	common
    }
} -body {
    x known
} -cleanup {
    x destroy
} -returnCodes error \
    -result "wrong # args: should be \"common key data\""

test xo-officer-6.2 {officer/action DSL, common, wrong\#args} -setup {
    cmdr create x foo {
	common KEY
    }
} -body {
    x known
} -cleanup {
    x destroy
} -returnCodes error \
    -result "wrong # args: should be \"common key data\""

test xo-officer-6.3 {officer/action DSL, common, wrong\#args} -setup {
    cmdr create x foo {
	common KEY DATA X
    }
} -body {
    x known
} -cleanup {
    x destroy
} -returnCodes error \
    -result "wrong # args: should be \"common key data\""

# # ## ### ##### ######## ############# #####################
return
|



|







 







|










|










|












|










|










|












|










|










|










|










|












|










|












|










|










|












1
2
3
4
5
6
7
8
9
10
11
12
..
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
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
# -*- tcl -*- Include file for cmdr.test.
# # ## ### ##### ######## ############# #####################
## Hierarchy of actions, aliases, defaults.

test cmdr-officer-1.0 {hierarchy: defaults, aliases, descriptions, commons} -body {
    cmdr create x foo {
	common K D
	description TEST
	officer bar {}
	default
	alias snafu
	officer tool {
................................................................................
        help --> help
    }
}

# # ## ### ##### ######## ############# #####################
## Error cases of the action DSL.

test cmdr-officer-2.0 {officer/action DSL, officer, wrong\#args} -setup {
    cmdr create x foo {
	officer
    }
} -body {
    x known
} -cleanup {
    x destroy
} -returnCodes error \
    -result "wrong # args: should be \"officer name ...\""

test cmdr-officer-2.1 {officer/action DSL, officer, wrong\#args} -setup {
    cmdr create x foo {
	officer foo
    }
} -body {
    x known
} -cleanup {
    x destroy
} -returnCodes error -match glob \
    -result "wrong # args: should be \"cmdr::officer create ::oo::*::officer_foo super name actions\""

test cmdr-officer-2.2 {officer/action DSL, officer, wrong\#args} -setup {
    cmdr create x foo {
	officer foo {} x
    }
} -body {
    x known
} -cleanup {
    x destroy
} -returnCodes error -match glob \
    -result "wrong # args: should be \"cmdr::officer create ::oo::*::officer_foo super name actions\""

# # ## ### ##### ######## ############# #####################

test cmdr-officer-3.0 {officer/action DSL, default, missing previous definition} -setup {
    cmdr create x foo {
	default
    }
} -body {
    x known
} -cleanup {
    x destroy
} -returnCodes error \
    -result {Cannot be used as first command}

test cmdr-officer-3.1 {officer/action DSL, default, wrong\#args} -setup {
    cmdr create x foo {
	default x y
    }
} -body {
    x known
} -cleanup {
    x destroy
} -returnCodes error \
    -result {wrong # args: should be "default ?name?"}

test cmdr-officer-3.2 {officer/action DSL, default, unknown action} -setup {
    cmdr create x foo {
	default x
    }
} -body {
    x known
} -cleanup {
    x destroy
} -returnCodes error \
    -result {Unable to set default, expected action, got "x"}

# # ## ### ##### ######## ############# #####################

test cmdr-officer-4.0 {officer/action DSL, alias, wrong\#args} -setup {
    cmdr create x foo {
	alias
    }
} -body {
    x known
} -cleanup {
    x destroy
} -returnCodes error \
    -result "wrong # args: should be \"alias name ...\""

test cmdr-officer-4.1 {officer/action DSL, alias, wrong\#args} -setup {
    cmdr create x foo {
	alias x =
    }
} -body {
    x known
} -cleanup {
    x destroy
} -returnCodes error \
    -result "wrong#args: should be \"name ?= cmd ?word...??\""

test cmdr-officer-4.2 {officer/action DSL, alias, wrong\#args} -setup {
    cmdr create x foo {
	alias x + a
    }
} -body {
    x known
} -cleanup {
    x destroy
} -returnCodes error \
    -result "wrong#args: should be \"name ?= cmd ?word...??\""

test cmdr-officer-4.3 {officer/action DSL, alias, missing previous definition} -setup {
    cmdr create x foo {
	alias x
    }
} -body {
    x known
} -cleanup {
    x destroy
} -returnCodes error \
    -result {Cannot be used as first command}

test cmdr-officer-4.4 {officer/action DSL, alias, missing definition} -setup {
    cmdr create x foo {
	alias x = y
    }
} -body {
    x known
} -cleanup {
    x destroy
} -returnCodes error \
    -result {Expected action name, got "y"}

# # ## ### ##### ######## ############# #####################

test cmdr-officer-5.1 {officer/action DSL, description, wrong\#args} -setup {
    cmdr create x foo {
	description
    }
} -body {
    x known
} -cleanup {
    x destroy
} -returnCodes error \
    -result "wrong # args: should be \"description text\""

test cmdr-officer-5.2 {officer/action DSL, description, wrong\#args} -setup {
    cmdr create x foo {
	description a b
    }
} -body {
    x known
} -cleanup {
    x destroy
} -returnCodes error \
    -result "wrong # args: should be \"description text\""

# # ## ### ##### ######## ############# #####################

test cmdr-officer-6.1 {officer/action DSL, common, wrong\#args} -setup {
    cmdr create x foo {
	common
    }
} -body {
    x known
} -cleanup {
    x destroy
} -returnCodes error \
    -result "wrong # args: should be \"common key data\""

test cmdr-officer-6.2 {officer/action DSL, common, wrong\#args} -setup {
    cmdr create x foo {
	common KEY
    }
} -body {
    x known
} -cleanup {
    x destroy
} -returnCodes error \
    -result "wrong # args: should be \"common key data\""

test cmdr-officer-6.3 {officer/action DSL, common, wrong\#args} -setup {
    cmdr create x foo {
	common KEY DATA X
    }
} -body {
    x known
} -cleanup {
    x destroy
} -returnCodes error \
    -result "wrong # args: should be \"common key data\""

# # ## ### ##### ######## ############# #####################
return

Changes to tests/parameter.tests.

1
2
3
4
5
6
7
8
..
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
..
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
..
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
...
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
...
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
...
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
...
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
...
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
...
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
...
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
...
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
...
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
...
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
...
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
...
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
...
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
...
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
...
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
...
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
...
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
...
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
...
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
...
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
...
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
...
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
...
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
...
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
...
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
...
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
...
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
...
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
...
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
# -*- tcl -*- Include file for xo.test.
# # ## ### ##### ######## ############# #####################
## DSL commands under test:
## (1) alias
## (2) default
## (3) generate
## (4) interact
## (5) list
................................................................................
## (7) test
## (8) validate
## (9) when-defined

# # ## ### ##### ######## ############# #####################
## Parameter DSL: 'alias' across parameters (input, option, state)

test xo-parameter-1.0 {parameter DSL, alias, wrong num args, not enough} -body {
    BadParamSpec input { alias }
} -returnCodes error \
    -result "wrong # args: should be \"alias name\""

test xo-parameter-1.1 {parameter DSL, alias, wrong num args, too many} -body {
    BadParamSpec input { alias X Y }
} -returnCodes error \
    -result "wrong # args: should be \"alias name\""

test xo-parameter-1.2 {parameter DSL, input, alias} -body {
    BadParamSpec input { alias X }
} -returnCodes error \
    -result {Non-option parameter "A" cannot have alias}

test xo-parameter-1.3 {parameter DSL, option, alias} -body {
    NiceParamSpec option { alias X }
} -result {
    foo bar = {
        description: ''
        option (--no-A) = A
        option (-A) = A
        option (-X) = A
................................................................................
            ge ()
            va (::cmdr::validate::boolean)
            wd ()
        }
    }
}

test xo-parameter-1.4 {parameter DSL, state, alias} -body {
    BadParamSpec state { alias X }
} -returnCodes error \
    -result {Non-option parameter "A" cannot have alias}

test xo-parameter-1.5 {parameter DSL, negative option, alias} -body {
    NiceParamSpec option { alias X } no-A
} -result {
    foo bar = {
        description: ''
        option (--no-A) = no-A
        option (-A) = no-A
        option (-X) = no-A
................................................................................
        }
    }
}

# # ## ### ##### ######## ############# #####################
## Parameter DSL: 'default' across parameters (input, option, state)

test xo-parameter-2.0 {parameter DSL, default, wrong num args, not enough} -body {
    BadParamSpec input { default }
} -returnCodes error \
    -result "wrong # args: should be \"default value\""

test xo-parameter-2.1 {parameter DSL, default, wrong num args, too many} -body {
    BadParamSpec input { default X Y }
} -returnCodes error \
    -result "wrong # args: should be \"default value\""

test xo-parameter-2.2 {(C6) parameter DSL, input, default, forbidden} -body {
    BadParamSpec input { default VALUE }
} -returnCodes error \
    -result {Required argument "A" must not have default value}

test xo-parameter-2.3 {parameter DSL, optional input, default, auto validate boolean} -body {
    NiceParamSpec input { optional ; default 0 }
} -result {
    foo bar = {
        description: ''
        argument (A)
        para (A) {
            description: '-'
................................................................................
            ge ()
            va (::cmdr::validate::boolean)
            wd ()
        }
    }
}

test xo-parameter-2.4 {parameter DSL, optional input, default, auto validate integer} -body {
    NiceParamSpec input { optional ; default 2 }
} -result {
    foo bar = {
        description: ''
        argument (A)
        para (A) {
            description: '-'
................................................................................
            ge ()
            va (::cmdr::validate::integer)
            wd ()
        }
    }
}

test xo-parameter-2.5 {parameter DSL, optional input, default, auto validate identity} -body {
    NiceParamSpec input { optional ; default X }
} -result {
    foo bar = {
        description: ''
        argument (A)
        para (A) {
            description: '-'
................................................................................
            ge ()
            va (::cmdr::validate::identity)
            wd ()
        }
    }
}

test xo-parameter-2.6 {parameter DSL, option, default, auto validate boolean} -body {
    NiceParamSpec option { default 0 }
} -result {
    foo bar = {
        description: ''
        option (--no-A) = A
        option (-A) = A
        map --n --> (--no-A)
................................................................................
            ge ()
            va (::cmdr::validate::boolean)
            wd ()
        }
    }
}

test xo-parameter-2.7 {parameter DSL, option, default, auto validate integer } -body {
    NiceParamSpec option { default 2 }
} -result {
    foo bar = {
        description: ''
        option (-A) = A
        map -A --> (-A)
        para (A) {
................................................................................
            ge ()
            va (::cmdr::validate::integer)
            wd ()
        }
    }
}

test xo-parameter-2.8 {parameter DSL, option, default, auto validate identity} -body {
    NiceParamSpec option { default X }
} -result {
    foo bar = {
        description: ''
        option (-A) = A
        map -A --> (-A)
        para (A) {
................................................................................
            ge ()
            va (::cmdr::validate::identity)
            wd ()
        }
    }
}

test xo-parameter-2.9 {parameter DSL, state, default, auto validate boolean} -body {
    NiceParamSpec state { default 0 }
} -result {
    foo bar = {
        description: ''
        para (A) {
            description: '-'
            !ordered, !cmdline, !splat, required, !interact
................................................................................
            ge ()
            va (::cmdr::validate::boolean)
            wd ()
        }
    }
}

test xo-parameter-2.10 {parameter DSL, state, default, auto validate integer} -body {
    NiceParamSpec state { default 2 }
} -result {
    foo bar = {
        description: ''
        para (A) {
            description: '-'
            !ordered, !cmdline, !splat, required, !interact
................................................................................
            ge ()
            va (::cmdr::validate::integer)
            wd ()
        }
    }
}

test xo-parameter-2.11 {parameter DSL, state, default, auto validate identity} -body {
    NiceParamSpec state { default X }
} -result {
    foo bar = {
        description: ''
        para (A) {
            description: '-'
            !ordered, !cmdline, !splat, required, !interact
................................................................................
            ge ()
            va (::cmdr::validate::identity)
            wd ()
        }
    }
}

test xo-parameter-2.12 {(C7) parameter DSL, optional input, default after generate} -body {
    BadParamSpec input { optional ; generate X ; default VALUE }
} -returnCodes error \
    -result {Default value and generator command for parameter "A" are in conflict}

test xo-parameter-2.13 {(C7) parameter DSL, option, default after generate} -body {
    BadParamSpec option { generate X ; default VALUE }
} -returnCodes error \
    -result {Default value and generator command for parameter "A" are in conflict}

test xo-parameter-2.14 {(C7) parameter DSL, state, default after generate} -body {
    BadParamSpec state { generate X ; default VALUE }
} -returnCodes error \
    -result {Default value and generator command for parameter "A" are in conflict}

# # ## ### ##### ######## ############# #####################
## Parameter DSL: 'generate' across parameters (input, option, state)

test xo-parameter-3.0 {parameter DSL, optional, wrong num args, too many} -body {
    BadParamSpec input { generate X Y }
} -returnCodes error \
    -result "wrong # args: should be \"generate cmd\""

test xo-parameter-3.1 {parameter DSL, optional, wrong num args, too many} -body {
    BadParamSpec input { generate X Y }
} -returnCodes error \
    -result "wrong # args: should be \"generate cmd\""

test xo-parameter-3.1 {(C6) parameter DSL, input, generate, forbidden} -body {
    BadParamSpec input { generate G }
} -returnCodes error \
    -result {Required argument "A" must not have generator command}

test xo-parameter-3.2 {parameter DSL, optional input, generate} -body {
    NiceParamSpec input { optional ; generate G }
} -result {
    foo bar = {
        description: ''
        argument (A)
        para (A) {
            description: '-'
................................................................................
            ge (G)
            va (::cmdr::validate::identity)
            wd ()
        }
    }
}

test xo-parameter-3.3 {parameter DSL, option, generate} -body {
    NiceParamSpec option { generate G }
} -result {
    foo bar = {
        description: ''
        option (-A) = A
        map -A --> (-A)
        para (A) {
................................................................................
            ge (G)
            va (::cmdr::validate::identity)
            wd ()
        }
    }
}

test xo-parameter-3.4 {parameter DSL, state, generate} -body {
    NiceParamSpec state { generate G }
} -result {
    foo bar = {
        description: ''
        para (A) {
            description: '-'
            !ordered, !cmdline, !splat, required, !interact
................................................................................
            ge (G)
            va (::cmdr::validate::identity)
            wd ()
        }
    }
}

test xo-parameter-3.5 {(C7) parameter DSL, optional input, generate after default} -body {
    BadParamSpec input { optional ; default VALUE ; generate X }
} -returnCodes error \
    -result {Default value and generator command for parameter "A" are in conflict}

test xo-parameter-3.6 {(C7) parameter DSL, option, generate after default} -body {
    BadParamSpec option { default VALUE ; generate X }
} -returnCodes error \
    -result {Default value and generator command for parameter "A" are in conflict}

test xo-parameter-3.7 {(C7) parameter DSL, state, generate after default} -body {
    BadParamSpec state { default VALUE ; generate X }
} -returnCodes error \
    -result {Default value and generator command for parameter "A" are in conflict}

# # ## ### ##### ######## ############# #####################
## Parameter DSL: 'interact' across parameters (input, option, state)

test xo-parameter-4.0 {parameter DSL, optional, wrong num args, too many} -body {
    BadParamSpec input { interact X Y }
} -returnCodes error \
    -result "wrong # args: should be \"interact ?prompt?\""

test xo-parameter-4.1 {(C6) parameter DSL, input, interact, forbidden} -body {
    BadParamSpec input { interact }
} -returnCodes error \
    -result {Required argument "A" must not have user interaction}

test xo-parameter-4.2 {parameter DSL, optional input, interact, default prompt} -body {
    NiceParamSpec input { optional ; interact }
} -result {
    foo bar = {
        description: ''
        argument (A)
        para (A) {
            description: '-'
................................................................................
            ge ()
            va (::cmdr::validate::identity)
            wd ()
        }
    }
}

test xo-parameter-4.3 {parameter DSL, optional input, interact, custom prompt} -body {
    NiceParamSpec input { optional ; interact HERE }
} -result {
    foo bar = {
        description: ''
        argument (A)
        para (A) {
            description: '-'
................................................................................
            ge ()
            va (::cmdr::validate::identity)
            wd ()
        }
    }
}

test xo-parameter-4.4 {parameter DSL, option, interact} -body {
    NiceParamSpec option { interact }
} -result {
    foo bar = {
        description: ''
        option (--no-A) = A
        option (-A) = A
        map --n --> (--no-A)
................................................................................
            ge ()
            va (::cmdr::validate::boolean)
            wd ()
        }
    }
}

test xo-parameter-4.5 {parameter DSL, state, interact} -body {
    NiceParamSpec state { interact }
} -result {
    foo bar = {
        description: ''
        para (A) {
            description: '-'
            !ordered, !cmdline, !splat, required, interact
................................................................................
        }
    }
}

# # ## ### ##### ######## ############# #####################
## Parameter DSL: 'list' across parameters (input, option, state)

test xo-parameter-5.0 {parameter DSL, list, wrong num args, too many} -body {
    BadParamSpec input { list X }
} -returnCodes error \
    -result "wrong # args: should be \"list\""

test xo-parameter-5.1 {parameter DSL, list input} -body {
    NiceParamSpec input { list }
} -result {
    foo bar = {
        description: ''
        argument (A)
        para (A) {
            description: '-'
................................................................................
            ge ()
            va (::cmdr::validate::identity)
            wd ()
        }
    }
}

test xo-parameter-5.2 {parameter DSL, list input not last} -body {
    # Double input, BadParamSpec not suitable
    cmdr create x foo {
	private bar {
	    input A - { list }
	    input X -
	} {}
    }
    [x lookup bar] keys
} -cleanup {
    x destroy
} -returnCodes error \
    -result {A splat must be the last argument in the specification}

test xo-parameter-5.3 {parameter DSL, list option} -body {
    NiceParamSpec option { list }
} -result {
    foo bar = {
        description: ''
        option (--no-A) = A
        option (-A) = A
        map --n --> (--no-A)
................................................................................
            ge ()
            va (::cmdr::validate::boolean)
            wd ()
        }
    }
}

test xo-parameter-5.4 {parameter DSL, list state} -body {
    NiceParamSpec state { list }
} -result {
    foo bar = {
        description: ''
        para (A) {
            description: '-'
            !ordered, !cmdline, splat, required, !interact
................................................................................
        }
    }
}

# # ## ### ##### ######## ############# #####################
## Parameter DSL: 'optional' across parameters (input, option, state)

test xo-parameter-6.0 {parameter DSL, optional, wrong num args, too many} -body {
    BadParamSpec input { optional X }
} -returnCodes error \
    -result "wrong # args: should be \"optional\""

test xo-parameter-6.1 {parameter DSL, optional input} -body {
    NiceParamSpec input { optional }
} -result {
    foo bar = {
        description: ''
        argument (A)
        para (A) {
            description: '-'
................................................................................
            ge ()
            va (::cmdr::validate::identity)
            wd ()
        }
    }
}

test xo-parameter-6.2 {parameter DSL, optional option} -body {
    BadParamSpec option { optional }
} -returnCodes error \
    -result {Option "A" is already optional}

test xo-parameter-6.3 {parameter DSL, optional state} -body {
    BadParamSpec state { optional }
} -returnCodes error \
    -result {State parameter "A" cannot be optional}

# # ## ### ##### ######## ############# #####################
## Parameter DSL: 'test' across parameters (input, option, state)

test xo-parameter-7.0 {parameter DSL, test, wrong num args, too many} -body {
    BadParamSpec input { test X }
} -returnCodes error \
    -result "wrong # args: should be \"test\""

test xo-parameter-7.1 {parameter DSL, input, test} -body {
    BadParamSpec input { test }
} -returnCodes error \
    -result {Required argument "A" has no test-mode}

test xo-parameter-7.2 {parameter DSL, optional input, test} -body {
    NiceParamSpec input { optional ; test }
} -result {
    foo bar = {
        description: ''
        argument (A)
        para (A) {
            description: '-'
................................................................................
            ge ()
            va (::cmdr::validate::identity)
            wd ()
        }
    }
}

test xo-parameter-7.3 {parameter DSL, option, test} -body {
    BadParamSpec option { test }
} -returnCodes error \
    -result {Option "A" has no test-mode}

test xo-parameter-7.4 {parameter DSL, state, test} -body {
    BadParamSpec state { test }
} -returnCodes error \
    -result {State parameter "A" has no test-mode}

# # ## ### ##### ######## ############# #####################
## Parameter DSL: 'validate' across parameters (input, option, state)

test xo-parameter-8.0 {parameter DSL, validate, wrong num args, not enough} -body {
    BadParamSpec input { validate }
} -returnCodes error \
    -result "wrong # args: should be \"validate cmd\""

test xo-parameter-8.1 {parameter DSL, validate, wrong num args, too many} -body {
    BadParamSpec input { validate X Y }
} -returnCodes error \
    -result "wrong # args: should be \"validate cmd\""

test xo-parameter-8.2 {parameter DSL, input, validate, shorthand} -body {
    NiceParamSpec input { validate integer }
} -result {
    foo bar = {
        description: ''
        argument (A)
        para (A) {
            description: '-'
................................................................................
            ge ()
            va (::cmdr::validate::integer)
            wd ()
        }
    }
}

test xo-parameter-8.3 {parameter DSL, input, validate} -body {
    NiceParamSpec input { validate ::cmdr::validate::identity }
} -result {
    foo bar = {
        description: ''
        argument (A)
        para (A) {
            description: '-'
................................................................................
            ge ()
            va (::cmdr::validate::identity)
            wd ()
        }
    }
}

test xo-parameter-8.4 {parameter DSL, option, validate, shorthand} -body {
    NiceParamSpec option { validate integer }
} -result {
    foo bar = {
        description: ''
        option (-A) = A
        map -A --> (-A)
        para (A) {
................................................................................
            ge ()
            va (::cmdr::validate::integer)
            wd ()
        }
    }
}

test xo-parameter-8.5 {parameter DSL, option, validate} -body {
    NiceParamSpec option { validate ::cmdr::validate::identity }
} -result {
    foo bar = {
        description: ''
        option (-A) = A
        map -A --> (-A)
        para (A) {
................................................................................
            ge ()
            va (::cmdr::validate::identity)
            wd ()
        }
    }
}

test xo-parameter-8.6 {parameter DSL, state, validate, shorthand} -body {
    NiceParamSpec state { validate integer }
} -result {
    foo bar = {
        description: ''
        para (A) {
            description: '-'
            !ordered, !cmdline, !splat, required, !interact
................................................................................
            ge ()
            va (::cmdr::validate::integer)
            wd ()
        }
    }
}

test xo-parameter-8.7 {parameter DSL, state, validate} -body {
    NiceParamSpec state { validate ::cmdr::validate::identity }
} -result {
    foo bar = {
        description: ''
        para (A) {
            description: '-'
            !ordered, !cmdline, !splat, required, !interact
................................................................................
        }
    }
}

# # ## ### ##### ######## ############# #####################
## Parameter DSL: 'when-defined' across parameters (input, option, state)

test xo-parameter-9.0 {parameter DSL, when-defined, wrong num args, not enough} -body {
    BadParamSpec input { when-defined }
} -returnCodes error \
    -result "wrong # args: should be \"when-defined cmd\""

test xo-parameter-9.1 {parameter DSL, when-defined, wrong num args, too many} -body {
    BadParamSpec input { when-defined X Y }
} -returnCodes error \
    -result "wrong # args: should be \"when-defined cmd\""

test xo-parameter-9.2 {parameter DSL, input, when-defined} -body {
    NiceParamSpec input { when-defined X }
} -result {
    foo bar = {
        description: ''
        argument (A)
        para (A) {
            description: '-'
................................................................................
            ge ()
            va (::cmdr::validate::identity)
            wd (X)
        }
    }
}

test xo-parameter-9.3 {parameter DSL, option, when-defined} -body {
    NiceParamSpec option { when-defined X }
} -result {
    foo bar = {
        description: ''
        option (--no-A) = A
        option (-A) = A
        map --n --> (--no-A)
................................................................................
            ge ()
            va (::cmdr::validate::boolean)
            wd (X)
        }
    }
}

test xo-parameter-9.4 {parameter DSL, state, when-defined} -body {
    NiceParamSpec state { when-defined X }
} -result {
    foo bar = {
        description: ''
        para (A) {
            description: '-'
            !ordered, !cmdline, !splat, required, !interact
|







 







|




|




|




|







 







|




|







 







|




|




|




|







 







|







 







|







 







|







 







|







 







|







 







|







 







|







 







|







 







|




|




|







|




|




|




|







 







|







 







|







 







|




|




|







|




|




|







 







|







 







|







 







|







 







|




|







 







|













|







 







|







 







|




|







 







|




|







|




|




|







 







|




|







|




|




|







 







|







 







|







 







|







 







|







 







|







 







|




|




|







 







|







 







|







1
2
3
4
5
6
7
8
..
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
..
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
..
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
...
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
...
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
...
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
...
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
...
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
...
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
...
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
...
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
...
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
...
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
...
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
...
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
...
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
...
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
...
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
...
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
...
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
...
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
...
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
...
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
...
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
...
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
...
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
...
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
...
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
...
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
...
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
...
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
...
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
# -*- tcl -*- Include file for cmdr.test.
# # ## ### ##### ######## ############# #####################
## DSL commands under test:
## (1) alias
## (2) default
## (3) generate
## (4) interact
## (5) list
................................................................................
## (7) test
## (8) validate
## (9) when-defined

# # ## ### ##### ######## ############# #####################
## Parameter DSL: 'alias' across parameters (input, option, state)

test cmdr-parameter-1.0 {parameter DSL, alias, wrong num args, not enough} -body {
    BadParamSpec input { alias }
} -returnCodes error \
    -result "wrong # args: should be \"alias name\""

test cmdr-parameter-1.1 {parameter DSL, alias, wrong num args, too many} -body {
    BadParamSpec input { alias X Y }
} -returnCodes error \
    -result "wrong # args: should be \"alias name\""

test cmdr-parameter-1.2 {parameter DSL, input, alias} -body {
    BadParamSpec input { alias X }
} -returnCodes error \
    -result {Non-option parameter "A" cannot have alias}

test cmdr-parameter-1.3 {parameter DSL, option, alias} -body {
    NiceParamSpec option { alias X }
} -result {
    foo bar = {
        description: ''
        option (--no-A) = A
        option (-A) = A
        option (-X) = A
................................................................................
            ge ()
            va (::cmdr::validate::boolean)
            wd ()
        }
    }
}

test cmdr-parameter-1.4 {parameter DSL, state, alias} -body {
    BadParamSpec state { alias X }
} -returnCodes error \
    -result {Non-option parameter "A" cannot have alias}

test cmdr-parameter-1.5 {parameter DSL, negative option, alias} -body {
    NiceParamSpec option { alias X } no-A
} -result {
    foo bar = {
        description: ''
        option (--no-A) = no-A
        option (-A) = no-A
        option (-X) = no-A
................................................................................
        }
    }
}

# # ## ### ##### ######## ############# #####################
## Parameter DSL: 'default' across parameters (input, option, state)

test cmdr-parameter-2.0 {parameter DSL, default, wrong num args, not enough} -body {
    BadParamSpec input { default }
} -returnCodes error \
    -result "wrong # args: should be \"default value\""

test cmdr-parameter-2.1 {parameter DSL, default, wrong num args, too many} -body {
    BadParamSpec input { default X Y }
} -returnCodes error \
    -result "wrong # args: should be \"default value\""

test cmdr-parameter-2.2 {(C6) parameter DSL, input, default, forbidden} -body {
    BadParamSpec input { default VALUE }
} -returnCodes error \
    -result {Required argument "A" must not have default value}

test cmdr-parameter-2.3 {parameter DSL, optional input, default, auto validate boolean} -body {
    NiceParamSpec input { optional ; default 0 }
} -result {
    foo bar = {
        description: ''
        argument (A)
        para (A) {
            description: '-'
................................................................................
            ge ()
            va (::cmdr::validate::boolean)
            wd ()
        }
    }
}

test cmdr-parameter-2.4 {parameter DSL, optional input, default, auto validate integer} -body {
    NiceParamSpec input { optional ; default 2 }
} -result {
    foo bar = {
        description: ''
        argument (A)
        para (A) {
            description: '-'
................................................................................
            ge ()
            va (::cmdr::validate::integer)
            wd ()
        }
    }
}

test cmdr-parameter-2.5 {parameter DSL, optional input, default, auto validate identity} -body {
    NiceParamSpec input { optional ; default X }
} -result {
    foo bar = {
        description: ''
        argument (A)
        para (A) {
            description: '-'
................................................................................
            ge ()
            va (::cmdr::validate::identity)
            wd ()
        }
    }
}

test cmdr-parameter-2.6 {parameter DSL, option, default, auto validate boolean} -body {
    NiceParamSpec option { default 0 }
} -result {
    foo bar = {
        description: ''
        option (--no-A) = A
        option (-A) = A
        map --n --> (--no-A)
................................................................................
            ge ()
            va (::cmdr::validate::boolean)
            wd ()
        }
    }
}

test cmdr-parameter-2.7 {parameter DSL, option, default, auto validate integer } -body {
    NiceParamSpec option { default 2 }
} -result {
    foo bar = {
        description: ''
        option (-A) = A
        map -A --> (-A)
        para (A) {
................................................................................
            ge ()
            va (::cmdr::validate::integer)
            wd ()
        }
    }
}

test cmdr-parameter-2.8 {parameter DSL, option, default, auto validate identity} -body {
    NiceParamSpec option { default X }
} -result {
    foo bar = {
        description: ''
        option (-A) = A
        map -A --> (-A)
        para (A) {
................................................................................
            ge ()
            va (::cmdr::validate::identity)
            wd ()
        }
    }
}

test cmdr-parameter-2.9 {parameter DSL, state, default, auto validate boolean} -body {
    NiceParamSpec state { default 0 }
} -result {
    foo bar = {
        description: ''
        para (A) {
            description: '-'
            !ordered, !cmdline, !splat, required, !interact
................................................................................
            ge ()
            va (::cmdr::validate::boolean)
            wd ()
        }
    }
}

test cmdr-parameter-2.10 {parameter DSL, state, default, auto validate integer} -body {
    NiceParamSpec state { default 2 }
} -result {
    foo bar = {
        description: ''
        para (A) {
            description: '-'
            !ordered, !cmdline, !splat, required, !interact
................................................................................
            ge ()
            va (::cmdr::validate::integer)
            wd ()
        }
    }
}

test cmdr-parameter-2.11 {parameter DSL, state, default, auto validate identity} -body {
    NiceParamSpec state { default X }
} -result {
    foo bar = {
        description: ''
        para (A) {
            description: '-'
            !ordered, !cmdline, !splat, required, !interact
................................................................................
            ge ()
            va (::cmdr::validate::identity)
            wd ()
        }
    }
}

test cmdr-parameter-2.12 {(C7) parameter DSL, optional input, default after generate} -body {
    BadParamSpec input { optional ; generate X ; default VALUE }
} -returnCodes error \
    -result {Default value and generator command for parameter "A" are in conflict}

test cmdr-parameter-2.13 {(C7) parameter DSL, option, default after generate} -body {
    BadParamSpec option { generate X ; default VALUE }
} -returnCodes error \
    -result {Default value and generator command for parameter "A" are in conflict}

test cmdr-parameter-2.14 {(C7) parameter DSL, state, default after generate} -body {
    BadParamSpec state { generate X ; default VALUE }
} -returnCodes error \
    -result {Default value and generator command for parameter "A" are in conflict}

# # ## ### ##### ######## ############# #####################
## Parameter DSL: 'generate' across parameters (input, option, state)

test cmdr-parameter-3.0 {parameter DSL, optional, wrong num args, too many} -body {
    BadParamSpec input { generate X Y }
} -returnCodes error \
    -result "wrong # args: should be \"generate cmd\""

test cmdr-parameter-3.1 {parameter DSL, optional, wrong num args, too many} -body {
    BadParamSpec input { generate X Y }
} -returnCodes error \
    -result "wrong # args: should be \"generate cmd\""

test cmdr-parameter-3.1 {(C6) parameter DSL, input, generate, forbidden} -body {
    BadParamSpec input { generate G }
} -returnCodes error \
    -result {Required argument "A" must not have generator command}

test cmdr-parameter-3.2 {parameter DSL, optional input, generate} -body {
    NiceParamSpec input { optional ; generate G }
} -result {
    foo bar = {
        description: ''
        argument (A)
        para (A) {
            description: '-'
................................................................................
            ge (G)
            va (::cmdr::validate::identity)
            wd ()
        }
    }
}

test cmdr-parameter-3.3 {parameter DSL, option, generate} -body {
    NiceParamSpec option { generate G }
} -result {
    foo bar = {
        description: ''
        option (-A) = A
        map -A --> (-A)
        para (A) {
................................................................................
            ge (G)
            va (::cmdr::validate::identity)
            wd ()
        }
    }
}

test cmdr-parameter-3.4 {parameter DSL, state, generate} -body {
    NiceParamSpec state { generate G }
} -result {
    foo bar = {
        description: ''
        para (A) {
            description: '-'
            !ordered, !cmdline, !splat, required, !interact
................................................................................
            ge (G)
            va (::cmdr::validate::identity)
            wd ()
        }
    }
}

test cmdr-parameter-3.5 {(C7) parameter DSL, optional input, generate after default} -body {
    BadParamSpec input { optional ; default VALUE ; generate X }
} -returnCodes error \
    -result {Default value and generator command for parameter "A" are in conflict}

test cmdr-parameter-3.6 {(C7) parameter DSL, option, generate after default} -body {
    BadParamSpec option { default VALUE ; generate X }
} -returnCodes error \
    -result {Default value and generator command for parameter "A" are in conflict}

test cmdr-parameter-3.7 {(C7) parameter DSL, state, generate after default} -body {
    BadParamSpec state { default VALUE ; generate X }
} -returnCodes error \
    -result {Default value and generator command for parameter "A" are in conflict}

# # ## ### ##### ######## ############# #####################
## Parameter DSL: 'interact' across parameters (input, option, state)

test cmdr-parameter-4.0 {parameter DSL, optional, wrong num args, too many} -body {
    BadParamSpec input { interact X Y }
} -returnCodes error \
    -result "wrong # args: should be \"interact ?prompt?\""

test cmdr-parameter-4.1 {(C6) parameter DSL, input, interact, forbidden} -body {
    BadParamSpec input { interact }
} -returnCodes error \
    -result {Required argument "A" must not have user interaction}

test cmdr-parameter-4.2 {parameter DSL, optional input, interact, default prompt} -body {
    NiceParamSpec input { optional ; interact }
} -result {
    foo bar = {
        description: ''
        argument (A)
        para (A) {
            description: '-'
................................................................................
            ge ()
            va (::cmdr::validate::identity)
            wd ()
        }
    }
}

test cmdr-parameter-4.3 {parameter DSL, optional input, interact, custom prompt} -body {
    NiceParamSpec input { optional ; interact HERE }
} -result {
    foo bar = {
        description: ''
        argument (A)
        para (A) {
            description: '-'
................................................................................
            ge ()
            va (::cmdr::validate::identity)
            wd ()
        }
    }
}

test cmdr-parameter-4.4 {parameter DSL, option, interact} -body {
    NiceParamSpec option { interact }
} -result {
    foo bar = {
        description: ''
        option (--no-A) = A
        option (-A) = A
        map --n --> (--no-A)
................................................................................
            ge ()
            va (::cmdr::validate::boolean)
            wd ()
        }
    }
}

test cmdr-parameter-4.5 {parameter DSL, state, interact} -body {
    NiceParamSpec state { interact }
} -result {
    foo bar = {
        description: ''
        para (A) {
            description: '-'
            !ordered, !cmdline, !splat, required, interact
................................................................................
        }
    }
}

# # ## ### ##### ######## ############# #####################
## Parameter DSL: 'list' across parameters (input, option, state)

test cmdr-parameter-5.0 {parameter DSL, list, wrong num args, too many} -body {
    BadParamSpec input { list X }
} -returnCodes error \
    -result "wrong # args: should be \"list\""

test cmdr-parameter-5.1 {parameter DSL, list input} -body {
    NiceParamSpec input { list }
} -result {
    foo bar = {
        description: ''
        argument (A)
        para (A) {
            description: '-'
................................................................................
            ge ()
            va (::cmdr::validate::identity)
            wd ()
        }
    }
}

test cmdr-parameter-5.2 {parameter DSL, list input not last} -body {
    # Double input, BadParamSpec not suitable
    cmdr create x foo {
	private bar {
	    input A - { list }
	    input X -
	} {}
    }
    [x lookup bar] keys
} -cleanup {
    x destroy
} -returnCodes error \
    -result {A splat must be the last argument in the specification}

test cmdr-parameter-5.3 {parameter DSL, list option} -body {
    NiceParamSpec option { list }
} -result {
    foo bar = {
        description: ''
        option (--no-A) = A
        option (-A) = A
        map --n --> (--no-A)
................................................................................
            ge ()
            va (::cmdr::validate::boolean)
            wd ()
        }
    }
}

test cmdr-parameter-5.4 {parameter DSL, list state} -body {
    NiceParamSpec state { list }
} -result {
    foo bar = {
        description: ''
        para (A) {
            description: '-'
            !ordered, !cmdline, splat, required, !interact
................................................................................
        }
    }
}

# # ## ### ##### ######## ############# #####################
## Parameter DSL: 'optional' across parameters (input, option, state)

test cmdr-parameter-6.0 {parameter DSL, optional, wrong num args, too many} -body {
    BadParamSpec input { optional X }
} -returnCodes error \
    -result "wrong # args: should be \"optional\""

test cmdr-parameter-6.1 {parameter DSL, optional input} -body {
    NiceParamSpec input { optional }
} -result {
    foo bar = {
        description: ''
        argument (A)
        para (A) {
            description: '-'
................................................................................
            ge ()
            va (::cmdr::validate::identity)
            wd ()
        }
    }
}

test cmdr-parameter-6.2 {parameter DSL, optional option} -body {
    BadParamSpec option { optional }
} -returnCodes error \
    -result {Option "A" is already optional}

test cmdr-parameter-6.3 {parameter DSL, optional state} -body {
    BadParamSpec state { optional }
} -returnCodes error \
    -result {State parameter "A" cannot be optional}

# # ## ### ##### ######## ############# #####################
## Parameter DSL: 'test' across parameters (input, option, state)

test cmdr-parameter-7.0 {parameter DSL, test, wrong num args, too many} -body {
    BadParamSpec input { test X }
} -returnCodes error \
    -result "wrong # args: should be \"test\""

test cmdr-parameter-7.1 {parameter DSL, input, test} -body {
    BadParamSpec input { test }
} -returnCodes error \
    -result {Required argument "A" has no test-mode}

test cmdr-parameter-7.2 {parameter DSL, optional input, test} -body {
    NiceParamSpec input { optional ; test }
} -result {
    foo bar = {
        description: ''
        argument (A)
        para (A) {
            description: '-'
................................................................................
            ge ()
            va (::cmdr::validate::identity)
            wd ()
        }
    }
}

test cmdr-parameter-7.3 {parameter DSL, option, test} -body {
    BadParamSpec option { test }
} -returnCodes error \
    -result {Option "A" has no test-mode}

test cmdr-parameter-7.4 {parameter DSL, state, test} -body {
    BadParamSpec state { test }
} -returnCodes error \
    -result {State parameter "A" has no test-mode}

# # ## ### ##### ######## ############# #####################
## Parameter DSL: 'validate' across parameters (input, option, state)

test cmdr-parameter-8.0 {parameter DSL, validate, wrong num args, not enough} -body {
    BadParamSpec input { validate }
} -returnCodes error \
    -result "wrong # args: should be \"validate cmd\""

test cmdr-parameter-8.1 {parameter DSL, validate, wrong num args, too many} -body {
    BadParamSpec input { validate X Y }
} -returnCodes error \
    -result "wrong # args: should be \"validate cmd\""

test cmdr-parameter-8.2 {parameter DSL, input, validate, shorthand} -body {
    NiceParamSpec input { validate integer }
} -result {
    foo bar = {
        description: ''
        argument (A)
        para (A) {
            description: '-'
................................................................................
            ge ()
            va (::cmdr::validate::integer)
            wd ()
        }
    }
}

test cmdr-parameter-8.3 {parameter DSL, input, validate} -body {
    NiceParamSpec input { validate ::cmdr::validate::identity }
} -result {
    foo bar = {
        description: ''
        argument (A)
        para (A) {
            description: '-'
................................................................................
            ge ()
            va (::cmdr::validate::identity)
            wd ()
        }
    }
}

test cmdr-parameter-8.4 {parameter DSL, option, validate, shorthand} -body {
    NiceParamSpec option { validate integer }
} -result {
    foo bar = {
        description: ''
        option (-A) = A
        map -A --> (-A)
        para (A) {
................................................................................
            ge ()
            va (::cmdr::validate::integer)
            wd ()
        }
    }
}

test cmdr-parameter-8.5 {parameter DSL, option, validate} -body {
    NiceParamSpec option { validate ::cmdr::validate::identity }
} -result {
    foo bar = {
        description: ''
        option (-A) = A
        map -A --> (-A)
        para (A) {
................................................................................
            ge ()
            va (::cmdr::validate::identity)
            wd ()
        }
    }
}

test cmdr-parameter-8.6 {parameter DSL, state, validate, shorthand} -body {
    NiceParamSpec state { validate integer }
} -result {
    foo bar = {
        description: ''
        para (A) {
            description: '-'
            !ordered, !cmdline, !splat, required, !interact
................................................................................
            ge ()
            va (::cmdr::validate::integer)
            wd ()
        }
    }
}

test cmdr-parameter-8.7 {parameter DSL, state, validate} -body {
    NiceParamSpec state { validate ::cmdr::validate::identity }
} -result {
    foo bar = {
        description: ''
        para (A) {
            description: '-'
            !ordered, !cmdline, !splat, required, !interact
................................................................................
        }
    }
}

# # ## ### ##### ######## ############# #####################
## Parameter DSL: 'when-defined' across parameters (input, option, state)

test cmdr-parameter-9.0 {parameter DSL, when-defined, wrong num args, not enough} -body {
    BadParamSpec input { when-defined }
} -returnCodes error \
    -result "wrong # args: should be \"when-defined cmd\""

test cmdr-parameter-9.1 {parameter DSL, when-defined, wrong num args, too many} -body {
    BadParamSpec input { when-defined X Y }
} -returnCodes error \
    -result "wrong # args: should be \"when-defined cmd\""

test cmdr-parameter-9.2 {parameter DSL, input, when-defined} -body {
    NiceParamSpec input { when-defined X }
} -result {
    foo bar = {
        description: ''
        argument (A)
        para (A) {
            description: '-'
................................................................................
            ge ()
            va (::cmdr::validate::identity)
            wd (X)
        }
    }
}

test cmdr-parameter-9.3 {parameter DSL, option, when-defined} -body {
    NiceParamSpec option { when-defined X }
} -result {
    foo bar = {
        description: ''
        option (--no-A) = A
        option (-A) = A
        map --n --> (--no-A)
................................................................................
            ge ()
            va (::cmdr::validate::boolean)
            wd (X)
        }
    }
}

test cmdr-parameter-9.4 {parameter DSL, state, when-defined} -body {
    NiceParamSpec state { when-defined X }
} -result {
    foo bar = {
        description: ''
        para (A) {
            description: '-'
            !ordered, !cmdline, !splat, required, !interact

Changes to tests/private.tests.

1
2
3
4
5
6
7
8
9
10
11
..
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
...
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
...
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
...
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
# -*- tcl -*- Include file for xo.test.
# # ## ### ##### ######## ############# #####################

test xo-private-1.0 {private basics, parameter default settings, fragment use} -body {
    cmdr create x foo {
	common def {
	    input  INPUT  INPUT-DESC
	    option OPTION OPTION-DESC
	    state  STATE  STATE-DESC
	}
	private bar {
................................................................................
            ge ()
            va (::cmdr::validate::identity)
            wd ()
        }
    }
}

test xo-private-1.1 {private basics, optional arguments, thresholding} -body {
    cmdr create x foo {
	private bar {
	    description 6.1
	    input A - {}
	    input B - { optional }
	    input C - {}
	    input D - { optional }
................................................................................
        }
    }
}

# # ## ### ##### ######## ############# #####################
## Parameter declaration commands: input, splat, option, state

test xo-private-2.0 {private, input, wrong num args, not enough} -setup {
    cmdr create x foo { private bar { input } ::snafu }
} -body {
    [x lookup bar] keys
} -cleanup {
    x destroy
} -returnCodes error -result "wrong # args: should be \"input name desc ?spec?\""

test xo-private-2.1 {private, input, wrong num args, not enough} -setup {
    cmdr create x foo { private bar { input A } ::snafu }
} -body {
    [x lookup bar] keys
} -cleanup {
    x destroy
} -returnCodes error -result "wrong # args: should be \"input name desc ?spec?\""

test xo-private-2.2 {private, input, wrong num args, too many} -setup {
    cmdr create x foo { private bar { input A D V X } ::snafu }
} -body {
    [x lookup bar] keys
} -cleanup {
    x destroy
} -returnCodes error -result "wrong # args: should be \"input name desc ?spec?\""

test xo-private-2.3 {private, input, defaults} -setup {
    cmdr create x foo { private bar { input A D } ::snafu }
} -body {
    ShowPrivate [x lookup bar]
} -cleanup {
    x destroy
} -result {
    foo bar = {
................................................................................
            wd ()
        }
    }
}

# # ## ### ##### ######## ############# #####################

test xo-private-3.0 {private, option, wrong num args, not enough} -setup {
    cmdr create x foo { private bar { option } ::snafu }
} -body {
    [x lookup bar] keys
} -cleanup {
    x destroy
} -returnCodes error -result "wrong # args: should be \"option name desc ?spec?\""

test xo-private-3.1 {private, option, wrong num args, not enough} -setup {
    cmdr create x foo { private bar { option A } ::snafu }
} -body {
    [x lookup bar] keys
} -cleanup {
    x destroy
} -returnCodes error -result "wrong # args: should be \"option name desc ?spec?\""

test xo-private-3.2 {private, option, wrong num args, too many} -setup {
    cmdr create x foo { private bar { option A D V X } ::snafu }
} -body {
    [x lookup bar] keys
} -cleanup {
    x destroy
} -returnCodes error -result "wrong # args: should be \"option name desc ?spec?\""

test xo-private-3.3 {private, option, defaults} -setup {
    cmdr create x foo { private bar { option A D } ::snafu }
} -body {
    ShowPrivate [x lookup bar]
} -cleanup {
    x destroy
} -result {
    foo bar = {
................................................................................
            wd ()
        }
    }
}

# # ## ### ##### ######## ############# #####################

test xo-private-4.0 {private, state, wrong num args, not enough} -setup {
    cmdr create x foo { private bar { state } ::snafu }
} -body {
    [x lookup bar] keys
} -cleanup {
    x destroy
} -returnCodes error -result "wrong # args: should be \"state name desc ?spec?\""

test xo-private-4.1 {private, state, wrong num args, not enough} -setup {
    cmdr create x foo { private bar { state A } ::snafu }
} -body {
    [x lookup bar] keys
} -cleanup {
    x destroy
} -returnCodes error -result "wrong # args: should be \"state name desc ?spec?\""

test xo-private-4.2 {private, state, wrong num args, too many} -setup {
    cmdr create x foo { private bar { state A D V X } ::snafu }
} -body {
    [x lookup bar] keys
} -cleanup {
    x destroy
} -returnCodes error -result "wrong # args: should be \"state name desc ?spec?\""

test xo-private-4.3 {private, state, defaults} -setup {
    cmdr create x foo { private bar { state A D } ::snafu }
} -body {
    ShowPrivate [x lookup bar]
} -cleanup {
    x destroy
} -result {
    foo bar = {
|


|







 







|







 







|







|







|







|







 







|







|







|







|







 







|







|







|







|







1
2
3
4
5
6
7
8
9
10
11
..
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
...
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
...
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
...
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
# -*- tcl -*- Include file for cmdr.test.
# # ## ### ##### ######## ############# #####################

test cmdr-private-1.0 {private basics, parameter default settings, fragment use} -body {
    cmdr create x foo {
	common def {
	    input  INPUT  INPUT-DESC
	    option OPTION OPTION-DESC
	    state  STATE  STATE-DESC
	}
	private bar {
................................................................................
            ge ()
            va (::cmdr::validate::identity)
            wd ()
        }
    }
}

test cmdr-private-1.1 {private basics, optional arguments, thresholding} -body {
    cmdr create x foo {
	private bar {
	    description 6.1
	    input A - {}
	    input B - { optional }
	    input C - {}
	    input D - { optional }
................................................................................
        }
    }
}

# # ## ### ##### ######## ############# #####################
## Parameter declaration commands: input, splat, option, state

test cmdr-private-2.0 {private, input, wrong num args, not enough} -setup {
    cmdr create x foo { private bar { input } ::snafu }
} -body {
    [x lookup bar] keys
} -cleanup {
    x destroy
} -returnCodes error -result "wrong # args: should be \"input name desc ?spec?\""

test cmdr-private-2.1 {private, input, wrong num args, not enough} -setup {
    cmdr create x foo { private bar { input A } ::snafu }
} -body {
    [x lookup bar] keys
} -cleanup {
    x destroy
} -returnCodes error -result "wrong # args: should be \"input name desc ?spec?\""

test cmdr-private-2.2 {private, input, wrong num args, too many} -setup {
    cmdr create x foo { private bar { input A D V X } ::snafu }
} -body {
    [x lookup bar] keys
} -cleanup {
    x destroy
} -returnCodes error -result "wrong # args: should be \"input name desc ?spec?\""

test cmdr-private-2.3 {private, input, defaults} -setup {
    cmdr create x foo { private bar { input A D } ::snafu }
} -body {
    ShowPrivate [x lookup bar]
} -cleanup {
    x destroy
} -result {
    foo bar = {
................................................................................
            wd ()
        }
    }
}

# # ## ### ##### ######## ############# #####################

test cmdr-private-3.0 {private, option, wrong num args, not enough} -setup {
    cmdr create x foo { private bar { option } ::snafu }
} -body {
    [x lookup bar] keys
} -cleanup {
    x destroy
} -returnCodes error -result "wrong # args: should be \"option name desc ?spec?\""

test cmdr-private-3.1 {private, option, wrong num args, not enough} -setup {
    cmdr create x foo { private bar { option A } ::snafu }
} -body {
    [x lookup bar] keys
} -cleanup {
    x destroy
} -returnCodes error -result "wrong # args: should be \"option name desc ?spec?\""

test cmdr-private-3.2 {private, option, wrong num args, too many} -setup {
    cmdr create x foo { private bar { option A D V X } ::snafu }
} -body {
    [x lookup bar] keys
} -cleanup {
    x destroy
} -returnCodes error -result "wrong # args: should be \"option name desc ?spec?\""

test cmdr-private-3.3 {private, option, defaults} -setup {
    cmdr create x foo { private bar { option A D } ::snafu }
} -body {
    ShowPrivate [x lookup bar]
} -cleanup {
    x destroy
} -result {
    foo bar = {
................................................................................
            wd ()
        }
    }
}

# # ## ### ##### ######## ############# #####################

test cmdr-private-4.0 {private, state, wrong num args, not enough} -setup {
    cmdr create x foo { private bar { state } ::snafu }
} -body {
    [x lookup bar] keys
} -cleanup {
    x destroy
} -returnCodes error -result "wrong # args: should be \"state name desc ?spec?\""

test cmdr-private-4.1 {private, state, wrong num args, not enough} -setup {
    cmdr create x foo { private bar { state A } ::snafu }
} -body {
    [x lookup bar] keys
} -cleanup {
    x destroy
} -returnCodes error -result "wrong # args: should be \"state name desc ?spec?\""

test cmdr-private-4.2 {private, state, wrong num args, too many} -setup {
    cmdr create x foo { private bar { state A D V X } ::snafu }
} -body {
    [x lookup bar] keys
} -cleanup {
    x destroy
} -returnCodes error -result "wrong # args: should be \"state name desc ?spec?\""

test cmdr-private-4.3 {private, state, defaults} -setup {
    cmdr create x foo { private bar { state A D } ::snafu }
} -body {
    ShowPrivate [x lookup bar]
} -cleanup {
    x destroy
} -result {
    foo bar = {

Changes to tests/runtime.tests.

1
2
3
4
5
6
7
8
..
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
..
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
..
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
...
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
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
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
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
...
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
...
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
...
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
...
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
...
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
# -*- tcl -*- Include file for xo.test.
# # ## ### ##### ######## ############# #####################

## Runtime parsing of a command line based on the argument spec.
## Cases to look at:
##
## arguments only
## - required only
................................................................................
## Take examples from the intended target app
## NOTE: interaction not testable!! linenoise - mockup ?!

# # ## ### ##### ######## ############# #####################
## Group I: 5 parameters, required and optional alternating. Called
## with zero to six arguments.

test xo-runtime-1.0 {required + optional arguments, not enough} -body {
    Parse {
	input A - { validate integer }
	input B - { validate integer; optional ; default 0 }
	input C - { validate integer }
	input D - { validate integer; optional ; default 0 }
	input E - { validate integer }
    }
} -returnCodes error \
    -result "wrong\#args, not enough"

test xo-runtime-1.1 {required + optional arguments, not enough} -body {
    Parse {
	input A - { validate integer }
	input B - { validate integer; optional ; default 0 }
	input C - { validate integer }
	input D - { validate integer; optional ; default 0 }
	input E - { validate integer }
    } 1
} -returnCodes error \
    -result "wrong\#args, not enough"

test xo-runtime-1.2 {required + optional arguments, not enough} -body {
    Parse {
	input A - { validate integer }
	input B - { validate integer; optional ; default 0 }
	input C - { validate integer }
	input D - { validate integer; optional ; default 0 }
	input E - { validate integer }
    } 1 2
} -returnCodes error \
    -result "wrong\#args, not enough"

test xo-runtime-1.3 {required + optional arguments, assignment under thresholding} -body {
    Parse {
	input A - { validate integer }
	input B - { validate integer; optional ; default 0 }
	input C - { validate integer }
	input D - { validate integer; optional ; default 0 }
	input E - { validate integer }
    } 1 2 3
................................................................................
    A = '1'         v'1'
    B = <undefined> v'0'
    C = '2'         v'2'
    D = <undefined> v'0'
    E = '3'         v'3'
}

test xo-runtime-1.4 {required + optional arguments, assignment under thresholding} -body {
    Parse {
	input A - { validate integer }
	input B - { validate integer; optional ; default 0 }
	input C - { validate integer }
	input D - { validate integer; optional ; default 0 }
	input E - { validate integer }
    } 1 2 3 4
................................................................................
    A = '1'         v'1'
    B = '2'         v'2'
    C = '3'         v'3'
    D = <undefined> v'0'
    E = '4'         v'4'
}

test xo-runtime-1.5 {required + optional arguments, assignment under thresholding} -body {
    Parse {
	input A - { validate integer }
	input B - { validate integer; optional ; default 0 }
	input C - { validate integer }
	input D - { validate integer; optional ; default 0 }
	input E - { validate integer }
    } 1 2 3 4 5
................................................................................
    A = '1' v'1'
    B = '2' v'2'
    C = '3' v'3'
    D = '4' v'4'
    E = '5' v'5'
}

test xo-runtime-1.6 {required + optional arguments, too many} -body {
    Parse {
	input A - { validate integer }
	input B - { validate integer; optional ; default 0 }
	input C - { validate integer }
	input D - { validate integer; optional ; default 0 }
	input E - { validate integer }
    } 1 2 3 4 5 6
} -returnCodes error \
    -result "wrong\#args, too many"

# # ## ### ##### ######## ############# #####################
## Group II: Splat arguments, required and optional

test xo-runtime-2.0 {required + required splat, not enough} -body {
    Parse {
	input A - { validate integer }
	input B - { list ; validate integer }
    }
} -returnCodes error \
    -result "wrong\#args, not enough"

test xo-runtime-2.1 {required + required splat, not enough} -body {
    Parse {
	input A - { validate integer }
	input B - { list ; validate integer }
    } 1
} -returnCodes error \
    -result "wrong\#args, not enough"

test xo-runtime-2.2 {required + required splat} -body {
    Parse {
	input A - { validate integer }
	input B - { list ; validate integer }
    } 1 2
} -result {
    A = '1' v'1'
    B = '2' v'2'
}

test xo-runtime-2.3 {required + required splat} -body {
    Parse {
	input A - { validate integer }
	input B - { list ; validate integer }
    } 1 2 3
} -result {
    A = '1'   v'1'
    B = '2 3' v'2 3'
}

test xo-runtime-2.4 {required + required splat} -body {
    Parse {
	input A - { validate integer }
	input B - { list ; validate integer }
    } 1 2 3 4
} -result {
    A = '1'     v'1'
    B = '2 3 4' v'2 3 4'
}

# # ## ### ##### ######## ############# #####################

test xo-runtime-2.5 {required + optional splat, not enough} -body {
    Parse {
	input A - { validate integer }
	input B - { list ; optional ; validate integer }
    }
} -returnCodes error \
    -result "wrong\#args, not enough"

test xo-runtime-2.6 {required + optional splat, empty} -body {
    Parse {
	input A - { validate integer }
	input B - { list ; optional ; validate integer }
    } 1
} -result {
    A = '1'         v'1'
    B = <undefined> v''
}

test xo-runtime-2.7 {required + optional splat} -body {
    Parse {
	input A - { validate integer }
	input B - { list ; optional ; validate integer }
    } 1 2
} -result {
    A = '1' v'1'
    B = '2' v'2'
}

test xo-runtime-2.8 {required + optional splat} -body {
    Parse {
	input A - { validate integer }
	input B - { list ; optional ; validate integer }
    } 1 2 3
} -result {
    A = '1'   v'1'
    B = '2 3' v'2 3'
}

test xo-runtime-2.9 {required + optional splat} -body {
    Parse {
	input A - { validate integer }
	input B - { list ; optional ; validate integer }
    } 1 2 3 4
} -result {
    A = '1'     v'1'
    B = '2 3 4' v'2 3 4'
}

# # ## ### ##### ######## ############# #####################

test xo-runtime-2.10 {optional + required splat, not enough} -body {
    Parse {
	input A - { optional ; validate integer }
	input B - { list ; validate integer }
    }
} -returnCodes error \
    -result "wrong\#args, not enough"

test xo-runtime-2.11 {optional + required splat, not enough} -body {
    Parse {
	input A - { optional ; validate integer }
	input B - { list ; validate integer }
    } 1
} -result {
    A = <undefined> v'0'
    B = '1'         v'1'
}
test xo-runtime-2.12 {optional + required splat} -body {
    Parse {
	input A - { optional ; validate integer }
	input B - { list ; validate integer }
    } 1 2
} -result {
    A = '1' v'1'
    B = '2' v'2'
}

test xo-runtime-2.13 {optional + required splat} -body {
    Parse {
	input A - { optional ; validate integer }
	input B - { list ; validate integer }
    } 1 2 3
} -result {
    A = '1'   v'1'
    B = '2 3' v'2 3'
}

test xo-runtime-2.14 {optional + required splat} -body {
    Parse {
	input A - { optional ; validate integer }
	input B - { list ; validate integer }
    } 1 2 3 4
} -result {
    A = '1'     v'1'
    B = '2 3 4' v'2 3 4'
}

# # ## ### ##### ######## ############# #####################

test xo-runtime-2.15 {optional + optional splat, not enough} -body {
    Parse {
	input A - { optional ; validate integer }
	input B - { list ; optional ; validate integer }
    }
} -result {
    A = <undefined> v'0'
    B = <undefined> v''
}

test xo-runtime-2.16 {optional + optional splat, empty} -body {
    Parse {
	input A - { optional ; validate integer }
	input B - { list ; optional ; validate integer }
    } 1
} -result {
    A = '1'         v'1'
    B = <undefined> v''
}

test xo-runtime-2.17 {optional + optional splat} -body {
    Parse {
	input A - { optional ; validate integer }
	input B - { list ; optional ; validate integer }
    } 1 2
} -result {
    A = '1' v'1'
    B = '2' v'2'
}

test xo-runtime-2.18 {optional + optional splat} -body {
    Parse {
	input A - { optional ; validate integer }
	input B - { list ; optional ; validate integer }
    } 1 2 3
} -result {
    A = '1'   v'1'
    B = '2 3' v'2 3'
}

test xo-runtime-2.19 {optional + optional splat} -body {
    Parse {
	input A - { optional ; validate integer }
	input B - { list ; optional ; validate integer }
    } 1 2 3 4
} -result {
    A = '1'     v'1'
    B = '2 3 4' v'2 3 4'
}

# # ## ### ##### ######## ############# #####################
## Group III: Options.

test xo-runtime-3.0 {options, simple, boolean} -body {
    Parse {
	option A -
    }
} -result {
    A = <undefined> v'no'
}

test xo-runtime-3.1 {options, simple, boolean} -body {
    Parse {
	option A -
    } -A 1
} -result {
    A = '1' v'1'
}

test xo-runtime-3.2 {options, simple, boolean} -body {
    Parse {
	option A -
    } -A 0
} -result {
    A = '0' v'0'
}

test xo-runtime-3.2 {options, simple, boolean, multiple use} -body {
    Parse {
	option A -
    } -A 0 -A 1
} -result {
    A = '1' v'1'
}

test xo-runtime-3.3 {options, simple, boolean, special forms} -body {
    Parse {
	option A -
	option B -
	option C -
	option D -
	option E -
	option F -
................................................................................
    E = '0'   v'0'
    F = '1'   v'1'
    G = 'X'   v'X'
}

# # ## ### ##### ######## ############# #####################

test xo-runtime-3.4 {options, list, string} -body {
    Parse {
	option A - { list ; validate identity }
    }
} -result {
    A = <undefined> v''
}

test xo-runtime-3.5 {options, list, string, missing value} -body {
    Parse {
	option A - { list ; validate identity }
    } -A
} -returnCodes error \
    -result "wrong\#args, not enough"

test xo-runtime-3.6 {options, list, string} -body {
    Parse {
	option A - { list ; validate identity }
    } -A X
} -result {
    A = 'X' v'X'
}

test xo-runtime-3.7 {options, list, string} -body {
    Parse {
	option A - { list ; validate identity }
    } -A X -A Y
} -result {
    A = 'X Y' v'X Y'
}

# # ## ### ##### ######## ############# #####################

test xo-runtime-3.8 {options, aliases} -body {
    Parse {
	option A - { validate identity ; alias Z }
    } -A X -Z Y
} -result {
    A = 'Y' v'Y'
}

test xo-runtime-3.9 {options, aliases, list} -body {
    Parse {
	option A - { list ; validate identity ; alias Z }
    } -A X -Z Y
} -result {
    A = 'X Y' v'X Y'
}

# # ## ### ##### ######## ############# #####################

test xo-runtime-3.10 {options, long names} -body {
    Parse {
	option ALPHA - { list ; validate identity }
    } --ALPHA Z
} -result {
    ALPHA = 'Z' v'Z'
}

test xo-runtime-3.11 {options, unique prefix expansion} -body {
    Parse {
	option ALPHA - { list ; validate identity }
    } --AL Z
} -result {
    ALPHA = 'Z' v'Z'
}

# # ## ### ##### ######## ############# #####################

test xo-runtime-3.12 {options, unknown option} -body {
    Parse {
	option A - { validate identity }
    } -B Z
} -returnCodes error \
    -result {Unknown option -B}

test xo-runtime-3.13 {options, ambiguous prefix} -body {
    Parse {
	option ALPHA - { validate identity }
	option ALNUM - { validate identity }
    } --AL Z
} -returnCodes error \
    -result {Ambiguous option prefix --AL, matching --ALNUM, --ALPHA}

# # ## ### ##### ######## ############# #####################
## Group IV: Mix options and arguments.

test xo-runtime-4.1 {options, arguments, and splat} -body {
    Parse {
	input  A - { optional ; validate identity }
	input  C - { optional ; validate identity ; list }
	option T - { validate identity }
    } A -T X C C C -T Y
    # The threshold method for optional arguments processes options
    # before arguments, handling the 2nd -T before splat collection.
................................................................................
    C = 'C C C' v'C C C'
    T = 'Y'     v'Y'
}

# # ## ### ##### ######## ############# #####################
## Group V: Optional arguments, via peek+validate

test xo-runtime-5.1 {options, arguments, and splat, peek} -body {
    Parse {
	input  A - { optional ; validate identity ; test }
	input  C - { optional ; validate identity ; test ; list }
	option T - { validate identity }
    } A -T X C C C -T Y
    # The peek+validate method for optional arguments does not look
    # ahead beyond that, thus the 2nd -T becomes part of the splat
................................................................................
}

# # ## ### ##### ######## ############# #####################
## Group VI: Introspect on the context of the generate, validate, and
##           when-defined command prefixes. Ensure that they are
##           called and work.

test xo-runtime-6.1 {generator command} -setup {
    StartNotes
    set ons A ; # Trigger parse to save the parameter object namespace.
} -body {
    Note {*}[split [Parse {
	input A - {
	    optional
	    generate {apply {{} {
................................................................................
    unset ons
    StopNotes
} -result {
    generate MATCH
    {} {    A = <undefined> v'G'} {}
}

test xo-runtime-6.2 {validation, default supplication} -setup {
    StartNotes
    set ons A ; # Trigger parse to save the object namespace.
} -body {
    Note {*}[split [Parse {
	input A - {
	    optional
	    validate {apply {{kind args} {
................................................................................
    names = {}
    validate default MATCH
    names = A
    validate validate MATCH
    {} {    A = <undefined> v'zZzZz'} {}
}

test xo-runtime-6.3 {generator command} -setup {
    StartNotes
    set ons A ; # Trigger parse to save the parameter object namespace.
} -body {
    Note {*}[split [Parse {
	input A - {
	    optional
	    when-defined {apply {{v} {
|







 







|










|










|










|







 







|







 







|







 







|













|







|







|









|









|











|







|









|









|









|











|







|








|









|









|











|









|









|









|









|












|







|







|







|







|







 







|







|






|







|









|







|









|







|









|






|










|







 







|







 







|







 







|







 







|







1
2
3
4
5
6
7
8
..
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
..
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
..
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
...
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
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
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
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
...
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
...
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
...
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
...
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
...
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
# -*- tcl -*- Include file for cmdr.test.
# # ## ### ##### ######## ############# #####################

## Runtime parsing of a command line based on the argument spec.
## Cases to look at:
##
## arguments only
## - required only
................................................................................
## Take examples from the intended target app
## NOTE: interaction not testable!! linenoise - mockup ?!

# # ## ### ##### ######## ############# #####################
## Group I: 5 parameters, required and optional alternating. Called
## with zero to six arguments.

test cmdr-runtime-1.0 {required + optional arguments, not enough} -body {
    Parse {
	input A - { validate integer }
	input B - { validate integer; optional ; default 0 }
	input C - { validate integer }
	input D - { validate integer; optional ; default 0 }
	input E - { validate integer }
    }
} -returnCodes error \
    -result "wrong\#args, not enough"

test cmdr-runtime-1.1 {required + optional arguments, not enough} -body {
    Parse {
	input A - { validate integer }
	input B - { validate integer; optional ; default 0 }
	input C - { validate integer }
	input D - { validate integer; optional ; default 0 }
	input E - { validate integer }
    } 1
} -returnCodes error \
    -result "wrong\#args, not enough"

test cmdr-runtime-1.2 {required + optional arguments, not enough} -body {
    Parse {
	input A - { validate integer }
	input B - { validate integer; optional ; default 0 }
	input C - { validate integer }
	input D - { validate integer; optional ; default 0 }
	input E - { validate integer }
    } 1 2
} -returnCodes error \
    -result "wrong\#args, not enough"

test cmdr-runtime-1.3 {required + optional arguments, assignment under thresholding} -body {
    Parse {
	input A - { validate integer }
	input B - { validate integer; optional ; default 0 }
	input C - { validate integer }
	input D - { validate integer; optional ; default 0 }
	input E - { validate integer }
    } 1 2 3
................................................................................
    A = '1'         v'1'
    B = <undefined> v'0'
    C = '2'         v'2'
    D = <undefined> v'0'
    E = '3'         v'3'
}

test cmdr-runtime-1.4 {required + optional arguments, assignment under thresholding} -body {
    Parse {
	input A - { validate integer }
	input B - { validate integer; optional ; default 0 }
	input C - { validate integer }
	input D - { validate integer; optional ; default 0 }
	input E - { validate integer }
    } 1 2 3 4
................................................................................
    A = '1'         v'1'
    B = '2'         v'2'
    C = '3'         v'3'
    D = <undefined> v'0'
    E = '4'         v'4'
}

test cmdr-runtime-1.5 {required + optional arguments, assignment under thresholding} -body {
    Parse {
	input A - { validate integer }
	input B - { validate integer; optional ; default 0 }
	input C - { validate integer }
	input D - { validate integer; optional ; default 0 }
	input E - { validate integer }
    } 1 2 3 4 5
................................................................................
    A = '1' v'1'
    B = '2' v'2'
    C = '3' v'3'
    D = '4' v'4'
    E = '5' v'5'
}

test cmdr-runtime-1.6 {required + optional arguments, too many} -body {
    Parse {
	input A - { validate integer }
	input B - { validate integer; optional ; default 0 }
	input C - { validate integer }
	input D - { validate integer; optional ; default 0 }
	input E - { validate integer }
    } 1 2 3 4 5 6
} -returnCodes error \
    -result "wrong\#args, too many"

# # ## ### ##### ######## ############# #####################
## Group II: Splat arguments, required and optional

test cmdr-runtime-2.0 {required + required splat, not enough} -body {
    Parse {
	input A - { validate integer }
	input B - { list ; validate integer }
    }
} -returnCodes error \
    -result "wrong\#args, not enough"

test cmdr-runtime-2.1 {required + required splat, not enough} -body {
    Parse {
	input A - { validate integer }
	input B - { list ; validate integer }
    } 1
} -returnCodes error \
    -result "wrong\#args, not enough"

test cmdr-runtime-2.2 {required + required splat} -body {
    Parse {
	input A - { validate integer }
	input B - { list ; validate integer }
    } 1 2
} -result {
    A = '1' v'1'
    B = '2' v'2'
}

test cmdr-runtime-2.3 {required + required splat} -body {
    Parse {
	input A - { validate integer }
	input B - { list ; validate integer }
    } 1 2 3
} -result {
    A = '1'   v'1'
    B = '2 3' v'2 3'
}

test cmdr-runtime-2.4 {required + required splat} -body {
    Parse {
	input A - { validate integer }
	input B - { list ; validate integer }
    } 1 2 3 4
} -result {
    A = '1'     v'1'
    B = '2 3 4' v'2 3 4'
}

# # ## ### ##### ######## ############# #####################

test cmdr-runtime-2.5 {required + optional splat, not enough} -body {
    Parse {
	input A - { validate integer }
	input B - { list ; optional ; validate integer }
    }
} -returnCodes error \
    -result "wrong\#args, not enough"

test cmdr-runtime-2.6 {required + optional splat, empty} -body {
    Parse {
	input A - { validate integer }
	input B - { list ; optional ; validate integer }
    } 1
} -result {
    A = '1'         v'1'
    B = <undefined> v''
}

test cmdr-runtime-2.7 {required + optional splat} -body {
    Parse {
	input A - { validate integer }
	input B - { list ; optional ; validate integer }
    } 1 2
} -result {
    A = '1' v'1'
    B = '2' v'2'
}

test cmdr-runtime-2.8 {required + optional splat} -body {
    Parse {
	input A - { validate integer }
	input B - { list ; optional ; validate integer }
    } 1 2 3
} -result {
    A = '1'   v'1'
    B = '2 3' v'2 3'
}

test cmdr-runtime-2.9 {required + optional splat} -body {
    Parse {
	input A - { validate integer }
	input B - { list ; optional ; validate integer }
    } 1 2 3 4
} -result {
    A = '1'     v'1'
    B = '2 3 4' v'2 3 4'
}

# # ## ### ##### ######## ############# #####################

test cmdr-runtime-2.10 {optional + required splat, not enough} -body {
    Parse {
	input A - { optional ; validate integer }
	input B - { list ; validate integer }
    }
} -returnCodes error \
    -result "wrong\#args, not enough"

test cmdr-runtime-2.11 {optional + required splat, not enough} -body {
    Parse {
	input A - { optional ; validate integer }
	input B - { list ; validate integer }
    } 1
} -result {
    A = <undefined> v'0'
    B = '1'         v'1'
}
test cmdr-runtime-2.12 {optional + required splat} -body {
    Parse {
	input A - { optional ; validate integer }
	input B - { list ; validate integer }
    } 1 2
} -result {
    A = '1' v'1'
    B = '2' v'2'
}

test cmdr-runtime-2.13 {optional + required splat} -body {
    Parse {
	input A - { optional ; validate integer }
	input B - { list ; validate integer }
    } 1 2 3
} -result {
    A = '1'   v'1'
    B = '2 3' v'2 3'
}

test cmdr-runtime-2.14 {optional + required splat} -body {
    Parse {
	input A - { optional ; validate integer }
	input B - { list ; validate integer }
    } 1 2 3 4
} -result {
    A = '1'     v'1'
    B = '2 3 4' v'2 3 4'
}

# # ## ### ##### ######## ############# #####################

test cmdr-runtime-2.15 {optional + optional splat, not enough} -body {
    Parse {
	input A - { optional ; validate integer }
	input B - { list ; optional ; validate integer }
    }
} -result {
    A = <undefined> v'0'
    B = <undefined> v''
}

test cmdr-runtime-2.16 {optional + optional splat, empty} -body {
    Parse {
	input A - { optional ; validate integer }
	input B - { list ; optional ; validate integer }
    } 1
} -result {
    A = '1'         v'1'
    B = <undefined> v''
}

test cmdr-runtime-2.17 {optional + optional splat} -body {
    Parse {
	input A - { optional ; validate integer }
	input B - { list ; optional ; validate integer }
    } 1 2
} -result {
    A = '1' v'1'
    B = '2' v'2'
}

test cmdr-runtime-2.18 {optional + optional splat} -body {
    Parse {
	input A - { optional ; validate integer }
	input B - { list ; optional ; validate integer }
    } 1 2 3
} -result {
    A = '1'   v'1'
    B = '2 3' v'2 3'
}

test cmdr-runtime-2.19 {optional + optional splat} -body {
    Parse {
	input A - { optional ; validate integer }
	input B - { list ; optional ; validate integer }
    } 1 2 3 4
} -result {
    A = '1'     v'1'
    B = '2 3 4' v'2 3 4'
}

# # ## ### ##### ######## ############# #####################
## Group III: Options.

test cmdr-runtime-3.0 {options, simple, boolean} -body {
    Parse {
	option A -
    }
} -result {
    A = <undefined> v'no'
}

test cmdr-runtime-3.1 {options, simple, boolean} -body {
    Parse {
	option A -
    } -A 1
} -result {
    A = '1' v'1'
}

test cmdr-runtime-3.2 {options, simple, boolean} -body {
    Parse {
	option A -
    } -A 0
} -result {
    A = '0' v'0'
}

test cmdr-runtime-3.2 {options, simple, boolean, multiple use} -body {
    Parse {
	option A -
    } -A 0 -A 1
} -result {
    A = '1' v'1'
}

test cmdr-runtime-3.3 {options, simple, boolean, special forms} -body {
    Parse {
	option A -
	option B -
	option C -
	option D -
	option E -
	option F -
................................................................................
    E = '0'   v'0'
    F = '1'   v'1'
    G = 'X'   v'X'
}

# # ## ### ##### ######## ############# #####################

test cmdr-runtime-3.4 {options, list, string} -body {
    Parse {
	option A - { list ; validate identity }
    }
} -result {
    A = <undefined> v''
}

test cmdr-runtime-3.5 {options, list, string, missing value} -body {
    Parse {
	option A - { list ; validate identity }
    } -A
} -returnCodes error \
    -result "wrong\#args, not enough"

test cmdr-runtime-3.6 {options, list, string} -body {
    Parse {
	option A - { list ; validate identity }
    } -A X
} -result {
    A = 'X' v'X'
}

test cmdr-runtime-3.7 {options, list, string} -body {
    Parse {
	option A - { list ; validate identity }
    } -A X -A Y
} -result {
    A = 'X Y' v'X Y'
}

# # ## ### ##### ######## ############# #####################

test cmdr-runtime-3.8 {options, aliases} -body {
    Parse {
	option A - { validate identity ; alias Z }
    } -A X -Z Y
} -result {
    A = 'Y' v'Y'
}

test cmdr-runtime-3.9 {options, aliases, list} -body {
    Parse {
	option A - { list ; validate identity ; alias Z }
    } -A X -Z Y
} -result {
    A = 'X Y' v'X Y'
}

# # ## ### ##### ######## ############# #####################

test cmdr-runtime-3.10 {options, long names} -body {
    Parse {
	option ALPHA - { list ; validate identity }
    } --ALPHA Z
} -result {
    ALPHA = 'Z' v'Z'
}

test cmdr-runtime-3.11 {options, unique prefix expansion} -body {
    Parse {
	option ALPHA - { list ; validate identity }
    } --AL Z
} -result {
    ALPHA = 'Z' v'Z'
}

# # ## ### ##### ######## ############# #####################

test cmdr-runtime-3.12 {options, unknown option} -body {
    Parse {
	option A - { validate identity }
    } -B Z
} -returnCodes error \
    -result {Unknown option -B}

test cmdr-runtime-3.13 {options, ambiguous prefix} -body {
    Parse {
	option ALPHA - { validate identity }
	option ALNUM - { validate identity }
    } --AL Z
} -returnCodes error \
    -result {Ambiguous option prefix --AL, matching --ALNUM, --ALPHA}

# # ## ### ##### ######## ############# #####################
## Group IV: Mix options and arguments.

test cmdr-runtime-4.1 {options, arguments, and splat} -body {
    Parse {
	input  A - { optional ; validate identity }
	input  C - { optional ; validate identity ; list }
	option T - { validate identity }
    } A -T X C C C -T Y
    # The threshold method for optional arguments processes options
    # before arguments, handling the 2nd -T before splat collection.
................................................................................
    C = 'C C C' v'C C C'
    T = 'Y'     v'Y'
}

# # ## ### ##### ######## ############# #####################
## Group V: Optional arguments, via peek+validate

test cmdr-runtime-5.1 {options, arguments, and splat, peek} -body {
    Parse {
	input  A - { optional ; validate identity ; test }
	input  C - { optional ; validate identity ; test ; list }
	option T - { validate identity }
    } A -T X C C C -T Y
    # The peek+validate method for optional arguments does not look
    # ahead beyond that, thus the 2nd -T becomes part of the splat
................................................................................
}

# # ## ### ##### ######## ############# #####################
## Group VI: Introspect on the context of the generate, validate, and
##           when-defined command prefixes. Ensure that they are
##           called and work.

test cmdr-runtime-6.1 {generator command} -setup {
    StartNotes
    set ons A ; # Trigger parse to save the parameter object namespace.
} -body {
    Note {*}[split [Parse {
	input A - {
	    optional
	    generate {apply {{} {
................................................................................
    unset ons
    StopNotes
} -result {
    generate MATCH
    {} {    A = <undefined> v'G'} {}
}

test cmdr-runtime-6.2 {validation, default supplication} -setup {
    StartNotes
    set ons A ; # Trigger parse to save the object namespace.
} -body {
    Note {*}[split [Parse {
	input A - {
	    optional
	    validate {apply {{kind args} {
................................................................................
    names = {}
    validate default MATCH
    names = A
    validate validate MATCH
    {} {    A = <undefined> v'zZzZz'} {}
}

test cmdr-runtime-6.3 {generator command} -setup {
    StartNotes
    set ons A ; # Trigger parse to save the parameter object namespace.
} -body {
    Note {*}[split [Parse {
	input A - {
	    optional
	    when-defined {apply {{v} {

Changes to tests/support.tcl.

67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
	cmdr help format $format $n [x help]
    } finally {
	x destroy
    }
}

# # ## ### ##### ######## ############# #####################
## Supporting procedures for xo.test et. al.

proc StartNotes {}     { set ::result {} ; return }
proc Note       {args} { lappend ::result $args ; return }
proc StopNotes  {}     { unset ::result ; return }
proc Notes      {}     { Wrap $::result }

proc NiceParamSpec {kind spec {name A}} {






|







67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
	cmdr help format $format $n [x help]
    } finally {
	x destroy
    }
}

# # ## ### ##### ######## ############# #####################
## Supporting procedures for cmdr.test et. al.

proc StartNotes {}     { set ::result {} ; return }
proc Note       {args} { lappend ::result $args ; return }
proc StopNotes  {}     { unset ::result ; return }
proc Notes      {}     { Wrap $::result }

proc NiceParamSpec {kind spec {name A}} {

Changes to util.tcl.

1
2
3
4
5
6
7
8
9
10
## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## XO - Util - General utilities

# # ## ### ##### ######## ############# #####################
## Requisites

package require Tcl 8.5
package require textutil::adjust


|







1
2
3
4
5
6
7
8
9
10
## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## CMDR - Util - General utilities

# # ## ### ##### ######## ############# #####################
## Requisites

package require Tcl 8.5
package require textutil::adjust

Changes to validate.tcl.

1
2
3
4
5
6
7
8
9
10
..
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## XO - Validate - Definition of core validation classes.

# # ## ### ##### ######## ############# #####################
## Requisites

package require Tcl 8.5

# # ## ### ##### ######## ############# #####################
................................................................................
	fail complete-enum config
    namespace ensemble create
}

# # ## ### ##### ######## ############# #####################

proc ::cmdr::validate::fail {code type x} {
    return -code error -errorcode [list XO VALIDATE {*}$code] \
	"Expected $type, got \"$x\""
}

proc ::cmdr::validate::complete-enum {choices nocase buffer} {
    if {$buffer eq {}} {
	return $choices
    }

|







 







|







1
2
3
4
5
6
7
8
9
10
..
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## CMDR - Validate - Definition of core validation classes.

# # ## ### ##### ######## ############# #####################
## Requisites

package require Tcl 8.5

# # ## ### ##### ######## ############# #####################
................................................................................
	fail complete-enum config
    namespace ensemble create
}

# # ## ### ##### ######## ############# #####################

proc ::cmdr::validate::fail {code type x} {
    return -code error -errorcode [list CMDR VALIDATE {*}$code] \
	"Expected $type, got \"$x\""
}

proc ::cmdr::validate::complete-enum {choices nocase buffer} {
    if {$buffer eq {}} {
	return $choices
    }