os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/incr-old.test
author sl
Tue, 10 Jun 2014 14:32:02 +0200
changeset 1 260cb5ec6c19
permissions -rw-r--r--
Update contrib.
     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.6.2.1 2003/03/27 13:11:13 dkf Exp $
    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.4 {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     (reading increment)
    66     invoked from within
    67 "incr x 1a"}}
    68 test incr-old-2.6 {incr errors} {
    69     proc readonly args {error "variable is read-only"}
    70     set x 123
    71     trace var x w readonly
    72     list [catch {incr x 1} msg] $msg $errorInfo
    73 } {1 {can't set "x": variable is read-only} {can't set "x": variable is read-only
    74     while executing
    75 "incr x 1"}}
    76 catch {unset x}
    77 test incr-old-2.7 {incr errors} {
    78     set x -
    79     list [catch {incr x 1} msg] $msg
    80 } {1 {expected integer but got "-"}}
    81 test incr-old-2.8 {incr errors} {
    82     set x {  -  }
    83     list [catch {incr x 1} msg] $msg
    84 } {1 {expected integer but got "  -  "}}
    85 test incr-old-2.9 {incr errors} {
    86     set x +
    87     list [catch {incr x 1} msg] $msg
    88 } {1 {expected integer but got "+"}}
    89 test incr-old-2.10 {incr errors} {
    90     set x {20 x}
    91     list [catch {incr x 1} msg] $msg
    92 } {1 {expected integer but got "20 x"}}
    93 
    94 # cleanup
    95 ::tcltest::cleanupTests
    96 return