os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/get.test
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/get.test Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,129 @@
1.4 +# Commands covered: none
1.5 +#
1.6 +# This file contains a collection of tests for the procedures in the
1.7 +# file tclGet.c. Sourcing this file into Tcl runs the tests and
1.8 +# generates output for errors. No output means no errors were found.
1.9 +#
1.10 +# Copyright (c) 1995-1996 Sun Microsystems, Inc.
1.11 +# Copyright (c) 1998-1999 by Scriptics Corporation.
1.12 +#
1.13 +# See the file "license.terms" for information on usage and redistribution
1.14 +# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.15 +#
1.16 +# RCS: @(#) $Id: get.test,v 1.8 2002/11/19 02:34:50 hobbs Exp $
1.17 +
1.18 +if {[lsearch [namespace children] ::tcltest] == -1} {
1.19 + package require tcltest
1.20 + namespace import -force ::tcltest::*
1.21 +}
1.22 +
1.23 +test get-1.1 {Tcl_GetInt procedure} {
1.24 + set x 44
1.25 + incr x { 22}
1.26 +} {66}
1.27 +test get-1.2 {Tcl_GetInt procedure} {
1.28 + set x 44
1.29 + incr x -3
1.30 +} {41}
1.31 +test get-1.3 {Tcl_GetInt procedure} {
1.32 + set x 44
1.33 + incr x +8
1.34 +} {52}
1.35 +test get-1.4 {Tcl_GetInt procedure} {
1.36 + set x 44
1.37 + list [catch {incr x foo} msg] $msg
1.38 +} {1 {expected integer but got "foo"}}
1.39 +test get-1.5 {Tcl_GetInt procedure} {
1.40 + set x 44
1.41 + list [catch {incr x {16 }} msg] $msg
1.42 +} {0 60}
1.43 +test get-1.6 {Tcl_GetInt procedure} {
1.44 + set x 44
1.45 + list [catch {incr x {16 x}} msg] $msg
1.46 +} {1 {expected integer but got "16 x"}}
1.47 +
1.48 +# The following tests are non-portable because they depend on
1.49 +# word size.
1.50 +
1.51 +if {wide(0x80000000) > wide(0)} {
1.52 + test get-1.7 {Tcl_GetInt procedure} {
1.53 + set x 44
1.54 + list [catch {eval incr x 18446744073709551616} msg] $msg $errorCode
1.55 + } {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
1.56 + test get-1.8 {Tcl_GetInt procedure} {
1.57 + set x 0
1.58 + list [catch {incr x 18446744073709551614} msg] $msg
1.59 + } {0 -2}
1.60 + test get-1.9 {Tcl_GetInt procedure} {
1.61 + set x 0
1.62 + list [catch {incr x +18446744073709551614} msg] $msg
1.63 + } {0 -2}
1.64 + test get-1.10 {Tcl_GetInt procedure} {
1.65 + set x 0
1.66 + list [catch {incr x -18446744073709551614} msg] $msg
1.67 + } {0 2}
1.68 +} else {
1.69 + test get-1.11 {Tcl_GetInt procedure} {
1.70 + set x 44
1.71 + list [catch {incr x 4294967296} msg] $msg $errorCode
1.72 + } {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
1.73 + test get-1.12 {Tcl_GetInt procedure} {
1.74 + set x 0
1.75 + list [catch {incr x 4294967294} msg] $msg
1.76 + } {0 -2}
1.77 + test get-1.13 {Tcl_GetInt procedure} {
1.78 + set x 0
1.79 + list [catch {incr x +4294967294} msg] $msg
1.80 + } {0 -2}
1.81 + test get-1.14 {Tcl_GetInt procedure} {
1.82 + set x 0
1.83 + list [catch {incr x -4294967294} msg] $msg
1.84 + } {0 2}
1.85 +}
1.86 +
1.87 +test get-2.1 {Tcl_GetInt procedure} {
1.88 + format %g 1.23
1.89 +} {1.23}
1.90 +test get-2.2 {Tcl_GetInt procedure} {
1.91 + format %g { 1.23 }
1.92 +} {1.23}
1.93 +test get-2.3 {Tcl_GetInt procedure} {
1.94 + list [catch {format %g clip} msg] $msg
1.95 +} {1 {expected floating-point number but got "clip"}}
1.96 +test get-2.4 {Tcl_GetInt procedure} {nonPortable} {
1.97 + list [catch {format %g .000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001} msg] $msg $errorCode
1.98 +} {1 {floating-point value too small to represent} {ARITH UNDERFLOW {floating-point value too small to represent}}}
1.99 +
1.100 +test get-3.1 {Tcl_GetInt(FromObj), bad numbers} {
1.101 + # SF bug #634856
1.102 + set result ""
1.103 + set numbers [list 1 +1 ++1 +-1 -+1 -1 --1 "- +1" "+12345678987654321" "++12345678987654321"]
1.104 + foreach num $numbers {
1.105 + lappend result [catch {format %ld $num} msg] $msg
1.106 + }
1.107 + set result
1.108 +} {0 1 0 1 1 {expected integer but got "++1"} 1 {expected integer but got "+-1"} 1 {expected integer but got "-+1"} 0 -1 1 {expected integer but got "--1"} 1 {expected integer but got "- +1"} 0 12345678987654321 1 {expected integer but got "++12345678987654321"}}
1.109 +test get-3.2 {Tcl_GetDouble(FromObj), bad numbers} {
1.110 + set result ""
1.111 + set numbers [list 1.0 +1.0 ++1.0 +-1.0 -+1.0 -1.0 --1.0 "- +1.0"]
1.112 + foreach num $numbers {
1.113 + lappend result [catch {format %g $num} msg] $msg
1.114 + }
1.115 + set result
1.116 +} {0 1 0 1 1 {expected floating-point number but got "++1.0"} 1 {expected floating-point number but got "+-1.0"} 1 {expected floating-point number but got "-+1.0"} 0 -1 1 {expected floating-point number but got "--1.0"} 1 {expected floating-point number but got "- +1.0"}}
1.117 +
1.118 +# cleanup
1.119 +::tcltest::cleanupTests
1.120 +return
1.121 +
1.122 +
1.123 +
1.124 +
1.125 +
1.126 +
1.127 +
1.128 +
1.129 +
1.130 +
1.131 +
1.132 +