1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/incr-old.test	Fri Jun 15 03:10:57 2012 +0200
     1.3 @@ -0,0 +1,96 @@
     1.4 +# Commands covered:  incr
     1.5 +#
     1.6 +# This file contains the original set of tests for Tcl's incr command.
     1.7 +# Since the incr command is now compiled, a new set of tests covering
     1.8 +# the new implementation is in the file "incr.test". Sourcing this file
     1.9 +# into Tcl runs the tests and generates output for errors.
    1.10 +# No output means no errors were found.
    1.11 +#
    1.12 +# Copyright (c) 1991-1993 The Regents of the University of California.
    1.13 +# Copyright (c) 1994-1996 Sun Microsystems, Inc.
    1.14 +# Copyright (c) 1998-1999 by Scriptics Corporation.
    1.15 +#
    1.16 +# See the file "license.terms" for information on usage and redistribution
    1.17 +# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    1.18 +#
    1.19 +# RCS: @(#) $Id: incr-old.test,v 1.6.2.1 2003/03/27 13:11:13 dkf Exp $
    1.20 +
    1.21 +if {[lsearch [namespace children] ::tcltest] == -1} {
    1.22 +    package require tcltest
    1.23 +    namespace import -force ::tcltest::*
    1.24 +}
    1.25 +
    1.26 +catch {unset x}
    1.27 +
    1.28 +test incr-old-1.1 {basic incr operation} {
    1.29 +    set x 23
    1.30 +    list [incr x] $x
    1.31 +} {24 24}
    1.32 +test incr-old-1.2 {basic incr operation} {
    1.33 +    set x 106
    1.34 +    list [incr x -5] $x
    1.35 +} {101 101}
    1.36 +test incr-old-1.3 {basic incr operation} {
    1.37 +    set x "  -106"
    1.38 +    list [incr x 1] $x
    1.39 +} {-105 -105}
    1.40 +test incr-old-1.4 {basic incr operation} {
    1.41 +    set x "  +106"
    1.42 +    list [incr x 1] $x
    1.43 +} {107 107}
    1.44 +
    1.45 +test incr-old-2.1 {incr errors} {
    1.46 +    list [catch incr msg] $msg
    1.47 +} {1 {wrong # args: should be "incr varName ?increment?"}}
    1.48 +test incr-old-2.2 {incr errors} {
    1.49 +    list [catch {incr a b c} msg] $msg
    1.50 +} {1 {wrong # args: should be "incr varName ?increment?"}}
    1.51 +test incr-old-2.3 {incr errors} {
    1.52 +    catch {unset x}
    1.53 +    list [catch {incr x} msg] $msg $errorInfo
    1.54 +} {1 {can't read "x": no such variable} {can't read "x": no such variable
    1.55 +    (reading value of variable to increment)
    1.56 +    invoked from within
    1.57 +"incr x"}}
    1.58 +test incr-old-2.4 {incr errors} {
    1.59 +    set x abc
    1.60 +    list [catch {incr x} msg] $msg $errorInfo
    1.61 +} {1 {expected integer but got "abc"} {expected integer but got "abc"
    1.62 +    while executing
    1.63 +"incr x"}}
    1.64 +test incr-old-2.5 {incr errors} {
    1.65 +    set x 123
    1.66 +    list [catch {incr x 1a} msg] $msg $errorInfo
    1.67 +} {1 {expected integer but got "1a"} {expected integer but got "1a"
    1.68 +    (reading increment)
    1.69 +    invoked from within
    1.70 +"incr x 1a"}}
    1.71 +test incr-old-2.6 {incr errors} {
    1.72 +    proc readonly args {error "variable is read-only"}
    1.73 +    set x 123
    1.74 +    trace var x w readonly
    1.75 +    list [catch {incr x 1} msg] $msg $errorInfo
    1.76 +} {1 {can't set "x": variable is read-only} {can't set "x": variable is read-only
    1.77 +    while executing
    1.78 +"incr x 1"}}
    1.79 +catch {unset x}
    1.80 +test incr-old-2.7 {incr errors} {
    1.81 +    set x -
    1.82 +    list [catch {incr x 1} msg] $msg
    1.83 +} {1 {expected integer but got "-"}}
    1.84 +test incr-old-2.8 {incr errors} {
    1.85 +    set x {  -  }
    1.86 +    list [catch {incr x 1} msg] $msg
    1.87 +} {1 {expected integer but got "  -  "}}
    1.88 +test incr-old-2.9 {incr errors} {
    1.89 +    set x +
    1.90 +    list [catch {incr x 1} msg] $msg
    1.91 +} {1 {expected integer but got "+"}}
    1.92 +test incr-old-2.10 {incr errors} {
    1.93 +    set x {20 x}
    1.94 +    list [catch {incr x 1} msg] $msg
    1.95 +} {1 {expected integer but got "20 x"}}
    1.96 +
    1.97 +# cleanup
    1.98 +::tcltest::cleanupTests
    1.99 +return