Author: coke Date: Sun Jul 27 17:11:43 2008 New Revision: 29810 Modified: trunk/languages/tcl/runtime/builtin/lsort.pir trunk/languages/tcl/t/cmd_lsort.t
Log: [tcl] http://code.google.com/p/partcl/issues/detail?id=29 -- first pass at [lsort -command], with a test. Modified: trunk/languages/tcl/runtime/builtin/lsort.pir ============================================================================== --- trunk/languages/tcl/runtime/builtin/lsort.pir (original) +++ trunk/languages/tcl/runtime/builtin/lsort.pir Sun Jul 27 17:11:43 2008 @@ -33,7 +33,7 @@ if $P0 == '-integer' goto c_int if $P0 == '-real' goto c_real if $P0 == '-dictionary' goto c_dict - # RT#40749: command etc necessary + if $P0 == '-command' goto c_command branch bad_opt c_dict: @@ -54,7 +54,12 @@ c_int: compare = get_root_global ['_tcl';'helpers';'lsort'], 'integer' branch chew_flag - +c_command: + .local string compareName + compareName = shift argv + $S0 = '&' . compareName + compare = find_global $S0 + branch chew_flag got_list: Modified: trunk/languages/tcl/t/cmd_lsort.t ============================================================================== --- trunk/languages/tcl/t/cmd_lsort.t (original) +++ trunk/languages/tcl/t/cmd_lsort.t Sun Jul 27 17:11:43 2008 @@ -10,7 +10,7 @@ __DATA__ source lib/test_more.tcl -plan 21 +plan 22 is [lsort {}] {} {empty list} @@ -79,3 +79,19 @@ eval_is { lsort -real {4.28 5.65 6.20 7.66 7.6 2.4 8.5 0.4 7.6 6.3} } {0.4 2.4 4.28 5.65 6.20 6.3 7.6 7.6 7.66 8.5} {-real} + +proc sortByLen {a b} { + set sizeA [string length $a] + set sizeB [string length $b] + if {$sizeA < $sizeB} { + return -1 + } elseif {$sizeB < $sizeA} { + return 1 + } else { + return 0 + } +} + +eval_is { + lsort -command sortByLen [list 12345 {} 1234 1 12345678 123456 1234567] +} {{} 1 1234 12345 123456 1234567 12345678} {-command option}
