1# Commands covered:  none
2#
3# This file contains a collection of tests for the procedures in the
4# file tclGet.c.  Sourcing this file into Tcl runs the tests and
5# generates output for errors.  No output means no errors were found.
6#
7# Copyright © 1995-1996 Sun Microsystems, Inc.
8# Copyright © 1998-1999 Scriptics Corporation.
9#
10# See the file "license.terms" for information on usage and redistribution
11# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
12
13if {"::tcltest" ni [namespace children]} {
14    package require tcltest 2.5
15    namespace import -force ::tcltest::*
16}
17
18::tcltest::loadTestedCommands
19catch [list package require -exact tcl::test [info patchlevel]]
20
21testConstraint testgetint [llength [info commands testgetint]]
22testConstraint testdoubleobj [llength [info commands testdoubleobj]]
23testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
24testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}]
25
26test get-1.1 {Tcl_GetInt procedure} testgetint {
27    testgetint 44 { 	  22}
28} {66}
29test get-1.2 {Tcl_GetInt procedure} testgetint {
30    testgetint 44 -3
31} {41}
32test get-1.3 {Tcl_GetInt procedure} testgetint {
33    testgetint 44 +8
34} {52}
35test get-1.4 {Tcl_GetInt procedure} testgetint {
36    list [catch {testgetint 44 foo} msg] $msg
37} {1 {expected integer but got "foo"}}
38test get-1.5 {Tcl_GetInt procedure} testgetint {
39    list [catch {testgetint 44 {16	 }} msg] $msg
40} {0 60}
41test get-1.6 {Tcl_GetInt procedure} testgetint {
42    list [catch {testgetint 44 {16	 x}} msg] $msg
43} {1 {expected integer but got "16	 x"}}
44test get-1.7 {Tcl_GetInt procedure} {testgetint longIs64bit} {
45    list [catch {testgetint 44 18446744073709551616} msg] $msg $errorCode
46} {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
47test get-1.8 {Tcl_GetInt procedure} {testgetint longIs64bit} {
48    testgetint 18446744073709551614
49} {-2}
50test get-1.9 {Tcl_GetInt procedure} {testgetint longIs64bit} {
51    testgetint +18446744073709551614
52} {-2}
53test get-1.10 {Tcl_GetInt procedure} {testgetint longIs64bit} {
54    list [catch {testgetint -18446744073709551614} msg] $msg $errorCode
55} {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
56test get-1.11 {Tcl_GetInt procedure} {testgetint longIs32bit} {
57    list [catch {testgetint 44 4294967296} msg] $msg $errorCode
58} {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
59test get-1.12 {Tcl_GetInt procedure} {testgetint longIs32bit} {
60    list [catch {testgetint 4294967294} msg] $msg
61} {0 -2}
62test get-1.13 {Tcl_GetInt procedure} {testgetint longIs32bit} {
63    list [catch {testgetint +4294967294} msg] $msg
64} {0 -2}
65test get-1.14 {Tcl_GetInt procedure} {testgetint longIs32bit} {
66    list [catch {testgetint -4294967294} msg] $msg
67} {1 {integer value too large to represent}}
68
69test get-2.1 {Tcl_GetInt procedure} {
70    format %g 1.23
71} {1.23}
72test get-2.2 {Tcl_GetInt procedure} {
73    format %g { 	 1.23 	}
74} {1.23}
75test get-2.3 {Tcl_GetInt procedure} {
76    list [catch {format %g clip} msg] $msg
77} {1 {expected floating-point number but got "clip"}}
78test get-2.4 {Tcl_GetInt procedure} {
79    format %g .000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001
80} 0
81
82test get-3.1 {Tcl_GetInt(FromObj), bad numbers} {
83    # SF bug #634856
84    set result ""
85    set numbers [list 1 +1 ++1 +-1 -+1 -1 --1 "- +1" "+12345678987654321" "++12345678987654321"]
86    foreach num $numbers {
87	lappend result [catch {format %ld $num} msg] $msg
88    }
89    set result
90} {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"}}
91test get-3.2 {Tcl_GetDouble(FromObj), bad numbers} {
92    set result ""
93    set numbers [list 1.0 +1.0 ++1.0 +-1.0 -+1.0 -1.0 --1.0 "- +1.0"]
94    foreach num $numbers {
95	lappend result [catch {format %g $num} msg] $msg
96    }
97    set result
98} {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"}}
99# Bug 7114ac6141
100test get-3.3 {tcl_GetInt with iffy numbers} testgetint {
101    lmap x {0 " 0" "0 " " 0 " " 0xa " " 007 " " 0o10 " " 0b10 "} {
102	catch {testgetint 44 $x} x
103	set x
104    }
105} {44 44 44 44 54 51 52 46}
106test get-3.4 {Tcl_GetDouble with iffy numbers} testdoubleobj {
107    lmap x {0 0.0 " .0" ".0 " " 0e0 " "07" "- 0" "-0" "0o12" "0b10"} {
108	catch {testdoubleobj set 1 $x} x
109	set x
110    }
111} {0.0 0.0 0.0 0.0 0.0 7.0 {expected floating-point number but got "- 0"} 0.0 10.0 2.0}
112test get-3.5 {tcl_GetInt with numeric whitespace (i.e. '_')} testgetint {
113    lmap x {0_0 " 1_0" "0_2 " " 3_3 " 14__23__32___4 " 0x_a " 0b1111_1111 " 0_07 " " 0o_1_0 " " 0b_1_0 " " 0_b1_0 " _33 42_ 0_x15 0_o17 0_d19 } {
114	catch {testgetint $x} x
115	set x
116    }
117} {0 10 2 33 1423324 10 255 7 8 2 {expected integer but got " 0_b1_0 "} {expected integer but got "_33"} {expected integer but got "42_"} {expected integer but got "0_x15"} {expected integer but got "0_o17"} {expected integer but got "0_d19"}}
118
119# cleanup
120::tcltest::cleanupTests
121return
122
123# Local Variables:
124# mode: tcl
125# End:
126