os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/linsert.test
author sl
Tue, 10 Jun 2014 14:32:02 +0200
changeset 1 260cb5ec6c19
permissions -rw-r--r--
Update contrib.
     1 # Commands covered:  linsert
     2 #
     3 # This file contains a collection of tests for one or more of the Tcl
     4 # built-in commands.  Sourcing this file into Tcl runs the tests and
     5 # generates output for errors.  No output means no errors were found.
     6 #
     7 # Copyright (c) 1991-1993 The Regents of the University of California.
     8 # Copyright (c) 1994 Sun Microsystems, Inc.
     9 # Copyright (c) 1998-1999 by Scriptics Corporation.
    10 #
    11 # See the file "license.terms" for information on usage and redistribution
    12 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    13 #
    14 # RCS: @(#) $Id: linsert.test,v 1.8 2000/04/10 17:19:01 ericm Exp $
    15 
    16 if {[lsearch [namespace children] ::tcltest] == -1} {
    17     package require tcltest
    18     namespace import -force ::tcltest::*
    19 }
    20 
    21 catch {unset lis}
    22 catch {rename p ""}
    23 
    24 test linsert-1.1 {linsert command} {
    25     linsert {1 2 3 4 5} 0 a
    26 } {a 1 2 3 4 5}
    27 test linsert-1.2 {linsert command} {
    28     linsert {1 2 3 4 5} 1 a
    29 } {1 a 2 3 4 5}
    30 test linsert-1.3 {linsert command} {
    31     linsert {1 2 3 4 5} 2 a
    32 } {1 2 a 3 4 5}
    33 test linsert-1.4 {linsert command} {
    34     linsert {1 2 3 4 5} 3 a
    35 } {1 2 3 a 4 5}
    36 test linsert-1.5 {linsert command} {
    37     linsert {1 2 3 4 5} 4 a
    38 } {1 2 3 4 a 5}
    39 test linsert-1.6 {linsert command} {
    40     linsert {1 2 3 4 5} 5 a
    41 } {1 2 3 4 5 a}
    42 test linsert-1.7 {linsert command} {
    43     linsert {1 2 3 4 5} 2 one two \{three \$four
    44 } {1 2 one two \{three {$four} 3 4 5}
    45 test linsert-1.8 {linsert command} {
    46     linsert {\{one \$two \{three \ four \ five} 2 a b c
    47 } {\{one {$two} a b c \{three { four} { five}}
    48 test linsert-1.9 {linsert command} {
    49     linsert {{1 2} {3 4} {5 6} {7 8}} 2 {x y} {a b}
    50 } {{1 2} {3 4} {x y} {a b} {5 6} {7 8}}
    51 test linsert-1.10 {linsert command} {
    52     linsert {} 2 a b c
    53 } {a b c}
    54 test linsert-1.11 {linsert command} {
    55     linsert {} 2 {}
    56 } {{}}
    57 test linsert-1.12 {linsert command} {
    58     linsert {a b "c c" d e} 3 1
    59 } {a b {c c} 1 d e}
    60 test linsert-1.13 {linsert command} {
    61     linsert { a b c d} 0 1 2
    62 } {1 2 a b c d}
    63 test linsert-1.14 {linsert command} {
    64     linsert {a b c {d e f}} 4 1 2
    65 } {a b c {d e f} 1 2}
    66 test linsert-1.15 {linsert command} {
    67     linsert {a b c \{\  abc} 4 q r
    68 } {a b c \{\  q r abc}
    69 test linsert-1.16 {linsert command} {
    70     linsert {a b c \{ abc} 4 q r
    71 } {a b c \{ q r abc}
    72 test linsert-1.17 {linsert command} {
    73     linsert {a b c} end q r
    74 } {a b c q r}
    75 test linsert-1.18 {linsert command} {
    76     linsert {a} end q r
    77 } {a q r}
    78 test linsert-1.19 {linsert command} {
    79     linsert {} end q r
    80 } {q r}
    81 test linsert-1.20 {linsert command, use of end-int index} {
    82     linsert {a b c d} end-2 e f
    83 } {a b e f c d}
    84 
    85 test linsert-2.1 {linsert errors} {
    86     list [catch linsert msg] $msg
    87 } {1 {wrong # args: should be "linsert list index element ?element ...?"}}
    88 test linsert-2.2 {linsert errors} {
    89     list [catch {linsert a b} msg] $msg
    90 } {1 {wrong # args: should be "linsert list index element ?element ...?"}}
    91 test linsert-2.3 {linsert errors} {
    92     list [catch {linsert a 12x 2} msg] $msg
    93 } {1 {bad index "12x": must be integer or end?-integer?}}
    94 test linsert-2.4 {linsert errors} {
    95     list [catch {linsert \{ 12 2} msg] $msg
    96 } {1 {unmatched open brace in list}}
    97 
    98 test linsert-3.1 {linsert won't modify shared argument objects} {
    99     proc p {} {
   100         linsert "a b c" 1 "x y"
   101         return "a b c"
   102     }
   103     p
   104 } "a b c"
   105 test linsert-3.2 {linsert won't modify shared argument objects} {
   106     catch {unset lis}
   107     set lis [format "a \"%s\" c" "b"]
   108     linsert $lis 0 [string length $lis]
   109 } "7 a b c"
   110 
   111 # cleanup
   112 catch {unset lis}
   113 catch {rename p ""}
   114 ::tcltest::cleanupTests
   115 return