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