From 29e7f1a55250207e75c6e1e5ef5871a569514f62 Mon Sep 17 00:00:00 2001
From: hobbs <hobbs>
Date: Tue, 10 Aug 1999 05:09:16 +0000
Subject: 1999-08-09  Jeff Hobbs  <hobbs@scriptics.com>

	* tests/string.test: added largest_int proc to adapt for >32 bit
	machines and int overflow testing.
	* tests/tcltest.test: fixed minor error in 8.2 result (from dgp)
---
 ChangeLog          |  4 ++++
 tests/string.test  | 18 +++++++++++++++---
 tests/tcltest.test |  5 +++--
 3 files changed, 22 insertions(+), 5 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 0714df6..dd9eb7f 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,9 @@
 1999-08-09  Jeff Hobbs  <hobbs@scriptics.com>
 
+	* tests/string.test: added largest_int proc to adapt for >32 bit
+	machines and int overflow testing.
+	* tests/tcltest.test: fixed minor error in 8.2 result (from dgp)
+
 	* doc/Object.3: clarified Tcl_DecrRefCount docs [Bug: 1952]
 	* doc/array.n: clarified array pattern docs [Bug: 1330]
 	* doc/clock.n: fixed clock docs [Bug: 693]
diff --git a/tests/string.test b/tests/string.test
index 951fd46..59cacae 100644
--- a/tests/string.test
+++ b/tests/string.test
@@ -11,7 +11,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: string.test,v 1.19 1999/07/09 02:11:56 stanton Exp $
+# RCS: @(#) $Id: string.test,v 1.20 1999/08/10 05:09:20 hobbs Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -245,6 +245,15 @@ test string-5.15 {string index, bytearray object} {
     string compare $i1 $i2
 } 0
 
+proc largest_int {} {
+    # This will give us what the largest valid int on this machine is,
+    # so we can test for overflow properly below on >32 bit systems
+    set int 1
+    set exp 7; # assume we get at least 8 bits
+    while {$int > 0} { set int [expr {1 << [incr exp]}] }
+    return [expr {$int-1}]
+}
+
 test string-6.1 {string is, too few args} {
     list [catch {string is} msg] $msg
 } {1 {wrong # args: should be "string is class ?-strict? ?-failindex var? str"}}
@@ -355,7 +364,8 @@ test string-6.36 {string is double, false} {
     list [string is double -fail var "\n"] $var
 } {0 0}
 test string-6.37 {string is double, false on int overflow} {
-    list [string is double -fail var 12345678901234567890] $var
+    # Make it the largest int recognizable, with one more digit for overflow
+    list [string is double -fail var [largest_int]0] $var
 } {0 -1}
 test string-6.38 {string is double, false on underflow} {
     catch {unset var}
@@ -416,7 +426,7 @@ test string-6.54 {string is integer, false} {
     list [string is integer -fail var 123abc] $var
 } {0 3}
 test string-6.55 {string is integer, false on overflow} {
-    list [string is integer -fail var +12345678901234567890] $var
+    list [string is integer -fail var +[largest_int]0] $var
 } {0 -1}
 test string-6.56 {string is integer, false} {
     list [string is integer -fail var [expr double(1)]] $var
@@ -528,6 +538,8 @@ test string-6.89 {string is xdigit} {
     list [string is xdigit -fail var 0123456789\u0061bcdefABCDEFg] $var
 } {0 22}
 
+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 string1 string2 ?startIndex?"}}
diff --git a/tests/tcltest.test b/tests/tcltest.test
index 7c37ebe..f1f709d 100755
--- a/tests/tcltest.test
+++ b/tests/tcltest.test
@@ -10,7 +10,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: tcltest.test,v 1.4 1999/07/30 19:10:47 jenn Exp $
+# RCS: @(#) $Id: tcltest.test,v 1.5 1999/08/10 05:09:20 hobbs Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -230,7 +230,8 @@ test tcltest-8.1 {tcltest a.tcl -tmpdir a} {
 } {1 {}}
 test tcltest-8.2 {tcltest a.tcl -tmpdir thisdirectoryisafile} {
     catch {exec $::tcltest::tcltest a.tcl -tmpdir thisdirectoryisafile} msg
-    list [regexp "not a directory" $msg]
+    # The join is necessary because the message can be split on multiple lines
+    list [regexp "not a directory" [join $msg]]
 } {1}
 
 # Platform-specific attribute testing still needs to be set up
-- 
cgit v0.12