diff options
| -rw-r--r-- | ChangeLog | 10 | ||||
| -rw-r--r-- | library/opt/optparse.tcl | 24 | ||||
| -rw-r--r-- | tests/opt.test | 28 | ||||
| -rw-r--r-- | tests/safe.test | 24 |
4 files changed, 46 insertions, 40 deletions
@@ -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}} |