summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authornijtmans <nijtmans>2010-05-27 08:32:22 (GMT)
committernijtmans <nijtmans>2010-05-27 08:32:22 (GMT)
commit11fff51d24f1d24c5fe3950c5a0dfffc10b03d62 (patch)
tree991dabe2e7c6e598cdcbe8719a2126e348c79390
parentb6b47d546475f2262d264826edf0f9397c9e08db (diff)
downloadtcl-11fff51d24f1d24c5fe3950c5a0dfffc10b03d62.zip
tcl-11fff51d24f1d24c5fe3950c5a0dfffc10b03d62.tar.gz
tcl-11fff51d24f1d24c5fe3950c5a0dfffc10b03d62.tar.bz2
optParse.tcl: Don't generate spaces at the end of a line.
-rw-r--r--ChangeLog10
-rw-r--r--library/opt/optparse.tcl24
-rw-r--r--tests/opt.test28
-rw-r--r--tests/safe.test24
4 files changed, 46 insertions, 40 deletions
diff --git a/ChangeLog b/ChangeLog
index a50dbab..349dfaf 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2010-05-27 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * library/opt/optParse.tcl Don't generate spaces at the end of a line.
+ * tests/opt.test
+ * tests/safe.test
+
2010-05-21 Jan Nijtmans <nijtmans@users.sf.net>
* tools/installData.tcl Make sure that copyDir only receives normalized
@@ -43,7 +49,7 @@
* library/platform/platform.tcl: Fix cpu name for Solaris/Intel 64bit.
* library/platform/pkgIndex.tcl: Package updated to version 1.0.8.
- * unix/Makefile.in:
+ * unix/Makefile.in:
* win/Makefile.in:
2010-05-06 Jan Nijtmans <nijtmans@users.sf.net>
@@ -99,7 +105,7 @@
* generic/tclInt.h (TclAppendBytesToByteArray): placing overflow
protection responsibility on caller. Convert "len" argument to signed
int which any value already vetted for overflow issues will fit into.
- * generic/tclStringObj.c: Update caller; standardize panic msg.
+ * generic/tclStringObj.c: Update caller; standardize panic msg.
* generic/tclBinary.c (UpdateStringOfByteArray): [Bug 2994924]: Add
panic when the generated string representation would grow beyond Tcl's
diff --git a/library/opt/optparse.tcl b/library/opt/optparse.tcl
index 67f3cc1..16e56b0 100644
--- a/library/opt/optparse.tcl
+++ b/library/opt/optparse.tcl
@@ -8,7 +8,7 @@
# on it. If your code does rely on this package you
# may directly incorporate this code into your application.
#
-# RCS: @(#) $Id: optparse.tcl,v 1.11 2009/11/18 21:45:37 nijtmans Exp $
+# RCS: @(#) $Id: optparse.tcl,v 1.12 2010/05/27 08:32:23 nijtmans Exp $
package require Tcl 8.2
# When this version number changes, update the pkgIndex.tcl file
@@ -892,22 +892,22 @@ proc ::tcl::OptKeyError {prefix descKey {header 0}} {
}
# output the tree
proc OptTree {desc nl tl dl} {
- set res "";
+ set res ""
foreach item $desc {
- if {[OptIsCounter $item]} continue;
+ if {[OptIsCounter $item]} continue
if {[OptIsPrg $item]} {
- append res [OptTree $item $nl $tl $dl];
+ append res [OptTree $item $nl $tl $dl]
} else {
- set dv [OptTypeArgs $item];
+ set dv [OptTypeArgs $item]
if {[OptState $item] != "header"} {
- set dv "($dv)";
+ set dv "($dv)"
}
- append res [format "\n %-*s %-*s %-*s %s" \
+ append res [string trimright [format "\n %-*s %-*s %-*s %s" \
$nl [OptName $item] $tl [OptType $item] \
- $dl $dv [OptHelp $item]]
+ $dl $dv [OptHelp $item]]]
}
}
- return $res;
+ return $res
}
# Give nice usage string
@@ -915,9 +915,9 @@ proc ::tcl::OptError {prefix desc {header 0}} {
# determine length
if {$header} {
# add faked instruction
- set h [list [OptNewInst header Var/FlagName Type Value Help]];
- lappend h [OptNewInst header ------------ ---- ----- ----];
- lappend h [OptNewInst header {( -help} "" "" {gives this help )}]
+ set h [list [OptNewInst header Var/FlagName Type Value Help]]
+ lappend h [OptNewInst header ------------ ---- ----- ----]
+ lappend h [OptNewInst header {(-help} "" "" {gives this help)}]
set desc [concat $h $desc]
}
OptLengths $desc nl tl dl
diff --git a/tests/opt.test b/tests/opt.test
index b7e3a55..9f01658 100644
--- a/tests/opt.test
+++ b/tests/opt.test
@@ -11,7 +11,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: opt.test,v 1.9 2004/05/19 12:48:32 dkf Exp $
+# RCS: @(#) $Id: opt.test,v 1.10 2010/05/27 08:32:23 nijtmans Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -58,7 +58,7 @@ test opt-3.2 {OptParse / temp key is removed even on errors} {
test opt-4.1 {OptProc} {
::tcl::OptProc optTest {} {}
- optTest ;
+ optTest
::tcl::OptKeyDelete optTest
} {}
@@ -74,12 +74,12 @@ test opt-5.1 {OptProcArgGiven} {
} {0 1 1 1}
test opt-6.1 {OptKeyParse} {
- ::tcl::OptKeyRegister {} test;
+ ::tcl::OptKeyRegister {} test
list [catch {::tcl::OptKeyParse test {-help}} msg] $msg
} {1 {Usage information:
Var/FlagName Type Value Help
------------ ---- ----- ----
- ( -help gives this help )}}
+ (-help gives this help)}}
test opt-7.1 {OptCheckType} {
list \
@@ -161,9 +161,9 @@ test opt-10.1 {ambigous flags} {
catch {optTest -fL} msg
set msg
} {ambigous option "-fL", choose from:
- -fla boolflag (false)
- -flag2xyz boolflag (false)
- -flag3xyz boolflag (false) }
+ -fla boolflag (false)
+ -flag2xyz boolflag (false)
+ -flag3xyz boolflag (false)}
test opt-10.2 {non ambigous flags} {
::tcl::OptProc optTest {{-flag1xyz} {-other} {-flag2xyz} {-flag3xyz}} {
return $flag2xyz
@@ -183,8 +183,8 @@ test opt-10.4 {ambigous flags, not exact match} {
catch {optTest -fLag1X} msg
set msg
} {ambigous option "-fLag1X", choose from:
- -flag1xy boolflag (false)
- -flag1xyz boolflag (false) }
+ -flag1xy boolflag (false)
+ -flag1xyz boolflag (false)}
# medium size overall test example: (defined once)
::tcl::OptProc optTest {
@@ -206,12 +206,12 @@ test opt-10.6 {medium size overall test} {
} {1 {Usage information:
Var/FlagName Type Value Help
------------ ---- ----- ----
- ( -help gives this help )
+ (-help gives this help)
cmd choice (print save delete) sub command to choose
- -allowBoing boolean (true)
+ -allowBoing boolean (true)
arg2 string () this is help
?arg3? int (7) optional number
- -moreflags boolflag (false) }}
+ -moreflags boolflag (false)}}
test opt-10.7 {medium size overall test} {
optTest save tst
} {save 1 tst 7 0}
@@ -232,8 +232,8 @@ test opt-11.1 {too many args test 2} {
} {1 {too many arguments (unexpected argument(s): blah), usage:
Var/FlagName Type Value Help
------------ ---- ----- ----
- ( -help gives this help )
- -foo boolflag (false) } {}}
+ (-help gives this help)
+ -foo boolflag (false)} {}}
test opt-11.2 {default value for args} {
set args {}
set key [::tcl::OptKeyRegister {{args -list {a b c} "args..."}}]
diff --git a/tests/safe.test b/tests/safe.test
index db8952b..9de3954 100644
--- a/tests/safe.test
+++ b/tests/safe.test
@@ -10,7 +10,7 @@
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: safe.test,v 1.32 2009/12/30 22:26:43 dkf Exp $
+# RCS: @(#) $Id: safe.test,v 1.33 2010/05/27 08:32:23 nijtmans Exp $
package require Tcl 8.5
@@ -41,7 +41,7 @@ test safe-1.2 {safe::interpCreate syntax} -returnCodes error -body {
} -result {Usage information:
Var/FlagName Type Value Help
------------ ---- ----- ----
- ( -help gives this help )
+ (-help gives this help)
?slave? name () name of the slave (optional)
-accessPath list () access path for the slave
-noStatics boolflag (false) prevent loading of statically linked pkgs
@@ -183,22 +183,22 @@ test safe-6.3 {test safe interpreters knowledge of the world} {
# high level general test
test safe-7.1 {tests that everything works at high level} {
- set i [safe::interpCreate];
+ set i [safe::interpCreate]
# no error shall occur:
# (because the default access_path shall include 1st level sub dirs
# so package require in a slave works like in the master)
set v [interp eval $i {package require http 1}]
# no error shall occur:
- interp eval $i {http_config};
+ interp eval $i {http_config}
safe::interpDelete $i
set v
} 1.0
test safe-7.2 {tests specific path and interpFind/AddToAccessPath} -body {
- set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]];
+ set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]]
# should not add anything (p0)
set token1 [safe::interpAddToAccessPath $i [info library]]
# should add as p1
- set token2 [safe::interpAddToAccessPath $i "/dummy/unixlike/test/path"];
+ set token2 [safe::interpAddToAccessPath $i "/dummy/unixlike/test/path"]
# an error shall occur (http is not anymore in the secure 0-level
# provided deep path)
list $token1 $token2 \
@@ -248,8 +248,8 @@ test safe-8.4 {safe source control on file} -setup {
proc safe-test-log {str} {global log; lappend log $str}
set prevlog [safe::setLogCmd]
} -body {
- safe::interpCreate $i;
- safe::setLogCmd safe-test-log;
+ safe::interpCreate $i
+ safe::setLogCmd safe-test-log
list [catch {$i eval {source /abc/def}} msg] $msg $log
} -cleanup {
safe::setLogCmd $prevlog
@@ -387,16 +387,16 @@ test safe-9.6 {interpConfigure widget like behaviour} -body {
list [set i [safe::interpCreate \
-noStatics \
-nestedLoadOk \
- -deleteHook {foo bar}];
- safe::interpConfigure $i -accessPath /foo/bar ;
+ -deleteHook {foo bar}]
+ safe::interpConfigure $i -accessPath /foo/bar
safe::interpConfigure $i]\
[safe::interpConfigure $i -aCCess]\
[safe::interpConfigure $i -nested]\
[safe::interpConfigure $i -statics]\
[safe::interpConfigure $i -DEL]\
- [safe::interpConfigure $i -accessPath /blah -statics 1;
+ [safe::interpConfigure $i -accessPath /blah -statics 1
safe::interpConfigure $i]\
- [safe::interpConfigure $i -deleteHook toto -nosta -nested 0;
+ [safe::interpConfigure $i -deleteHook toto -nosta -nested 0
safe::interpConfigure $i]
} -match glob -result {{-accessPath * -statics 0 -nested 1 -deleteHook {foo bar}} {-accessPath *} {-nested 1} {-statics 0} {-deleteHook {foo bar}} {-accessPath * -statics 1 -nested 1 -deleteHook {foo bar}} {-accessPath * -statics 0 -nested 0 -deleteHook toto}}