diff options
| -rw-r--r-- | ChangeLog | 5 | ||||
| -rw-r--r-- | generic/tclCmdMZ.c | 11 | ||||
| -rw-r--r-- | tests/string.test | 56 |
3 files changed, 64 insertions, 8 deletions
@@ -1,3 +1,8 @@ +2013-09-08 Donal Fellows <dkf@users.sf.net> + + * generic/tclCmdMZ.c (StringIsCmd): [Bug 3600057]: Filled out missing + parts of implementation of [string is double]. + 2013-08-01 Harald Oehlmann <oehhar@users.sf.net> * tclUnixNotify.c Tcl_InitNotifier: Bug [a0bc856dcd] diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 6fd468c..5db4b5b 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -1512,14 +1512,14 @@ StringIsCmd( case STR_IS_DIGIT: chcomp = Tcl_UniCharIsDigit; break; - case STR_IS_DOUBLE: { - /* TODO */ + case STR_IS_DOUBLE: if ((objPtr->typePtr == &tclDoubleType) || - (objPtr->typePtr == &tclIntType) || + (objPtr->bytes == NULL && + ((objPtr->typePtr == &tclIntType) || #ifndef NO_WIDE_TYPE (objPtr->typePtr == &tclWideIntType) || #endif - (objPtr->typePtr == &tclBignumType)) { + (objPtr->typePtr == &tclBignumType)))) { break; } string1 = TclGetStringFromObj(objPtr, &length1); @@ -1531,7 +1531,7 @@ StringIsCmd( } end = string1 + length1; if (TclParseNumber(NULL, objPtr, NULL, NULL, -1, - (const char **) &stop, 0) != TCL_OK) { + (const char **) &stop, TCL_PARSE_DECIMAL_ONLY) != TCL_OK) { result = 0; failat = 0; } else { @@ -1543,7 +1543,6 @@ StringIsCmd( } } break; - } case STR_IS_GRAPH: chcomp = Tcl_UniCharIsGraph; break; diff --git a/tests/string.test b/tests/string.test index 7a7a749..9fd6602 100644 --- a/tests/string.test +++ b/tests/string.test @@ -17,11 +17,28 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +proc testIEEE {} { + binary scan [binary format dd -1.0 1.0] c* c + switch -exact -- $c { + {0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} { + return 1 + } + {-65 -16 0 0 0 0 0 0 63 -16 0 0 0 0 0 0} { + return 1 + } + default { + return 0 + } + } +} + # Some tests require the testobj command testConstraint testobj [expr {[info commands testobj] != {}}] testConstraint testindexobj [expr {[info commands testindexobj] != {}}] - +# Some tests require full IEEE floating point value support +testConstraint ieeeFloatingPoint [testIEEE] + test string-1.1 {error conditions} { list [catch {string gorp a b} msg] $msg } {1 {unknown or ambiguous subcommand "gorp": must be bytelength, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}} @@ -675,6 +692,41 @@ test string-6.108 {string is double, Bug 1382287} { test string-6.109 {string is double, Bug 1360532} { string is double 1\u00a0 } 0 +test string-6.132 {string is double, false on hex} { + string is double [format "0%c5" [scan x %c]] +} 0 +test string-6.133 {string is double, false on hex} -setup { + set var unset +} -body { + list [string is double -fail var [format "0%c5" [scan x %c]]] $var +} -result {0 1} +test string-6.134 {string is double, false on hex} { + # Force the presence of an integer representation + set val 0x5; expr {$val + 1} + list [string is int $val] [string is double $val] +} {1 0} +test string-6.135 {string is double, false on new octal} { + string is double [format "0%c5" [scan o %c]] +} 0 +test string-6.136 {string is double, false on new octal} -setup { + set var unset +} -body { + list [string is double -fail var [format "0%c5" [scan o %c]]] $var +} -result {0 1} +test string-6.137 {string is double, false on hex} { + # Force the presence of an integer representation + set val 0o5; expr {$val + 1} + list [string is int $val] [string is double $val] +} {1 0} +test string-6.138 {string is double, true on inf} ieeeFloatingPoint { + string is double Inf +} 1 +test string-6.139 {string is double, true on -inf} ieeeFloatingPoint { + string is double -Inf +} 1 +test string-6.140 {string is double, true on NaN} ieeeFloatingPoint { + string is double NaN +} 1 catch {rename largest_int {}} @@ -1664,7 +1716,7 @@ test string-25.14 {string is list} { set x {} list [string is list -failindex x "\uabcd {b c}d e"] $x } {0 2} - + # cleanup ::tcltest::cleanupTests return |