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

Text File | 1991-11-14 | 52.8 KB | 1,607 lines

Newsgroups: comp.sources.misc
From: [e-mail] (Karl Lehenbauer)
Subject:  v25i070:  tcl - tool command language, version 6.1, Part02/33
Message-ID: <[e-mail]>
X-Md4-Signature: 743852cd0db93e77b02a0e4d85767fc5
Date: Thu, 14 Nov 1991 20:25:36 GMT
Approved: [e-mail]

Submitted-by: [e-mail] (Karl Lehenbauer)
Posting-number: Volume 25, Issue 70
Archive-name: tcl/part02
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 2 (of 33)."
# Contents:  tcl6.1/compat/strtol.c tcl6.1/tclTest.c
#   tcl6.1/tests/append.test tcl6.1/tests/case.test
#   tcl6.1/tests/cd.test tcl6.1/tests/env.test tcl6.1/tests/incr.test
#   tcl6.1/tests/lindex.test tcl6.1/tests/linsert.test
#   tcl6.1/tests/list.test tcl6.1/tests/lrange.test
#   tcl6.1/tests/lreplace.test tcl6.1/tests/rename.test
#   tcl6.1/tests/source.test tcl6.1/tests/uplevel.test
#   tcl6.1/tests/while.test
# Wrapped by karl@one on Tue Nov 12 19:44:11 1991
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'tcl6.1/compat/strtol.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'tcl6.1/compat/strtol.c'\"
else
echo shar: Extracting \"'tcl6.1/compat/strtol.c'\" \(2267 characters\)
sed "s/^X//" >'tcl6.1/compat/strtol.c' <<'END_OF_FILE'
X/*
X * strtol.c --
X *
X *    Source code for the "strtol" library procedure.
X *
X * Copyright 1988 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 the above copyright
X * notice appear in all copies.  The University of California
X * makes no representations about the suitability of this
X * software for any purpose.  It is provided "as is" without
X * express or implied warranty.
X */
X
X#ifndef lint
Xstatic char rcsid[] = "$Header: /sprite/src/lib/tcl/compat/RCS/strtol.c,v 1.1 91/09/22 15:42:49 ouster Exp $ SPRITE (Berkeley)";
X#endif /* not lint */
X
X#include <ctype.h>
X
X
X/*
X *----------------------------------------------------------------------
X *
X * strtol --
X *
X *    Convert an ASCII string into an integer.
X *
X * Results:
X *    The return value is the integer equivalent of string.  If endPtr
X *    is non-NULL, then *endPtr is filled in with the character
X *    after the last one that was part of the integer.  If string
X *    doesn't contain a valid integer value, then zero is returned
X *    and *endPtr is set to string.
X *
X * Side effects:
X *    None.
X *
X *----------------------------------------------------------------------
X */
X
Xlong int
Xstrtol(string, endPtr, base)
X    char *string;        /* String of ASCII digits, possibly
X                 * preceded by white space.  For bases
X                 * greater than 10, either lower- or
X                 * upper-case digits may be used.
X                 */
X    char **endPtr;        /* Where to store address of terminating
X                 * character, or NULL. */
X    int base;            /* Base for conversion.  Must be less
X                 * than 37.  If 0, then the base is chosen
X                 * from the leading characters of string:
X                 * "0x" means hex, "0" means octal, anything
X                 * else means decimal.
X                 */
X{
X    register char *p;
X    int result;
X
X    /*
X     * Skip any leading blanks.
X     */
X
X    p = string;
X    while (isspace(*p)) {
X    p += 1;
X    }
X
X    /*
X     * Check for a sign.
X     */
X
X    if (*p == '-') {
X    p += 1;
X    result = -(strtoul(p, endPtr, base));
X    } else {
X    if (*p == '+') {
X        p += 1;
X    }
X    result = strtoul(p, endPtr, base);
X    }
X    if ((result == 0) && (endPtr != 0) && (*endPtr == p)) {
X    *endPtr = string;
X    }
X    return result;
X}
END_OF_FILE
if test 2267 -ne `wc -c <'tcl6.1/compat/strtol.c'`; then
    echo shar: \"'tcl6.1/compat/strtol.c'\" unpacked with wrong size!
fi
# end of 'tcl6.1/compat/strtol.c'
fi
if test -f 'tcl6.1/tclTest.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'tcl6.1/tclTest.c'\"
else
echo shar: Extracting \"'tcl6.1/tclTest.c'\" \(3427 characters\)
sed "s/^X//" >'tcl6.1/tclTest.c' <<'END_OF_FILE'
X/*
X * tclTest.c --
X *
X *    Test driver for TCL.
X *
X * Copyright 1987-1991 Regents of the University of California
X * All rights reserved.
X *
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 the above copyright
X * notice appears in all copies.  The University of California
X * makes no representations about the suitability of this
X * software for any purpose.  It is provided "as is" without
X * express or implied warranty.
X */
X
X#ifndef lint
Xstatic char rcsid[] = "$Header: /user6/ouster/tcl/tclTest/RCS/tclTest.c,v 1.18 91/10/27 16:46:07 ouster Exp $ SPRITE (Berkeley)";
X#endif
X
X#include <stdio.h>
X#include <errno.h>
X#include <string.h>
X#include "tcl.h"
X
Xextern int exit();
Xextern int Tcl_DumpActiveMemory();
X
XTcl_Interp *interp;
XTcl_CmdBuf buffer;
Xchar dumpFile[100];
Xint quitFlag = 0;
X
Xchar *initCmd =
X    "if [file exists [info library]/init.tcl] {source [info library]/init.tcl}";
X
X    /* ARGSUSED */
Xint
XcmdCheckmem(clientData, interp, argc, argv)
X    ClientData *clientData;
X    Tcl_Interp *interp;
X    int argc;
X    char *argv[];
X{
X    if (argc != 2) {
X    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
X        " fileName\"", (char *) NULL);
X    return TCL_ERROR;
X    }
X    strcpy(dumpFile, argv[1]);
X    quitFlag = 1;
X    return TCL_OK;
X}
X
X    /* ARGSUSED */
Xint
XcmdEcho(clientData, interp, argc, argv)
X    ClientData *clientData;
X    Tcl_Interp *interp;
X    int argc;
X    char *argv[];
X{
X    int i;
X
X    for (i = 1; ; i++) {
X    if (argv[i] == NULL) {
X        if (i != argc) {
X        echoError:
X        sprintf(interp->result,
X            "argument list wasn't properly NULL-terminated in \"%s\" command",
X            argv[0]);
X        }
X        break;
X    }
X    if (i >= argc) {
X        goto echoError;
X    }
X    fputs(argv[i], stdout);
X    if (i < (argc-1)) {
X        printf(" ");
X    }
X    }
X    printf("\n");
X    return TCL_OK;
X}
X
Xvoid
XdeleteProc(clientData)
X    char *clientData;
X{
X    printf("Deleting command with clientData \"%s\".\n", clientData);
X}
X
Xint
Xmain()
X{
X    char line[1000], *cmd;
X    int result, gotPartial;
X
X    interp = Tcl_CreateInterp();
X#ifdef TCL_MEM_DEBUG
X    Tcl_InitMemory(interp);
X#endif
X    Tcl_CreateCommand(interp, "echo", cmdEcho, (ClientData) "echo",
X        (Tcl_CmdDeleteProc *) NULL);
X    Tcl_CreateCommand(interp, "checkmem", cmdCheckmem, (ClientData) 0,
X        (Tcl_CmdDeleteProc *) NULL);
X    buffer = Tcl_CreateCmdBuf();
X    result = Tcl_Eval(interp, initCmd, 0, (char **) NULL);
X    if (result != TCL_OK) {
X    printf("%s\n", interp->result);
X    exit(1);
X    }
X
X    gotPartial = 0;
X    while (1) {
X    clearerr(stdin);
X    if (!gotPartial) {
X        fputs("% ", stdout);
X        fflush(stdout);
X    }
X    if (fgets(line, 1000, stdin) == NULL) {
X        if (!gotPartial) {
X        exit(0);
X        }
X        line[0] = 0;
X    }
X    cmd = Tcl_AssembleCmd(buffer, line);
X    if (cmd == NULL) {
X        gotPartial = 1;
X        continue;
X    }
X
X    gotPartial = 0;
X    result = Tcl_RecordAndEval(interp, cmd, 0);
X    if (result == TCL_OK) {
X        if (*interp->result != 0) {
X        printf("%s\n", interp->result);
X        }
X        if (quitFlag) {
X        Tcl_DeleteInterp(interp);
X        Tcl_DeleteCmdBuf(buffer);
X#ifdef TCL_MEM_DEBUG
X        Tcl_DumpActiveMemory(dumpFile);
X#endif
X        exit(0);
X        }
X    } else {
X        if (result == TCL_ERROR) {
X        printf("Error");
X        } else {
X        printf("Error %d", result);
X        }
X        if (*interp->result != 0) {
X        printf(": %s\n", interp->result);
X        } else {
X        printf("\n");
X        }
X    }
X    }
X}
END_OF_FILE
if test 3427 -ne `wc -c <'tcl6.1/tclTest.c'`; then
    echo shar: \"'tcl6.1/tclTest.c'\" unpacked with wrong size!
