Add support for lsort -real

Signed-off-by: Steve Bennett <steveb@workware.net.au>

3 files changed, 39 insertions, 4 deletions

diff --git a/jim.c b/jim.c
index 0a56a35..ac90725 100644
--- a/jim.c
+++ b/jim.c
@@ -6396,6 +6396,7 @@ struct lsort_info {
         JIM_LSORT_ASCII,
         JIM_LSORT_NOCASE,
         JIM_LSORT_INTEGER,
+        JIM_LSORT_REAL,
         JIM_LSORT_COMMAND
     } type;
     int order;
@@ -6440,6 +6441,23 @@ static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
     return JimSign(lhs - rhs) * sort_info->order;
 }
 
+static int ListSortReal(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
+{
+    double lhs = 0, rhs = 0;
+
+    if (Jim_GetDouble(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
+        Jim_GetDouble(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
+        longjmp(sort_info->jmpbuf, JIM_ERR);
+    }
+	if (lhs == rhs) {
+		return 0;
+	}
+	if (lhs > rhs) {
+		return sort_info->order;
+	}
+	return -sort_info->order;
+}
+
 static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
 {
     Jim_Obj *compare_script;
@@ -6491,6 +6509,9 @@ static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsor
         case JIM_LSORT_INTEGER:
             fn = ListSortInteger;
             break;
+        case JIM_LSORT_REAL:
+            fn = ListSortReal;
+            break;
         case JIM_LSORT_COMMAND:
             fn = ListSortCommand;
             break;
@@ -12512,10 +12533,10 @@ static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg
 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
 {
     static const char * const options[] = {
-        "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-index", NULL
+        "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", NULL
     };
     enum
-    { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_INDEX };
+    { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX };
     Jim_Obj *resObj;
     int i;
     int retCode;
@@ -12549,6 +12570,9 @@ static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const arg
             case OPT_INTEGER:
                 info.type = JIM_LSORT_INTEGER;
                 break;
+            case OPT_REAL:
+                info.type = JIM_LSORT_REAL;
+                break;
             case OPT_INCREASING:
                 info.order = 1;
                 break;
diff --git a/jim_tcl.txt b/jim_tcl.txt
index a859dfd..d2e9636 100644
--- a/jim_tcl.txt
+++ b/jim_tcl.txt
@@ -3136,7 +3136,7 @@ the list are to be matched against pattern and must have one of the values below
 
 lsort
 ~~~~~
-+*lsort* ?*-index* 'listindex'? ?*-nocase*!*-integer*|*-command* 'cmdname'? ?*-decreasing*|*-increasing*? 'list'+
++*lsort* ?*-index* 'listindex'? ?*-nocase!-integer|-real|-command* 'cmdname'? ?*-decreasing*|*-increasing*? 'list'+
 
 Sort the elements of +'list'+, returning a new list in sorted order.
 By default, ASCII (or UTF-8) sorting is used, with the result in increasing order.
@@ -3145,6 +3145,8 @@ If +-nocase+ is specified, comparisons are case-insenstive.
 
 If +-integer+ is specified, numeric sorting is used.
 
+If +-real+ is specified, floating point number sorting is used.
+
 If +-command 'cmdname'+ is specified, +'cmdname'+ is treated as a command
 name. For each comparison, +'cmdname $value1 $value2+' is called which
 should compare the values and return an integer less than, equal
diff --git a/tests/lsort.test b/tests/lsort.test
index ad28b6e..b3096a7 100644
--- a/tests/lsort.test
+++ b/tests/lsort.test
@@ -17,7 +17,7 @@ test lsort-1.1 {Tcl_LsortObjCmd procedure} jim {
 } {1 {wrong # args: should be "lsort ?options? list"}}
 test lsort-1.2 {Tcl_LsortObjCmd procedure} jim {
     list [catch {lsort -foo {1 3 2 5}} msg] $msg
-} {1 {bad option "-foo": must be -ascii, -command, -decreasing, -increasing, -index, -integer, or -nocase}}
+} {1 {bad option "-foo": must be -ascii, -command, -decreasing, -increasing, -index, -integer, -nocase, or -real}}
 test lsort-1.3 {Tcl_LsortObjCmd procedure, default options} {
     lsort {d e c b a \{ d35 d300}
 } {a b c d d300 d35 e \{}
@@ -40,6 +40,9 @@ test lsort-1.6 {Tcl_LsortObjCmd procedure, -command option} {
 test lsort-1.7 {Tcl_LsortObjCmd procedure, -decreasing option} {
     lsort -decreasing {d e c b a d35 d300}
 } {e d35 d300 d c b a}
+test lsort-1.8 {Tcl_LsortObjCmd procedure, -real option} {
+    lsort -real {24.2 6e3 150e-1}
+} {150e-1 24.2 6e3}
 test lsort-1.10 {Tcl_LsortObjCmd procedure, -increasing option} {
     lsort -decreasing -increasing {d e c b a d35 d300}
 } {a b c d d300 d35 e}
@@ -125,6 +128,9 @@ test lsort-3.1 {SortCompare procedure, skip comparisons after error} {
     list [catch {lsort -integer -command cmp {48 6 28 190 16 2 3 6 1}} msg] \
 	    $msg $x
 } {1 {error #1} 1}
+test lsort-3.2 {lsort -real, returning indices} {
+    lsort -decreasing -real {1.2 34.5 34.5 5.6}
+} {34.5 34.5 5.6 1.2}
 test lsort-3.3 {SortCompare procedure, -index option} jim {
     list [catch {lsort -integer -index 2 {{20 10} {15 30 40}}} msg] $msg
 } {1 {list index out of range}}
@@ -173,6 +179,9 @@ test lsort-3.18 {SortCompare procedure, -command option} {
 test lsort-3.19 {SortCompare procedure, -decreasing option} {
     lsort -decreasing -integer {35 21 0x20 30 023 100 8}
 } {100 35 0x20 30 023 21 8}
+test lsort-3.20 {SortCompare procedure, -real option} -body {
+    lsort -real {6...4 3}
+} -returnCodes error -result {expected number but got "6...4"}
 
 test lsort-4.26 {DefaultCompare procedure, signed characters} utf8 {
     set l [lsort [list "abc\u80" "abc"]]