Tcl Source Code

2013-09-08  Donal Fellows  <[email protected]>

	* generic/tclCmdMZ.c (StringIsCmd): [Bug 3600057]: Filled out missing
	parts of implementation of [string is double].

2013-08-01  Harald Oehlmann  <[email protected]>

	* tclUnixNotify.c Tcl_InitNotifier: Bug [a0bc856dcd]
	  Start notifier thread again if we were forked, to solve Rivet bug
	  55153.

2013-07-05  Kevin B. Kenny  <[email protected]>

	break;
    case STR_IS_CONTROL:
	chcomp = Tcl_UniCharIsControl;
	break;
    case STR_IS_DIGIT:
	chcomp = Tcl_UniCharIsDigit;
	break;
    case STR_IS_DOUBLE:

	if ((objPtr->typePtr == &tclDoubleType) ||
		(objPtr->bytes == NULL &&
		((objPtr->typePtr == &tclIntType) ||
#ifndef NO_WIDE_TYPE
		(objPtr->typePtr == &tclWideIntType) ||
#endif
		(objPtr->typePtr == &tclBignumType)))) {
	    break;
	}
	string1 = TclGetStringFromObj(objPtr, &length1);
	if (length1 == 0) {
	    if (strict) {
		result = 0;
	    }
	    goto str_is_done;
	}
	end = string1 + length1;
	if (TclParseNumber(NULL, objPtr, NULL, NULL, -1,
		(const char **) &stop, TCL_PARSE_DECIMAL_ONLY) != TCL_OK) {
	    result = 0;
	    failat = 0;
	} else {
	    failat = stop - string1;
	    if (stop < end) {
		result = 0;
		TclFreeIntRep(objPtr);
		objPtr->typePtr = NULL;
	    }
	}
	break;

    case STR_IS_GRAPH:
	chcomp = Tcl_UniCharIsGraph;
	break;
    case STR_IS_INT:
	if (TCL_OK == TclGetIntFromObj(NULL, objPtr, &i)) {
	    break;
	}

# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    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}}
test string-1.2 {error conditions} {
    list [catch {string} msg] $msg
} {1 {wrong # args: should be "string subcommand ?argument ...?"}}

    set x 2turtledoves
    string is double $x
    string is double $x
} 0
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 {}}

test string-7.1 {string last, too few args} {
    list [catch {string last a} msg] $msg
} {1 {wrong # args: should be "string last needleString haystackString ?startIndex?"}}
test string-7.2 {string last, bad args} {

    set x {}
    list [string is list -failindex x {  {b c}d e}] $x
} {0 2}
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

# Local Variables:
# mode: tcl
# End: