From 34fd6003c9fe9da83ffe806108ebbd4bbffb796e Mon Sep 17 00:00:00 2001 From: rjohnson Date: Tue, 13 Oct 1998 20:05:38 +0000 Subject: Fixed bug in "lsort -dictionary" that caused problems when comparing numbers that started with 0. --- changes | 8 +++++++- generic/tclCmdIL.c | 6 +++--- tests/cmdIL.test | 25 ++++++++++++++----------- 3 files changed, 24 insertions(+), 15 deletions(-) diff --git a/changes b/changes index e886008..912354e 100644 --- a/changes +++ b/changes @@ -1,6 +1,6 @@ Recent user-visible changes to Tcl: -RCS: @(#) $Id: changes,v 1.24 1998/10/13 18:44:15 rjohnson Exp $ +RCS: @(#) $Id: changes,v 1.25 1998/10/13 20:05:38 rjohnson Exp $ 1. No more [command1] [command2] construct for grouping multiple commands on a single command line. @@ -3627,3 +3627,9 @@ TclCreateProc to take both strings and "procbody". (EMS) 10/13/98 (bug fix) The "info complete" command can now handle strings with NULLs embedded. Thanks to colin@field.medicine.adelaide.edu.au for providing this fix. (RJ) + +10/13/98 (bug fix) The "lsort -dictionary" command did not properly +handle some numbers starting with 0. Thanks to Richard Hipp + for the creating the patch and Viktor Dukhovni + for submitting the it to Scriptics. (RJ) + diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index a1e6894..05d09ae 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCmdIL.c,v 1.8 1998/10/13 18:44:16 rjohnson Exp $ + * RCS: @(#) $Id: tclCmdIL.c,v 1.9 1998/10/13 20:05:39 rjohnson Exp $ */ #include "tclInt.h" @@ -2861,11 +2861,11 @@ DictionaryCompare(left, right) */ zeros = 0; - while ((*right == '0') && (*(right + 1) != '\0')) { + while ((*right == '0') && (isdigit(UCHAR(right[1])))) { right++; zeros--; } - while ((*left == '0') && (*(left + 1) != '\0')) { + while ((*left == '0') && (isdigit(UCHAR(left[1])))) { left++; zeros++; } diff --git a/tests/cmdIL.test b/tests/cmdIL.test index 925570f..f01728b 100644 --- a/tests/cmdIL.test +++ b/tests/cmdIL.test @@ -7,7 +7,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: cmdIL.test,v 1.3 1998/09/14 18:40:08 stanton Exp $ +# RCS: @(#) $Id: cmdIL.test,v 1.4 1998/10/13 20:05:39 rjohnson Exp $ if {[string compare test [info procs test]] == 1} then {source defs} @@ -38,34 +38,37 @@ test cmdIL-1.7 {Tcl_LsortObjCmd procedure, -decreasing option} { test cmdIL-1.8 {Tcl_LsortObjCmd procedure, -dictionary option} { lsort -dictionary {d e c b a d35 d300} } {a b c d d35 d300 e} -test cmdIL-1.9 {Tcl_LsortObjCmd procedure, -increasing option} { +test cmdIL-1.9 {Tcl_LsortObjCmd procedure, -dictionary option} { + lsort -dictionary {1k 0k 10k} +} {0k 1k 10k} +test cmdIL-1.10 {Tcl_LsortObjCmd procedure, -increasing option} { lsort -decreasing -increasing {d e c b a d35 d300} } {a b c d d300 d35 e} -test cmdIL-1.10 {Tcl_LsortObjCmd procedure, -index option} { +test cmdIL-1.11 {Tcl_LsortObjCmd procedure, -index option} { list [catch {lsort -index {1 3 2 5}} msg] $msg } {1 {"-index" option must be followed by list index}} -test cmdIL-1.11 {Tcl_LsortObjCmd procedure, -index option} { +test cmdIL-1.12 {Tcl_LsortObjCmd procedure, -index option} { list [catch {lsort -index foo {1 3 2 5}} msg] $msg } {1 {bad index "foo": must be integer or "end"}} -test cmdIL-1.12 {Tcl_LsortObjCmd procedure, -index option} { +test cmdIL-1.13 {Tcl_LsortObjCmd procedure, -index option} { lsort -index end -integer {{2 25} {10 20 50 100} {3 16 42} 1} } {1 {2 25} {3 16 42} {10 20 50 100}} -test cmdIL-1.13 {Tcl_LsortObjCmd procedure, -index option} { +test cmdIL-1.14 {Tcl_LsortObjCmd procedure, -index option} { lsort -index 1 -integer {{1 25 100} {3 16 42} {10 20 50}} } {{3 16 42} {10 20 50} {1 25 100}} -test cmdIL-1.14 {Tcl_LsortObjCmd procedure, -integer option} { +test cmdIL-1.15 {Tcl_LsortObjCmd procedure, -integer option} { lsort -integer {24 6 300 18} } {6 18 24 300} -test cmdIL-1.15 {Tcl_LsortObjCmd procedure, -integer option} { +test cmdIL-1.16 {Tcl_LsortObjCmd procedure, -integer option} { list [catch {lsort -integer {1 3 2.4}} msg] $msg } {1 {expected integer but got "2.4"}} -test cmdIL-1.16 {Tcl_LsortObjCmd procedure, -real option} { +test cmdIL-1.17 {Tcl_LsortObjCmd procedure, -real option} { lsort -real {24.2 6e3 150e-1} } {150e-1 24.2 6e3} -test cmdIL-1.17 {Tcl_LsortObjCmd procedure, bogus list} { +test cmdIL-1.18 {Tcl_LsortObjCmd procedure, bogus list} { list [catch {lsort "1 2 3 \{ 4"} msg] $msg } {1 {unmatched open brace in list}} -test cmdIL-1.18 {Tcl_LsortObjCmd procedure, empty list} { +test cmdIL-1.19 {Tcl_LsortObjCmd procedure, empty list} { lsort {} } {} -- cgit v0.12