fi
# end of 'tcl6.1/tclTest.c'
fi
if test -f 'tcl6.1/tests/append.test' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'tcl6.1/tests/append.test'\"
else
echo shar: Extracting \"'tcl6.1/tests/append.test'\" \(3126 characters\)
sed "s/^X//" >'tcl6.1/tests/append.test' <<'END_OF_FILE'
X# Commands covered:  append lappend
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/append.test,v 1.3 91/09/08 13:43:32 ouster Exp $ (Berkeley)
X
Xif {[string compare test [info procs test]] == 1} then {source defs}
X
Xcatch {unset x}
Xtest append-1.1 {append command} {
X    catch {unset x}
X    list [append x 1 2 abc "long string"] $x
X} {{12abclong string} {12abclong string}}
Xtest append-1.2 {append command} {
X    set x ""
X    list [append x first] [append x second] [append x third] $x
X} {first firstsecond firstsecondthird firstsecondthird}
X
Xtest append-2.1 {long appends} {
X    set x ""
X    for {set i 0} {$i < 1000} {set i [expr $i+1]} {
X    append x "foobar "
X    }
X    set y "foobar"
X    set y "$y $y $y $y $y $y $y $y $y $y"
X    set y "$y $y $y $y $y $y $y $y $y $y"
X    set y "$y $y $y $y $y $y $y $y $y $y "
X    expr {$x == $y}
X} 1
X
Xtest append-3.1 {append errors} {
X    list [catch {append} msg] $msg
X} {1 {wrong # args: should be "append varName value ?value ...?"}}
Xtest append-3.2 {append errors} {
X    list [catch {append x} msg] $msg
X} {1 {wrong # args: should be "append varName value ?value ...?"}}
Xtest append-3.3 {append errors} {
X    set x ""
X    list [catch {append x(0) 44} msg] $msg
X} {1 {can't set "x(0)": variable isn't array}}
X
Xtest append-4.1 {lappend command} {
X    catch {unset x}
X    list [lappend x 1 2 abc "long string"] $x
X} {{1 2 abc {long string}} {1 2 abc {long string}}}
Xtest append-4.2 {lappend command} {
X    set x ""
X    list [lappend x first] [lappend x second] [lappend x third] $x
X} {first {first second} {first second third} {first second third}}
X
Xproc check {var size} {
X    set l [llength $var]
X    if {$l != $size} {
X    return "length mismatch: should have been $size, was $l"
X    }
X    for {set i 0} {$i < $size} {set i [expr $i+1]} {
X    set j [lindex $var $i]
X    if {$j != "item $i"} {
X        return "element $i should have been \"item $i\", was \"$j\"
X    }
X    }
X    return ok
X}
Xtest append-5.1 {long lappends} {
X    set x ""
X    for {set i 0} {$i < 300} {set i [expr $i+1]} {
X    lappend x "item $i"
X    }
X    check $x 300
X} ok
X
Xtest append-6.1 {lappend errors} {
X    list [catch {lappend} msg] $msg
X} {1 {wrong # args: should be "lappend varName value ?value ...?"}}
Xtest append-6.2 {lappend errors} {
X    list [catch {lappend x} msg] $msg
X} {1 {wrong # args: should be "lappend varName value ?value ...?"}}
Xtest append-6.3 {lappend errors} {
X    set x ""
X    list [catch {lappend x(0) 44} msg] $msg
X} {1 {can't set "x(0)": variable isn't array}}
END_OF_FILE
if test 3126 -ne `wc -c <'tcl6.1/tests/append.test'`; then
    echo shar: \"'tcl6.1/tests/append.test'\" unpacked with wrong size!
fi
# end of 'tcl6.1/tests/append.test'
fi
if test -f 'tcl6.1/tests/case.test' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'tcl6.1/tests/case.test'\"
else
echo shar: Extracting \"'tcl6.1/tests/case.test'\" \(2756 characters\)
sed "s/^X//" >'tcl6.1/tests/case.test' <<'END_OF_FILE'
X# Commands covered:  case
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/case.test,v 1.5 91/11/07 09:01:50 ouster Exp $ (Berkeley)
X
Xif {[string compare test [info procs test]] == 1} then {source defs}
X
Xtest case-1.1 {simple pattern} {
X    case a in a {format 1} b {format 2} c {format 3} default {format 4}
X} 1
Xtest case-1.2 {simple pattern} {
X    case b a {format 1} b {format 2} c {format 3} default {format 4}
X} 2
Xtest case-1.3 {simple pattern} {
X    case x in a {format 1} b {format 2} c {format 3} default {format 4}
X} 4
Xtest case-1.4 {simple pattern} {
X    case x a {format 1} b {format 2} c {format 3}
X} {}
Xtest case-1.5 {simple pattern matches many times} {
X    case b a {format 1} b {format 2} b {format 3} b {format 4}
X} 2
Xtest case-1.6 {fancier pattern} {
X    case cx a {format 1} *c {format 2} *x {format 3} default {format 4}
X} 3
Xtest case-1.7 {list of patterns} {
X    case abc in {a b c} {format 1} {def abc ghi} {format 2}
X} 2
X
Xtest case-2.1 {error in executed command} {
X    list [catch {case a in a {error "Just a test"} default {format 1}} msg] \
X        $msg $errorInfo
X} {1 {Just a test} {Just a test
X    while executing
X"error "Just a test""
X    ("a" arm line 1)
X    invoked from within
X"case a in a {error "Just a test"} default {format 1}"}}
Xtest case-2.2 {error: not enough args} {
X    list [catch {case} msg] $msg
X} {1 {wrong # args: should be "case string ?in? patList body ... ?default body?"}}
Xtest case-2.3 {error: pattern with no body} {
X    list [catch {case a b} msg] $msg
X} {1 {extra case pattern with no body}}
Xtest case-2.4 {error: pattern with no body} {
X    list [catch {case a in b {format 1} c} msg] $msg
X} {1 {extra case pattern with no body}}
X
Xtest case-3.1 {single-argument form for pattern/command pairs} {
X    case b in {
X    a {format 1}
X    b {format 2}
X    default {format 6}
X    }
X} {2}
Xtest case-3.2 {single-argument form for pattern/command pairs} {
X    case b {
X    a {format 1}
X    b {format 2}
X    default {format 6}
X    }
X} {2}
Xtest case-3.3 {single-argument form for pattern/command pairs} {
X    list [catch {case z in {a 2 b}} msg] $msg
X} {1 {extra case pattern with no body}}
END_OF_FILE
if test 2756 -ne `wc -c <'tcl6.1/tests/case.test'`; then
    echo shar: \"'tcl6.1/tests/case.test'\" unpacked with wrong size!
fi
# end of 'tcl6.1/tests/case.test'
fi
if test -f 'tcl6.1/tests/cd.test' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'tcl6.1/tests/cd.test'\"
else
echo shar: Extracting \"'tcl6.1/tests/cd.test'\" \(2888 characters\)
sed "s/^X//" >'tcl6.1/tests/cd.test' <<'END_OF_FILE'
X# Commands covered:  cd, pwd
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/cd.test,v 1.15 91/10/17 16:22:35 ouster Exp $ (Berkeley)
X
Xif {[string compare test [info procs test]] == 1} then {source defs}
X
Xcatch {exec rm -rf cd.dir}
Xexec mkdir cd.dir
Xexec cat << "Sample text" > cd.dir/test.file
Xset cwd [exec pwd]
X
Xtest cd-1.1 {simple pwd check} {
X    pwd
X} $cwd
X
Xcd cd.dir
Xtest cd-2.1 {changing directories} {
X    list [exec pwd]
X} $cwd/cd.dir
Xtest cd-2.2 {changing directories} {
X    pwd
X} $cwd/cd.dir
Xtest cd-2.3 {changing directories} {
X    exec cat test.file
X} "Sample text"
Xcd ..
Xtest cd-2.4 {changing directories} {
X    exec pwd
X} $cwd
Xtest cd-2.5 {changing directories} {
X    pwd
X} $cwd
Xtest cd-2.6 {changing directories} {
X    exec cat cd.dir/test.file
X} "Sample text"
Xset home [exec sh -c "cd; pwd"]
Xtest cd-2.7 {changing directories} {
X    cd ~
X    set x [list [exec pwd] [pwd]]
X    cd $cwd
X    set x
X} "$home $home"
Xtest cd-2.8 {changing directories} {
X    cd
X    set x [list [exec pwd] [pwd]]
X    cd $cwd
X    set x
X} "$home $home"
X
Xtest cd-3.1 {cd return value} {
X    cd .
X} {}
X
Xtest cd-4.1 {errors in cd command} {
X    list [catch {cd 1 2} msg] $msg $errorCode
X} {1 {wrong # args: should be "cd dirName"} NONE}
Xtest cd-4.2 {errors in cd command} {
X    string tolower [list [catch {cd _non_existent_dir} msg] $msg $errorCode]
X} {1 {couldn't change working directory to "_non_existent_dir": no such file or directory} \
X{unix enoent {no such file or directory}}}
Xtest cd-4.3 {errors in cd command} {
X    string tolower [list [catch {cd cd.dir/test.file} msg] $msg $errorCode]
X} {1 {couldn't change working directory to "cd.dir/test.file": not a directory} {unix enotdir {not a directory}}}
Xtest cd-4.4 {errors in cd command} {
X    set home $env(HOME)
X    unset env(HOME)
X    set x [list [catch cd msg] $msg]
X    set env(HOME) $home
X    set x
X} {1 {couldn't find HOME environment variable to expand "~"}}
X
Xtest cd-5.1 {errors in pwd command} {
X    list [catch {pwd a} msg] $msg
X} {1 {wrong # args: should be "pwd"}}
Xexec mkdir cd.dir/child
Xcd cd.dir/child
Xexec chmod 111 ..
Xif {$user != "root"} {
X    test cd-5.2 {errors in pwd command} {
X    catch pwd msg
X    } 1
X}
Xcd $cwd
Xexec chmod 775 cd.dir
X
Xcatch {exec rm -rf cd.dir}
Xformat ""
END_OF_FILE
if test 2888 -ne `wc -c <'tcl6.1/tests/cd.test'`; then
    echo shar: \"'tcl6.1/tests/cd.test'\" unpacked with wrong size!
fi
# end of 'tcl6.1/tests/cd.test'
fi
if test -f 'tcl6.1/tests/env.test' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'tcl6.1/tests/env.test'\"
else
echo shar: Extracting \"'tcl6.1/tests/env.test'\" \(2832 characters\)
sed "s/^X//" >'tcl6.1/tests/env.test' <<'END_OF_FILE'
X# Commands covered:  none (tests environment variable implementation)
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/env.test,v 1.4 91/09/16 14:39:47 ouster Exp $ (Berkeley)
X
Xif {[string compare test [info procs test]] == 1} then {source defs}
X
X# If there is no "printenv" program on this system, then it's just too
X# much trouble to run this test (can't necessarily run csh to get the
X# envionrment:  on some systems it barfs if there isn't a minimum set
X# predefined environment variables.  Also, printenv returns a non-zero
X# status on some systems, so read the environment using a procedure
X# that catches errors.
X
Xset printenv {}
Xif [info exists env(PATH)] {
X    set dirs [split $env(PATH) :]
X} else {
X    set dirs {/bin /usr/bin /usr/ucb /usr/local /usr/public /usr/etc}
X}
Xforeach i $dirs {
X    if [file executable $i/printenv] {
X    set printenv $i/printenv
X    break
X    }
X}
Xif {$printenv == ""} {
X    puts stdout "Skipping env tests:  need \"printenv\" to read environment."
X    return ""
X}
Xproc getenv {} {
X    global printenv
X    catch {exec $printenv} out
X    return $out
X}
X
X# Save the current environment variables at the start of the test.
X
Xforeach name [array names env] {
X    set env2($name) $env($name)
X    unset env($name)
X}
X
Xtest env-1.1 {adding environment variables} {
X    getenv
X} {}
X
Xset env(NAME1) "test string"
Xtest env-1.2 {adding environment variables} {
X    getenv
X} {NAME1=test string}
X
Xset env(NAME2) "more"
Xtest env-1.3 {adding environment variables} {
X    getenv
X} {NAME1=test string
XNAME2=more}
X
Xset env(XYZZY) "garbage"
Xtest env-1.4 {adding environment variables} {
X    getenv
X} {NAME1=test string
XNAME2=more
XXYZZY=garbage}
X
Xset env(NAME2) "new value"
Xtest env-2.1 {changing environment variables} {
X    getenv
X} {NAME1=test string
XNAME2=new value
XXYZZY=garbage}
X
Xunset env(NAME2)
Xtest env-3.1 {unsetting environment variables} {
X    getenv
X} {NAME1=test string
XXYZZY=garbage}
Xunset env(NAME1)
Xtest env-3.2 {unsetting environment variables} {
X    getenv
X} {XYZZY=garbage}
X
X# Restore the environment variables at the end of the test.
X
Xforeach name [array names env] {
X    unset env($name)
X}
Xforeach name [array names env2] {
X    set env($name) $env2($name)
X}
END_OF_FILE
if test 2832 -ne `wc -c <'tcl6.1/tests/env.test'`; then
    echo shar: \"'tcl6.1/tests/env.test'\" unpacked with wrong size!
fi
# end of 'tcl6.1/tests/env.test'
fi
if test -f 'tcl6.1/tests/incr.test' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'tcl6.1/tests/incr.test'\"
else
echo shar: Extracting \"'tcl6.1/tests/incr.test'\" \(2296 characters\)
sed "s/^X//" >'tcl6.1/tests/incr.test' <<'END_OF_FILE'
X# Commands covered:  lreplace
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/incr.test,v 1.2 91/08/28 16:27:35 ouster Exp $ (Berkeley)
X
Xif {[string compare test [info procs test]] == 1} then {source defs}
X
Xcatch {unset x}
X
Xtest incr-1.1 {basic incr operation} {
X    set x 23
X    list [incr x] $x
X} {24 24}
Xtest incr-1.2 {basic incr operation} {
X    set x 106
X    list [incr x -5] $x
X} {101 101}
X
Xtest incr-2.1 {incr errors} {
X    list [catch incr msg] $msg
X} {1 {wrong # args: should be "incr varName ?increment?"}}
Xtest incr-2.2 {incr errors} {
X    list [catch {incr a b c} msg] $msg
X} {1 {wrong # args: should be "incr varName ?increment?"}}
Xtest incr-2.3 {incr errors} {
X    catch {unset x}
X    list [catch {incr x} msg] $msg $errorInfo
X} {1 {can't read "x": no such variable} {can't read "x": no such variable
X    while executing
X"incr x"}}
Xtest incr-2.4 {incr errors} {
X    set x abc
X    list [catch {incr x} msg] $msg $errorInfo
X} {1 {expected integer but got "abc"} {expected integer but got "abc"
X    (reading value of variable to increment)
X    invoked from within
X"incr x"}}
Xtest incr-2.5 {incr errors} {
X    set x 123
X    list [catch {incr x 1a} msg] $msg $errorInfo
X} {1 {expected integer but got "1a"} {expected integer but got "1a"
X    (reading increment)
X    invoked from within
X"incr x 1a"}}
Xtest incr-2.6 {incr errors} {
X    proc readonly args {error "variable is read-only"}
X    set x 123
X    trace var x w readonly
X    list [catch {incr x 1} msg] $msg $errorInfo
X} {1 {can't set "x": access disallowed by trace command} {can't set "x": access disallowed by trace command
X    while executing
X"incr x 1"}}
X
Xcatch {unset x}
Xconcat {}
END_OF_FILE
if test 2296 -ne `wc -c <'tcl6.1/tests/incr.test'`; then
    echo shar: \"'tcl6.1/tests/incr.test'\" unpacked with wrong size!
fi
# end of 'tcl6.1/tests/incr.test'
fi
if test -f 'tcl6.1/tests/lindex.test' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'tcl6.1/tests/lindex.test'\"
else
echo shar: Extracting \"'tcl6.1/tests/lindex.test'\" \(2290 characters\)
sed "s/^X//" >'tcl6.1/tests/lindex.test' <<'END_OF_FILE'
X# Commands covered:  lindex
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/lindex.test,v 1.1 91/09/06 14:48:02 ouster Exp $ (Berkeley)
X
Xif {[string compare test [info procs test]] == 1} then {source defs}
X
Xtest lindex-1.1 {basic tests} {
X    lindex {a b c} 0} a
Xtest lindex-1.2 {basic tests} {
X    lindex {a {b c d} x} 1} {b c d}
Xtest lindex-1.3 {basic tests} {
X    lindex {a b\ c\ d x} 1} {b c d}
Xtest lindex-1.4 {basic tests} {
X    lindex {a b c} 3} {}
Xtest lindex-1.5 {basic tests} {
X    list [catch {lindex {a b c} -1} msg] $msg
X} {0 {}}
X
Xtest lindex-2.1 {error conditions} {
X    list [catch {lindex msg} msg] $msg
X} {1 {wrong # args: should be "lindex list index"}}
Xtest lindex-2.2 {error conditions} {
X    list [catch {lindex 1 2 3 4} msg] $msg
X} {1 {wrong # args: should be "lindex list index"}}
Xtest lindex-2.3 {error conditions} {
X    list [catch {lindex 1 2a2} msg] $msg
X} {1 {expected integer but got "2a2"}}
Xtest lindex-2.4 {error conditions} {
X    list [catch {lindex "a \{" 2} msg] $msg
X} {1 {unmatched open brace in list}}
Xtest lindex-2.5 {error conditions} {
X    list [catch {lindex {a {b c}d e} 2} msg] $msg
X} {1 {list element in braces followed by "d" instead of space}}
Xtest lindex-2.6 {error conditions} {
X    list [catch {lindex {a "b c"def ghi} 2} msg] $msg
X} {1 {list element in quotes followed by "def" instead of space}}
X
Xtest lindex-3.1 {quoted elements} {
X    lindex {a "b c" d} 1
X} {b c}
Xtest lindex-3.2 {quoted elements} {
X    lindex {"{}" b c} 0
X} {{}}
Xtest lindex-3.3 {quoted elements} {
X    lindex {ab "c d \" x" y} 1
X} {c d " x}
Xtest lindex-3.4 {quoted elements} {
X    lindex {a b {c d "e} {f g"}} 2
X} {c d "e}
END_OF_FILE
if test 2290 -ne `wc -c <'tcl6.1/tests/lindex.test'`; then
    echo shar: \"'tcl6.1/tests/lindex.test'\" unpacked with wrong size!
fi
# end of 'tcl6.1/tests/lindex.test'
fi
if test -f 'tcl6.1/tests/linsert.test' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'tcl6.1/tests/linsert.test'\"
else
echo shar: Extracting \"'tcl6.1/tests/linsert.test'\" \(2399 characters\)
sed "s/^X//" >'tcl6.1/tests/linsert.test' <<'END_OF_FILE'
X# Commands covered:  linsert
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/linsert.test,v 1.1 91/08/21 13:37:24 ouster Exp $ (Berkeley)
X
Xif {[string compare test [info procs test]] == 1} then {source defs}
X
Xtest linsert-1.1 {linsert command} {
X    linsert {1 2 3 4 5} 0 a
X} {a 1 2 3 4 5}
Xtest linsert-1.2 {linsert command} {
X    linsert {1 2 3 4 5} 1 a
X} {1 a 2 3 4 5}
Xtest linsert-1.3 {linsert command} {
X    linsert {1 2 3 4 5} 2 a
X} {1 2 a 3 4 5}
Xtest linsert-1.4 {linsert command} {
X    linsert {1 2 3 4 5} 3 a
X} {1 2 3 a 4 5}
Xtest linsert-1.5 {linsert command} {
X    linsert {1 2 3 4 5} 4 a
X} {1 2 3 4 a 5}
Xtest linsert-1.6 {linsert command} {
X    linsert {1 2 3 4 5} 5 a
X} {1 2 3 4 5 a}
Xtest linsert-1.7 {linsert command} {
X    linsert {1 2 3 4 5} 2 one two \{three \$four
X} {1 2 one two \{three {$four} 3 4 5}
Xtest linsert-1.8 {linsert command} {
X    linsert {\{one \$two \{three \ four \ five} 2 a b c
X} {\{one \$two a b c \{three \ four \ five}
Xtest linsert-1.9 {linsert command} {
X    linsert {{1 2} {3 4} {5 6} {7 8}} 2 {x y} {a b}
X} {{1 2} {3 4} {x y} {a b} {5 6} {7 8}}
Xtest linsert-1.10 {linsert command} {
X    linsert {} 2 a b c
X} {a b c}
Xtest linsert-1.11 {linsert command} {
X    linsert {} 2 {}
X} {{}}
X
Xtest linsert-2.1 {linsert errors} {
X    list [catch linsert msg] $msg
X} {1 {wrong # args: should be "linsert list index element ?element ...?"}}
Xtest linsert-2.2 {linsert errors} {
X    list [catch {linsert a b} msg] $msg
X} {1 {wrong # args: should be "linsert list index element ?element ...?"}}
Xtest linsert-2.3 {linsert errors} {
X    list [catch {linsert a 12x 2} msg] $msg
X} {1 {expected integer but got "12x"}}
Xtest linsert-2.4 {linsert errors} {
X    list [catch {linsert \{ 12 2} msg] $msg
X} {1 {unmatched open brace in list}}
END_OF_FILE
if test 2399 -ne `wc -c <'tcl6.1/tests/linsert.test'`; then
    echo shar: \"'tcl6.1/tests/linsert.test'\" unpacked with wrong size!
fi
# end of 'tcl6.1/tests/linsert.test'
fi
if test -f 'tcl6.1/tests/list.test' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'tcl6.1/tests/list.test'\"
else
echo shar: Extracting \"'tcl6.1/tests/list.test'\" \(2924 characters\)
sed "s/^X//" >'tcl6.1/tests/list.test' <<'END_OF_FILE'
X# Commands covered:  list
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/list.test,v 1.9 91/10/17 15:49:39 ouster Exp $ (Berkeley)
X
Xif {[string compare test [info procs test]] == 1} then {source defs}
X
X# First, a bunch of individual tests
X
Xtest list-1.1 {basic tests} {list a b c} {a b c}
Xtest list-1.2 {basic tests} {list {a b} c} {{a b} c}
Xtest list-1.3 {basic tests} {list \{a b c} {\{a b c}
Xtest list-1.4 {basic tests} "list a{}} b{} c}" "a{}} b{} c}"
Xtest list-1.5 {basic tests} {list a\[ b\] } "{a\[} b\\]"
Xtest list-1.6 {basic tests} {list c\  d\t } "{c } {d\t}"
Xtest list-1.7 {basic tests} {list e\n f\$ } "{e\n} {f\$}"
Xtest list-1.8 {basic tests} {list g\; h\\} {{g;} h\\}
Xtest list-1.9 {basic tests} "list a\\\[} b\\\]} " "a\\\[} b\\\]}"
Xtest list-1.10 {basic tests} "list c\\\} d\\t} " "c} d\\t}"
Xtest list-1.11 {basic tests} "list e\\n} f\\$} " "e\\n} f\\$}"
Xtest list-1.12 {basic tests} "list g\\;} h\\\\} " "g\\;} {h\\}}"
Xtest list-1.13 {basic tests} {list a {{}} b} {a {{}} b}
Xtest list-1.14 {basic tests} {list a b xy\\} "a b xy\\\\"
Xtest list-1.15 {basic tests} "list a b\} e\\" "a b} e\\\\"
Xtest list-1.16 {basic tests} "list a b\}\\\$ e\\\$\\" "a b\}\\\$ e\\\$\\\\"
Xtest list-1.17 {basic tests} {list a\f \{\f} "{a\f} \\\{\\f"
Xtest list-1.18 {basic tests} {list a\r \{\r} "{a\r} \\\{\\r"
Xtest list-1.19 {basic tests} {list a\v \{\v} "{a\v} \\\{\\v"
X
X# For the next round of tests create a list and then pick it apart
X# with "index" to make sure that we get back exactly what went in.
X
Xset num 1
Xproc lcheck {a b c} {
X    global num d
X    set d [list $a $b $c]
X    test list-2.$num {what goes in must come out} {lindex $d 0} $a
X    set num [expr $num+1]
X    test list-2.$num {what goes in must come out} {lindex $d 1} $b
X    set num [expr $num+1]
X    test list-2.$num {what goes in must come out} {lindex $d 2} $c
X    set num [expr $num+1]
X}
Xlcheck a b c
Xlcheck "a b" c\td e\nf
Xlcheck {{a b}} {} {  }
Xlcheck \$ \$ab ab\$
Xlcheck \; \;ab ab\;
Xlcheck \[ \[ab ab\[
Xlcheck \\ \\ab ab\\
Xlcheck {"} {"ab} {ab"}
Xlcheck {a b} { ab} {ab }
Xlcheck a{ a{b \{ab
Xlcheck a} a}b }ab
Xlcheck a\\} {a \}b} {a \{c}
X
Xtest list-3.1 {error conditions} {catch list msg} 1
Xtest list-3.2 {error conditions} {
X    catch list msg
X    set msg
X} {wrong # args: should be "list arg ?arg ...?"}
END_OF_FILE
if test 2924 -ne `wc -c <'tcl6.1/tests/list.test'`; then
    echo shar: \"'tcl6.1/tests/list.test'\" unpacked with wrong size!
fi
# end of 'tcl6.1/tests/list.test'
fi
if test -f 'tcl6.1/tests/lrange.test' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'tcl6.1/tests/lrange.test'\"
else
echo shar: Extracting \"'tcl6.1/tests/lrange.test'\" \(2523 characters\)
sed "s/^X//" >'tcl6.1/tests/lrange.test' <<'END_OF_FILE'
X# Commands covered:  lrange
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/lrange.test,v 1.1 91/09/06 14:47:58 ouster Exp $ (Berkeley)
X
Xif {[string compare test [info procs test]] == 1} then {source defs}
X
Xtest lrange-1.1 {range of list elements} {
X    lrange {a b c d} 1 2
X} {b c}
Xtest lrange-1.2 {range of list elements} {
X    lrange {a {bcd e {f g {}}} l14 l15 d} 1 1
X} {{bcd e {f g {}}}}
Xtest lrange-1.3 {range of list elements} {
X    lrange {a {bcd e {f g {}}} l14 l15 d} 3 end
X} {l15 d}
Xtest lrange-1.4 {range of list elements} {
X    lrange {a {bcd e {f g {}}} l14 l15 d} 4 10000
X} {d}
Xtest lrange-1.5 {range of list elements} {
X    lrange {a {bcd e {f g {}}} l14 l15 d} 4 3
X} {}
Xtest lrange-1.6 {range of list elements} {
X    lrange {a {bcd e {f g {}}} l14 l15 d} 10 11
X} {}
Xtest lrange-1.7 {range of list elements} {
X    lrange {a b c d e} -1 2
X} {a b c}
Xtest lrange-1.8 {range of list elements} {
X    lrange {a b c d e} -2 -1
X} {}
Xtest lrange-1.9 {range of list elements} {
X    lrange {a b c d e} -2 e
X} {a b c d e}
Xtest lrange-1.10 {range of list elements} {
X    lrange "a b\{c d" 1 2
X} "b\{c d"
X
Xtest lrange-2.1 {error conditions} {
X    list [catch {lrange a b} msg] $msg
X} {1 {wrong # args: should be "lrange list first last"}}
Xtest lrange-2.2 {error conditions} {
X    list [catch {lrange a b 6 7} msg] $msg
X} {1 {wrong # args: should be "lrange list first last"}}
Xtest lrange-2.3 {error conditions} {
X    list [catch {lrange a b 6} msg] $msg
X} {1 {expected integer but got "b"}}
Xtest lrange-2.4 {error conditions} {
X    list [catch {lrange a 0 enigma} msg] $msg
X} {1 {expected integer or "end" but got "enigma"}}
Xtest lrange-2.5 {error conditions} {
X    list [catch {lrange "a \{b c" 3 4} msg] $msg
X} {1 {unmatched open brace in list}}
Xtest lrange-2.6 {error conditions} {
X    list [catch {lrange "a b c \{ d e" 1 4} msg] $msg
X} {1 {unmatched open brace in list}}
END_OF_FILE
if test 2523 -ne `wc -c <'tcl6.1/tests/lrange.test'`; then
    echo shar: \"'tcl6.1/tests/lrange.test'\" unpacked with wrong size!
fi
# end of 'tcl6.1/tests/lrange.test'
fi
if test -f 'tcl6.1/tests/lreplace.test' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'tcl6.1/tests/lreplace.test'\"
else
echo shar: Extracting \"'tcl6.1/tests/lreplace.test'\" \(2951 characters\)
sed "s/^X//" >'tcl6.1/tests/lreplace.test' <<'END_OF_FILE'
X# Commands covered:  lreplace
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/lreplace.test,v 1.2 91/08/21 13:59:19 ouster Exp $ (Berkeley)
X
Xif {[string compare test [info procs test]] == 1} then {source defs}
X
Xtest lreplace-1.1 {lreplace command} {
X    lreplace {1 2 3 4 5} 0 0 a
X} {a 2 3 4 5}
Xtest lreplace-1.2 {lreplace command} {
X    lreplace {1 2 3 4 5} 1 1 a
X} {1 a 3 4 5}
Xtest lreplace-1.3 {lreplace command} {
X    lreplace {1 2 3 4 5} 2 2 a
X} {1 2 a 4 5}
Xtest lreplace-1.4 {lreplace command} {
X    lreplace {1 2 3 4 5} 3 3 a
X} {1 2 3 a 5}
Xtest lreplace-1.5 {lreplace command} {
X    lreplace {1 2 3 4 5} 4 4 a
X} {1 2 3 4 a}
Xtest lreplace-1.6 {lreplace command} {
X    lreplace {1 2 3 4 5} 4 5 a
X} {1 2 3 4 a}
Xtest lreplace-1.7 {lreplace command} {
X    lreplace {1 2 3 4 5} -1 -1 a
X} {a 2 3 4 5}
Xtest lreplace-1.8 {lreplace command} {
X    lreplace {1 2 3 4 5} 2 end a b c d
X} {1 2 a b c d}
Xtest lreplace-1.9 {lreplace command} {
X    lreplace {1 2 3 4 5} 0 3
X} {5}
Xtest lreplace-1.10 {lreplace command} {
X    lreplace {1 2 3 4 5} 0 4
X} {}
Xtest lreplace-1.11 {lreplace command} {
X    lreplace {1 2 3 4 5} 0 1
X} {3 4 5}
Xtest lreplace-1.12 {lreplace command} {
X    lreplace {1 2 3 4 5} 2 3
X} {1 2 5}
Xtest lreplace-1.13 {lreplace command} {
X    lreplace {1 2 3 4 5} 3 end
X} {1 2 3}
Xtest lreplace-1.14 {lreplace command} {
X    lreplace {1 2 3 4 5} -1 4 a b c
X} {a b c}
X
Xtest lreplace-2.1 {lreplace errors} {
X    list [catch lreplace msg] $msg
X} {1 {wrong # args: should be "lreplace list first last ?element element ...?"}}
Xtest lreplace-2.2 {lreplace errors} {
X    list [catch {lreplace a b} msg] $msg
X} {1 {wrong # args: should be "lreplace list first last ?element element ...?"}}
Xtest lreplace-2.3 {lreplace errors} {
X    list [catch {lreplace x a 10} msg] $msg
X} {1 {expected integer but got "a"}}
Xtest lreplace-2.4 {lreplace errors} {
X    list [catch {lreplace x 10 x} msg] $msg
X} {1 {bad index "x": must be integer or "end"}}
Xtest lreplace-2.5 {lreplace errors} {
X    list [catch {lreplace x 10 1x} msg] $msg
X} {1 {expected integer but got "1x"}}
Xtest lreplace-2.6 {lreplace errors} {
X    list [catch {lreplace x 3 2} msg] $msg
X} {1 {first index must not be greater than second}}
Xtest lreplace-2.7 {lreplace errors} {
X    list [catch {lreplace x 1 1} msg] $msg
X} {1 {list doesn't contain element 1}}
END_OF_FILE
if test 2951 -ne `wc -c <'tcl6.1/tests/lreplace.test'`; then
    echo shar: \"'tcl6.1/tests/lreplace.test'\" unpacked with wrong size!
fi
# end of 'tcl6.1/tests/lreplace.test'
fi
if test -f 'tcl6.1/tests/rename.test' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'tcl6.1/tests/rename.test'\"
else
echo shar: Extracting \"'tcl6.1/tests/rename.test'\" \(2522 characters\)
sed "s/^X//" >'tcl6.1/tests/rename.test' <<'END_OF_FILE'
X# Commands covered:  rename
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/rename.test,v 1.4 91/08/14 11:45:18 ouster Exp $ (Berkeley)
X
Xif {[string compare test [info procs test]] == 1} then {source defs}
X
Xcatch {rename r2 {}}
Xproc r1 {} {return "procedure r1"}
Xrename r1 r2
Xtest rename-1.1 {simple renaming} {
X    r2
X} {procedure r1}
Xtest rename-1.2 {simple renaming} {
X    list [catch r1 msg] $msg
X} {1 {invalid command name: "r1"}}
Xrename r2 {}
Xtest rename-1.3 {simple renaming} {
X    list [catch r2 msg] $msg
X} {1 {invalid command name: "r2"}}
X
X# The test below is tricky because it renames a built-in command.
X# It's possible that the test procedure uses this command, so must
X# restore the command before calling test again.
X
Xrename list l.new
Xset a [catch list msg1]
Xset b [l.new a b c]
Xrename l.new list
Xset c [catch l.new msg2]
Xset d [list 111 222]
Xtest 2.1 {renaming built-in command} {
X    list $a $msg1 $b $c $msg2 $d
X} {1 {invalid command name: "list"} {a b c} 1 {invalid command name: "l.new"} {111 222}}
X
Xtest rename-3.1 {error conditions} {
X    list [catch {rename r1} msg] $msg $errorCode
X} {1 {wrong # args: should be "rename oldName newName"} NONE}
Xtest rename-3.2 {error conditions} {
X    list [catch {rename r1 r2 r3} msg] $msg $errorCode
X} {1 {wrong # args: should be "rename oldName newName"} NONE}
Xtest rename-3.3 {error conditions} {
X    proc r1 {} {}
X    proc r2 {} {}
X    list [catch {rename r1 r2} msg] $msg
X} {1 {can't rename to "r2": command already exists}}
Xtest rename-3.4 {error conditions} {
X    catch {rename r1 {}}
X    catch {rename r2 {}}
X    list [catch {rename r1 r2} msg] $msg
X} {1 {can't rename "r1":  command doesn't exist}}
Xtest rename-3.5 {error conditions} {
X    catch {rename _non_existent_command {}}
X    list [catch {rename _non_existent_command {}} msg] $msg
X} {1 {can't delete "_non_existent_command": command doesn't exist}}
END_OF_FILE
if test 2522 -ne `wc -c <'tcl6.1/tests/rename.test'`; then
    echo shar: \"'tcl6.1/tests/rename.test'\" unpacked with wrong size!
fi
# end of 'tcl6.1/tests/rename.test'
fi
if test -f 'tcl6.1/tests/source.test' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'tcl6.1/tests/source.test'\"
else
echo shar: Extracting \"'tcl6.1/tests/source.test'\" \(2609 characters\)
sed "s/^X//" >'tcl6.1/tests/source.test' <<'END_OF_FILE'
X# Commands covered:  source
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/source.test,v 1.6 91/09/11 17:30:17 ouster Exp $ (Berkeley)
X
Xif {[string compare test [info procs test]] == 1} then {source defs}
X
Xtest source-1.1 {source command} {
X    set x "old x value"
X    set y "old y value"
X    set z "old z value"
X    exec cat << {
X    set x 22
X    set y 33
X    set z 44
X    } > source.file
X    source source.file
X    list $x $y $z
X} {22 33 44}
Xtest source-1.2 {source command} {
X    exec cat << {list result} > source.file
X    source source.file
X} result
X
Xtest source-2.1 {source error conditions} {
X    list [catch {source} msg] $msg
X} {1 {wrong # args: should be "source fileName"}}
Xtest source-2.2 {source error conditions} {
X    list [catch {source a b} msg] $msg
X} {1 {wrong # args: should be "source fileName"}}
Xtest source-2.3 {source error conditions} {
X    exec cat << {
X    set x 146
X    error "error in sourced file"
X    set y $x
X    } > source.file
X    list [catch {source source.file} msg] $msg $errorInfo
X} {1 {error in sourced file} {error in sourced file
X    while executing
X"error "error in sourced file""
X    (file "source.file" line 3)
X    invoked from within
X"source source.file"}}
Xtest source-2.4 {source error conditions} {
X    exec cat << {break} > source.file
X    catch {source source.file}
X} 3
Xtest source-2.5 {source error conditions} {
X    exec cat << {continue} > source.file
X    catch {source source.file}
X} 4
Xtest source-2.6 {source error conditions} {
X    string tolower [list [catch {source _non_existent_} msg] $msg $errorCode]
X} {1 {couldn't read file "_non_existent_": no such file or directory} {unix enoent {no such file or directory}}}
X
Xtest source-3.1 {return in middle of source file} {
X    exec cat << {
X    set x new-x
X    return allDone
X    set y new-y
X    } > source.file
X    set x old-x
X    set y old-y
X    set z [source source.file]
X    list $x $y $z
X} {new-x old-y allDone}
X
Xcatch {exec rm source.file}
X
X# Generate null final value
X
Xconcat {}
END_OF_FILE
if test 2609 -ne `wc -c <'tcl6.1/tests/source.test'`; then
    echo shar: \"'tcl6.1/tests/source.test'\" unpacked with wrong size!
fi
# end of 'tcl6.1/tests/source.test'
fi
if test -f 'tcl6.1/tests/uplevel.test' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'tcl6.1/tests/uplevel.test'\"
else
echo shar: Extracting \"'tcl6.1/tests/uplevel.test'\" \(2665 characters\)
sed "s/^X//" >'tcl6.1/tests/uplevel.test' <<'END_OF_FILE'
X# Commands covered:  uplevel
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/uplevel.test,v 1.8 91/09/30 16:59:26 ouster Exp $ (Berkeley)
X
Xif {[string compare test [info procs test]] == 1} then {source defs}
X
Xproc a {x y} {
X    newset z [expr $x+$y]
X    return $z
X}
Xproc newset {name value} {
X    uplevel set $name $value
X    uplevel 1 {uplevel 1 {set xyz 22}}
X}
X
Xtest uplevel-1.1 {simple operation} {
X    set xyz 0
X    a 22 33
X} 55
Xtest uplevel-1.2 {command is another uplevel command} {
X    set xyz 0
X    a 22 33
X    set xyz
X} 22
X
Xproc a1 {} {
X    b1
X    global a a1
X    set a $x
X    set a1 $y
X}
Xproc b1 {} {
X    c1
X    global b b1
X    set b $x
X    set b1 $y
X}
Xproc c1 {} {
X    uplevel 1 set x 111
X    uplevel #2 set y 222
X    uplevel 2 set x 333
X    uplevel #1 set y 444
X    uplevel 3 set x 555
X    uplevel #0 set y 666
X}
Xa1
Xtest uplevel-2.1 {relative and absolute uplevel} {set a} 333
Xtest uplevel-2.2 {relative and absolute uplevel} {set a1} 444
Xtest uplevel-2.3 {relative and absolute uplevel} {set b} 111
Xtest uplevel-2.4 {relative and absolute uplevel} {set b1} 222
Xtest uplevel-2.5 {relative and absolute uplevel} {set x} 555
Xtest uplevel-2.6 {relative and absolute uplevel} {set y} 666
X
Xtest uplevel-3.1 {error: non-existent level} {
X    list [catch c1 msg] $msg
X} {1 {bad level "#2"}}
Xtest uplevel-3.2 {error: non-existent level} {
X    proc c2 {} {uplevel 3 {set a b}}
X    list [catch c2 msg] $msg
X} {1 {bad level "3"}}
Xtest uplevel-3.3 {error: already at global level} {
X    list [catch {uplevel gorp} msg] $msg
X} {1 {already at top level}}
Xtest uplevel-3.4 {error: already at global level} {
X    list [catch {uplevel 1 gorp} msg] $msg
X} {1 {already at top level}}
Xtest uplevel-3.5 {error: not enough args} {
X    list [catch uplevel msg] $msg
X} {1 {wrong # args: should be "uplevel ?level? command ?command ...?"}}
X
Xproc a2 {} {
X    uplevel a3
X}
Xproc a3 {} {
X    global x y
X    set x [info level]
X    set y [info level 1]
X}
Xa2
Xtest uplevel-4.1 {info level} {set x} 1
Xtest uplevel-4.2 {info level} {set y} a3
END_OF_FILE
if test 2665 -ne `wc -c <'tcl6.1/tests/uplevel.test'`; then
    echo shar: \"'tcl6.1/tests/uplevel.test'\" unpacked with wrong size!
fi
# end of 'tcl6.1/tests/uplevel.test'
fi
if test -f 'tcl6.1/tests/while.test' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'tcl6.1/tests/while.test'\"
else
echo shar: Extracting \"'tcl6.1/tests/while.test'\" \(2870 characters\)
sed "s/^X//" >'tcl6.1/tests/while.test' <<'END_OF_FILE'
X# Commands covered:  while
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/while.test,v 1.5 91/09/08 13:43:30 ouster Exp $ (Berkeley)
X
Xif {[string compare test [info procs test]] == 1} then {source defs}
X
Xtest while-1.1 {basic while loops} {
X    set count 0
X    while {$count < 10} {set count [expr $count+1]}
X    set count
X} 10
Xtest while-1.2 {basic while loops} {
X    set value xxx
X    while {2 > 3} {set value yyy}
X    set value
X} xxx
X
Xtest while-2.1 {continue in while loop} {
X    set list {1 2 3 4 5}
X    set index 0
X    set result {}
X    while {$index < 5} {
X    if {$index == 2} {set index [expr $index+1]; continue}
X    set result [concat $result [lindex $list $index]]
X    set index [expr $index+1]
X    }
X    set result
X} {1 2 4 5}
X
Xtest while-3.1 {break in while loop} {
X    set list {1 2 3 4 5}
X    set index 0
X    set result {}
X    while {$index < 5} {
X    if {$index == 3} break
X    set result [concat $result [lindex $list $index]]
X    set index [expr $index+1]
X    }
X    set result
X} {1 2 3}
X
Xtest while-4.1 {errors in while loops} {
X    set err [catch {while} msg]
X    list $err $msg
X} {1 {wrong # args: should be "while test command"}}
Xtest while-4.2 {errors in while loops} {
X    set err [catch {while 1} msg]
X    list $err $msg
X} {1 {wrong # args: should be "while test command"}}
Xtest while-4.3 {errors in while loops} {
X    set err [catch {while 1 2 3} msg]
X    list $err $msg
X} {1 {wrong # args: should be "while test command"}}
Xtest while-4.4 {errors in while loops} {
X    set err [catch {while {"a"+"b"} {error "loop aborted"}} msg]
X    list $err $msg
X} {1 {can't use non-numeric string as operand of "+"}}
Xtest while-4.5 {errors in while loops} {
X    set x 1
X    set err [catch {while {$x} {set x foo}} msg]
X    list $err $msg
X} {1 {expression didn't have numeric value}}
Xtest while-4.6 {errors in while loops} {
X    set err [catch {while {1} {error "loop aborted"}} msg]
X    list $err $msg $errorInfo
X} {1 {loop aborted} {loop aborted
X    while executing
X"error "loop aborted""
X    ("while" body line 1)
X    invoked from within
X"while {1} {error "loop aborted"}"}}
X
Xtest while-5.1 {while return result} {
X    while {0} {set a 400}
X} {}
Xtest while-5.2 {while return result} {
X    set x 1
X    while {$x} {set x 0}
X} {}
END_OF_FILE
if test 2870 -ne `wc -c <'tcl6.1/tests/while.test'`; then
    echo shar: \"'tcl6.1/tests/while.test'\" unpacked with wrong size!
fi
# end of 'tcl6.1/tests/while.test'
fi
echo shar: End of archive 2 \(of 33\).
cp /dev/null ark2isdone
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].