1# Commands covered: incr 2# 3# This file contains the original set of tests for Tcl's incr command. 4# Since the incr command is now compiled, a new set of tests covering 5# the new implementation is in the file "incr.test". Sourcing this file 6# into Tcl runs the tests and generates output for errors. 7# No output means no errors were found. 8# 9# Copyright (c) 1991-1993 The Regents of the University of California. 10# Copyright (c) 1994-1996 Sun Microsystems, Inc. 11# Copyright (c) 1998-1999 by Scriptics Corporation. 12# 13# See the file "license.terms" for information on usage and redistribution 14# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 15# 16# RCS: @(#) $Id: incr-old.test,v 1.10 2006/10/09 19:15:44 msofer Exp $ 17 18if {[lsearch [namespace children] ::tcltest] == -1} { 19 package require tcltest 2 20 namespace import -force ::tcltest::* 21} 22 23catch {unset x} 24 25test incr-old-1.1 {basic incr operation} { 26 set x 23 27 list [incr x] $x 28} {24 24} 29test incr-old-1.2 {basic incr operation} { 30 set x 106 31 list [incr x -5] $x 32} {101 101} 33test incr-old-1.3 {basic incr operation} { 34 set x " -106" 35 list [incr x 1] $x 36} {-105 -105} 37test incr-old-1.4 {basic incr operation} { 38 set x " +106" 39 list [incr x 1] $x 40} {107 107} 41 42test incr-old-2.1 {incr errors} { 43 list [catch incr msg] $msg 44} {1 {wrong # args: should be "incr varName ?increment?"}} 45test incr-old-2.2 {incr errors} { 46 list [catch {incr a b c} msg] $msg 47} {1 {wrong # args: should be "incr varName ?increment?"}} 48test incr-old-2.3 {incr errors} { 49 catch {unset x} 50 incr x 51} 1 52test incr-old-2.4 {incr errors} { 53 set x abc 54 list [catch {incr x} msg] $msg $::errorInfo 55} {1 {expected integer but got "abc"} {expected integer but got "abc" 56 while executing 57"incr x"}} 58test incr-old-2.5 {incr errors} { 59 set x 123 60 list [catch {incr x 1a} msg] $msg $::errorInfo 61} {1 {expected integer but got "1a"} {expected integer but got "1a" 62 (reading increment) 63 invoked from within 64"incr x 1a"}} 65test incr-old-2.6 {incr errors} -body { 66 proc readonly args {error "variable is read-only"} 67 set x 123 68 trace var x w readonly 69 list [catch {incr x 1} msg] $msg $::errorInfo 70} -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only 71 while executing 72* 73"incr x 1"}} 74catch {unset x} 75test incr-old-2.7 {incr errors} { 76 set x - 77 list [catch {incr x 1} msg] $msg 78} {1 {expected integer but got "-"}} 79test incr-old-2.8 {incr errors} { 80 set x { - } 81 list [catch {incr x 1} msg] $msg 82} {1 {expected integer but got " - "}} 83test incr-old-2.9 {incr errors} { 84 set x + 85 list [catch {incr x 1} msg] $msg 86} {1 {expected integer but got "+"}} 87test incr-old-2.10 {incr errors} { 88 set x {20 x} 89 list [catch {incr x 1} msg] $msg 90} {1 {expected integer but got "20 x"}} 91 92# cleanup 93::tcltest::cleanupTests 94return 95