Usenet 1994 January/usenetsourcesnewsgroupsinfomagicjanuary1994.iso/sources/misc/volume25/tcl/part13

Text File | 1991-11-14 | 36.0 KB | 1,100 lines

Newsgroups: comp.sources.misc
From: [e-mail] (Karl Lehenbauer)
Subject:  v25i081:  tcl - tool command language, version 6.1, Part13/33
Message-ID: <[e-mail]>
X-Md4-Signature: 24e161b8d7f9ba16091e298daafb566f
Date: Thu, 14 Nov 1991 20:31:00 GMT
Approved: [e-mail]

Submitted-by: [e-mail] (Karl Lehenbauer)
Posting-number: Volume 25, Issue 81
Archive-name: tcl/part13
Environment: UNIX

#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#        "End of archive 13 (of 33)."
# Contents:  tcl6.1/tests/open.test tcl6.1/tests/set.test
# Wrapped by karl@one on Tue Nov 12 19:44:22 1991
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'tcl6.1/tests/open.test' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'tcl6.1/tests/open.test'\"
else
echo shar: Extracting \"'tcl6.1/tests/open.test'\" \(16158 characters\)
sed "s/^X//" >'tcl6.1/tests/open.test' <<'END_OF_FILE'
X# Commands covered:  open, close, gets, puts, read, seek, tell, eof, flush
X#
X# This file contains a collection of tests for one or more of the Tcl
X# built-in commands.  Sourcing this file into Tcl runs the tests and
X# generates output for errors.  No output means no errors were found.
X#
X# Copyright 1991 Regents of the University of California
X# Permission to use, copy, modify, and distribute this
X# software and its documentation for any purpose and without
X# fee is hereby granted, provided that this copyright notice
X# appears in all copies.  The University of California makes no
X# representations about the suitability of this software for any
X# purpose.  It is provided "as is" without express or implied
X# warranty.
X#
X# $Header: /sprite/src/lib/tcl/tests/RCS/open.test,v 1.8 91/09/24 16:17:00 ouster Exp $ (Berkeley)
X
Xif {[string compare test [info procs test]] == 1} then {source defs}
X
Xcatch {exec rm -f test1 test2 test3}
Xexec cat > test1 << "Two lines: this one\nand this one\n"
Xexec cat > test2 << "line1\nline2\nline3\nline4\nline5\n"
X
Xtest open-1.1 {open command (files only)} {
X    set f [open test1]
X    set x [gets $f]
X    close $f
X    set x
X} {Two lines: this one}
Xtest open-1.2 {open command (files only)} {
X    set f [open test1]
X    set f2 [open test2]
X    set f3 [open test1]
X    set f4 [open test1]
X    set x [list [gets $f] [gets $f2] [gets $f3] [gets $f4] \
X        [gets $f] [gets $f2]]
X    close $f
X    close $f2
X    close $f3
X    close $f4
X    set x
X} {{Two lines: this one} line1 {Two lines: this one} {Two lines: this one} {and this one} line2}
Xtest open-1.3 {open command (files only)} {
X    set f [open test3 w]
X    puts $f xyz
X    close $f
X    exec cat test3
X} "xyz"
Xtest open-1.4 {open command (files only)} {
X    set f [open test3 w]
X    puts $f xyz
X    close $f
X    set f [open test3 a]
X    puts $f 123
X    close $f
X    exec cat test3
X} "xyz\n123"
Xtest open-1.5 {open command (files only)} {
X    set f [open test3 w]
X    puts $f xyz\n123
X    close $f
X    set f [open test3 r+]
X    set x [gets $f]
X    seek $f 0 current
X    puts $f 456
X    close $f
X    list $x [exec cat test3]
X} "xyz {xyz
X456}"
Xtest open-1.6 {open command (files only)} {
X    set f [open test3 w]
X    puts $f xyz\n123
X    close $f
X    set f [open test3 w+]
X    puts $f xyzzy
X    seek $f 2
X    set x [gets $f]
X    close $f
X    list $x [exec cat test3]
X} "zzy xyzzy"
Xtest open-1.7 {open command (files only)} {
X    set f [open test3 w]
X    puts $f xyz\n123
X    close $f
X    set f [open test3 a+]
X    puts $f xyzzy
X    flush $f
X    set x [tell $f]
X    seek $f -4 cur
X    set y [gets $f]
X    close $f
X    list $x [exec cat test3] $y
X} {14 {xyz
X123
Xxyzzy} zzy}
X
Xtest open-2.1 {errors in open command} {
X    list [catch {open} msg] $msg
X} {1 {wrong # args: should be "open filename ?access?"}}
Xtest open-2.2 {errors in open command} {
X    list [catch {open a b c} msg] $msg
X} {1 {wrong # args: should be "open filename ?access?"}}
Xtest open-2.3 {errors in open command} {
X    list [catch {open test1 x} msg] $msg
X} {1 {illegal access mode "x"}}
Xtest open-2.4 {errors in open command} {
X    list [catch {open test1 rw} msg] $msg
X} {1 {illegal access mode "rw"}}
Xtest open-2.5 {errors in open command} {
X    list [catch {open test1 r+1} msg] $msg
X} {1 {illegal access mode "r+1"}}
Xtest open-2.6 {errors in open command} {
X    string tolower [list [catch {open _non_existent_} msg] $msg $errorCode]
X} {1 {couldn't open "_non_existent_": no such file or directory} {unix enoent {no such file or directory}}}
X
Xif {![file exists ~/_test_] && [file writable ~]} {
X    test open-3.1 {tilde substitution in open} {
X    set f [open ~/_test_ w]
X    puts $f "Some text"
X    close $f
X    set x [file exists $env(HOME)/_test_]
X    exec rm -f $env(HOME)/_test_
X    set x
X    } 1
X}
Xtest open-3.2 {tilde substitution in open} {
X    set home $env(HOME)
X    unset env(HOME)
X    set x [list [catch {open ~/foo} msg] $msg]
X    set env(HOME) $home
X    set x
X} {1 {couldn't find HOME environment variable to expand "~/foo"}}
X
Xtest open-4.1 {file id parsing errors} {
X    list [catch {eof gorp} msg] $msg $errorCode
X} {1 {bad file identifier "gorp"} NONE}
Xtest open-4.2 {file id parsing errors} {
X    list [catch {eof filex} msg] $msg
X} {1 {bad file identifier "filex"}}
Xtest open-4.3 {file id parsing errors} {
X    list [catch {eof file12a} msg] $msg
X} {1 {bad file identifier "file12a"}}
Xtest open-4.4 {file id parsing errors} {
X    list [catch {eof file123} msg] $msg
X} {1 {file "file123" isn't open}}
Xtest open-4.5 {file id parsing errors} {
X    list [catch {eof file1} msg] $msg
X} {0 0}
Xtest open-4.5 {file id parsing errors} {
X    list [catch {eof stdin} msg] $msg
X} {0 0}
Xtest open-4.6 {file id parsing errors} {
X    list [catch {eof stdout} msg] $msg
X} {0 0}
Xtest open-4.7 {file id parsing errors} {
X    list [catch {eof stderr} msg] $msg
X} {0 0}
Xtest open-4.8 {file id parsing errors} {
X    list [catch {eof stderr1} msg] $msg
X} {1 {bad file identifier "stderr1"}}
Xset f [open test1]
Xclose $f
Xset expect "1 {file \"$f\" isn't open}"
Xtest open-4.9 {file id parsing errors} {
X    list [catch {eof $f} msg] $msg
X} $expect
X
Xtest open-5.1 {close command (files only)} {
X    list [catch {close} msg] $msg $errorCode
X} {1 {wrong # args: should be "close fileId"} NONE}
Xtest open-5.2 {close command (files only)} {
X    list [catch {close a b} msg] $msg $errorCode
X} {1 {wrong # args: should be "close fileId"} NONE}
Xtest open-5.3 {close command (files only)} {
X    list [catch {close gorp} msg] $msg $errorCode
X} {1 {bad file identifier "gorp"} NONE}
Xtest open-5.4 {close command (files only)} {
X    list [catch {close file4} msg] \
X        [string range $msg [string first {" } $msg] end] $errorCode
X} {1 {" isn't open} NONE}
X
Xtest open-6.1 {puts command} {
X    list [catch {puts file3} msg] $msg $errorCode
X} {1 {wrong # args: should be "puts fileId string ?nonewline?"} NONE}
Xtest open-6.2 {puts command} {
X    list [catch {puts a b c d} msg] $msg $errorCode
X} {1 {wrong # args: should be "puts fileId string ?nonewline?"} NONE}
Xtest open-6.3 {puts command} {
X    list [catch {puts a b nonewlinx} msg] $msg $errorCode
X} {1 {bad argument "nonewlinx": should be "nonewline"} NONE}
Xtest open-6.4 {puts command} {
X    list [catch {puts gorp "New text"} msg] $msg $errorCode
X} {1 {bad file identifier "gorp"} NONE}
Xtest open-6.5 {puts command} {
X    set f [open test3]
X    set x [list [catch {puts $f "New text"} msg] \
X    [string range $msg [string first " " $msg] end] $errorCode]
X    close $f
X    set x
X} {1 { wasn't opened for writing} NONE}
Xtest open-6.6 {puts command} {
X    set f [open test3 w]
X    puts $f "Text1" n
X    puts $f " Text 2" no
X    puts $f " Text 3"
X    close $f
X    exec cat test3
X} {Text1 Text 2 Text 3}
X
Xtest open-7.1 {gets command} {
X    list [catch {gets} msg] $msg $errorCode
X} {1 {wrong # args: should be "gets fileId ?varName?"} NONE}
Xtest open-7.2 {gets command} {
X    list [catch {gets a b c} msg] $msg $errorCode
X} {1 {wrong # args: should be "gets fileId ?varName?"} NONE}
Xtest open-7.3 {gets command} {
X    list [catch {gets a} msg] $msg $errorCode
X} {1 {bad file identifier "a"} NONE}
Xtest open-7.4 {gets command} {
X    set f [open test3 w]
X    set x [list [catch {gets $f} msg] \
X        [string range $msg [string first " " $msg] end] $errorCode]
X    close $f
X    set x
X} {1 { wasn't opened for reading} NONE}
Xset f [open test3 w]
Xputs $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" nonewline
Xputs $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" nonewline
Xputs $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" nonewline
Xputs $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" nonewline
Xputs $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
Xclose $f
Xtest open-7.5 {gets command with long line} {
X    set f [open test3]
X    set x [gets $f]
X    close $f
X    set x
X} {abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
Xtest open-7.6 {gets command with long line} {
X    set f [open test3]
X    set x [gets $f y]
X    close $f
X    list $x $y
X} {260 abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
Xtest open-7.7 {gets command and end of file} {
X    set f [open test3 w]
X    puts $f "Test1\nTest2" nonewline
X    close $f
X    set f [open test3]
X    set x {}
X    set y {}
X    lappend x [gets $f y] $y
X    set y {}
X    lappend x [gets $f y] $y
X    set y {}
X    lappend x [gets $f y] $y
X    close $f
X    set x
X} {5 Test1 5 Test2 -1 {}}
X
Xtest open-8.1 {read command} {
X    list [catch {read} msg] $msg $errorCode
X} {1 {wrong # args: should be "read fileId ?numBytes|nonewline?"} NONE}
Xtest open-8.2 {read command} {
X    list [catch {read a b c} msg] $msg $errorCode
X} {1 {wrong # args: should be "read fileId ?numBytes|nonewline?"} NONE}
Xtest open-8.3 {read command} {
X    list [catch {read file10} msg] $msg $errorCode
X} {1 {file "file10" isn't open} NONE}
Xtest open-8.4 {read command} {
X    set f [open test3 w]
X    set x [list [catch {read $f} msg] \
X        [string range $msg [string first " " $msg] end] $errorCode]
X    close $f
X    set x
X} {1 { wasn't opened for reading} NONE}
Xtest open-8.5 {read command} {
X    set f [open test1]
X    set x [list [catch {read $f 12z} msg] $msg $errorCode]
X    close $f
X    set x
X} {1 {expected integer but got "12z"} NONE}
Xtest open-8.6 {read command} {
X    set f [open test1]
X    set x [list [catch {read $f z} msg] $msg $errorCode]
X    close $f
X    set x
X} {1 {bad argument "z": should be "nonewline"} NONE}
Xtest open-8.7 {read command} {
X    set f [open test1]
X    set x [list [read $f 1] [read $f 2] [read $f]]
X    close $f
X    set x
X} {T wo { lines: this one
Xand this one
X}}
Xtest open-8.8 {read command, with over-large count} {
X    set f [open test1]
X    set x [read $f 100]
X    close $f
X    set x
X} {Two lines: this one
Xand this one
X}
Xtest open-8.9 {read command, nonewline option} {
X    set f [open test1]
X    set x [read $f n]
X    close $f
X    set x
X} {Two lines: this one
Xand this one}
X
Xtest open-9.1 {seek command} {
X    list [catch {seek foo} msg] $msg $errorCode
X} {1 {wrong # args: should be "seek fileId offset ?origin?"} NONE}
Xtest open-9.2 {seek command} {
X    list [catch {seek foo a b c} msg] $msg $errorCode
X} {1 {wrong # args: should be "seek fileId offset ?origin?"} NONE}
Xtest open-9.3 {seek command} {
X    list [catch {seek foo 0} msg] $msg $errorCode
X} {1 {bad file identifier "foo"} NONE}
Xtest open-9.4 {seek command} {
X    set f [open test2]
X    set x [list [catch {seek $f xyz} msg] $msg $errorCode]
X    close $f
X    set x
X} {1 {expected integer but got "xyz"} NONE}
Xtest open-9.5 {seek command} {
X    set f [open test2]
X    set x [list [catch {seek $f 100 gorp} msg] $msg $errorCode]
X    close $f
X    set x
X} {1 {bad origin "gorp": should be start, current, or end} NONE}
Xset f [open test3 w]
Xputs $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" nonewline
Xclose $f
Xtest open-9.6 {seek command} {
X    set f [open test3]
X    set x [read $f 1]
X    seek $f 3
X    lappend x [read $f 1]
X    seek $f 0 start
X    lappend x [read $f 1]
X    seek $f 10 current
X    lappend x [read $f 1]
X    seek $f -2 end
X    lappend x [read $f 1]
X    seek $f 50 end
X    lappend x [read $f 1]
X    seek $f 1
X    lappend x [read $f 1]
X    close $f
X    set x
X} {a d a l Y {} b}
X
Xtest open-10.1 {tell command} {
X    list [catch {tell} msg] $msg $errorCode
X} {1 {wrong # args: should be "tell fileId"} NONE}
Xtest open-10.2 {tell command} {
X    list [catch {tell a b} msg] $msg $errorCode
X} {1 {wrong # args: should be "tell fileId"} NONE}
Xtest open-10.3 {tell command} {
X    list [catch {tell a} msg] $msg $errorCode
X} {1 {bad file identifier "a"} NONE}
Xtest open-10.4 {tell command} {
X    set f [open test2]
X    set x [tell $f]
X    read $f 3
X    lappend x [tell $f]
X    seek $f 2
X    lappend x [tell $f]
X    seek $f 10 current
X    lappend x [tell $f]
X    seek $f 0 end
X    lappend x [tell $f]
X    close $f
X    set x
X} {0 3 2 12 30}
X
Xtest open-11.1 {eof command} {
X    list [catch {eof} msg] $msg $errorCode
X} {1 {wrong # args: should be "eof fileId"} NONE}
Xtest open-11.2 {eof command} {
X    list [catch {eof a b} msg] $msg $errorCode
X} {1 {wrong # args: should be "eof fileId"} NONE}
Xtest open-11.3 {eof command} {
X    list [catch {eof file100} msg] $msg $errorCode
X} {1 {file "file100" isn't open} NONE}
Xtest open-11.4 {eof command} {
X    set f [open test1]
X    set x [eof $f]
X    lappend x [eof $f]
X    gets $f
X    lappend x [eof $f]
X    gets $f
X    lappend x [eof $f]
X    gets $f
X    lappend x [eof $f]
X    lappend x [eof $f]
X    close $f
X    set x
X} {0 0 0 0 1 1}
X
Xtest open-12.1 {flush command} {
X    list [catch {flush} msg] $msg $errorCode
X} {1 {wrong # args: should be "flush fileId"} NONE}
Xtest open-12.2 {flush command} {
X    list [catch {flush a b} msg] $msg $errorCode
X} {1 {wrong # args: should be "flush fileId"} NONE}
Xtest open-12.3 {flush command} {
X    list [catch {flush a} msg] $msg $errorCode
X} {1 {bad file identifier "a"} NONE}
Xtest open-12.4 {flush command} {
X    set f [open test3]
X    set x [list [catch {flush $f} msg] \
X        [string range $msg [string first " " $msg] end] $errorCode]
X    close $f
X    set x
X} {1 { wasn't opened for writing} NONE}
Xtest open-12.5 {flush command} {
X    set f [open test3 w]
X    puts $f "Line 1"
X    puts $f "Line 2"
X    set f2 [open test3]
X    set x {}
X    lappend x [read $f2 nonewline]
X    close $f2
X    flush $f
X    set f2 [open test3]
X    lappend x [read $f2 nonewline]
X    close $f2
X    close $f
X    set x
X} {{} {Line 1
XLine 2}}
X
Xtest open-13.1 {I/O to command pipelines} {
X    list [catch {open "| cat < test1 > test3" w} msg] $msg $errorCode
X} {1 {can't write input to command: standard input was redirected} NONE}
Xtest open-13.2 {I/O to command pipelines} {
X    list [catch {open "| echo > test3" r} msg] $msg $errorCode
X} {1 {can't read output from command: standard output was redirected} NONE}
Xtest open-13.3 {I/O to command pipelines} {
X    list [catch {open "| echo > test3" r+} msg] $msg $errorCode
X} {1 {can't read output from command: standard output was redirected} NONE}
Xtest open-13.4 {writing to command pipelines} {
X    exec rm test3
X    set f [open "| cat | cat > test3" w]
X    puts $f "Line 1"
X    puts $f "Line 2"
X    close $f
X    exec cat test3
X} {Line 1
XLine 2}
Xtest open-13.5 {reading from command pipelines} {
X    set f [open "| cat test2" r]
X    set x [list [gets $f] [gets $f] [gets $f]]
X    close $f
X    set x
X} {line1 line2 line3}
Xtest open-13.6 {both reading and writing from/to command pipelines} {
X    set f [open "| cat" r+]
X    puts $f "Line1"
X    flush $f
X    set x [gets $f]
X    close $f
X    set x
X} {Line1}
Xtest open-13.7 {errors in command pipelines} {
X    set f [open "|gorp"]
X    list [catch {close $f} msg] $msg [lindex $errorCode 0] [lindex $errorCode 2]
X} {1 {couldn't find "gorp" to execute} CHILDSTATUS 1}
Xtest open-13.8 {errors in command pipelines} {
X    set f [open "|gorp" w]
X    exec sleep 1
X    puts $f output
X    set x [list [catch {flush $f} msg] [concat \
X        [string range $msg 0 [string first {"} $msg]] \
X        [string range $msg [string first : $msg] end]] $errorCode]
X    catch {close $f}
X    string tolower $x
X} {1 {error flushing " : broken pipe} {unix epipe {broken pipe}}}
Xtest open-13.9 {errors in command pipelines} {
X    set f [open "|gorp" w]
X    list [catch {close $f} msg] $msg \
X        [lindex $errorCode 0] [lindex $errorCode 2]
X} {1 {couldn't find "gorp" to execute} CHILDSTATUS 1}
Xtest open-13.10 {errors in command pipelines} {
X    set f [open "|gorp" w]
X    exec sleep 1
X    puts $f output
X    string tolower [list [catch {close $f} msg] [concat \
X        [string range $msg 0 [string first {"} $msg]] \
X        [string range $msg [string first : $msg] end]] \
X        [lindex $errorCode 0] [lindex $errorCode 2]]
X} {1 {error closing " : broken pipe
Xcouldn't find "gorp" to execute} childstatus 1}
X
Xcatch {exec rm -f test1 test2 test3}
Xconcat {}
END_OF_FILE
if test 16158 -ne `wc -c <'tcl6.1/tests/open.test'`; then
    echo shar: \"'tcl6.1/tests/open.test'\" unpacked with wrong size!
fi
# end of 'tcl6.1/tests/open.test'
fi
if test -f 'tcl6.1/tests/set.test' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'tcl6.1/tests/set.test'\"
else
echo shar: Extracting \"'tcl6.1/tests/set.test'\" \(16970 characters\)
sed "s/^X//" >'tcl6.1/tests/set.test' <<'END_OF_FILE'
X# Commands covered:  set, unset, array
X#
X# This file contains a collection of tests for one or more of the Tcl
X# built-in commands.  Sourcing this file into Tcl runs the tests and
X# generates output for errors.  No output means no errors were found.
X#
X# Copyright 1991 Regents of the University of California
X# Permission to use, copy, modify, and distribute this
X# software and its documentation for any purpose and without
X# fee is hereby granted, provided that this copyright notice
X# appears in all copies.  The University of California makes no
X# representations about the suitability of this software for any
X# purpose.  It is provided "as is" without express or implied
X# warranty.
X#
X# $Header: /user6/ouster/tcl/tests/RCS/set.test,v 1.8 91/10/31 16:40:57 ouster Exp $ (Berkeley)
X
Xif {[string compare test [info procs test]] == 1} then {source defs}
X
Xproc ignore args {}
X
X# Simple variable operations.
X
Xcatch {unset a}
Xtest set-1.1 {basic variable setting and unsetting} {
X    set a 22
X} 22
Xtest set-1.2 {basic variable setting and unsetting} {
X    set a 123
X    set a
X} 123
Xtest set-1.3 {basic variable setting and unsetting} {
X    set a xxx
X    format %s $a
X} xxx
Xtest set-1.4 {basic variable setting and unsetting} {
X    set a 44
X    unset a
X    list [catch {set a} msg] $msg
X} {1 {can't read "a": no such variable}}
X
X# Basic array operations.
X
Xcatch {unset a}
Xset a(xyz) 2
Xset a(44) 3
Xset {a(a long name)} test
Xtest set-2.1 {basic array operations} {
X    lsort [array names a]
X} {44 {a long name} xyz}
Xtest set-2.2 {basic array operations} {
X    set a(44)
X} 3
Xtest set-2.3 {basic array operations} {
X    set a(xyz)
X} 2
Xtest set-2.4 {basic array operations} {
X    set "a(a long name)"
X} test
Xtest set-2.5 {basic array operations} {
X    list [catch {set a(other)} msg] $msg
X} {1 {can't read "a(other)": no such element in array}}
Xtest set-2.6 {basic array operations} {
X    list [catch {set a} msg] $msg
X} {1 {can't read "a": no such variable}}
Xtest set-2.7 {basic array operations} {
X    format %s $a(44)
X} 3
Xtest set-2.8 {basic array operations} {
X    format %s $a(a long name)
X} test
Xunset a(44)
Xtest set-2.9 {basic array operations} {
X    lsort [array names a]
X} {{a long name} xyz}
Xunset a
Xtest set-2.10 {basic array operations} {
X    list [catch {set a(xyz)} msg] $msg
X} {1 {can't read "a(xyz)": no such variable}}
X
X# Test the set commands, and exercise the corner cases of the code
X# that parses array references into two parts.
X
Xtest set-3.1 {set command} {
X    list [catch {set} msg] $msg
X} {1 {wrong # args: should be "set varName ?newValue?"}}
Xtest set-3.2 {set command} {
X    list [catch {set x y z} msg] $msg
X} {1 {wrong # args: should be "set varName ?newValue?"}}
Xtest set-3.3 {set command} {
X    catch {unset a}
X    list [catch {set a} msg] $msg
X} {1 {can't read "a": no such variable}}
Xtest set-3.4 {set command} {
X    catch {unset a}
X    set a(14) 83
X    list [catch {set a 22} msg] $msg
X} {1 {can't set "a": variable is array}}
X
X# Test the corner-cases of parsing array names, using set and unset.
X
Xtest set-4.1 {parsing array names} {
X    catch {unset a}
X    set a(()) 44
X    list [catch {array names a} msg] $msg
X} {0 ()}
Xtest set-4.2 {parsing array names} {
X    catch {unset a a(abcd}
X    set a(abcd 33
X    info exists a(abcd
X} 1
Xtest set-4.3 {parsing array names} {
X    catch {unset a a(abcd}
X    set a(abcd 33
X    list [catch {array names a} msg] $msg
X} {1 {"a" isn't an array}}
Xtest set-4.4 {parsing array names} {
X    catch {unset a abcd)}
X    set abcd) 33
X    info exists abcd)
X} 1
Xtest set-4.5 {parsing array names} {
X    set a(bcd yyy
X    catch {unset a}
X    list [catch {set a(bcd} msg] $msg
X} {0 yyy}
Xtest set-4.6 {parsing array names} {
X    catch {unset a}
X    set a 44
X    list [catch {set a(bcd test} msg] $msg
X} {0 test}
X
X# Errors in reading variables
X
Xtest set-5.1 {errors in reading variables} {
X    catch {unset a}
X    list [catch {set a} msg] $msg
X} {1 {can't read "a": no such variable}}
Xtest set-5.2 {errors in reading variables} {
X    catch {unset a}
X    set a 44
X    list [catch {set a(18)} msg] $msg
X} {1 {can't read "a(18)": variable isn't array}}
Xtest set-5.3 {errors in reading variables} {
X    catch {unset a}
X    set a(6) 44
X    list [catch {set a(18)} msg] $msg
X} {1 {can't read "a(18)": no such element in array}}
Xtest set-5.4 {errors in reading variables} {
X    catch {unset a}
X    set a(6) 44
X    list [catch {set a} msg] $msg
X} {1 {can't read "a": no such variable}}
X
X# Errors and other special cases in writing variables
X
Xtest set-6.1 {creating array during write} {
X    catch {unset a}
X    trace var a rwu ignore
X    list [catch {set a(14) 186} msg] $msg [array names a]
X} {0 186 14}
Xtest set-6.2 {errors in writing variables} {
X    catch {unset a}
X    set a xxx
X    list [catch {set a(14) 186} msg] $msg
X} {1 {can't set "a(14)": variable isn't array}}
Xtest set-6.3 {errors in writing variables} {
X    catch {unset a}
X    set a(100) yyy
X    list [catch {set a 2} msg] $msg
X} {1 {can't set "a": variable is array}}
Xtest set-6.4 {expanding variable size} {
X    catch {unset a}
X    list [set a short] [set a "longer name"] [set a "even longer name"] \
X        [set a "a much much truly longer name"]
X} {short {longer name} {even longer name} {a much much truly longer name}}
X
X# Unset command, Tcl_UnsetVar procedures
X
Xtest set-7.1 {unset command} {
X    catch {unset a}; catch {unset b}; catch {unset c}; catch {unset d}
X    set a 44
X    set b 55
X    set c 66
X    set d 77
X    unset a b c
X    list [catch {set a(0) 0}] [catch {set b(0) 0}] [catch {set c(0) 0}] \
X        [catch {set d(0) 0}]
X} {0 0 0 1}
Xtest set-7.2 {unset command} {
X    list [catch {unset} msg] $msg
X} {1 {wrong # args: should be "unset varName ?varName ...?"}}
Xtest set-7.3 {unset command} {
X    catch {unset a}
X    list [catch {unset a} msg] $msg
X} {1 {can't unset "a": no such variable}}
Xtest set-7.4 {unset command} {
X    catch {unset a}
X    set a 44
X    list [catch {unset a(14)} msg] $msg
X} {1 {can't unset "a(14)": variable isn't array}}
Xtest set-7.5 {unset command} {
X    catch {unset a}
X    set a(0) xx
X    list [catch {unset a(14)} msg] $msg
X} {1 {can't unset "a(14)": no such element in array}}
Xtest set-7.6 {unset command} {
X    catch {unset a}; catch {unset b}; catch {unset c}
X    set a foo
X    set c gorp
X    list [catch {unset a a a(14)} msg] $msg [info exists c]
X} {1 {can't unset "a": no such variable} 1}
Xtest set-7.7 {unsetting globals from within procedures} {
X    set y 0
X    proc p1 {} {
X    global y
X    set z [p2]
X    return [list $z [catch {set y} msg] $msg]
X    }
X    proc p2 {} {global y; unset y; list [catch {set y} msg] $msg}
X    p1
X} {{1 {can't read "y": no such variable}} 1 {can't read "y": no such variable}}
Xtest set-7.8 {unsetting globals from within procedures} {
X    set y 0
X    proc p1 {} {
X    global y
X    p2
X    return [list [catch {set y 44} msg] $msg]
X    }
X    proc p2 {} {global y; unset y}
X    concat [p1] [list [catch {set y} msg] $msg]
X} {0 44 0 44}
Xtest set-7.9 {unsetting globals from within procedures} {
X    set y 0
X    proc p1 {} {
X    global y
X    unset y
X    return [list [catch {set y 55} msg] $msg]
X    }
X    concat [p1] [list [catch {set y} msg] $msg]
X} {0 55 0 55}
Xtest set-7.10 {unset command} {
X    catch {unset a}
X    set a(14) 22
X    unset a(14)
X    list [catch {set a(14)} msg] $msg [catch {array names a} msg2] $msg2
X} {1 {can't read "a(14)": no such element in array} 0 {}}
Xtest set-7.11 {unset command} {
X    catch {unset a}
X    set a(14) 22
X    unset a
X    list [catch {set a(14)} msg] $msg [catch {array names a} msg2] $msg2
X} {1 {can't read "a(14)": no such variable} 1 {"a" isn't an array}}
X
X# Array command.
X
Xtest set-8.1 {array command} {
X    list [catch {array} msg] $msg
X} {1 {wrong # args: should be "array option arrayName ?arg ...?"}}
Xtest set-8.2 {array command} {
X    catch {unset a}
X    list [catch {array names a} msg] $msg
X} {1 {"a" isn't an array}}
Xtest set-8.3 {array command} {
X    catch {unset a}
X    set a 44
X    list [catch {array names a} msg] $msg
X} {1 {"a" isn't an array}}
Xtest set-8.4 {array command} {
X    catch {unset a}
X    set a(22) 3
X    list [catch {array gorp a} msg] $msg
X} {1 {bad option "gorp": should be anymore, donesearch, names, nextelement, size, or startsearch}}
Xtest set-8.5 {array command, names option} {
X    catch {unset a}
X    set a(22) 3
X    list [catch {array names a 4} msg] $msg
X} {1 {wrong # args: should be "array names arrayName"}}
Xtest set-8.6 {array command, names option} {
X    catch {unset a}
X    set a(22) 3; set a(Textual_name) 44; set "a(name with spaces)" xxx
X    list [catch {lsort [array names a]} msg] $msg
X} {0 {22 Textual_name {name with spaces}}}
Xtest set-8.7 {array command, names option} {
X    catch {unset a}
X    set a(22) 3; set a(33) 44;
X    trace var a(xxx) w ignore
X    list [catch {lsort [array names a]} msg] $msg
X} {0 {22 33}}
Xtest set-8.8 {array command, names option} {
X    catch {unset a}
X    set a(22) 3; set a(33) 44;
X    trace var a(xxx) w ignore
X    set a(xxx) value
X    list [catch {lsort [array names a]} msg] $msg
X} {0 {22 33 xxx}}
Xtest set-8.9 {array command, size option} {
X    catch {unset a}
X    set a(22) 3
X    list [catch {array size a 4} msg] $msg
X} {1 {wrong # args: should be "array size arrayName"}}
Xtest set-8.10 {array command, size option} {
X    catch {unset a}
X    set a(22) 3; set a(Textual_name) 44; set "a(name with spaces)" xxx
X    list [catch {array size a} msg] $msg
X} {0 3}
Xtest set-8.10 {array command, size option} {
X    catch {unset a}
X    set a(22) 3; set a(xx) 44; set a(y) xxx
X    unset a(22) a(y) a(xx)
X    list [catch {array size a} msg] $msg
X} {0 0}
Xtest set-8.11 {array command, size option} {
X    catch {unset a}
X    set a(22) 3;
X    trace var a(33) rwu ignore
X    list [catch {array size a} msg] $msg
X} {0 1}
X
Xtest set-9.1 {ids for array enumeration} {
X    catch {unset a}
X    set a(a) 1
X    list [array st a] [array st a] [array done a s-1-a; array st a] \
X        [array done a s-2-a; array d a s-3-a; array start a]
X} {s-1-a s-2-a s-3-a s-1-a}
Xtest set-9.2 {array enumeration} {
X    catch {unset a}
X    set a(a) 1
X    set a(b) 1
X    set a(c) 1
X    set x [array startsearch a]
X    list [array nextelement a $x] [array ne a $x] [array next a $x] \
X        [array next a $x] [array next a $x]
X} {a b c {} {}}
Xtest set-9.3 {array enumeration} {
X    catch {unset a}
X    set a(a) 1
X    set a(b) 1
X    set a(c) 1
X    set x [array startsearch a]
X    set y [array startsearch a]
X    set z [array startsearch a]
X    list [array nextelement a $x] [array ne a $x] \
X        [array next a $y] [array next a $z] [array next a $y] \
X        [array next a $z] [array next a $y] [array next a $z] \
X        [array next a $y] [array next a $z] [array next a $x] \
X        [array next a $x]
X} {a b a a b b c c {} {} c {}}
Xtest set-9.4 {array enumeration: stopping searches} {
X    catch {unset a}
X    set a(a) 1
X    set a(b) 1
X    set a(c) 1
X    set x [array startsearch a]
X    set y [array startsearch a]
X    set z [array startsearch a]
X    list [array next a $x] [array next a $x] [array next a $y] \
X        [array done a $z; array next a $x] \
X        [array done a $x; array next a $y] [array next a $y]
X} {a b a c b c}
Xtest set-9.5 {array enumeration: stopping searches} {
X    catch {unset a}
X    set a(a) 1
X    set x [array startsearch a]
X    array done a $x
X    list [catch {array next a $x} msg] $msg
X} {1 {couldn't find search "s-1-a"}}
Xtest set-9.6 {array enumeration: searches automatically stopped} {
X    catch {unset a}
X    set a(a) 1
X    set x [array startsearch a]
X    set y [array startsearch a]
X    set a(b) 1
X    list [catch {array next a $x} msg] $msg \
X        [catch {array next a $y} msg2] $msg2
X} {1 {couldn't find search "s-1-a"} 1 {couldn't find search "s-2-a"}}
Xtest set-9.7 {array enumeration: searches automatically stopped} {
X    catch {unset a}
X    set a(a) 1
X    set x [array startsearch a]
X    set y [array startsearch a]
X    set a(a) 2
X    list [catch {array next a $x} msg] $msg \
X        [catch {array next a $y} msg2] $msg2
X} {0 a 0 a}
Xtest set-9.8 {array enumeration: searches automatically stopped} {
X    catch {unset a}
X    set a(a) 1
X    set x [array startsearch a]
X    set y [array startsearch a]
X    catch {unset a(c)}
X    list [catch {array next a $x} msg] $msg \
X        [catch {array next a $y} msg2] $msg2
X} {1 {couldn't find search "s-1-a"} 1 {couldn't find search "s-2-a"}}
Xtest set-9.9 {array enumeration: searches automatically stopped} {
X    catch {unset a}
X    set a(a) 1
X    set x [array startsearch a]
X    set y [array startsearch a]
X    trace var a(b) r {}
X    list [catch {array next a $x} msg] $msg \
X        [catch {array next a $y} msg2] $msg2
X} {1 {couldn't find search "s-1-a"} 1 {couldn't find search "s-2-a"}}
Xtest set-9.10 {array enumeration: searches automatically stopped} {
X    catch {unset a}
X    set a(a) 1
X    set x [array startsearch a]
X    set y [array startsearch a]
X    trace var a(a) r {}
X    list [catch {array next a $x} msg] $msg \
X        [catch {array next a $y} msg2] $msg2
X} {0 a 0 a}
Xtest set-9.11 {array enumeration with traced undefined elements} {
X    catch {unset a}
X    set a(a) 1
X    trace var a(b) r {}
X    set x [array startsearch a]
X    list [array next a $x] [array next a $x]
X} {a {}}
X
Xtest set-10.1 {array enumeration errors} {
X    list [catch {array start} msg] $msg
X} {1 {wrong # args: should be "array option arrayName ?arg ...?"}}
Xtest set-10.2 {array enumeration errors} {
X    list [catch {array start a b} msg] $msg
X} {1 {wrong # args: should be "array startsearch arrayName"}}
Xtest set-10.3 {array enumeration errors} {
X    catch {unset a}
X    list [catch {array start a} msg] $msg
X} {1 {"a" isn't an array}}
Xtest set-10.4 {array enumeration errors} {
X    catch {unset a}
X    set a(a) 1
X    set x [array startsearch a]
X    list [catch {array next a} msg] $msg
X} {1 {wrong # args: should be "array nextelement arrayName searchId"}}
Xtest set-10.5 {array enumeration errors} {
X    catch {unset a}
X    set a(a) 1
X    set x [array startsearch a]
X    list [catch {array next a b c} msg] $msg
X} {1 {wrong # args: should be "array nextelement arrayName searchId"}}
Xtest set-10.6 {array enumeration errors} {
X    catch {unset a}
X    set a(a) 1
X    set x [array startsearch a]
X    list [catch {array next a a-1-a} msg] $msg
X} {1 {illegal search identifier "a-1-a"}}
Xtest set-10.7 {array enumeration errors} {
X    catch {unset a}
X    set a(a) 1
X    set x [array startsearch a]
X    list [catch {array next a sx1-a} msg] $msg
X} {1 {illegal search identifier "sx1-a"}}
Xtest set-10.8 {array enumeration errors} {
X    catch {unset a}
X    set a(a) 1
X    set x [array startsearch a]
X    list [catch {array next a s--a} msg] $msg
X} {1 {illegal search identifier "s--a"}}
Xtest set-10.9 {array enumeration errors} {
X    catch {unset a}
X    set a(a) 1
X    set x [array startsearch a]
X    list [catch {array next a s-1-b} msg] $msg
X} {1 {search identifier "s-1-b" isn't for variable "a"}}
Xtest set-10.10 {array enumeration errors} {
X    catch {unset a}
X    set a(a) 1
X    set x [array startsearch a]
X    list [catch {array next a s-1ba} msg] $msg
X} {1 {illegal search identifier "s-1ba"}}
Xtest set-10.11 {array enumeration errors} {
X    catch {unset a}
X    set a(a) 1
X    set x [array startsearch a]
X    list [catch {array next a s-2-a} msg] $msg
X} {1 {couldn't find search "s-2-a"}}
Xtest set-10.12 {array enumeration errors} {
X    list [catch {array done a} msg] $msg
X} {1 {wrong # args: should be "array donesearch arrayName searchId"}}
Xtest set-10.13 {array enumeration errors} {
X    list [catch {array done a b c} msg] $msg
X} {1 {wrong # args: should be "array donesearch arrayName searchId"}}
Xtest set-10.14 {array enumeration errors} {
X    list [catch {array done a b} msg] $msg
X} {1 {illegal search identifier "b"}}
Xtest set-10.15 {array enumeration errors} {
X    list [catch {array anymore a} msg] $msg
X} {1 {wrong # args: should be "array anymore arrayName searchId"}}
Xtest set-10.16 {array enumeration errors} {
X    list [catch {array any a b c} msg] $msg
X} {1 {wrong # args: should be "array anymore arrayName searchId"}}
Xtest set-10.17 {array enumeration errors} {
X    catch {unset a}
X    set a(0) 44
X    list [catch {array any a bogus} msg] $msg
X} {1 {illegal search identifier "bogus"}}
X
X# Array enumeration with "anymore" option
X
Xtest set-11.1 {array anymore option} {
X    catch {unset a}
X    set a(a) 1
X    set a(b) 2
X    set a(c) 3
X    array startsearch a
X    list [array anymore a s-1-a] [array next a s-1-a] \
X        [array anymore a s-1-a] [array next a s-1-a] \
X        [array anymore a s-1-a] [array next a s-1-a] \
X        [array anymore a s-1-a] [array next a s-1-a]
X} {1 a 1 b 1 c 0 {}}
Xtest set-11.2 {array anymore option} {
X    catch {unset a}
X    set a(a) 1
X    set a(b) 2
X    set a(c) 3
X    array startsearch a
X    list [array next a s-1-a] [array next a s-1-a] \
X        [array anymore a s-1-a] [array next a s-1-a] \
X        [array next a s-1-a] [array anymore a s-1-a]
X} {a b 1 c {} 0}
X
X# Must delete variables when done, since these arrays get used as
X# scalars by other tests.
X
Xcatch {unset a}
Xcatch {unset b}
Xcatch {unset c}
Xreturn ""
END_OF_FILE
if test 16970 -ne `wc -c <'tcl6.1/tests/set.test'`; then
    echo shar: \"'tcl6.1/tests/set.test'\" unpacked with wrong size!
fi
# end of 'tcl6.1/tests/set.test'
fi
echo shar: End of archive 13 \(of 33\).
cp /dev/null ark13isdone
MISSING=""
for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 ; do
    if test ! -f ark${I}isdone ; then
    MISSING="${MISSING} ${I}"
    fi
done
if test "${MISSING}" = "" ; then
    echo You have unpacked all 33 archives.
    rm -f ark[1-9]isdone ark[1-9][0-9]isdone
else
    echo You still need to unpack the following archives:
    echo "        " ${MISSING}
fi
##  End of shell archive.
exit 0

exit 0 # Just in case...
--
Kent Landfield                   INTERNET: [e-mail]
Sterling Software, IMD           UUCP:     uunet!sparky!kent
Phone:    [phone]         FAX:      [phone]
Please send comp.sources.misc-related mail to [e-mail].