tcl/tests/incr-old.test

   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$
  17
  18 if {[lsearch [namespace children] ::tcltest] == -1} {
  19     package require tcltest
  20     namespace import -force ::tcltest::*
  21 }
  22
  23 catch {unset x}
  24
  25 test incr-old-1.1 {basic incr operation} {
  26     set x 23
  27     list [incr x] $x
  28 } {24 24}
  29 test incr-old-1.2 {basic incr operation} {
  30     set x 106
  31     list [incr x -5] $x
  32 } {101 101}
  33 test incr-old-1.3 {basic incr operation} {
  34     set x "  -106"
  35     list [incr x 1] $x
  36 } {-105 -105}
  37 test incr-old-1.3 {basic incr operation} {
  38     set x "  +106"
  39     list [incr x 1] $x
  40 } {107 107}
  41
  42 test incr-old-2.1 {incr errors} {
  43     list [catch incr msg] $msg
  44 } {1 {wrong # args: should be "incr varName ?increment?"}}
  45 test incr-old-2.2 {incr errors} {
  46     list [catch {incr a b c} msg] $msg
  47 } {1 {wrong # args: should be "incr varName ?increment?"}}
  48 test incr-old-2.3 {incr errors} {
  49     catch {unset x}
  50     list [catch {incr x} msg] $msg $errorInfo
  51 } {1 {can't read "x": no such variable} {can't read "x": no such variable
  52     (reading value of variable to increment)
  53     invoked from within
  54 "incr x"}}
  55 test incr-old-2.4 {incr errors} {
  56     set x abc
  57     list [catch {incr x} msg] $msg $errorInfo
  58 } {1 {expected integer but got "abc"} {expected integer but got "abc"
  59     while executing
  60 "incr x"}}
  61 test incr-old-2.5 {incr errors} {
  62     set x 123
  63     list [catch {incr x 1a} msg] $msg $errorInfo
  64 } {1 {expected integer but got "1a"} {expected integer but got "1a"
  65     while executing
  66 "incr x 1a"}}
  67 test incr-old-2.6 {incr errors} {
  68     proc readonly args {error "variable is read-only"}
  69     set x 123
  70     trace var x w readonly
  71     list [catch {incr x 1} msg] $msg $errorInfo
  72 } {1 {can't set "x": variable is read-only} {can't set "x": variable is read-only
  73     while executing
  74 "incr x 1"}}
  75 catch {unset x}
  76 test incr-old-2.7 {incr errors} {
  77     set x -
  78     list [catch {incr x 1} msg] $msg
  79 } {1 {expected integer but got "-"}}
  80 test incr-old-2.8 {incr errors} {
  81     set x {  -  }
  82     list [catch {incr x 1} msg] $msg
  83 } {1 {expected integer but got "  -  "}}
  84 test incr-old-2.9 {incr errors} {
  85     set x +
  86     list [catch {incr x 1} msg] $msg
  87 } {1 {expected integer but got "+"}}
  88 test incr-old-2.10 {incr errors} {
  89     set x {20 x}
  90     list [catch {incr x 1} msg] $msg
  91 } {1 {expected integer but got "20 x"}}
  92
  93 # cleanup
  94 ::tcltest::cleanupTests
  95 return
  96
  97
  98
  99
 100
 101
 102
 103
 104
 105
 106
 107