v25i069: tcl - tool command language, version 6.1, Part01/33

23 views
Skip to first unread message

Karl Lehenbauer

unread,
Nov 14, 1991, 3:25:03 PM11/14/91
to
Submitted-by: ka...@sugar.neosoft.com (Karl Lehenbauer)
Posting-number: Volume 25, Issue 69
Archive-name: tcl/part01
Environment: UNIX

This is a posting of the source and documentation for Tcl, an
embeddable tool command language, created by John Ousterhout.

This was posted at John's request by Karl Lehenbauer (ka...@NeoSoft.com).

This is release 6.1.

For more information, see the file "tcl6.1/README" in this release.

The file tclVar.c had to be split into two files, tclVar.c.1 and tclVar.c.2,
in order to not exceed the maximum size of a Usenet posting. Similarly,
the file doc/Tcl.man was split into three files, doc/Tcl.man.1, doc/Tcl.man.2
and doc/Tcl.man.3. Although these files should be automatically concatenated
when you unpack the last part, if they are not for some reason, you should put
them together by hand.

Good luck. If you have any problems with the Usenet distribution, contact
Karl or Mark Diekhans (ma...@Grizzly.com). For problems with Tcl 6.1 itself,
contact John Ousterhout (ous...@sprite.berkeley.edu).

Regards,
Karl Lehenbauer (ka...@NeoSoft.com)
-----------
#! /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 1 (of 33)."
# Contents: README tcl6.1 tcl6.1/MANIFEST tcl6.1/Makefile
# tcl6.1/compat tcl6.1/compat/README tcl6.1/compat/dirent.h
# tcl6.1/compat/dirent2.h tcl6.1/compat/limits.h
# tcl6.1/compat/opendir.c tcl6.1/compat/stdlib.h
# tcl6.1/compat/string.h tcl6.1/compat/strstr.c
# tcl6.1/compat/testpid.c tcl6.1/compat/testwait.c tcl6.1/doc
# tcl6.1/library tcl6.1/library/mkindex.tcl
# tcl6.1/library/parray.tcl tcl6.1/library/tclIndex tcl6.1/panic.c
# tcl6.1/regexp.h tcl6.1/tests tcl6.1/tests/all
# tcl6.1/tests/concat.test tcl6.1/tests/defs tcl6.1/tests/eval.test
# tcl6.1/tests/join.test tcl6.1/tests/llength.test
# tcl6.1/tests/lsearch.test tcl6.1/tests/lsort.test
# tcl6.1/tests/split.test tcl6.1/tests/unknown.test
# Wrapped by karl@one on Tue Nov 12 19:44:10 1991
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'README' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'README'\"
else
echo shar: Extracting \"'README'\" \(955 characters\)
sed "s/^X//" >'README' <<'END_OF_FILE'
X
XThis is a posting of the source and documentation for Tcl, an
Xembeddable tool command language, created by John Ousterhout.
X
XThis is release 6.1.
X
XFor more information, see the file "tcl6.1/README" in this release.
X
XThis was posted at John's request by Karl Lehenbauer (ka...@NeoSoft.com).
X
XThe file tclVar.c had to be split into two files, tclVar.c.1 and tclVar.c.2,
Xin order to not exceed the maximum size of a Usenet posting. Similarly,
Xthe file doc/Tcl.man was split into three files, doc/Tcl.man.1, doc/Tcl.man.2
Xand doc/Tcl.man.3. Although these files should be automatically concatenated
Xwhen you unpack the last part, if they are not for some reason, you should put
Xthem together by hand.
X
XGood luck. If you have any problems with the Usenet distribution, contact
XKarl or Mark Diekhans (ma...@Grizzly.com). For problems with Tcl 6.1 itself,
Xcontact John Ousterhout (ous...@sprite.berkeley.edu).
X
XRegards,
XKarl Lehenbauer (ka...@NeoSoft.com)
X
END_OF_FILE
if test 955 -ne `wc -c <'README'`; then
echo shar: \"'README'\" unpacked with wrong size!
fi
# end of 'README'
fi
if test ! -d 'tcl6.1' ; then
echo shar: Creating directory \"'tcl6.1'\"
mkdir 'tcl6.1'
fi
if test -f 'tcl6.1/MANIFEST' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/MANIFEST'\"
else
echo shar: Extracting \"'tcl6.1/MANIFEST'\" \(4022 characters\)
sed "s/^X//" >'tcl6.1/MANIFEST' <<'END_OF_FILE'
X File Name Archive # Description
X-----------------------------------------------------------
X README 1
X tcl6.1 1
X tcl6.1/MANIFEST 1 This shipping list
X tcl6.1/Makefile 1
X tcl6.1/README 8
X tcl6.1/changes 11
X tcl6.1/compat 1
X tcl6.1/compat/README 1
X tcl6.1/compat/dirent.h 1
X tcl6.1/compat/dirent2.h 1
X tcl6.1/compat/limits.h 1
X tcl6.1/compat/opendir.c 1
X tcl6.1/compat/stdlib.h 1
X tcl6.1/compat/strerror.c 10
X tcl6.1/compat/string.h 1
X tcl6.1/compat/strstr.c 1
X tcl6.1/compat/strtol.c 2
X tcl6.1/compat/strtoul.c 3
X tcl6.1/compat/testpid.c 1
X tcl6.1/compat/testwait.c 1
X tcl6.1/config 7
X tcl6.1/doc 1
X tcl6.1/doc/AddErrInfo.man 6
X tcl6.1/doc/AssembCmd.man 5
X tcl6.1/doc/Backslash.man 4
X tcl6.1/doc/Concat.man 4
X tcl6.1/doc/CrtCommand.man 6
X tcl6.1/doc/CrtInterp.man 4
X tcl6.1/doc/CrtPipelin.man 5
X tcl6.1/doc/CrtTrace.man 6
X tcl6.1/doc/Eval.man 5
X tcl6.1/doc/ExprLong.man 5
X tcl6.1/doc/Fork.man 6
X tcl6.1/doc/GetInt.man 5
X tcl6.1/doc/Hash.man 10
X tcl6.1/doc/History.man 4
X tcl6.1/doc/Interp.man 7
X tcl6.1/doc/SetResult.man 8
X tcl6.1/doc/SetVar.man 8
X tcl6.1/doc/SplitList.man 6
X tcl6.1/doc/StrMatch.man 3
X tcl6.1/doc/Tcl.man.1 27
X tcl6.1/doc/Tcl.man.2 33
X tcl6.1/doc/Tcl.man.3 32
X tcl6.1/doc/TildeSubst.man 4
X tcl6.1/doc/TraceVar.man 14
X tcl6.1/doc/library.man 9
X tcl6.1/doc/usenix.text 31
X tcl6.1/library 1
X tcl6.1/library/init.tcl 3
X tcl6.1/library/mkindex.tcl 1
X tcl6.1/library/parray.tcl 1
X tcl6.1/library/tclIndex 1
X tcl6.1/panic.c 1
X tcl6.1/regexp.c 18
X tcl6.1/regexp.h 1
X tcl6.1/tcl.h 9
X tcl6.1/tclAssem.c 4
X tcl6.1/tclBasic.c 17
X tcl6.1/tclCkalloc.c 12
X tcl6.1/tclCmdAH.c 16
X tcl6.1/tclCmdIL.c 20
X tcl6.1/tclCmdMZ.c 28
X tcl6.1/tclEnv.c 9
X tcl6.1/tclExpr.c 26
X tcl6.1/tclGet.c 3
X tcl6.1/tclGlob.c 11
X tcl6.1/tclHash.c 16
X tcl6.1/tclHash.h 3
X tcl6.1/tclHistory.c 21
X tcl6.1/tclInt.h 23
X tcl6.1/tclParse.c 24
X tcl6.1/tclProc.c 12
X tcl6.1/tclTest.c 2
X tcl6.1/tclUnix.h 5
X tcl6.1/tclUnixAZ.c 30
X tcl6.1/tclUnixStr.c 12
X tcl6.1/tclUnixUtil.c 19
X tcl6.1/tclUtil.c 29
X tcl6.1/tclVar.c.1 25
X tcl6.1/tclVar.c.2 22
X tcl6.1/tests 1
X tcl6.1/tests/README 3
X tcl6.1/tests/all 1
X tcl6.1/tests/append.test 2
X tcl6.1/tests/case.test 2
X tcl6.1/tests/cd.test 2
X tcl6.1/tests/concat.test 1
X tcl6.1/tests/defs 1
X tcl6.1/tests/env.test 2
X tcl6.1/tests/error.test 3
X tcl6.1/tests/eval.test 1
X tcl6.1/tests/exec.test 4
X tcl6.1/tests/expr.test 14
X tcl6.1/tests/file.test 7
X tcl6.1/tests/for.test 3
X tcl6.1/tests/format.test 10
X tcl6.1/tests/glob.test 3
X tcl6.1/tests/history.test 11
X tcl6.1/tests/if.test 3
X tcl6.1/tests/incr.test 2
X tcl6.1/tests/info.test 9
X tcl6.1/tests/join.test 1
X tcl6.1/tests/lindex.test 2
X tcl6.1/tests/linsert.test 2
X tcl6.1/tests/list.test 2
X tcl6.1/tests/llength.test 1
X tcl6.1/tests/lrange.test 2
X tcl6.1/tests/lreplace.test 2
X tcl6.1/tests/lsearch.test 1
X tcl6.1/tests/lsort.test 1
X tcl6.1/tests/open.test 13
X tcl6.1/tests/parse.test 10
X tcl6.1/tests/proc.test 7
X tcl6.1/tests/regexp.test 7
X tcl6.1/tests/rename.test 2
X tcl6.1/tests/scan.test 15
X tcl6.1/tests/set.test 13
X tcl6.1/tests/source.test 2
X tcl6.1/tests/split.test 1
X tcl6.1/tests/string.test 8
X tcl6.1/tests/trace.test 15
X tcl6.1/tests/unknown.test 1
X tcl6.1/tests/uplevel.test 2
X tcl6.1/tests/upvar.test 4
X tcl6.1/tests/while.test 2
END_OF_FILE
if test 4022 -ne `wc -c <'tcl6.1/MANIFEST'`; then
echo shar: \"'tcl6.1/MANIFEST'\" unpacked with wrong size!
fi
# end of 'tcl6.1/MANIFEST'
fi
if test -f 'tcl6.1/Makefile' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/Makefile'\"
else
echo shar: Extracting \"'tcl6.1/Makefile'\" \(1820 characters\)
sed "s/^X//" >'tcl6.1/Makefile' <<'END_OF_FILE'
X#
X# This Makefile is for use when distributing Tcl to the outside world.
X# It is normally set up by running the "config" script. Before modifying
X# this file by hand, you should read through the "config" script to see
X# what it does.
X#
X# Some changes you may wish to make here:
X#
X# 1. To compile for non-UNIX systems (so that only the non-UNIX-specific
X# commands are available), change the OBJS line below so it doesn't
X# include ${UNIX_OBJS}. Also, add the switch "-DTCL_GENERIC_ONLY" to
X# CFLAGS. Lastly, you'll have to provide your own replacement for the
X# "panic" procedure (see panic.c for what the current one does).
X#
X# 2. ANSI-C procedure prototypes are turned on by default if supported
X# by the compiler. To turn them off, add "-DNO_PROTOTYPE" to CFLAGS
X# below.
X#
X# 3. If you've put the Tcl script library in a non-standard place, change
X# the definition of TCL_LIBRARY to correspond to its location on your
X# system.
X#
X
XTCL_LIBRARY = /usr/local/lib/tcl
X
XCC = cc
XCFLAGS = -g -I. -DTCL_LIBRARY=\"${TCL_LIBRARY}\"
X
XGENERIC_OBJS = regexp.o tclAssem.o tclBasic.o tclCkalloc.o \
X tclCmdAH.o tclCmdIL.o tclCmdMZ.o tclExpr.o tclGet.o \
X tclHash.o tclHistory.o tclParse.o tclProc.o tclUtil.o \
X tclVar.o
X
XUNIX_OBJS = panic.o tclEnv.o tclGlob.o tclUnixAZ.o tclUnixStr.o \
X tclUnixUtil.o
X
XCOMPAT_OBJS = strerror.o opendir.o strstr.o strtoul.o
X
XOBJS = ${GENERIC_OBJS} ${UNIX_OBJS} ${COMPAT_OBJS}
X
Xlibtcl.a: ${OBJS}
X rm -f libtcl.a
X ar cr libtcl.a ${OBJS}
X
XtclTest: tclTest.o libtcl.a
X ${CC} ${CFLAGS} tclTest.o libtcl.a -o tclTest
X
Xclean:
X rm -f ${OBJS} libtcl.a tclTest.o tclTest
X
X# The following target is used during configuration to compile
X# a test program to see if certain facilities are available on
X# the system.
X
Xtest:
X ${CC} ${CFLAGS} test.c
X
X${OBJS}: tcl.h tclHash.h tclInt.h
X${UNIX_OBJS}: tclUnix.h
END_OF_FILE
if test 1820 -ne `wc -c <'tcl6.1/Makefile'`; then
echo shar: \"'tcl6.1/Makefile'\" unpacked with wrong size!
fi
# end of 'tcl6.1/Makefile'
fi
if test ! -d 'tcl6.1/compat' ; then
echo shar: Creating directory \"'tcl6.1/compat'\"
mkdir 'tcl6.1/compat'
fi
if test -f 'tcl6.1/compat/README' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/compat/README'\"
else
echo shar: Extracting \"'tcl6.1/compat/README'\" \(363 characters\)
sed "s/^X//" >'tcl6.1/compat/README' <<'END_OF_FILE'
XThis directory contains various header and code files that are
Xused make Tcl compatible with various releases of UNIX and UNIX-like
Xsystems. Typically, files from this directory are used to compile
XTcl when the corresponding files aren't present in the system's
Xlibrary area. When the whole world is POSIX-ified, this information
Xshould become unnecessary. (?)
END_OF_FILE
if test 363 -ne `wc -c <'tcl6.1/compat/README'`; then
echo shar: \"'tcl6.1/compat/README'\" unpacked with wrong size!
fi
# end of 'tcl6.1/compat/README'
fi
if test -f 'tcl6.1/compat/dirent.h' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/compat/dirent.h'\"
else
echo shar: Extracting \"'tcl6.1/compat/dirent.h'\" \(809 characters\)
sed "s/^X//" >'tcl6.1/compat/dirent.h' <<'END_OF_FILE'
X/*
X * dirent.h --
X *
X * This file is a replacement for <dirent.h> in systems that
X * support the old BSD-style <sys/dir.h> with a "struct direct".
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
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 * $Header: /sprite/src/lib/tcl/compat/RCS/dirent.h,v 1.1 91/09/19 16:22:06 ouster Exp $ SPRITE (Berkeley)
X */
X
X#ifndef _DIRENT
X#define _DIRENT
X
X#include <sys/dir.h>
X
X#define dirent direct
X
X#endif /* _DIRENT */
END_OF_FILE
if test 809 -ne `wc -c <'tcl6.1/compat/dirent.h'`; then
echo shar: \"'tcl6.1/compat/dirent.h'\" unpacked with wrong size!
fi
# end of 'tcl6.1/compat/dirent.h'
fi
if test -f 'tcl6.1/compat/dirent2.h' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/compat/dirent2.h'\"
else
echo shar: Extracting \"'tcl6.1/compat/dirent2.h'\" \(1658 characters\)
sed "s/^X//" >'tcl6.1/compat/dirent2.h' <<'END_OF_FILE'
X/*
X * dirent.h --
X *
X * Declarations of a library of directory-reading procedures
X * in the POSIX style ("struct dirent").
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
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 * $Header: /sprite/src/lib/tcl/compat/RCS/dirent2.h,v 1.1 91/09/19 16:22:08 ouster Exp $ SPRITE (Berkeley)
X */
X
X#ifndef _DIRENT
X#define _DIRENT
X
X#ifndef _TCL
X#include <tcl.h>
X#endif
X
X/*
X * Dirent structure, which holds information about a single
X * directory entry.
X */
X
X#define MAXNAMLEN 255
X#define DIRBLKSIZ 512
X
Xstruct dirent {
X long d_ino; /* Inode number of entry */
X short d_reclen; /* Length of this record */
X short d_namlen; /* Length of string in d_name */
X char d_name[MAXNAMLEN + 1]; /* Name must be no longer than this */
X};
X
X/*
X * State that keeps track of the reading of a directory (clients
X * should never look inside this structure; the fields should
X * only be accessed by the library procedures).
X */
X
Xtypedef struct _dirdesc {
X int dd_fd;
X long dd_loc;
X long dd_size;
X char dd_buf[DIRBLKSIZ];
X} DIR;
X
X/*
X * Procedures defined for reading directories:
X */
X
Xextern void closedir _ANSI_ARGS_((DIR *dirp));
Xextern DIR * opendir _ANSI_ARGS_((char *name));
Xextern struct dirent * readdir _ANSI_ARGS_((DIR *dirp));
X
X#endif /* _DIRENT */
END_OF_FILE
if test 1658 -ne `wc -c <'tcl6.1/compat/dirent2.h'`; then
echo shar: \"'tcl6.1/compat/dirent2.h'\" unpacked with wrong size!
fi
# end of 'tcl6.1/compat/dirent2.h'
fi
if test -f 'tcl6.1/compat/limits.h' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/compat/limits.h'\"
else
echo shar: Extracting \"'tcl6.1/compat/limits.h'\" \(893 characters\)
sed "s/^X//" >'tcl6.1/compat/limits.h' <<'END_OF_FILE'
X/*
X * limits.h --
X *
X * This is a dummy header file to #include in Tcl when there
X * is no limits.h in /usr/include. The file is totally empty.
X * In case you're wondering why Tcl includes the file at all
X * if it can be empty, it's because there's already code in
X * tclUnix.h to #define anything that's not defined in limits.h.
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
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 * $Header: /sprite/src/lib/tcl/compat/RCS/limits.h,v 1.1 91/09/19 16:22:08 ouster Exp $ SPRITE (Berkeley)
X */
END_OF_FILE
if test 893 -ne `wc -c <'tcl6.1/compat/limits.h'`; then
echo shar: \"'tcl6.1/compat/limits.h'\" unpacked with wrong size!
fi
# end of 'tcl6.1/compat/limits.h'
fi
if test -f 'tcl6.1/compat/opendir.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/compat/opendir.c'\"
else
echo shar: Extracting \"'tcl6.1/compat/opendir.c'\" \(1983 characters\)
sed "s/^X//" >'tcl6.1/compat/opendir.c' <<'END_OF_FILE'
X/*
X * opendir.c --
X *
X * This file provides dirent-style directory-reading procedures
X * for V7 Unix systems that don't have such procedures. The
X * origin of this code is unclear, but it seems to have come
X * originally from Larry Wall.
X *
X */
X
X#include <tclInt.h>
X#include <tclUnix.h>
X
X#undef DIRSIZ
X#define DIRSIZ(dp) \
X ((sizeof (struct dirent) - (MAXNAMLEN+1)) + (((dp)->d_namlen+1 + 3) &~ 3))
X
X/*
X * open a directory.
X */
XDIR *
Xopendir(name)
Xchar *name;
X{
X register DIR *dirp;
X register int fd;
X char *myname;
X
X myname = ((*name == '\0') ? "." : name);
X if ((fd = open(myname, 0, 0)) == -1)
X return NULL;
X if ((dirp = (DIR *)ckalloc(sizeof(DIR))) == NULL) {
X close (fd);
X return NULL;
X }
X dirp->dd_fd = fd;
X dirp->dd_loc = 0;
X return dirp;
X}
X
X/*
X * read an old style directory entry and present it as a new one
X */
X#ifndef pyr
X#define ODIRSIZ 14
X
Xstruct olddirect {
X ino_t od_ino;
X char od_name[ODIRSIZ];
X};
X#else /* a Pyramid in the ATT universe */
X#define ODIRSIZ 248
X
Xstruct olddirect {
X long od_ino;
X short od_fill1, od_fill2;
X char od_name[ODIRSIZ];
X};
X#endif
X
X/*
X * get next entry in a directory.
X */
Xstruct dirent *
Xreaddir(dirp)
Xregister DIR *dirp;
X{
X register struct olddirect *dp;
X static struct dirent dir;
X
X for (;;) {
X if (dirp->dd_loc == 0) {
X dirp->dd_size = read(dirp->dd_fd, dirp->dd_buf,
X DIRBLKSIZ);
X if (dirp->dd_size <= 0)
X return NULL;
X }
X if (dirp->dd_loc >= dirp->dd_size) {
X dirp->dd_loc = 0;
X continue;
X }
X dp = (struct olddirect *)(dirp->dd_buf + dirp->dd_loc);
X dirp->dd_loc += sizeof(struct olddirect);
X if (dp->od_ino == 0)
X continue;
X dir.d_ino = dp->od_ino;
X strncpy(dir.d_name, dp->od_name, ODIRSIZ);
X dir.d_name[ODIRSIZ] = '\0'; /* insure null termination */
X dir.d_namlen = strlen(dir.d_name);
X dir.d_reclen = DIRSIZ(&dir);
X return (&dir);
X }
X}
X
X/*
X * close a directory.
X */
Xvoid
Xclosedir(dirp)
Xregister DIR *dirp;
X{
X close(dirp->dd_fd);
X dirp->dd_fd = -1;
X dirp->dd_loc = 0;
X ckfree((char *) dirp);
X}
END_OF_FILE
if test 1983 -ne `wc -c <'tcl6.1/compat/opendir.c'`; then
echo shar: \"'tcl6.1/compat/opendir.c'\" unpacked with wrong size!
fi
# end of 'tcl6.1/compat/opendir.c'
fi
if test -f 'tcl6.1/compat/stdlib.h' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/compat/stdlib.h'\"
else
echo shar: Extracting \"'tcl6.1/compat/stdlib.h'\" \(1915 characters\)
sed "s/^X//" >'tcl6.1/compat/stdlib.h' <<'END_OF_FILE'
X/*
X * stdlib.h --
X *
X * Declares facilities exported by the "stdlib" portion of
X * the C library. This file isn't complete in the ANSI-C
X * sense; it only declares things that are needed by Tcl.
X * This file is needed even on many systems with their own
X * stdlib.h (e.g. SunOS) because not all stdlib.h files
X * declare all the procedures needed here (such as strtod).
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 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 * $Header: /user6/ouster/tcl/compat/RCS/stdlib.h,v 1.2 91/10/17 10:52:12 ouster Exp $ SPRITE (Berkeley)
X */
X
X#ifndef _STDLIB
X#define _STDLIB
X
X#include <tcl.h>
X
Xextern void abort _ANSI_ARGS_((void));
Xextern double atof _ANSI_ARGS_((char *string));
Xextern int atoi _ANSI_ARGS_((char *string));
Xextern long atol _ANSI_ARGS_((char *string));
Xextern char * calloc _ANSI_ARGS_((unsigned int numElements,
X unsigned int size));
Xextern int exit _ANSI_ARGS_((int status));
Xextern int free _ANSI_ARGS_((char *blockPtr));
Xextern char * getenv _ANSI_ARGS_((char *name));
Xextern char * malloc _ANSI_ARGS_((unsigned int numBytes));
Xextern void qsort _ANSI_ARGS_((char *base, int n, int size,
X int (*compar)(char *element1, char *element2)));
Xextern char * realloc _ANSI_ARGS_((char *ptr, unsigned int numBytes));
Xextern double strtod _ANSI_ARGS_((char *string, char **endPtr));
Xextern long strtol _ANSI_ARGS_((char *string, char **endPtr,
X int base));
Xextern unsigned long strtoul _ANSI_ARGS_((CONST char *string,
X char **endPtr, int base));
X
X#endif /* _STDLIB */
END_OF_FILE
if test 1915 -ne `wc -c <'tcl6.1/compat/stdlib.h'`; then
echo shar: \"'tcl6.1/compat/stdlib.h'\" unpacked with wrong size!
fi
# end of 'tcl6.1/compat/stdlib.h'
fi
if test -f 'tcl6.1/compat/string.h' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/compat/string.h'\"
else
echo shar: Extracting \"'tcl6.1/compat/string.h'\" \(2141 characters\)
sed "s/^X//" >'tcl6.1/compat/string.h' <<'END_OF_FILE'
X/*
X * string.h --
X *
X * Declarations of ANSI C library procedures for string handling.
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 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 * $Header: /sprite/src/lib/tcl/compat/RCS/string.h,v 1.1 91/09/19 16:22:11 ouster Exp $ SPRITE (Berkeley)
X */
X
X#ifndef _STRING
X#define _STRING
X
X#include <tcl.h>
X
Xextern char * memchr _ANSI_ARGS_((char *s, int c, int n));
Xextern int memcmp _ANSI_ARGS_((char *s1, char *s2, int n));
Xextern char * memcpy _ANSI_ARGS_((char *t, char *f, int n));
Xextern char * memmove _ANSI_ARGS_((char *t, char *f, int n));
Xextern char * memset _ANSI_ARGS_((char *s, int c, int n));
X
Xextern int strcasecmp _ANSI_ARGS_((char *s1, char *s2));
Xextern char * strcat _ANSI_ARGS_((char *dst, char *src));
Xextern char * strchr _ANSI_ARGS_((char *string, int c));
Xextern int strcmp _ANSI_ARGS_((char *s1, char *s2));
Xextern char * strcpy _ANSI_ARGS_((char *dst, char *src));
Xextern int strcspn _ANSI_ARGS_((char *string, char *chars));
Xextern char * strdup _ANSI_ARGS_((char *string));
Xextern char * strerror _ANSI_ARGS_((int error));
Xextern int strlen _ANSI_ARGS_((char *string));
Xextern int strncasecmp _ANSI_ARGS_((char *s1, char *s2, int n));
Xextern char * strncat _ANSI_ARGS_((char *dst, char *src,
X int numChars));
Xextern int strncmp _ANSI_ARGS_((char *s1, char *s2, int nChars));
Xextern char * strncpy _ANSI_ARGS_((char *dst, char *src,
X int numChars));
Xextern char * strpbrk _ANSI_ARGS_((char *string, char *chars));
Xextern char * strrchr _ANSI_ARGS_((char *string, int c));
Xextern int strspn _ANSI_ARGS_((char *string, char *chars));
Xextern char * strstr _ANSI_ARGS_((char *string, char *substring));
Xextern char * strtok _ANSI_ARGS_((char *s, char *delim));
X
X#endif /* _STRING */
END_OF_FILE
if test 2141 -ne `wc -c <'tcl6.1/compat/string.h'`; then
echo shar: \"'tcl6.1/compat/string.h'\" unpacked with wrong size!
fi
# end of 'tcl6.1/compat/string.h'
fi
if test -f 'tcl6.1/compat/strstr.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/compat/strstr.c'\"
else
echo shar: Extracting \"'tcl6.1/compat/strstr.c'\" \(1922 characters\)
sed "s/^X//" >'tcl6.1/compat/strstr.c' <<'END_OF_FILE'
X/*
X * strstr.c --
X *
X * Source code for the "strstr" library routine.
X *
X * Copyright 1988-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 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: /sprite/src/lib/tcl/compat/RCS/strstr.c,v 1.1 91/09/19 16:22:12 ouster Exp $ SPRITE (Berkeley)";
X#endif /* not lint */
X
X/*
X *----------------------------------------------------------------------
X *
X * strstr --
X *
X * Locate the first instance of a substring in a string.
X *
X * Results:
X * If string contains substring, the return value is the
X * location of the first matching instance of substring
X * in string. If string doesn't contain substring, the
X * return value is 0. Matching is done on an exact
X * character-for-character basis with no wildcards or special
X * characters.
X *
X * Side effects:
X * None.
X *
X *----------------------------------------------------------------------
X */
X
Xchar *
Xstrstr(string, substring)
X register char *string; /* String to search. */
X char *substring; /* Substring to try to find in string. */
X{
X register char *a, *b;
X
X /* First scan quickly through the two strings looking for a
X * single-character match. When it's found, then compare the
X * rest of the substring.
X */
X
X b = substring;
X if (*b == 0) {
X return string;
X }
X for ( ; *string != 0; string += 1) {
X if (*string != *b) {
X continue;
X }
X a = string;
X while (1) {
X if (*b == 0) {
X return string;
X }
X if (*a++ != *b++) {
X break;
X }
X }
X b = substring;
X }
X return (char *) 0;
X}
END_OF_FILE
if test 1922 -ne `wc -c <'tcl6.1/compat/strstr.c'`; then
echo shar: \"'tcl6.1/compat/strstr.c'\" unpacked with wrong size!
fi
# end of 'tcl6.1/compat/strstr.c'
fi
if test -f 'tcl6.1/compat/testpid.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/compat/testpid.c'\"
else
echo shar: Extracting \"'tcl6.1/compat/testpid.c'\" \(931 characters\)
sed "s/^X//" >'tcl6.1/compat/testpid.c' <<'END_OF_FILE'
X/*
X * testpid.c --
X *
X * This file contains a simple program that will compile
X * correctly if and only if <sys/types.h> defines the
X * type pid_t and uid_t. It is used to determine whether
X * these types are defined on a given system.
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
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/compat/RCS/testpid.c,v 1.1 91/11/07 10:26:53 ouster Exp $ SPRITE (Berkeley)";
X#endif /* not lint */
X
X#include <sys/types.h>
X
Xpid_t pid;
Xuid_t uid;
X
Xint main()
X{
X return 0;
X}
END_OF_FILE
if test 931 -ne `wc -c <'tcl6.1/compat/testpid.c'`; then
echo shar: \"'tcl6.1/compat/testpid.c'\" unpacked with wrong size!
fi
# end of 'tcl6.1/compat/testpid.c'
fi
if test -f 'tcl6.1/compat/testwait.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/compat/testwait.c'\"
else
echo shar: Extracting \"'tcl6.1/compat/testwait.c'\" \(946 characters\)
sed "s/^X//" >'tcl6.1/compat/testwait.c' <<'END_OF_FILE'
X/*
X * testwait.c --
X *
X * This file contains a simple program that will compile
X * correctly if and only if <sys/wait.h> defines the
X * type "union wait". It is used during configuration
X * to determine whether or not to use this type.
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
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/compat/RCS/testwait.c,v 1.1 91/11/07 10:26:56 ouster Exp $ SPRITE (Berkeley)";
X#endif /* not lint */
X
X#include <sys/types.h>
X#include <sys/wait.h>
X
Xunion wait x;
X
Xint main()
X{
X return 0;
X}
END_OF_FILE
if test 946 -ne `wc -c <'tcl6.1/compat/testwait.c'`; then
echo shar: \"'tcl6.1/compat/testwait.c'\" unpacked with wrong size!
fi
# end of 'tcl6.1/compat/testwait.c'
fi
if test ! -d 'tcl6.1/doc' ; then
echo shar: Creating directory \"'tcl6.1/doc'\"
mkdir 'tcl6.1/doc'
fi
if test ! -d 'tcl6.1/library' ; then
echo shar: Creating directory \"'tcl6.1/library'\"
mkdir 'tcl6.1/library'
fi
if test -f 'tcl6.1/library/mkindex.tcl' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/library/mkindex.tcl'\"
else
echo shar: Extracting \"'tcl6.1/library/mkindex.tcl'\" \(1662 characters\)
sed "s/^X//" >'tcl6.1/library/mkindex.tcl' <<'END_OF_FILE'
X# auto_mkindex:
X# Given a directory and a glob-style specification for files in that
X# directory, generate a "tclIndex" file in the directory that is suitable
X# for use in auto-loading. Returns a null string.
X#
X# $Header: /sprite/src/lib/tcl/scripts/RCS/mkindex.tcl,v 1.1 91/09/26 09:55:03 ouster Exp $ SPRITE (Berkeley)
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
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
Xproc auto_mkindex {dir files} {
X set oldDir [pwd]
X cd $dir
X set dir [pwd]
X append index "# Tcl autoload index file: each line identifies a Tcl\n"
X append index "# procedure and the file where that procedure is\n"
X append index "# defined. Generated by the \"auto_mkindex\" command.\n"
X append index "\n"
X foreach file [glob $files] {
X set f ""
X set error [catch {
X set f [open $file]
X while {[gets $f line] >= 0} {
X if [regexp {^proc[ ]+([^ ]*)} $line match indices] {
X set procName [string range $line [lindex $indices 0] \
X [lindex $indices 1]]
X append index "[list $procName $file]\n"
X }
X }
X close $f
X } msg]
X if $error {
X set code $errorCode
X set info $errorInfo
X catch [close $f]
X cd $oldDir
X error $msg $info $code
X }
X }
X set f [open tclIndex w]
X puts $f $index nonewline
X close $f
X cd $oldDir
X}
END_OF_FILE
if test 1662 -ne `wc -c <'tcl6.1/library/mkindex.tcl'`; then
echo shar: \"'tcl6.1/library/mkindex.tcl'\" unpacked with wrong size!
fi
# end of 'tcl6.1/library/mkindex.tcl'
fi
if test -f 'tcl6.1/library/parray.tcl' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/library/parray.tcl'\"
else
echo shar: Extracting \"'tcl6.1/library/parray.tcl'\" \(1001 characters\)
sed "s/^X//" >'tcl6.1/library/parray.tcl' <<'END_OF_FILE'
X# parray:
X# Print the contents of a global array on stdout.
X#
X# $Header: /sprite/src/lib/tcl/scripts/RCS/parray.tcl,v 1.1 91/09/26 09:55:03 ouster Exp $ SPRITE (Berkeley)
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
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
Xproc parray a {
X global $a
X set maxl 0
X foreach name [lsort [array names $a]] {
X if {[string length $name] > $maxl} {
X set maxl [string length $name]
X }
X }
X set maxl [expr {$maxl + [string length $a] + 2}]
X foreach name [lsort [array names $a]] {
X set nameString [format %s(%s) $a $name]
X puts stdout [format "%-*s = %s" $maxl $nameString [set ${a}($name)]]
X }
X}
END_OF_FILE
if test 1001 -ne `wc -c <'tcl6.1/library/parray.tcl'`; then
echo shar: \"'tcl6.1/library/parray.tcl'\" unpacked with wrong size!
fi
# end of 'tcl6.1/library/parray.tcl'
fi
if test -f 'tcl6.1/library/tclIndex' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/library/tclIndex'\"
else
echo shar: Extracting \"'tcl6.1/library/tclIndex'\" \(277 characters\)
sed "s/^X//" >'tcl6.1/library/tclIndex' <<'END_OF_FILE'
X# Tcl autoload index file: each line identifies a Tcl
X# procedure and the file where that procedure is
X# defined. Generated by the "auto_mkindex" command.
X
Xunknown init.tcl
Xauto_load init.tcl
Xauto_execok init.tcl
Xauto_reset init.tcl
Xauto_mkindex mkindex.tcl
Xparray parray.tcl
END_OF_FILE
if test 277 -ne `wc -c <'tcl6.1/library/tclIndex'`; then
echo shar: \"'tcl6.1/library/tclIndex'\" unpacked with wrong size!
fi
# end of 'tcl6.1/library/tclIndex'
fi
if test -f 'tcl6.1/panic.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/panic.c'\"
else
echo shar: Extracting \"'tcl6.1/panic.c'\" \(1603 characters\)
sed "s/^X//" >'tcl6.1/panic.c' <<'END_OF_FILE'
X/*
X * panic.c --
X *
X * Source code for the "panic" library procedure for Tcl;
X * individual applications will probably override this with
X * an application-specific panic procedure.
X *
X * Copyright 1988-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 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/RCS/panic.c,v 1.3 91/10/10 11:25:51 ouster Exp $ SPRITE (Berkeley)";
X#endif
X
X#include <stdio.h>
X#include <stdlib.h>
X
X/*
X *----------------------------------------------------------------------
X *
X * panic --
X *
X * Print an error message and kill the process.
X *
X * Results:
X * None.
X *
X * Side effects:
X * The process dies, entering the debugger if possible.
X *
X *----------------------------------------------------------------------
X */
X
X /* VARARGS ARGSUSED */
Xvoid
Xpanic(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8)
X char *format; /* Format string, suitable for passing to
X * fprintf. */
X char *arg1, *arg2, *arg3; /* Additional arguments (variable in number)
X * to pass to fprintf. */
X char *arg4, *arg5, *arg6, *arg7, *arg8;
X{
X (void) fprintf(stderr, format, arg1, arg2, arg3, arg4, arg5, arg6,
X arg7, arg8);
X (void) fflush(stderr);
X abort();
X}
END_OF_FILE
if test 1603 -ne `wc -c <'tcl6.1/panic.c'`; then
echo shar: \"'tcl6.1/panic.c'\" unpacked with wrong size!
fi
# end of 'tcl6.1/panic.c'
fi
if test -f 'tcl6.1/regexp.h' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/regexp.h'\"
else
echo shar: Extracting \"'tcl6.1/regexp.h'\" \(806 characters\)
sed "s/^X//" >'tcl6.1/regexp.h' <<'END_OF_FILE'
X/*
X * Definitions etc. for regexp(3) routines.
X *
X * Caveat: this is V8 regexp(3) [actually, a reimplementation thereof],
X * not the System V one.
X */
X
X#ifndef _TCL
X#include "tcl.h"
X#endif
X#ifndef _REGEXP
X#define _REGEXP 1
X
X#define NSUBEXP 10
Xtypedef struct regexp {
X char *startp[NSUBEXP];
X char *endp[NSUBEXP];
X char regstart; /* Internal use only. */
X char reganch; /* Internal use only. */
X char *regmust; /* Internal use only. */
X int regmlen; /* Internal use only. */
X char program[1]; /* Unwarranted chumminess with compiler. */
X} regexp;
X
Xextern regexp *regcomp _ANSI_ARGS_((char *exp));
Xextern int regexec _ANSI_ARGS_((regexp *prog, char *string));
Xextern void regsub _ANSI_ARGS_((regexp *prog, char *source, char *dest));
Xextern void regerror _ANSI_ARGS_((char *msg));
X
X#endif /* REGEXP */
END_OF_FILE
if test 806 -ne `wc -c <'tcl6.1/regexp.h'`; then
echo shar: \"'tcl6.1/regexp.h'\" unpacked with wrong size!
fi
# end of 'tcl6.1/regexp.h'
fi
if test ! -d 'tcl6.1/tests' ; then
echo shar: Creating directory \"'tcl6.1/tests'\"
mkdir 'tcl6.1/tests'
fi
if test -f 'tcl6.1/tests/all' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/tests/all'\"
else
echo shar: Extracting \"'tcl6.1/tests/all'\" \(315 characters\)
sed "s/^X//" >'tcl6.1/tests/all' <<'END_OF_FILE'
X# This file contains a top-level script to run all of the Tcl
X# tests. Execute it by invoking "source all" when running tclTest
X# in this directory.
X#
X# $Header: /sprite/src/lib/tcl/tests/RCS/all,v 1.4 91/09/08 13:43:07 ouster Exp $ (Berkeley)
X
Xforeach i [lsort [glob *.test]] {
X puts stdout $i
X source $i
X}
END_OF_FILE
if test 315 -ne `wc -c <'tcl6.1/tests/all'`; then
echo shar: \"'tcl6.1/tests/all'\" unpacked with wrong size!
fi
# end of 'tcl6.1/tests/all'
fi
if test -f 'tcl6.1/tests/concat.test' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/tests/concat.test'\"
else
echo shar: Extracting \"'tcl6.1/tests/concat.test'\" \(1604 characters\)
sed "s/^X//" >'tcl6.1/tests/concat.test' <<'END_OF_FILE'
X# Commands covered: concat
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/concat.test,v 1.4 91/07/23 21:00:59 ouster Exp $ (Berkeley)
X
Xif {[string compare test [info procs test]] == 1} then {source defs}
X
Xtest concat-1.1 {simple concatenation} {
X concat a b c d e f g
X} {a b c d e f g}
Xtest concat-1.2 {merging lists together} {
X concat a {b c d} {e f g h}
X} {a b c d e f g h}
Xtest concat-1.3 {merge lists, retain sub-lists} {
X concat a {b {c d}} {{e f}} g h
X} {a b {c d} {e f} g h}
Xtest concat-1.4 {special characters} {
X concat a\{ {b \{c d} \{d
X} "a{ b \\{c d {d"
X
Xtest concat-2.1 {error: no arguments} {catch concat} 1
Xtest concat-2.2 {error: no arguments} {
X catch concat msg
X set msg
X} {wrong # args: should be "concat arg ?arg ...?"}
X
Xtest concat-3.1 {pruning off extra white space} {
X concat {} {a b c}
X} {a b c}
Xtest concat-3.2 {pruning off extra white space} {
X concat x y " a b c \n\t " " " " def "
X} {x y a b c def}
END_OF_FILE
if test 1604 -ne `wc -c <'tcl6.1/tests/concat.test'`; then
echo shar: \"'tcl6.1/tests/concat.test'\" unpacked with wrong size!
fi
# end of 'tcl6.1/tests/concat.test'
fi
if test -f 'tcl6.1/tests/defs' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/tests/defs'\"
else
echo shar: Extracting \"'tcl6.1/tests/defs'\" \(1884 characters\)
sed "s/^X//" >'tcl6.1/tests/defs' <<'END_OF_FILE'
X# This file contains support code for the Tcl test suite. It is
X# normally sourced by the individual files in the test suite before
X# they run their tests. This improved approach to testing was designed
X# and initially implemented by Mary Ann May-Pumphrey of Sun Microsystems.
X
Xset VERBOSE 0
Xset TESTS {}
Xset auto_noexec 1
Xset auto_noload 1
Xcatch {rename unknown ""}
X
X# If tests are being run as root, issue a warning message and set a
X# variable to prevent some tests from running at all.
X
Xset user {}
Xcatch {set user [exec whoami]}
Xif {$user == "root"} {
X puts stdout "Warning: you're executing as root. I'll have to"
X puts stdout "skip some of the tests, since they'll fail as root."
X}
X
Xproc print_verbose {test_name test_description contents_of_test answer} {
X puts stdout "\n"
X puts stdout "==== $test_name $test_description"
X puts stdout "==== Contents of test case:"
X puts stdout "$contents_of_test"
X puts stdout "==== Result was:"
X puts stdout "$answer"
X}
X
Xproc test {test_name test_description contents_of_test passing_results} {
X global VERBOSE
X global TESTS
X if {[string compare $TESTS ""] != 0} then {
X set ok 0
X foreach test $TESTS {
X if [string match $test $test_name] then {
X set ok 1
X break
X }
X }
X if !$ok then return
X }
X set answer [uplevel $contents_of_test]
X if {[string compare $answer $passing_results] == 0} then {
X if $VERBOSE then {
X print_verbose $test_name $test_description $contents_of_test $answer
X puts stdout "++++ $test_name PASSED"
X }
X } else {
X print_verbose $test_name $test_description $contents_of_test $answer
X puts stdout "---- Result should have been:"
X puts stdout "$passing_results"
X puts stdout "---- $test_name FAILED"
X }
X}
X
Xproc dotests {file args} {
X global TESTS
X set savedTests $TESTS
X set TESTS $args
X source $file
X set TESTS $savedTests
X}
END_OF_FILE
if test 1884 -ne `wc -c <'tcl6.1/tests/defs'`; then
echo shar: \"'tcl6.1/tests/defs'\" unpacked with wrong size!
fi
# end of 'tcl6.1/tests/defs'
fi
if test -f 'tcl6.1/tests/eval.test' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/tests/eval.test'\"
else
echo shar: Extracting \"'tcl6.1/tests/eval.test'\" \(1765 characters\)
sed "s/^X//" >'tcl6.1/tests/eval.test' <<'END_OF_FILE'
X# Commands covered: eval
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/eval.test,v 1.4 91/08/20 14:19:02 ouster Exp $ (Berkeley)
X
Xif {[string compare test [info procs test]] == 1} then {source defs}
X
Xtest eval-1.1 {single argument} {
X eval {format 22}
X} 22
Xtest eval-1.2 {multiple arguments} {
X set a {$b}
X set b xyzzy
X eval format $a
X} xyzzy
Xtest eval-1.3 {single argument} {
X eval concat a b c d e f g
X} {a b c d e f g}
X
Xtest eval-2.1 {error: not enough arguments} {catch eval} 1
Xtest eval-2.2 {error: not enough arguments} {
X catch eval msg
X set msg
X} {wrong # args: should be "eval arg ?arg ...?"}
Xtest eval-2.3 {error in eval'ed command} {
X catch {eval {error "test error"}}
X} 1
Xtest eval-2.4 {error in eval'ed command} {
X catch {eval {error "test error"}} msg
X set msg
X} {test error}
Xtest eval-2.5 {error in eval'ed command: setting errorInfo} {
X catch {eval {
X set a 1
X error "test error"
X }} msg
X set errorInfo
X} "test error
X while executing
X\"error \"test error\"\"
X (\"eval\" body line 3)
X invoked from within
X\"eval {
X set a 1
X error \"test error\"
X }\""
END_OF_FILE
if test 1765 -ne `wc -c <'tcl6.1/tests/eval.test'`; then
echo shar: \"'tcl6.1/tests/eval.test'\" unpacked with wrong size!
fi
# end of 'tcl6.1/tests/eval.test'
fi
if test -f 'tcl6.1/tests/join.test' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/tests/join.test'\"
else
echo shar: Extracting \"'tcl6.1/tests/join.test'\" \(1519 characters\)
sed "s/^X//" >'tcl6.1/tests/join.test' <<'END_OF_FILE'
X# Commands covered: join
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/join.test,v 1.3 91/08/01 17:19:57 ouster Exp $ (Berkeley)
X
Xif {[string compare test [info procs test]] == 1} then {source defs}
X
Xtest join-1.1 {basic join commands} {
X join {a b c} xyz
X} axyzbxyzc
Xtest join-1.2 {basic join commands} {
X join {a b c} {}
X} abc
Xtest join-1.3 {basic join commands} {
X join {} xyz
X} {}
Xtest join-1.4 {basic join commands} {
X join {12 34 56}
X} {12 34 56}
X
Xtest join-2.1 {join errors} {
X list [catch join msg] $msg $errorCode
X} {1 {wrong # args: should be "join list ?joinString?"} NONE}
Xtest join-2.2 {join errors} {
X list [catch {join a b c} msg] $msg $errorCode
X} {1 {wrong # args: should be "join list ?joinString?"} NONE}
Xtest join-2.3 {join errors} {
X list [catch {join "a \{ c" 111} msg] $msg $errorCode
X} {1 {unmatched open brace in list} NONE}
END_OF_FILE
if test 1519 -ne `wc -c <'tcl6.1/tests/join.test'`; then
echo shar: \"'tcl6.1/tests/join.test'\" unpacked with wrong size!
fi
# end of 'tcl6.1/tests/join.test'
fi
if test -f 'tcl6.1/tests/llength.test' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/tests/llength.test'\"
else
echo shar: Extracting \"'tcl6.1/tests/llength.test'\" \(1416 characters\)
sed "s/^X//" >'tcl6.1/tests/llength.test' <<'END_OF_FILE'
X# Commands covered: llength
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/llength.test,v 1.1 91/09/06 14:48:03 ouster Exp $ (Berkeley)
X
Xif {[string compare test [info procs test]] == 1} then {source defs}
X
Xtest llength-1.1 {length of list} {
X llength {a b c d}
X} 4
Xtest llength-1.2 {length of list} {
X llength {a b c {a b {c d}} d}
X} 5
Xtest llength-1.3 {length of list} {
X llength {}
X} 0
X
Xtest llength-2.1 {error conditions} {
X list [catch {llength} msg] $msg
X} {1 {wrong # args: should be "llength list"}}
Xtest llength-2.2 {error conditions} {
X list [catch {llength 123 2} msg] $msg
X} {1 {wrong # args: should be "llength list"}}
Xtest llength-2.3 {error conditions} {
X list [catch {llength "a b c \{"} msg] $msg
X} {1 {unmatched open brace in list}}
END_OF_FILE
if test 1416 -ne `wc -c <'tcl6.1/tests/llength.test'`; then
echo shar: \"'tcl6.1/tests/llength.test'\" unpacked with wrong size!
fi
# end of 'tcl6.1/tests/llength.test'
fi
if test -f 'tcl6.1/tests/lsearch.test' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/tests/lsearch.test'\"
else
echo shar: Extracting \"'tcl6.1/tests/lsearch.test'\" \(1630 characters\)
sed "s/^X//" >'tcl6.1/tests/lsearch.test' <<'END_OF_FILE'
X# Commands covered: lsearch
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/lsearch.test,v 1.1 91/08/21 13:37:25 ouster Exp $ (Berkeley)
X
Xif {[string compare test [info procs test]] == 1} then {source defs}
X
Xset x {abcd bbcd 123 234 345}
Xtest lsearch-1.1 {lsearch command} {
X lsearch $x 123
X} 2
Xtest lsearch-1.2 {lsearch command} {
X lsearch $x 3456
X} -1
Xtest lsearch-1.3 {lsearch command} {
X lsearch $x *5
X} 4
Xtest lsearch-1.4 {lsearch command} {
X lsearch $x *bc*
X} 0
X
Xtest lsearch-2.1 {lsearch errors} {
X list [catch lsearch msg] $msg
X} {1 {wrong # args: should be "lsearch list pattern"}}
Xtest lsearch-2.2 {lsearch errors} {
X list [catch {lsearch a} msg] $msg
X} {1 {wrong # args: should be "lsearch list pattern"}}
Xtest lsearch-2.3 {lsearch errors} {
X list [catch {lsearch a b c} msg] $msg
X} {1 {wrong # args: should be "lsearch list pattern"}}
Xtest lsearch-2.4 {lsearch errors} {
X list [catch {lsearch "\{" b} msg] $msg
X} {1 {unmatched open brace in list}}
END_OF_FILE
if test 1630 -ne `wc -c <'tcl6.1/tests/lsearch.test'`; then
echo shar: \"'tcl6.1/tests/lsearch.test'\" unpacked with wrong size!
fi
# end of 'tcl6.1/tests/lsearch.test'
fi
if test -f 'tcl6.1/tests/lsort.test' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/tests/lsort.test'\"
else
echo shar: Extracting \"'tcl6.1/tests/lsort.test'\" \(1505 characters\)
sed "s/^X//" >'tcl6.1/tests/lsort.test' <<'END_OF_FILE'
X# Commands covered: lsort
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/lsort.test,v 1.1 91/08/21 13:37:25 ouster Exp $ (Berkeley)
X
Xif {[string compare test [info procs test]] == 1} then {source defs}
X
Xtest lsort-1.1 {lsort command} {
X lsort {abdeq ab 1 ac a}
X} {1 a ab abdeq ac}
Xtest lsort-1.2 {lsort command} {
X lsort {{one long element}}
X} {{one long element}}
Xtest lsort-1.3 {lsort command} {
X lsort {}
X} {}
Xtest lsort-1.4 {lsort with characters needing backslashes} {
X lsort {$ \\ [] \{}
X} {{$} {[]} \\ \{}
X
Xtest lsort-2.1 {lsort errors} {
X list [catch lsort msg] $msg
X} {1 {wrong # args: should be "lsort list"}}
Xtest lsort-2.2 {lsort errors} {
X list [catch {lsort a b} msg] $msg
X} {1 {wrong # args: should be "lsort list"}}
Xtest lsort-2.3 {lsort errors} {
X list [catch {lsort "\{"} msg] $msg
X} {1 {unmatched open brace in list}}
END_OF_FILE
if test 1505 -ne `wc -c <'tcl6.1/tests/lsort.test'`; then
echo shar: \"'tcl6.1/tests/lsort.test'\" unpacked with wrong size!
fi
# end of 'tcl6.1/tests/lsort.test'
fi
if test -f 'tcl6.1/tests/split.test' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/tests/split.test'\"
else
echo shar: Extracting \"'tcl6.1/tests/split.test'\" \(1701 characters\)
sed "s/^X//" >'tcl6.1/tests/split.test' <<'END_OF_FILE'
X# Commands covered: split
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/split.test,v 1.2 91/08/11 17:08:26 ouster Exp $ (Berkeley)
X
Xif {[string compare test [info procs test]] == 1} then {source defs}
X
Xtest split-1.1 {basic split commands} {
X split "a\n b\t\r c\n "
X} {a {} b {} {} c {} {}}
Xtest split-1.2 {basic split commands} {
X split "word 1xyzword 2zword 3" xyz
X} {{word 1} {} {} {word 2} {word 3}}
Xtest split-1.3 {basic split commands} {
X split "12345" {}
X} {1 2 3 4 5}
Xtest split-1.4 {basic split commands} {
X split "a\}b\[c\{\]\$"
X} "a}b\\\[c{\\\]\\\$"
Xtest split-1.5 {basic split commands} {
X split {} {}
X} {}
Xtest split-1.6 {basic split commands} {
X split {}
X} {}
Xtest split-1.7 {basic split commands} {
X split { }
X} {{} {} {} {}}
X
Xtest split-2.1 {split errors} {
X list [catch split msg] $msg $errorCode
X} {1 {wrong # args: should be "split string ?splitChars?"} NONE}
Xtest split-2.2 {split errors} {
X list [catch {split a b c} msg] $msg $errorCode
X} {1 {wrong # args: should be "split string ?splitChars?"} NONE}
END_OF_FILE
if test 1701 -ne `wc -c <'tcl6.1/tests/split.test'`; then
echo shar: \"'tcl6.1/tests/split.test'\" unpacked with wrong size!
fi
# end of 'tcl6.1/tests/split.test'
fi
if test -f 'tcl6.1/tests/unknown.test' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/tests/unknown.test'\"
else
echo shar: Extracting \"'tcl6.1/tests/unknown.test'\" \(1948 characters\)
sed "s/^X//" >'tcl6.1/tests/unknown.test' <<'END_OF_FILE'
X# Commands covered: unknown
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/unknown.test,v 1.3 91/08/21 13:53:23 ouster Exp $ (Berkeley)
X
Xif {[string compare test [info procs test]] == 1} then {source defs}
X
Xcatch {rename unknown {}}
X
Xtest unknown-1.1 {non-existent "unknown" command} {
X list [catch {_non-existent_ foo bar} msg] $msg
X} {1 {invalid command name: "_non-existent_"}}
X
Xproc unknown {args} {
X global x
X set x $args
X}
X
Xtest unknown-2.1 {calling "unknown" command} {
X foobar x y z
X set x
X} {foobar x y z}
Xtest unknown-2.2 {calling "unknown" command with lots of args} {
X foobar 1 2 3 4 5 6 7
X set x
X} {foobar 1 2 3 4 5 6 7}
Xtest unknown-2.3 {calling "unknown" command with lots of args} {
X foobar 1 2 3 4 5 6 7 8
X set x
X} {foobar 1 2 3 4 5 6 7 8}
Xtest unknown-2.4 {calling "unknown" command with lots of args} {
X foobar 1 2 3 4 5 6 7 8 9
X set x
X} {foobar 1 2 3 4 5 6 7 8 9}
X
Xtest unknown-3.1 {argument quoting in calls to "unkown"} {
X foobar \{ \} a\{b \; "\\" \$a a\[b \]
X set x
X} "foobar \\{ \} a\{b {;} \\\\ {\$a} {a\[b} \\]"
X
Xproc unknown args {
X error "unknown failed"
X}
X
Xtest unknown-4.1 {errors in "unknown" procedure} {
X list [catch {non-existent a b} msg] $msg $errorCode
X} {1 {unknown failed} NONE}
X
Xcatch {rename unknown {}}
Xreturn {}
END_OF_FILE
if test 1948 -ne `wc -c <'tcl6.1/tests/unknown.test'`; then
echo shar: \"'tcl6.1/tests/unknown.test'\" unpacked with wrong size!
fi
# end of 'tcl6.1/tests/unknown.test'
fi
echo shar: End of archive 1 \(of 33\).
cp /dev/null ark1isdone
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: ke...@sparky.IMD.Sterling.COM
Sterling Software, IMD UUCP: uunet!sparky!kent
Phone: (402) 291-8300 FAX: (402) 291-4362
Please send comp.sources.misc-related mail to ke...@uunet.uu.net.

Karl Lehenbauer

unread,
Nov 14, 1991, 3:25:36 PM11/14/91
to
Submitted-by: ka...@sugar.neosoft.com (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

Karl Lehenbauer

unread,
Nov 14, 1991, 3:26:07 PM11/14/91
to
Submitted-by: ka...@sugar.neosoft.com (Karl Lehenbauer)
Posting-number: Volume 25, Issue 71
Archive-name: tcl/part03
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 3 (of 33)."
# Contents: tcl6.1/compat/strtoul.c tcl6.1/doc/StrMatch.man
# tcl6.1/library/init.tcl tcl6.1/tclGet.c tcl6.1/tclHash.h
# tcl6.1/tests/README tcl6.1/tests/error.test tcl6.1/tests/for.test
# tcl6.1/tests/glob.test tcl6.1/tests/if.test
# Wrapped by karl@one on Tue Nov 12 19:44:12 1991


PATH=/bin:/usr/bin:/usr/ucb ; export PATH

if test -f 'tcl6.1/compat/strtoul.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/compat/strtoul.c'\"
else
echo shar: Extracting \"'tcl6.1/compat/strtoul.c'\" \(4318 characters\)
sed "s/^X//" >'tcl6.1/compat/strtoul.c' <<'END_OF_FILE'
X/*
X * strtoul.c --
X *
X * Source code for the "strtoul" 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/strtoul.c,v 1.2 91/09/22 14:04:43 ouster Exp $ SPRITE (Berkeley)";


X#endif /* not lint */
X

X#include <ctype.h>
X
X/*
X * The table below is used to convert from ASCII digits to a
X * numerical equivalent. It maps from '0' through 'z' to integers
X * (100 for non-digit characters).
X */
X
Xstatic char cvtIn[] = {
X 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, /* '0' - '9' */
X 100, 100, 100, 100, 100, 100, 100, /* punctuation */
X 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, /* 'A' - 'Z' */
X 20, 21, 22, 23, 24, 25, 26, 27, 28, 29,
X 30, 31, 32, 33, 34, 35,
X 100, 100, 100, 100, 100, 100, /* punctuation */
X 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, /* 'a' - 'z' */
X 20, 21, 22, 23, 24, 25, 26, 27, 28, 29,
X 30, 31, 32, 33, 34, 35};


X
X/*
X *----------------------------------------------------------------------
X *

X * strtoul --
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

Xunsigned long int
Xstrtoul(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 register unsigned long int result = 0;
X register unsigned digit;
X int anyDigits = 0;


X
X /*
X * Skip any leading blanks.
X */
X
X p = string;
X while (isspace(*p)) {
X p += 1;
X }
X
X /*

X * If no base was provided, pick one from the leading characters
X * of the string.
X */
X
X if (base == 0)
X {
X if (*p == '0') {
X p += 1;
X if (*p == 'x') {
X p += 1;
X base = 16;
X } else {
X
X /*
X * Must set anyDigits here, otherwise "0" produces a
X * "no digits" error.
X */
X
X anyDigits = 1;
X base = 8;
X }
X }
X else base = 10;
X } else if (base == 16) {
X
X /*
X * Skip a leading "0x" from hex numbers.
X */
X
X if ((p[0] == '0') && (p[1] == 'x')) {
X p += 2;
X }
X }
X
X /*
X * Sorry this code is so messy, but speed seems important. Do
X * different things for base 8, 10, 16, and other.
X */
X
X if (base == 8) {
X for ( ; ; p += 1) {
X digit = *p - '0';
X if (digit > 7) {
X break;
X }
X result = (result << 3) + digit;
X anyDigits = 1;
X }
X } else if (base == 10) {
X for ( ; ; p += 1) {
X digit = *p - '0';
X if (digit > 9) {
X break;
X }
X result = (10*result) + digit;
X anyDigits = 1;
X }
X } else if (base == 16) {
X for ( ; ; p += 1) {
X digit = *p - '0';
X if (digit > ('z' - '0')) {
X break;
X }
X digit = cvtIn[digit];
X if (digit > 15) {
X break;
X }
X result = (result << 4) + digit;
X anyDigits = 1;
X }
X } else {
X for ( ; ; p += 1) {
X digit = *p - '0';
X if (digit > ('z' - '0')) {
X break;
X }
X digit = cvtIn[digit];
X if (digit >= base) {
X break;
X }
X result = result*base + digit;
X anyDigits = 1;
X }
X }
X
X /*
X * See if there were any digits at all.
X */
X
X if (!anyDigits) {


X p = string;
X }

X
X if (endPtr != 0) {
X *endPtr = p;
X }


X
X return result;
X}
END_OF_FILE

if test 4318 -ne `wc -c <'tcl6.1/compat/strtoul.c'`; then
echo shar: \"'tcl6.1/compat/strtoul.c'\" unpacked with wrong size!
fi
# end of 'tcl6.1/compat/strtoul.c'
fi
if test -f 'tcl6.1/doc/StrMatch.man' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/doc/StrMatch.man'\"
else
echo shar: Extracting \"'tcl6.1/doc/StrMatch.man'\" \(4906 characters\)
sed "s/^X//" >'tcl6.1/doc/StrMatch.man' <<'END_OF_FILE'
X'\" Copyright 1989 Regents of the University of California
X'\" Permission to use, copy, modify, and distribute this
X'\" documentation for any purpose and without fee is hereby
X'\" granted, provided that this notice appears in all copies.
X'\" The University of California makes no representations about
X'\" the suitability of this material for any purpose. It is
X'\" provided "as is" without express or implied warranty.
X'\"
X'\" $Header: /user6/ouster/tcl/doc/RCS/StrMatch.man,v 1.2 91/04/03 15:14:14 ouster Exp $ SPRITE (Berkeley)
X'\"
X.\" The definitions below are for supplemental macros used in Sprite
X.\" manual entries.
X.\"
X.\" .HS name section [date [version]]
X.\" Replacement for .TH in other man pages. See below for valid
X.\" section names.
X.\"
X.\" .AP type name in/out [indent]
X.\" Start paragraph describing an argument to a library procedure.
X.\" type is type of argument (int, etc.), in/out is either "in", "out",
X.\" or "in/out" to describe whether procedure reads or modifies arg,
X.\" and indent is equivalent to second arg of .IP (shouldn't ever be
X.\" needed; use .AS below instead)
X.\"
X.\" .AS [type [name]]
X.\" Give maximum sizes of arguments for setting tab stops. Type and
X.\" name are examples of largest possible arguments that will be passed
X.\" to .AP later. If args are omitted, default tab stops are used.
X.\"
X.\" .BS
X.\" Start box enclosure. From here until next .BE, everything will be
X.\" enclosed in one large box.
X.\"
X.\" .BE
X.\" End of box enclosure.
X.\"
X.\" .VS
X.\" Begin vertical sidebar, for use in marking newly-changed parts
X.\" of man pages.
X.\"
X.\" .VE
X.\" End of vertical sidebar.
X.\"
X.\" .DS
X.\" Begin an indented unfilled display.
X.\"
X.\" .DE
X.\" End of indented unfilled display.
X.\"
X' # Heading for Sprite man pages
X.de HS
X.if '\\$2'cmds' .TH \\$1 1 \\$3 \\$4
X.if '\\$2'lib' .TH \\$1 3 \\$3 \\$4
X.if '\\$2'tcl' .TH \\$1 3 \\$3 \\$4
X.if '\\$2'tk' .TH \\$1 3 \\$3 \\$4
X.if t .wh -1.3i ^B
X.nr ^l \\n(.l
X.ad b
X..
X' # Start an argument description
X.de AP
X.ie !"\\$4"" .TP \\$4
X.el \{\
X. ie !"\\$2"" .TP \\n()Cu
X. el .TP 15
X.\}
X.ie !"\\$3"" \{\
X.ta \\n()Au \\n()Bu
X\&\\$1 \\fI\\$2\\fP (\\$3)
X.\".b
X.\}
X.el \{\
X.br
X.ie !"\\$2"" \{\
X\&\\$1 \\fI\\$2\\fP
X.\}
X.el \{\
X\&\\fI\\$1\\fP
X.\}
X.\}
X..
X' # define tabbing values for .AP
X.de AS
X.nr )A 10n
X.if !"\\$1"" .nr )A \\w'\\$1'u+3n
X.nr )B \\n()Au+15n
X.\"
X.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+3n
X.nr )C \\n()Bu+\\w'(in/out)'u+2n
X..
X' # BS - start boxed text
X' # ^y = starting y location
X' # ^b = 1
X.de BS
X.br
X.mk ^y
X.nr ^b 1u
X.if n .nf
X.if n .ti 0
X.if n \l'\\n(.lu\(ul'
X.if n .fi
X..
X' # BE - end boxed text (draw box now)
X.de BE
X.nf
X.ti 0
X.mk ^t
X.ie n \l'\\n(^lu\(ul'
X.el \{\
X.\" Draw four-sided box normally, but don't draw top of
X.\" box if the box started on an earlier page.
X.ie !\\n(^b-1 \{\
X\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul'
X.\}
X.el \}\
X\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul'
X.\}
X.\}
X.fi
X.br
X.nr ^b 0
X..
X' # VS - start vertical sidebar
X' # ^Y = starting y location
X' # ^v = 1 (for troff; for nroff this doesn't matter)
X.de VS
X.mk ^Y
X.ie n 'mc \s12\(br\s0
X.el .nr ^v 1u
X..
X' # VE - end of vertical sidebar
X.de VE
X.ie n 'mc
X.el \{\
X.ev 2
X.nf
X.ti 0
X.mk ^t
X\h'|\\n(^lu+3n'\L'|\\n(^Yu-1v\(bv'\v'\\n(^tu+1v-\\n(^Yu'\h'-|\\n(^lu+3n'
X.sp -1
X.fi
X.ev
X.\}
X.nr ^v 0
X..
X' # Special macro to handle page bottom: finish off current
X' # box/sidebar if in box/sidebar mode, then invoked standard
X' # page bottom macro.
X.de ^B
X.ev 2
X'ti 0
X'nf
X.mk ^t
X.if \\n(^b \{\
X.\" Draw three-sided box if this is the box's first page,
X.\" draw two sides but no top otherwise.
X.ie !\\n(^b-1 \h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c
X.el \h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c
X.\}
X.if \\n(^v \{\
X.nr ^x \\n(^tu+1v-\\n(^Yu
X\kx\h'-\\nxu'\h'|\\n(^lu+3n'\ky\L'-\\n(^xu'\v'\\n(^xu'\h'|0u'\c
X.\}
X.bp
X'fi
X.ev
X.if \\n(^b \{\
X.mk ^y
X.nr ^b 2
X.\}
X.if \\n(^v \{\
X.mk ^Y
X.\}
X..
X' # DS - begin display
X.de DS
X.RS
X.nf
X.sp
X..
X' # DE - end display
X.de DE
X.fi
X.RE
X.sp .5
X..
X.HS Tcl_StringMatch tcl
X.BS
X.SH NAME
XTcl_StringMatch \- test whether a string matches a pattern
X.SH SYNOPSIS
X.nf
X\fB#include <tcl.h>\fR
X.sp
Xint
X\Tcl_StringMatch\fR(\fIstring\fR, \fIpattern\fR)
X.SH ARGUMENTS
X.AP char *string in
XString to test.
X.AP char *pattern in
XPattern to match against string. May contain special
Xcharacters from the set *?\e[].
X.BE
X
X.SH DESCRIPTION
X.PP
XThis utility procedure determines whether a string matches
Xa given pattern. If it does, then \fBTcl_StringMatch\fR returns
X1. Otherwise \fBTcl_StringMatch\fR returns 0. The algorithm
Xused for matching is the same algorithm used in the ``string match''
XTcl command and is similar to the algorithm used by the C-shell
Xfor file name matching; see the Tcl manual entry for details.
X
X.SH KEYWORDS
Xmatch, pattern, string
END_OF_FILE
if test 4906 -ne `wc -c <'tcl6.1/doc/StrMatch.man'`; then
echo shar: \"'tcl6.1/doc/StrMatch.man'\" unpacked with wrong size!
fi
# end of 'tcl6.1/doc/StrMatch.man'
fi
if test -f 'tcl6.1/library/init.tcl' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/library/init.tcl'\"
else
echo shar: Extracting \"'tcl6.1/library/init.tcl'\" \(3973 characters\)
sed "s/^X//" >'tcl6.1/library/init.tcl' <<'END_OF_FILE'
X# init.tcl --
X#
X# Default system startup file for Tcl-based applications. Defines
X# "unknown" procedure and auto-load facilities.
X#
X# $Header: /sprite/src/lib/tcl/scripts/RCS/init.tcl,v 1.2 91/09/26 10:05:45 ouster Exp $ SPRITE (Berkeley)


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
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# unknown:
X# Invoked when a Tcl command is invoked that doesn't exist in the
X# interpreter:
X#
X# 1. See if the autoload facility can locate the command in a
X# Tcl script file. If so, load it and execute it.
X# 2. See if the command exists as an executable UNIX program.
X# If so, "exec" the command.
X# 3. See if the command is a valid abbreviation for another command.
X# if so, invoke the command. However, only permit abbreviations
X# at top-level.
X
Xproc unknown args {
X global auto_noexec auto_noload env unknown_active
X
X if [info exists unknown_active] {
X unset unknown_active
X error "unexpected recursion in \"unknown\" command"
X }
X set unknown_active 1
X set name [lindex $args 0]
X if ![info exists auto_noload] {
X if [auto_load $name] {
X unset unknown_active
X return [uplevel $args]
X }
X }
X if ![info exists auto_noexec] {
X if [auto_execok $name] {
X unset unknown_active
X return [uplevel exec $args]
X }
X }
X if {([info level] == 1) && ([info script] == "")} {
X set cmds [info commands $name*]
X if {[llength $cmds] == 1} {
X unset unknown_active
X return [uplevel [lreplace $args 0 0 $cmds]]
X }
X if {[llength $cmds] != 0} {
X unset unknown_active
X error "ambiguous command name \"$name\": $cmds"
X }
X }
X unset unknown_active
X error "invalid command name \"$name\""
X}
X
X# auto_load:
X# Checks a collection of library directories to see if a procedure
X# is defined in one of them. If so, it sources the appropriate
X# library file to create the procedure. Returns 1 if it successfully
X# loaded the procedure, 0 otherwise.
X
Xproc auto_load cmd {
X global auto_index auto_path env
X
X if [info exists auto_index($cmd)] {
X source $auto_index($cmd)
X return 1
X }
X if [catch {set path $auto_path}] {
X if [catch {set path $env(TCLLIBPATH)}] {
X if [catch {set path [info library]}] {
X return 0
X }
X }
X }
X foreach dir $path {
X set f ""
X catch {
X set f [open $dir/tclIndex]
X if {[gets $f] != "# Tcl autoload index file: each line identifies a Tcl"} {
X puts stdout "Bad id line in file $dir/tclIndex"
X error done
X }


X while {[gets $f line] >= 0} {

X if {([string index $line 0] == "#") || ([llength $line] != 2)} {
X continue
X }
X set name [lindex $line 0]
X if {![info exists auto_index($name)]} {
X set auto_index($name) $dir/[lindex $line 1]
X }
X }
X }
X if {$f != ""} {
X close $f
X }
X }
X if [info exists auto_index($cmd)] {
X source $auto_index($cmd)
X return 1


X }
X return 0
X}

X
X# auto_execok:
X# Returns 1 if there's an executable in the current path for the
X# given name, 0 otherwise. Builds an associative array auto_execs
X# that caches information about previous checks, for speed.
X
Xproc auto_execok name {
X global auto_execs env
X
X if [info exists auto_execs($name)] {
X return $auto_execs($name)
X }
X set auto_execs($name) 0
X foreach dir [split $env(PATH) :] {
X if {[file executable $dir/$name] && ![file isdirectory $dir/$name]} {
X set auto_execs($name) 1
X return 1
X }


X }
X return 0
X}

X
X# auto_reset:
X# Destroy all cached information for auto-loading and auto-execution,
X# so that the information gets recomputed the next time it's needed.
X
Xproc auto_reset {} {
X global auto_execs auto_index
X unset auto_execs auto_index
X}
END_OF_FILE
if test 3973 -ne `wc -c <'tcl6.1/library/init.tcl'`; then
echo shar: \"'tcl6.1/library/init.tcl'\" unpacked with wrong size!
fi
# end of 'tcl6.1/library/init.tcl'
fi
if test -f 'tcl6.1/tclGet.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/tclGet.c'\"
else
echo shar: Extracting \"'tcl6.1/tclGet.c'\" \(5017 characters\)
sed "s/^X//" >'tcl6.1/tclGet.c' <<'END_OF_FILE'
X/*
X * tclGet.c --
X *
X * This file contains procedures to convert strings into
X * other forms, like integers or floating-point numbers or
X * booleans, doing syntax checking along the way.
X *
X * Copyright 1990-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 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/RCS/tclGet.c,v 1.10 91/09/04 16:53:25 ouster Exp $ SPRITE (Berkeley)";


X#endif /* not lint */
X

X#include "tclInt.h"
X
Xdouble strtod();
X


X
X/*
X *----------------------------------------------------------------------
X *

X * Tcl_GetInt --
X *
X * Given a string, produce the corresponding integer value.


X *
X * Results:

X * The return value is normally TCL_OK; in this case *intPtr
X * will be set to the integer value equivalent to string. If
X * string is improperly formed then TCL_ERROR is returned and
X * an error message will be left in interp->result.


X *
X * Side effects:
X * None.
X *
X *----------------------------------------------------------------------
X */
X

Xint
XTcl_GetInt(interp, string, intPtr)
X Tcl_Interp *interp; /* Interpreter to use for error reporting. */
X char *string; /* String containing a (possibly signed)
X * integer in a form acceptable to strtol. */
X int *intPtr; /* Place to store converted result. */
X{
X char *end;
X int i;
X
X i = strtol(string, &end, 0);
X while ((*end != '\0') && isspace(*end)) {
X end++;
X }
X if ((end == string) || (*end != 0)) {
X Tcl_AppendResult(interp, "expected integer but got \"", string,
X "\"", (char *) NULL);
X return TCL_ERROR;
X }
X *intPtr = i;
X return TCL_OK;
X}


X
X/*
X *----------------------------------------------------------------------
X *

X * Tcl_GetDouble --
X *
X * Given a string, produce the corresponding double-precision
X * floating-point value.


X *
X * Results:

X * The return value is normally TCL_OK; in this case *doublePtr
X * will be set to the double-precision value equivalent to string.
X * If string is improperly formed then TCL_ERROR is returned and
X * an error message will be left in interp->result.


X *
X * Side effects:
X * None.
X *
X *----------------------------------------------------------------------
X */
X

Xint
XTcl_GetDouble(interp, string, doublePtr)
X Tcl_Interp *interp; /* Interpreter to use for error reporting. */
X char *string; /* String containing a floating-point number
X * in a form acceptable to strtod. */
X double *doublePtr; /* Place to store converted result. */
X{
X char *end;
X double d;
X
X d = strtod(string, &end);
X while ((*end != '\0') && isspace(*end)) {
X end++;
X }
X if ((end == string) || (*end != 0)) {
X Tcl_AppendResult(interp, "expected floating-point number but got \"",
X string, "\"", (char *) NULL);
X return TCL_ERROR;
X }
X *doublePtr = d;
X return TCL_OK;
X}


X
X/*
X *----------------------------------------------------------------------
X *

X * Tcl_GetBoolean --
X *
X * Given a string, return a 0/1 boolean value corresponding
X * to the string.


X *
X * Results:

X * The return value is normally TCL_OK; in this case *boolPtr
X * will be set to the 0/1 value equivalent to string. If
X * string is improperly formed then TCL_ERROR is returned and
X * an error message will be left in interp->result.


X *
X * Side effects:
X * None.
X *
X *----------------------------------------------------------------------
X */
X

Xint
XTcl_GetBoolean(interp, string, boolPtr)
X Tcl_Interp *interp; /* Interpreter to use for error reporting. */
X char *string; /* String containing a boolean number
X * specified either as 1/0 or true/false or
X * yes/no. */
X int *boolPtr; /* Place to store converted result, which
X * will be 0 or 1. */
X{
X char c;
X char lowerCase[10];
X int i, length;
X
X /*
X * Convert the input string to all lower-case.
X */
X
X for (i = 0; i < 9; i++) {
X c = string[i];
X if (c == 0) {
X break;
X }
X if ((c >= 'A') && (c <= 'Z')) {
X c += 'a' - 'A';
X }
X lowerCase[i] = c;
X }
X lowerCase[i] = 0;
X
X length = strlen(lowerCase);
X c = lowerCase[0];
X if ((c == '0') && (lowerCase[1] == '\0')) {
X *boolPtr = 0;
X } else if ((c == '1') && (lowerCase[1] == '\0')) {
X *boolPtr = 1;
X } else if ((c == 'y') && (strncmp(lowerCase, "yes", length) == 0)) {
X *boolPtr = 1;
X } else if ((c == 'n') && (strncmp(lowerCase, "no", length) == 0)) {
X *boolPtr = 0;
X } else if ((c == 't') && (strncmp(lowerCase, "true", length) == 0)) {
X *boolPtr = 1;
X } else if ((c == 'f') && (strncmp(lowerCase, "false", length) == 0)) {
X *boolPtr = 0;
X } else {
X Tcl_AppendResult(interp, "expected boolean value but got \"",
X string, "\"", (char *) NULL);
X return TCL_ERROR;
X }
X return TCL_OK;
X}
END_OF_FILE
if test 5017 -ne `wc -c <'tcl6.1/tclGet.c'`; then
echo shar: \"'tcl6.1/tclGet.c'\" unpacked with wrong size!
fi
# end of 'tcl6.1/tclGet.c'
fi
if test -f 'tcl6.1/tclHash.h' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/tclHash.h'\"
else
echo shar: Extracting \"'tcl6.1/tclHash.h'\" \(4968 characters\)
sed "s/^X//" >'tcl6.1/tclHash.h' <<'END_OF_FILE'
X/*
X * tclHash.h --
X *
X * This header file declares the facilities provided by the
X * Tcl hash table procedures.


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 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 * $Header: /sprite/src/lib/tcl/RCS/tclHash.h,v 1.3 91/08/27 11:36:04 ouster Exp $ SPRITE (Berkeley)
X */
X
X#ifndef _TCLHASH
X#define _TCLHASH


X
X#ifndef _TCL
X#include <tcl.h>
X#endif
X
X/*

X * Structure definition for an entry in a hash table. No-one outside
X * Tcl should access any of these fields directly; use the macros
X * defined below.
X */
X
Xtypedef struct Tcl_HashEntry {
X struct Tcl_HashEntry *nextPtr; /* Pointer to next entry in this
X * hash bucket, or NULL for end of
X * chain. */
X struct Tcl_HashTable *tablePtr; /* Pointer to table containing entry. */
X struct Tcl_HashEntry **bucketPtr; /* Pointer to bucket that points to
X * first entry in this entry's chain:
X * used for deleting the entry. */
X ClientData clientData; /* Application stores something here
X * with Tcl_SetHashValue. */
X union { /* Key has one of these forms: */
X char *oneWordValue; /* One-word value for key. */
X int words[1]; /* Multiple integer words for key.
X * The actual size will be as large
X * as necessary for this table's
X * keys. */
X char string[4]; /* String for key. The actual size
X * will be as large as needed to hold
X * the key. */
X } key; /* MUST BE LAST FIELD IN RECORD!! */
X} Tcl_HashEntry;
X
X/*
X * Structure definition for a hash table. Must be in tcl.h so clients
X * can allocate space for these structures, but clients should never
X * access any fields in this structure.
X */
X
X#define TCL_SMALL_HASH_TABLE 4
Xtypedef struct Tcl_HashTable {
X Tcl_HashEntry **buckets; /* Pointer to bucket array. Each
X * element points to first entry in
X * bucket's hash chain, or NULL. */
X Tcl_HashEntry *staticBuckets[TCL_SMALL_HASH_TABLE];
X /* Bucket array used for small tables
X * (to avoid mallocs and frees). */
X int numBuckets; /* Total number of buckets allocated
X * at **bucketPtr. */
X int numEntries; /* Total number of entries present
X * in table. */
X int rebuildSize; /* Enlarge table when numEntries gets
X * to be this large. */
X int downShift; /* Shift count used in hashing
X * function. Designed to use high-
X * order bits of randomized keys. */
X int mask; /* Mask value used in hashing
X * function. */
X int keyType; /* Type of keys used in this table.
X * It's either TCL_STRING_KEYS,
X * TCL_ONE_WORD_KEYS, or an integer
X * giving the number of ints in a
X */
X Tcl_HashEntry *(*findProc) _ANSI_ARGS_((struct Tcl_HashTable *tablePtr,
X char *key));
X Tcl_HashEntry *(*createProc) _ANSI_ARGS_((struct Tcl_HashTable *tablePtr,
X char *key, int *newPtr));
X} Tcl_HashTable;
X
X/*
X * Structure definition for information used to keep track of searches
X * through hash tables:
X */
X
Xtypedef struct Tcl_HashSearch {
X Tcl_HashTable *tablePtr; /* Table being searched. */
X int nextIndex; /* Index of next bucket to be
X * enumerated after present one. */
X Tcl_HashEntry *nextEntryPtr; /* Next entry to be enumerated in the
X * the current bucket. */
X} Tcl_HashSearch;
X
X/*
X * Acceptable key types for hash tables:
X */
X
X#define TCL_STRING_KEYS 0
X#define TCL_ONE_WORD_KEYS 1
X
X/*
X * Macros for clients to use to access fields of hash entries:
X */
X
X#define Tcl_GetHashValue(h) ((h)->clientData)
X#define Tcl_SetHashValue(h, value) ((h)->clientData = (ClientData) (value))
X#define Tcl_GetHashKey(tablePtr, h) \
X ((char *) (((tablePtr)->keyType == TCL_ONE_WORD_KEYS) ? (h)->key.oneWordValue \
X : (h)->key.string))
X
X/*
X * Macros to use for clients to use to invoke find and create procedures
X * for hash tables:
X */
X
X#define Tcl_FindHashEntry(tablePtr, key) \
X (*((tablePtr)->findProc))(tablePtr, key)
X#define Tcl_CreateHashEntry(tablePtr, key, newPtr) \
X (*((tablePtr)->createProc))(tablePtr, key, newPtr)
X
X/*
X * Exported procedures:
X */
X
Xextern void Tcl_DeleteHashEntry _ANSI_ARGS_((
X Tcl_HashEntry *entryPtr));
Xextern void Tcl_DeleteHashTable _ANSI_ARGS_((
X Tcl_HashTable *tablePtr));
Xextern Tcl_HashEntry * Tcl_FirstHashEntry _ANSI_ARGS_((
X Tcl_HashTable *tablePtr,
X Tcl_HashSearch *searchPtr));
Xextern char * Tcl_HashStats _ANSI_ARGS_((Tcl_HashTable *tablePtr));
Xextern void Tcl_InitHashTable _ANSI_ARGS_((Tcl_HashTable *tablePtr,
X int keyType));
Xextern Tcl_HashEntry * Tcl_NextHashEntry _ANSI_ARGS_((
X Tcl_HashSearch *searchPtr));
X
X#endif /* _TCLHASH */
END_OF_FILE
if test 4968 -ne `wc -c <'tcl6.1/tclHash.h'`; then
echo shar: \"'tcl6.1/tclHash.h'\" unpacked with wrong size!
fi
# end of 'tcl6.1/tclHash.h'
fi
if test -f 'tcl6.1/tests/README' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/tests/README'\"
else
echo shar: Extracting \"'tcl6.1/tests/README'\" \(3434 characters\)
sed "s/^X//" >'tcl6.1/tests/README' <<'END_OF_FILE'
XTcl Test Suite
X--------------
X
XThis directory contains a set of validation tests for the Tcl
Xcommands. Each of the files whose name ends in ".test" is
Xintended to fully exercise one or a few Tcl commands. The
Xcommands tested by a given file are listed in the first line
Xof the file.
X
XThe simplest way to run a test is to start up tclTest in this
Xdirectory and "source" the test file (for example, type "source
Xparse.test"). To run all of the tests, type "source all". If
Xall goes well then no output will appear. If there are errors
Xthen messages will appear in the format described below.
X
XThe rest of this file provides additional information on the
Xfeatures of the testing environment.
X
XThis approach to testing was designed and initially implemented
Xby Mary Ann May-Pumphrey of Sun Microsystems. Many thanks to
Xher for donating her work back to the public Tcl release.
X
XDefinitions file:
X-----------------
X
XThe file "defs" defines a collection of procedures and variables
Xused to run the tests. It is read in automatically by each of the
X.test files if needed, but once it has been read once it will not
Xbe read again by the .test files. If you change defs while running
Xtests you'll have to "source" it by hand to load its new contents.
X
XTest output:
X------------
X
XNormally, output only appears when there are errors. However, if
Xthe variable VERBOSE is set to 1 then tests will be run in "verbose"
Xmode and output will be generated for each test regardless of
Xwhether it succeeded or failed. Test output consists of the
Xfollowing information:
X
X - the test identifier (which can be used to locate the test code
X in the .test file)
X - a brief description of the test
X - the contents of the test code
X - the actual results produced by the tests
X - a "PASSED" or "FAILED" message
X - the expected results (if the test failed)
X
XYou can set VERBOSE either interactively (after the defs file has been
Xread in), or you can change the default value in "defs".
X
XSelecting tests for execution:
X------------------------------
X
XNormally, all the tests in a file are run whenever the file is
X"source"d. However, you can select a specific set of tests using
Xthe global variable TESTS. This variable contains a pattern; any
Xtest whose identifier matches TESTS will be run. For example,
Xthe following interactive command causes all of the "for" tests in
Xgroups 2 and 4 to be executed:
X
X set TESTS {for-[24]*}
X
XTESTS defaults to *, but you can change the default in "defs" if
Xyou wish.
X
XSaving keystrokes:
X------------------
X
XA convenience procedure named "dotests" is included in file
X"defs". It takes two arguments--the name of the test file (such
Xas "parse.test"), and a pattern selecting the tests you want to
Xexecute. It sets TESTS to the second argument, calls "source" on
Xthe file specified in the first argument, and restores TESTS to
Xits pre-call value at the end.
X
XBatch vs. interactive execution:
X--------------------------------
X
XThe tests can be run in either batch or interactive mode. Batch
Xmode refers to using I/O redirection from a UNIX shell. For example,
Xthe following command causes the tests in the file named "parse.test"
Xto be executed:
X
X tclTest < parse.test > parse.test.results
X
XUsers who want to execute the tests in this fashion need to first
Xensure that the file "defs" has proper values for the global
Xvariables that control the testing environment (VERBOSE and TESTS).
END_OF_FILE
if test 3434 -ne `wc -c <'tcl6.1/tests/README'`; then
echo shar: \"'tcl6.1/tests/README'\" unpacked with wrong size!
fi
# end of 'tcl6.1/tests/README'
fi
if test -f 'tcl6.1/tests/error.test' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/tests/error.test'\"
else
echo shar: Extracting \"'tcl6.1/tests/error.test'\" \(5000 characters\)
sed "s/^X//" >'tcl6.1/tests/error.test' <<'END_OF_FILE'
X# Commands covered: error, catch


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/error.test,v 1.11 91/08/20 14:18:52 ouster Exp $ (Berkeley)


X
Xif {[string compare test [info procs test]] == 1} then {source defs}
X

Xproc foo {} {
X global errorInfo
X set a [catch {format [error glorp2]} b]
X error {Human-generated}
X}
X
Xproc foo2 {} {
X global errorInfo
X set a [catch {format [error glorp2]} b]
X error {Human-generated} $errorInfo
X}
X
X# Catch errors occurring in commands and errors from "error" command
X
Xtest error-1.1 {simple errors from commands} {
X catch {format [string compare]} b
X} 1
X
Xtest error-1.2 {simple errors from commands} {
X catch {format [string compare]} b
X set b
X} {wrong # args: should be "string compare string1 string2"}
X
Xtest error-1.3 {simple errors from commands} {
X catch {format [string compare]} b
X set errorInfo
X} {wrong # args: should be "string compare string1 string2"
X while executing
X"string compare"
X invoked from within
X"format [string compare]..."}
X
Xtest error-1.4 {simple errors from commands} {
X catch {error glorp} b
X} 1
X
Xtest error-1.5 {simple errors from commands} {
X catch {error glorp} b
X set b
X} glorp
X
Xtest error-1.6 {simple errors from commands} {
X catch {catch a b c} b
X} 1
X
Xtest error-1.7 {simple errors from commands} {
X catch {catch a b c} b
X set b
X} {wrong # args: should be "catch command ?varName?"}
X
Xtest error-2.1 {simple errors from commands} {
X catch catch
X} 1
X
X# Check errors nested in procedures. Also check the optional argument
X# to "error" to generate a new error trace.
X
Xtest error-2.1 {errors in nested procedures} {
X catch foo b
X} 1
X
Xtest error-2.2 {errors in nested procedures} {
X catch foo b
X set b
X} {Human-generated}
X
Xtest error-2.3 {errors in nested procedures} {
X catch foo b
X set errorInfo
X} {Human-generated
X while executing
X"error {Human-generated}"
X (procedure "foo" line 4)
X invoked from within
X"foo"}
X
Xtest error-2.4 {errors in nested procedures} {
X catch foo2 b
X} 1
X
Xtest error-2.5 {errors in nested procedures} {
X catch foo2 b
X set b
X} {Human-generated}
X
Xtest error-2.6 {errors in nested procedures} {
X catch foo2 b
X set errorInfo
X} {glorp2
X while executing
X"error glorp2"
X invoked from within
X"format [error glorp2]..."
X (procedure "foo2" line 1)
X invoked from within
X"foo2"}
X
X# Error conditions related to "catch".
X
Xtest error-3.1 {errors in catch command} {
X list [catch {catch} msg] $msg
X} {1 {wrong # args: should be "catch command ?varName?"}}
Xtest error-3.2 {errors in catch command} {
X list [catch {catch a b c} msg] $msg
X} {1 {wrong # args: should be "catch command ?varName?"}}
Xtest error-3.3 {errors in catch command} {
X catch {unset a}
X set a(0) 22
X list [catch {catch {format 44} a} msg] $msg
X} {1 {couldn't save command result in variable}}
Xcatch {unset a}
X
X# More tests related to errorInfo and errorCode
X
Xtest error-4.1 {errorInfo and errorCode variables} {
X list [catch {error msg1 msg2 msg3} msg] $msg $errorInfo $errorCode
X} {1 msg1 msg2 msg3}
Xtest error-4.2 {errorInfo and errorCode variables} {
X list [catch {error msg1 {} msg3} msg] $msg $errorInfo $errorCode
X} {1 msg1 {msg1
X while executing
X"error msg1 {} msg3"} msg3}
Xtest error-4.3 {errorInfo and errorCode variables} {
X list [catch {error msg1 {}} msg] $msg $errorInfo $errorCode
X} {1 msg1 {msg1
X while executing
X"error msg1 {}"} NONE}
Xtest error-4.4 {errorInfo and errorCode variables} {
X set errorCode bogus
X list [catch {error msg1} msg] $msg $errorInfo $errorCode
X} {1 msg1 {msg1
X while executing
X"error msg1"} NONE}
Xtest error-4.5 {errorInfo and errorCode variables} {
X set errorCode bogus
X list [catch {error msg1 msg2 {}} msg] $msg $errorInfo $errorCode
X} {1 msg1 msg2 {}}
X
X# Errors in error command itself
X
Xtest error-5.1 {errors in error command} {
X list [catch {error} msg] $msg
X} {1 {wrong # args: should be "error message ?errorInfo? ?errorCode?"}}
Xtest error-5.2 {errors in error command} {
X list [catch {error a b c d} msg] $msg
X} {1 {wrong # args: should be "error message ?errorInfo? ?errorCode?"}}
X
X# Make sure that catch resets error information
X
Xtest error-6.1 {catch must reset error state} {
X catch {error outer [catch {error inner inner.errorInfo inner.errorCode}]}
X list $errorCode $errorInfo
X} {NONE 1}
X
Xreturn ""
END_OF_FILE
if test 5000 -ne `wc -c <'tcl6.1/tests/error.test'`; then
echo shar: \"'tcl6.1/tests/error.test'\" unpacked with wrong size!
fi
# end of 'tcl6.1/tests/error.test'
fi
if test -f 'tcl6.1/tests/for.test' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/tests/for.test'\"
else
echo shar: Extracting \"'tcl6.1/tests/for.test'\" \(4309 characters\)
sed "s/^X//" >'tcl6.1/tests/for.test' <<'END_OF_FILE'
X# Commands covered: foreach, for, continue, break


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/for.test,v 1.7 91/07/23 21:01:05 ouster Exp $ (Berkeley)


X
Xif {[string compare test [info procs test]] == 1} then {source defs}
X

X# Basic "foreach" operation.
X
Xtest for-1.1 {basic foreach tests} {
X set a {}
X foreach i {a b c d} {
X set a [concat $a $i]
X }
X set a


X} {a b c d}

Xtest for-1.2 {basic foreach tests} {
X set a {}
X foreach i {a b {{c d} e} {123 {{x}}}} {
X set a [concat $a $i]
X }
X set a
X} {a b {c d} e 123 {{x}}}
Xtest for-1.3 {basic foreach tests} {catch {foreach} msg} 1
Xtest for-1.4 {basic foreach tests} {
X catch {foreach} msg
X set msg
X} {wrong # args: should be "foreach varName list command"}
Xtest for-1.5 {basic foreach tests} {catch {foreach i} msg} 1
Xtest for-1.6 {basic foreach tests} {
X catch {foreach i} msg
X set msg
X} {wrong # args: should be "foreach varName list command"}
Xtest for-1.7 {basic foreach tests} {catch {foreach i j} msg} 1
Xtest for-1.8 {basic foreach tests} {
X catch {foreach i j} msg
X set msg
X} {wrong # args: should be "foreach varName list command"}
Xtest for-1.9 {basic foreach tests} {catch {foreach i j k l} msg} 1
Xtest for-1.10 {basic foreach tests} {
X catch {foreach i j k l} msg
X set msg
X} {wrong # args: should be "foreach varName list command"}
Xtest for-1.11 {basic foreach tests} {
X set a {}
X foreach i {} {
X set a [concat $a $i]
X }
X set a
X} {}
Xtest for-1.11 {foreach errors} {
X catch {unset a}
X set a(0) 44
X list [catch {foreach a {1 2 3} {}} msg] $msg
X} {1 {couldn't set loop variable}}
Xcatch {unset a}
X
X# Check "continue".
X
Xtest for-2.1 {continue tests} {catch continue} 4
Xtest for-2.2 {continue tests} {
X set a {}
X foreach i {a b c d} {
X if {[string compare $i "b"] == 0} continue
X set a [concat $a $i]
X }
X set a
X} {a c d}
Xtest for-2.3 {continue tests} {
X set a {}
X foreach i {a b c d} {
X if {[string compare $i "b"] != 0} continue
X set a [concat $a $i]
X }
X set a
X} {b}
Xtest for-2.4 {continue tests} {catch {continue foo} msg} 1
Xtest for-2.5 {continue tests} {
X catch {continue foo} msg
X set msg
X} {wrong # args: should be "continue"}
X
X# Check "break".
X
Xtest for-3.1 {break tests} {catch break} 3
Xtest for-3.2 {break tests} {
X set a {}
X foreach i {a b c d} {
X if {[string compare $i "c"] == 0} break
X set a [concat $a $i]
X }
X set a
X} {a b}
Xtest for-3.3 {break tests} {catch {break foo} msg} 1
Xtest for-3.4 {break tests} {
X catch {break foo} msg
X set msg
X} {wrong # args: should be "break"}
X
X# Check "for" and its use of continue and break.
X
Xtest for-4.1 {for tests} {
X set a {}
X for {set i 1} {$i<6} {set i [expr $i+1]} {
X set a [concat $a $i]
X }
X set a


X} {1 2 3 4 5}

Xtest for-4.2 {for tests} {
X set a {}
X for {set i 1} {$i<6} {set i [expr $i+1]} {
X if $i==4 continue
X set a [concat $a $i]
X }
X set a
X} {1 2 3 5}
Xtest for-4.3 {for tests} {
X set a {}
X for {set i 1} {$i<6} {set i [expr $i+1]} {
X if $i==4 break
X set a [concat $a $i]
X }
X set a
X} {1 2 3}
Xtest for-4.4 {for tests} {catch {for 1 2 3} msg} 1
Xtest for-4.5 {for tests} {
X catch {for 1 2 3} msg
X set msg
X} {wrong # args: should be "for start test next command"}
Xtest for-4.6 {for tests} {catch {for 1 2 3 4 5} msg} 1
Xtest for-4.7 {for tests} {
X catch {for 1 2 3 4 5} msg
X set msg
X} {wrong # args: should be "for start test next command"}
Xtest for-4.8 {for tests} {
X set a {xyz}
X for {set i 1} {$i<6} {set i [expr $i+1]} {}
X set a
X} xyz
Xtest for-4.9 {for tests} {
X set a {}
X for {set i 1} {$i<6} {set i [expr $i+1]; if $i==4 break} {
X set a [concat $a $i]
X }
X set a
X} {1 2 3}
END_OF_FILE
if test 4309 -ne `wc -c <'tcl6.1/tests/for.test'`; then
echo shar: \"'tcl6.1/tests/for.test'\" unpacked with wrong size!
fi
# end of 'tcl6.1/tests/for.test'
fi
if test -f 'tcl6.1/tests/glob.test' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/tests/glob.test'\"
else
echo shar: Extracting \"'tcl6.1/tests/glob.test'\" \(4230 characters\)
sed "s/^X//" >'tcl6.1/tests/glob.test' <<'END_OF_FILE'
X# Commands covered: glob


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/glob.test,v 1.15 91/10/17 16:22:32 ouster Exp $ (Berkeley)


X
Xif {[string compare test [info procs test]] == 1} then {source defs}
X

X# First, create some subdirectories to use for testing.
X
Xexec rm -rf globTest
Xexec mkdir globTest globTest/a1 globTest/a2 globTest/a3
Xexec mkdir globTest/a1/b1 globTest/a1/b2 globTest/a2/b3
Xexec cat << abc > globTest/x1.c
Xexec cat << abc > globTest/y1.c
Xexec cat << abc > globTest/z1.c
Xexec cat << abc > "globTest/weird name.c"
Xexec cat << abc > globTest/.1
Xexec cat << abc > globTest/a1/b1/x2.c
Xexec cat << abc > globTest/a1/b2/y2.c
X
Xtest glob-1.1 {simple globbing} {glob a} a
Xtest glob-1.2 {simple globbing} {glob aaa bbb ccc} {aaa bbb ccc}
X
Xtest glob-2.1 {globbing with braces} {glob "{a1,a2}"} "a1 a2"
Xtest glob-2.2 {globbing with braces} {glob a/{x,y}{123,456}/z} \
X "a/x123/z a/x456/z a/y123/z a/y456/z"
X
Xtest glob-3.1 {asterisks and question marks} {glob g*/*.c} \
X "globTest/x1.c globTest/y1.c globTest/z1.c {globTest/weird name.c}"
Xtest glob-3.2 {asterisks and question marks} {glob globTest/?1.c} \
X "globTest/x1.c globTest/y1.c globTest/z1.c"
Xtest glob-3.3 {asterisks and question marks} {glob */*/*/*.c} \
X "globTest/a1/b1/x2.c globTest/a1/b2/y2.c"
Xtest glob-3.4 {asterisks and question marks} {glob globTest/*} \
X "globTest/a1 globTest/a2 globTest/a3 globTest/x1.c globTest/y1.c globTest/z1.c {globTest/weird name.c}"
Xtest glob-3.5 {asterisks and question marks} {glob globTest/.*} \
X "globTest/. globTest/.. globTest/.1"
Xtest glob-3.6 {asterisks and question marks} {glob globTest/*/*} \
X "globTest/a1/b1 globTest/a1/b2 globTest/a2/b3"
Xtest glob-3.7 {asterisks and question marks} {glob {globTest/[xy]1.*}} \
X "globTest/x1.c globTest/y1.c"
X
X# The tests immediately below can only be run at Berkeley, where
X# the file-system structure is well-known.
X
Xif {[string compare [glob ~] /users/ouster] == 0} {
X test glob-4.1 {tildes} {glob ~/.csh*} "/users/ouster/.cshrc"
X test glob-4.2 {tildes} {glob ~/.csh*} "/users/ouster/.cshrc"
X}
X
Xtest glob-5.1 {error conditions} {
X list [catch {glob} msg] $msg
X} {1 {wrong # args: should be "glob ?-nocomplain? name ?name ...?"}}
Xtest glob-5.2 {error conditions} {
X list [catch {glob a/{b,c,d}/\{} msg] $msg
X} {1 {unmatched open-brace in file name}}
Xtest glob-5.3 {error conditions} {
X list [catch {glob goo/*} msg] $msg
X} {1 {no files matched glob pattern(s)}}
Xtest glob-5.4 {error conditions} {
X list [catch {glob globTest/*.c goo/*} msg] $msg
X} {0 {globTest/x1.c globTest/y1.c globTest/z1.c {globTest/weird name.c}}}
Xtest glob-5.5 {error conditions} {
X list [catch {glob ~no-one} msg] $msg
X} {1 {user "no-one" doesn't exist}}
Xtest glob-5.6 {error conditions} {


X set home $env(HOME)
X unset env(HOME)

X set x [list [catch {glob ~/*} msg] $msg]


X set env(HOME) $home
X set x

X} {1 {couldn't find HOME environment variable to expand "~/*"}}
X
Xexec chmod 000 globTest
Xif {$user != "root"} {
X test glob-6.1 {setting errorCode variable} {
X string tolower [list [catch {glob globTest/*} msg] $msg $errorCode]
X } {1 {couldn't read directory "globtest/": permission denied} {unix eacces {permission denied}}}
X}
Xexec chmod 755 globTest
X
Xtest glob-7.1 {-nocomplain option} {
X list [catch {glob -nocomplai} msg] $msg
X} {0 -nocomplai}
Xtest glob-7.2 {-nocomplain option} {
X list [catch {glob -nocomplain} msg] $msg
X} {1 {wrong # args: should be "glob ?-nocomplain? name ?name ...?"}}
Xtest glob-7.3 {-nocomplain option} {
X list [catch {glob -nocomplain goo/*} msg] $msg
X} {0 {}}
X
Xexec rm -rf globTest
END_OF_FILE
if test 4230 -ne `wc -c <'tcl6.1/tests/glob.test'`; then
echo shar: \"'tcl6.1/tests/glob.test'\" unpacked with wrong size!
fi
# end of 'tcl6.1/tests/glob.test'
fi
if test -f 'tcl6.1/tests/if.test' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/tests/if.test'\"
else
echo shar: Extracting \"'tcl6.1/tests/if.test'\" \(4547 characters\)
sed "s/^X//" >'tcl6.1/tests/if.test' <<'END_OF_FILE'
X# Commands covered: if


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/if.test,v 1.3 91/08/20 14:19:03 ouster Exp $ (Berkeley)


X
Xif {[string compare test [info procs test]] == 1} then {source defs}
X

Xtest if-1.1 {taking proper branch} {
X set a {}
X if 0 {set a 1} else {set a 2}
X set a
X} 2
Xtest if-1.2 {taking proper branch} {
X set a {}
X if 1 {set a 1} else {set a 2}
X set a
X} 1
Xtest if-1.3 {taking proper branch} {
X set a {}
X if 1<2 {set a 1}
X set a
X} 1
Xtest if-1.4 {taking proper branch} {
X set a {}
X if 1>2 {set a 1}
X set a
X} {}
Xtest if-1.4 {taking proper branch} {
X set a {}
X if 1>2 {set a 1} else {}
X set a
X} {}
X
Xtest if-2.1 {optional then-else args} {
X set a 44
X if 1==3 then {set a 1} else {set a 2}
X set a
X} 2
Xtest if-2.2 {optional then-else args} {
X set a 44
X if 1!=3 then {set a 1} else {set a 2}
X set a
X} 1
Xtest if-2.3 {optional then-else args} {
X set a 44
X if 1==3 {set a 1} else {set a 2}
X set a
X} 2
Xtest if-2.4 {optional then-else args} {
X set a 44
X if 1!=3 {set a 1} else {set a 2}
X set a
X} 1
Xtest if-2.5 {optional then-else args} {
X set a 44
X if 1==3 then {set a 1} {set a 2}
X set a
X} 2
Xtest if-2.6 {optional then-else args} {
X set a 44
X if 1!=3 then {set a 1} {set a 2}
X set a
X} 1
Xtest if-2.7 {optional then-else args} {
X set a 44
X if 1==3 {set a 1} {set a 2}
X set a
X} 2
Xtest if-2.8 {optional then-else args} {
X set a 44
X if 1!=3 {set a 1} {set a 2}
X set a
X} 1
Xtest if-2.9 {optional then-else args} {
X set a 44
X if 1==3 t {set a 1} e {set a 2}
X set a
X} 2
X
Xtest if-3.1 {error conditions} {
X catch {if 2}
X} 1
Xtest if-3.2 {error conditions} {
X catch {if 2} msg
X set msg
X} {wrong # args: should be "if bool ?then? command ?else? ?command?"}
Xtest if-3.3 {error conditions} {
X catch {if 1 then}
X} 1
Xtest if-3.4 {error conditions} {
X catch {if 1 then} msg
X set msg
X} {wrong # args: should be "if bool ?then? command ?else? ?command?"}
Xtest if-3.5 {error conditions} {
X catch {if 1 {set a b} else}
X} 1
Xtest if-3.6 {error conditions} {
X catch {if 1 {set a b} else} msg
X set msg
X} {wrong # args: should be "if bool ?then? command ?else? ?command?"}
Xtest if-3.7 {error conditions} {
X catch {if {[error "error in condition"]} foo}
X} 1
Xtest if-3.8 {error conditions} {
X catch {if {[error "error in condition"]} foo} msg
X set msg
X} {error in condition}
Xtest if-3.9 {error conditions} {
X catch {if {[error "error in condition"]} foo} msg
X set errorInfo
X} {error in condition
X while executing
X"error "error in condition""
X ("if" test line 1)
X invoked from within
X"if {[error "error in condition"]} foo"}
Xtest if-3.10 {error conditions} {
X catch {if 1 then {error "error in then clause"}}
X} 1
Xtest if-3.11 {error conditions} {
X catch {if 1 then {error "error in then clause"}} msg
X set msg
X} {error in then clause}
Xtest if-3.12 {error conditions} {
X catch {if 1 then {error "error in then clause"}} msg
X set errorInfo
X} {error in then clause
X while executing
X"error "error in then clause""
X ("then" clause line 1)
X invoked from within
X"if 1 then {error "error in then clause"}"}
Xtest if-3.13 {error conditions} {
X catch {if 0 {} {error "error in else clause"}}
X} 1
Xtest if-3.14 {error conditions} {
X catch {if 0 {} {error "error in else clause"}} msg
X set msg
X} {error in else clause}
Xtest if-3.15 {error conditions} {
X catch {if 0 {} {error "error in else clause"}} msg
X set errorInfo
X} {error in else clause
X while executing
X"error "error in else clause""
X ("else" clause line 1)
X invoked from within
X"if 0 {} {error "error in else clause"}"}
X
Xtest if-4.1 {return value} {
X if 1 then {set a 22; format abc}
X} abc
Xtest if-4.2 {return value} {
X if 0 then {set a 22; format abc} else {format def}
X} def
Xtest if-4.3 {return value} {
X if 0 then {set a 22; format abc}
X} {}
END_OF_FILE
if test 4547 -ne `wc -c <'tcl6.1/tests/if.test'`; then
echo shar: \"'tcl6.1/tests/if.test'\" unpacked with wrong size!
fi
# end of 'tcl6.1/tests/if.test'
fi
echo shar: End of archive 3 \(of 33\).
cp /dev/null ark3isdone

Karl Lehenbauer

unread,
Nov 14, 1991, 3:26:46 PM11/14/91
to
Submitted-by: ka...@sugar.neosoft.com (Karl Lehenbauer)
Posting-number: Volume 25, Issue 72
Archive-name: tcl/part04
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 4 (of 33)."
# Contents: tcl6.1/doc/Backslash.man tcl6.1/doc/Concat.man
# tcl6.1/doc/CrtInterp.man tcl6.1/doc/History.man
# tcl6.1/doc/TildeSubst.man tcl6.1/tclAssem.c tcl6.1/tests/exec.test
# tcl6.1/tests/upvar.test
# Wrapped by karl@one on Tue Nov 12 19:44:13 1991


PATH=/bin:/usr/bin:/usr/ucb ; export PATH

if test -f 'tcl6.1/doc/Backslash.man' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/doc/Backslash.man'\"
else
echo shar: Extracting \"'tcl6.1/doc/Backslash.man'\" \(5407 characters\)
sed "s/^X//" >'tcl6.1/doc/Backslash.man' <<'END_OF_FILE'


X'\" Copyright 1989 Regents of the University of California
X'\" Permission to use, copy, modify, and distribute this
X'\" documentation for any purpose and without fee is hereby
X'\" granted, provided that this notice appears in all copies.
X'\" The University of California makes no representations about

X'\" the suitability of this material for any purpose. It is
X'\" provided "as is" without express or implied warranty.
X'\"
X'\" $Header: /user6/ouster/tcl/doc/RCS/Backslash.man,v 1.6 91/05/23 14:11:06 ouster Exp $ SPRITE (Berkeley)

X.HS Tcl_Backslash tcl
X.BS
X.SH NAME
XTcl_Backslash \- parse a backslash sequence


X.SH SYNOPSIS
X.nf
X\fB#include <tcl.h>\fR
X.sp

Xchar
X\fBTcl_Backslash\fR(\fIsrc, countPtr\fR)
X.SH ARGUMENTS
X.AP char *src in
XPointer to a string starting with a backslash.
X.AP int *countPtr out
XIf \fIcountPtr\fR isn't NULL, \fI*countPtr\fR gets filled
Xin with number of characters in the backslash sequence, including
Xthe backslash character.


X.BE
X
X.SH DESCRIPTION
X.PP

XThis is a utility procedure used by several of the Tcl
Xcommands. It parses a backslash sequence and returns
Xthe single character corresponding to the sequence.
X.VS
XIf the backslash sequence should be replaced by no character
Xat all (e.g. backslash-newline) then \fBTcl_Backslash\fR returns 0.
X.VE
X\fBTcl_Backslash\fR modifies \fI*countPtr\fR to contain the number
Xof characters in the backslash sequence.
XIf \fIsrc\fR doesn't point to a backslash
Xsequence understood by Tcl, then Tcl_Backslash returns a backslash
Xas its result and \fI*countPtr\fR gets set to 1 (in this case the
Xbackslash character should not get any special treatment).
X.PP
XSee the Tcl manual entry for information on the valid
Xbackslash sequences.
X.VS
XAll of the sequences described in the Tcl
Xmanual entry are supported by \fBTcl_Backslash\fR.
X.VE
X
X.SH KEYWORDS
Xbackslash, parse
END_OF_FILE
if test 5407 -ne `wc -c <'tcl6.1/doc/Backslash.man'`; then
echo shar: \"'tcl6.1/doc/Backslash.man'\" unpacked with wrong size!
fi
# end of 'tcl6.1/doc/Backslash.man'
fi
if test -f 'tcl6.1/doc/Concat.man' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/doc/Concat.man'\"
else
echo shar: Extracting \"'tcl6.1/doc/Concat.man'\" \(5457 characters\)
sed "s/^X//" >'tcl6.1/doc/Concat.man' <<'END_OF_FILE'


X'\" Copyright 1989 Regents of the University of California
X'\" Permission to use, copy, modify, and distribute this
X'\" documentation for any purpose and without fee is hereby
X'\" granted, provided that this notice appears in all copies.
X'\" The University of California makes no representations about

X'\" the suitability of this material for any purpose. It is
X'\" provided "as is" without express or implied warranty.
X'\"
X'\" $Header: /user6/ouster/tcl/doc/RCS/Concat.man,v 1.2 91/05/29 14:45:29 ouster Exp $ SPRITE (Berkeley)

X.HS Tcl_Concat tcl
X.BS
X.SH NAME
XTcl_Concat \- concatenate a collection of strings


X.SH SYNOPSIS
X.nf
X\fB#include <tcl.h>\fR
X.sp

Xchar *
X\fBTcl_Concat\fR(\fIargc, argv\fR)
X.SH ARGUMENTS
X.AP int argc in
XNumber of strings.
X.AP char *argv[] in
XArray of strings to concatenate. Must have \fIargc\fR entries.


X.BE
X
X.SH DESCRIPTION
X.PP

X\fBTcl_Concat\fR is a utility procedure used by several of the
XTcl commands. Given a collection of strings, it concatenates
Xthem together into a single string, with the original strings
Xseparated by spaces. This procedure behaves differently than
X\fBTcl_Merge\fR, in that the arguments are simply concatenated:
Xno effort is made to ensure proper list structure.
X.VS
XHowever, in most common usage the arguments will all be proper
Xlists themselves; if this is true, then the result will also have
Xproper list structure.
X.PP
X\fBTcl_Concat\fR eliminates leading and trailing white space as it
Xcopies strings from \fBargv\fR to the result. If an element of
X\fBargv\fR consists of nothing but white space, then that string
Xis ignored entirely. This white-space removal was added to make
Xthe output of the \fBconcat\fR command cleaner-looking.
X.VE
X.PP
XThe result string is dynamically allocated
Xusing \fBmalloc()\fR; the caller must eventually release the space
Xby calling \fBfree()\fR.
X
X.SH KEYWORDS
Xconcatenate, strings
END_OF_FILE
if test 5457 -ne `wc -c <'tcl6.1/doc/Concat.man'`; then
echo shar: \"'tcl6.1/doc/Concat.man'\" unpacked with wrong size!
fi
# end of 'tcl6.1/doc/Concat.man'
fi
if test -f 'tcl6.1/doc/CrtInterp.man' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/doc/CrtInterp.man'\"
else
echo shar: Extracting \"'tcl6.1/doc/CrtInterp.man'\" \(5355 characters\)
sed "s/^X//" >'tcl6.1/doc/CrtInterp.man' <<'END_OF_FILE'


X'\" Copyright 1989 Regents of the University of California
X'\" Permission to use, copy, modify, and distribute this
X'\" documentation for any purpose and without fee is hereby
X'\" granted, provided that this notice appears in all copies.
X'\" The University of California makes no representations about

X'\" the suitability of this material for any purpose. It is
X'\" provided "as is" without express or implied warranty.
X'\"
X'\" $Header: /user6/ouster/tcl/doc/RCS/CrtInterp.man,v 1.3 91/07/23 21:47:05 ouster Exp $ SPRITE (Berkeley)

X.HS Tcl_CreateInterp tcl
X.BS
X.SH NAME
XTcl_CreateInterp, Tcl_DeleteInterp \- create and delete Tcl command interpreters


X.SH SYNOPSIS
X.nf
X\fB#include <tcl.h>\fR
X.sp

XTcl_Interp *
X\fBTcl_CreateInterp\fR()
X.sp
X\fBTcl_DeleteInterp\fR(\fIinterp\fR)
X.SH ARGUMENTS
X.AS Tcl_Interp *interp
X.AP Tcl_Interp *interp in
XToken for interpreter to be destroyed.


X.BE
X
X.SH DESCRIPTION
X.PP

X\fBTcl_CreateInterp\fR creates a new interpreter structure and returns
Xa token for it. The token is required in calls to most other Tcl
Xprocedures, such as \fBTcl_CreateCommand\fR, \fBTcl_Eval\fR, and
X\fBTcl_DeleteInterp\fR.
XClients are only allowed to access a few of the fields of
XTcl_Interp structures; see the Tcl_Interp
Xand \fBTcl_CreateCommand\fR man pages for details.
XThe new interpreter is initialized with no defined variables and only
Xthe built-in Tcl commands. To bind in additional commands, call
X\fBTcl_CreateCommand\fR.
X.PP
X\fBTcl_DeleteInterp\fR destroys a command interpreter and releases all of
Xthe resources associated with it, including variables, procedures,
Xand application-specific command bindings. After \fBTcl_DeleteInterp\fR
Xreturns the caller should never again use the \fIinterp\fR token.
X
X.SH KEYWORDS
Xcommand, create, delete, interpreter
END_OF_FILE
if test 5355 -ne `wc -c <'tcl6.1/doc/CrtInterp.man'`; then
echo shar: \"'tcl6.1/doc/CrtInterp.man'\" unpacked with wrong size!
fi
# end of 'tcl6.1/doc/CrtInterp.man'
fi
if test -f 'tcl6.1/doc/History.man' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/doc/History.man'\"
else
echo shar: Extracting \"'tcl6.1/doc/History.man'\" \(6235 characters\)
sed "s/^X//" >'tcl6.1/doc/History.man' <<'END_OF_FILE'


X'\" Copyright 1989 Regents of the University of California
X'\" Permission to use, copy, modify, and distribute this
X'\" documentation for any purpose and without fee is hereby
X'\" granted, provided that this notice appears in all copies.
X'\" The University of California makes no representations about

X'\" the suitability of this material for any purpose. It is
X'\" provided "as is" without express or implied warranty.
X'\"
X'\" $Header: /user6/ouster/tcl/doc/RCS/History.man,v 1.3 91/10/27 14:29:31 ouster Exp $ SPRITE (Berkeley)

X.HS Tcl_InitHistory tcl
X.BS
X.SH NAME
XTcl_InitHistory, Tcl_RecordAndEval \- procedures for managing history list


X.SH SYNOPSIS
X.nf
X\fB#include <tcl.h>\fR
X.sp

X.VS
X\fBTcl_InitHistory\fR(\fIinterp\fR)
X.VE
X.sp
Xint
X\fBTcl_RecordAndEval\fR(\fIinterp, cmd, flags\fR)
X.SH ARGUMENTS
X.AS Tcl_Interp *interp;
X.AP Tcl_Interp *interp in
XTcl interpreter in which history facilities are being used.
X.AP char *cmd in
XCommand (or sequence of commands) to execute.
X.AP char flags in
XFlags to pass to \fBTcl_Eval\fR (normally 0). If -1, then the
Xcommand is not executed; it's just recorded.


X.BE
X
X.SH DESCRIPTION
X.PP

XThe procedure \fBTcl_HistoryInit\fR is invoked to enable the
X.VS
Xhistory facilities in an interpreter (by default there is no
X\fBhistory\fR command in an interpreter).
XAfter this command has been executed the \fBhistory\fR
Xcommand will be available in \fIinterp\fR and the history facilities
Xwill be initialized.
X\fBTcl_HistoryInit\fR is invoked automatically by
X\fBTcl_RecordAndEval\fR, so it need not be invoked explicitly
Xunless the \fBhistory\fR command is to
Xbe used before \fBTcl_RecordAndEval\fR has been called.
X.VE
X.PP
X\fBTcl_RecordAndEval\fR is invoked to record a command on the history
Xlist and then execute it. Programs that do not wish to use the history
Xmechanism should not call \fBTcl_RecordAndEval\fR; they should call
X\fBTcl_Eval\fR instead. Furthermore, \fBTcl_RecordAndEval\fR should
Xonly be called with top-level commands typed by the user, since the
Xpurpose of history is to allow the user to re-issue recently-invoked
Xcommands.
X.PP
X\fBTcl_RecordAndEval\fR does three things.
XFirst, it calls \fBTcl_HistoryInit\fR to initialize history for the
Xinterpreter \fIinterp\fR, if this hasn't already been done.
XSecond, \fBTcl_RecordAndEval\fR saves \fIcommand\fR in
Xthe history list for \fIinterp\fR, making a new event to hold the
Xcommand.
XThird, \fBTcl_RecordAndEval\fR executes the command by passing it
Xand \fIflags\fR to \fBTcl_Eval\fR. If \fIflags\fR is -1 then only
Xthe first two steps are taken; the command will not be executed.
X
X.SH KEYWORDS
Xcommand, event, execute, history, interpreter, record
END_OF_FILE
if test 6235 -ne `wc -c <'tcl6.1/doc/History.man'`; then
echo shar: \"'tcl6.1/doc/History.man'\" unpacked with wrong size!
fi
# end of 'tcl6.1/doc/History.man'
fi
if test -f 'tcl6.1/doc/TildeSubst.man' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/doc/TildeSubst.man'\"
else
echo shar: Extracting \"'tcl6.1/doc/TildeSubst.man'\" \(5835 characters\)
sed "s/^X//" >'tcl6.1/doc/TildeSubst.man' <<'END_OF_FILE'


X'\" Copyright 1989 Regents of the University of California
X'\" Permission to use, copy, modify, and distribute this
X'\" documentation for any purpose and without fee is hereby
X'\" granted, provided that this notice appears in all copies.
X'\" The University of California makes no representations about

X'\" the suitability of this material for any purpose. It is
X'\" provided "as is" without express or implied warranty.
X'\"
X'\" $Header: /user6/ouster/tcl/doc/RCS/TildeSubst.man,v 1.3 91/04/03 15:14:15 ouster Exp $ SPRITE (Berkeley)

X.HS Tcl_TildeSubst tcl
X.BS
X.SH NAME
XTcl_TildeSubst \- replace tilde with home directory in a file name


X.SH SYNOPSIS
X.nf
X\fB#include <tcl.h>\fR
X.sp

Xchar *
X\Tcl_TildeSubst\fR(\fIinterp\fR, \fIname\fR)
X.SH ARGUMENTS
X.AP Tcl_Interp *interp in
XInterpreter in which to report an error, if any.
X.AP char *name in
XFile name, which may start with a ``~''.


X.BE
X
X.SH DESCRIPTION
X.PP

XThis utility procedure does tilde substition. If \fIname\fR doesn't
Xstart with a ``~'' character, then the procedure returns \fIname\fR.
XIf \fIname\fR does start with a tilde, then \fBTcl_TildeSubst\fR
Xreturns a new string identical to \fIname\fR except that the first
Xelement of \fIname\fR is replaced with the location of the home
Xdirectory for the given user. The substitution is carried out in
Xthe same way that it would be done by \fIcsh\fR. If the tilde is
Xfollowed immediately by a slash, then the \fB$HOME\fR environment
Xvariable is substituted. Otherwise the characters between the
Xtilde and the next slash are taken as a user name, which is
Xlooked up in the password file; the user's home directory is
Xretrieved from the password file and substituted.
X.PP
XThe string returned by \fBTcl_TildeSubst\fR is a static string
Xbelonging to \fBTcl_TildeSubst\fR. Its value will only persist
Xuntil the next call to \fBTcl_TildeSubst\fR; the caller should
Xmake a copy of the result if it needs to live a long time.
X.PP
XIf an error occurs (e.g. because there was no user by the given
Xname) then NULL is returned and an error message will be left
Xat \fIinterp->result\fR. It is assumed that \fIinterp->result\fR
Xhas been initialized in the standard way when \fBTcl_TildeSubst\fR
Xis invoked.
X
X.SH KEYWORDS
Xfile name, home directory, tilde, user
END_OF_FILE
if test 5835 -ne `wc -c <'tcl6.1/doc/TildeSubst.man'`; then
echo shar: \"'tcl6.1/doc/TildeSubst.man'\" unpacked with wrong size!
fi
# end of 'tcl6.1/doc/TildeSubst.man'
fi
if test -f 'tcl6.1/tclAssem.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/tclAssem.c'\"
else
echo shar: Extracting \"'tcl6.1/tclAssem.c'\" \(5788 characters\)
sed "s/^X//" >'tcl6.1/tclAssem.c' <<'END_OF_FILE'
X/*
X * tclAssem.c --
X *
X * This file contains procedures to help assemble Tcl commands
X * from an input source where commands may arrive in pieces, e.g.
X * several lines of type-in corresponding to one command.
X *
X * Copyright 1990-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 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/RCS/tclAssem.c,v 1.8 91/09/23 11:22:22 ouster Exp $ SPRITE (Berkeley)";


X#endif /* not lint */
X

X#include "tclInt.h"
X
X/*
X * The structure below is the internal representation for a command
X * buffer, which is used to hold a piece of a command until a full
X * command is available. When a full command is available, it will
X * be returned to the user, but it will also be retained in the buffer
X * until the NEXT call to Tcl_AssembleCmd, at which point it will be
X * removed.
X */
X
Xtypedef struct {
X char *buffer; /* Storage for command being assembled.
X * Malloc-ed, and grows as needed. */
X int bufSize; /* Total number of bytes in buffer. */
X int bytesUsed; /* Number of bytes in buffer currently
X * occupied (0 means there is not a
X * buffered incomplete command). */
X} CmdBuf;
X
X/*
X * Default amount of space to allocate in command buffer:
X */
X
X#define CMD_BUF_SIZE 100


X
X/*
X *----------------------------------------------------------------------
X *

X * Tcl_CreateCmdBuf --
X *
X * Allocate and initialize a command buffer.


X *
X * Results:

X * The return value is a token that may be passed to
X * Tcl_AssembleCmd and Tcl_DeleteCmdBuf.


X *
X * Side effects:

X * Memory is allocated.


X *
X *----------------------------------------------------------------------
X */
X

XTcl_CmdBuf
XTcl_CreateCmdBuf()
X{
X register CmdBuf *cbPtr;
X
X cbPtr = (CmdBuf *) ckalloc(sizeof(CmdBuf));
X cbPtr->buffer = (char *) ckalloc(CMD_BUF_SIZE);
X cbPtr->bufSize = CMD_BUF_SIZE;
X cbPtr->bytesUsed = 0;
X return (Tcl_CmdBuf) cbPtr;
X}


X
X/*
X *----------------------------------------------------------------------
X *

X * Tcl_DeleteCmdBuf --
X *
X * Release all of the resources associated with a command buffer.
X * The caller should never again use buffer again.


X *
X * Results:
X * None.
X *
X * Side effects:

X * Memory is released.


X *
X *----------------------------------------------------------------------
X */
X

Xvoid
XTcl_DeleteCmdBuf(buffer)
X Tcl_CmdBuf buffer; /* Token for command buffer (return value
X * from previous call to Tcl_CreateCmdBuf). */
X{
X register CmdBuf *cbPtr = (CmdBuf *) buffer;
X
X ckfree(cbPtr->buffer);
X ckfree((char *) cbPtr);
X}


X
X/*
X *----------------------------------------------------------------------
X *

X * Tcl_AssembleCmd --
X *
X * This is a utility procedure to assist in situations where
X * commands may be read piece-meal from some input source. Given
X * some input text, it adds the text to an input buffer and returns
X * whole commands when they are ready.


X *
X * Results:

X * If the addition of string to any currently-buffered information
X * results in one or more complete Tcl commands, then the return value
X * is a pointer to the complete command(s). The command value will
X * only be valid until the next call to this procedure with the
X * same buffer. If the addition of string leaves an incomplete
X * command at the end of the buffer, then NULL is returned.


X *
X * Side effects:

X * If string leaves a command incomplete, the partial command
X * information is buffered for use in later calls to this procedure.
X * Once a command has been returned, that command is deleted from
X * the buffer on the next call to this procedure.


X *
X *----------------------------------------------------------------------
X */
X
Xchar *

XTcl_AssembleCmd(buffer, string)
X Tcl_CmdBuf buffer; /* Token for a command buffer previously
X * created by Tcl_CreateCmdBuf. */
X char *string; /* Bytes to be appended to command stream.
X * Note: if the string is zero length,
X * then whatever is buffered will be
X * considered to be a complete command
X * regardless of whether parentheses are
X * matched or not. */
X{
X register CmdBuf *cbPtr = (CmdBuf *) buffer;
X int length, totalLength;


X register char *p;
X

X /*
X * If an empty string is passed in, just pretend the current
X * command is complete, whether it really is or not.
X */
X
X length = strlen(string);
X if (length == 0) {
X cbPtr->bytesUsed = 0;
X return cbPtr->buffer;
X }
X
X /*
X * Add the new information to the buffer. If the current buffer
X * isn't large enough, grow it by at least a factor of two, or
X * enough to hold the new text.
X */
X
X length = strlen(string);
X totalLength = cbPtr->bytesUsed + length + 1;
X if (totalLength > cbPtr->bufSize) {
X unsigned int newSize;
X char *newBuf;
X
X newSize = cbPtr->bufSize*2;
X if (newSize < totalLength) {
X newSize = totalLength;
X }
X newBuf = (char *) ckalloc(newSize);
X strcpy(newBuf, cbPtr->buffer);
X ckfree(cbPtr->buffer);
X cbPtr->buffer = newBuf;
X cbPtr->bufSize = newSize;
X }
X strcpy(cbPtr->buffer+cbPtr->bytesUsed, string);
X cbPtr->bytesUsed += length;
X
X /*
X * See if there is now a complete command in the buffer.
X */
X
X p = cbPtr->buffer;
X while (1) {
X int gotNewLine = 0;
X
X while (isspace(*p)) {
X if (*p == '\n') {
X gotNewLine = 1;
X }
X p++;
X }
X if (*p == 0) {
X if (gotNewLine) {
X cbPtr->bytesUsed = 0;
X return cbPtr->buffer;
X }
X return NULL;
X }
X p = TclWordEnd(p, 0);
X }
X}
END_OF_FILE
if test 5788 -ne `wc -c <'tcl6.1/tclAssem.c'`; then
echo shar: \"'tcl6.1/tclAssem.c'\" unpacked with wrong size!
fi
# end of 'tcl6.1/tclAssem.c'
fi
if test -f 'tcl6.1/tests/exec.test' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/tests/exec.test'\"
else
echo shar: Extracting \"'tcl6.1/tests/exec.test'\" \(6291 characters\)
sed "s/^X//" >'tcl6.1/tests/exec.test' <<'END_OF_FILE'
X# Commands covered: exec


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/exec.test,v 1.16 91/09/11 17:29:55 ouster Exp $ (Berkeley)


X
Xif {[string compare test [info procs test]] == 1} then {source defs}
X

X# Basic operations.
X
Xtest exec-1.1 {basic exec operation} {
X exec echo a b c
X} "a b c"
Xtest exec-1.2 {pipelining} {
X exec echo a b c d | cat | cat


X} "a b c d"

Xtest exec-1.3 {pipelining} {
X set a [exec echo a b c d | cat | wc]
X list [scan $a "%d %d %d" b c d] $b $c $d
X} {3 1 4 8}
X
X# I/O redirection: input from Tcl command.
X
Xtest exec-2.1 {redirecting input from immediate source} {
X exec cat << "Sample text"
X} {Sample text}
Xtest exec-2.2 {redirecting input from immediate source} {
X exec << "Sample text" cat | cat
X} {Sample text}
Xtest exec-2.3 {redirecting input from immediate source} {
X exec cat << "Sample text" | cat
X} {Sample text}
Xtest exec-2.4 {redirecting input from immediate source} {
X exec cat | cat << "Sample text"
X} {Sample text}
X
X# I/O redirection: output to file.
X
Xcatch [exec rm -f gorp.file]
Xtest exec-3.1 {redirecting output to file} {
X exec echo "Some simple words" > gorp.file
X exec cat gorp.file
X} "Some simple words"
Xtest exec-3.2 {redirecting output to file} {
X exec echo "More simple words" | > gorp.file cat | cat
X exec cat gorp.file
X} "More simple words"
Xtest exec-3.3 {redirecting output to file} {
X exec > gorp.file echo "Different simple words" | cat | cat
X exec cat gorp.file
X} "Different simple words"
X
X# I/O redirection: input from file.
X
Xexec echo "Just a few thoughts" > gorp.file
Xtest exec-4.1 {redirecting input from file} {
X exec cat < gorp.file
X} {Just a few thoughts}
Xtest exec-4.2 {redirecting input from file} {
X exec cat | cat < gorp.file
X} {Just a few thoughts}
Xtest exec-4.3 {redirecting input from file} {
X exec cat < gorp.file | cat
X} {Just a few thoughts}
Xtest exec-4.4 {redirecting input from file} {
X exec < gorp.file cat | cat
X} {Just a few thoughts}
X
X# I/O redirection: combinations.
X
Xcatch {exec rm -f gorp.file2}
Xtest exec-5.1 {multiple I/O redirections} {
X exec << "command input" > gorp.file2 cat < gorp.file
X exec cat gorp.file2
X} {Just a few thoughts}
Xtest exec-5.2 {multiple I/O redirections} {
X exec < gorp.file << "command input" cat
X} {command input}
X
X# Long input to command and output from command.
X
Xset a "0123456789 xxxxxxxxx abcdefghi ABCDEFGHIJK\n"
Xset a [concat $a $a $a $a]
Xset a [concat $a $a $a $a]
Xset a [concat $a $a $a $a]
Xset a [concat $a $a $a $a]
Xtest exec-6.1 {long input and output} {
X exec cat << $a
X} $a
X
X# Commands that return errors.
X
Xtest exec-7.1 {commands returning errors} {
X set x [catch {exec gorp} msg]
X list $x $msg [lindex $errorCode 0] [lrange $errorCode 2 end]
X} {1 {couldn't find "gorp" to execute} CHILDSTATUS 1}
Xtest exec-7.2 {commands returning errors} {
X set x [catch {exec foo | gorp} msg]
X set x1 {couldn't find "foo" to execute
Xcouldn't find "gorp" to execute}
X set x2 {couldn't find "gorp" to execute
Xcouldn't find "foo" to execute}
X set y [expr {($msg == $x1) || ($msg == $x2)}]
X list $x $y [lindex $errorCode 0] [lrange $errorCode 2 end]
X} {1 1 CHILDSTATUS 1}
Xtest exec-7.3 {commands returning errors} {
X list [catch {exec sleep 1 | sh -c "exit 43" | sleep 1} msg] $msg
X} {1 {}}
Xtest exec-7.4 {commands returning errors} {
X list [catch {exec gorp | echo a b c} msg] $msg
X} {1 {a b c
Xcouldn't find "gorp" to execute}}
X
X# Errors in executing the Tcl command, as opposed to errors in the
X# processes that are invoked.
X
Xtest exec-8.1 {errors in exec invocation} {
X list [catch {exec} msg] $msg
X} {1 {didn't specify command to execute}}
Xtest exec-8.2 {errors in exec invocation} {
X list [catch {exec | cat} msg] $msg
X} {1 {illegal use of | in command}}
Xtest exec-8.3 {errors in exec invocation} {
X list [catch {exec cat |} msg] $msg
X} {1 {illegal use of | in command}}
Xtest exec-8.4 {errors in exec invocation} {
X list [catch {exec cat | | cat} msg] $msg
X} {1 {illegal use of | in command}}
Xtest exec-8.5 {errors in exec invocation} {
X list [catch {exec cat <} msg] $msg
X} {1 {can't specify "<" as last word in command}}
Xtest exec-8.6 {errors in exec invocation} {
X list [catch {exec cat >} msg] $msg
X} {1 {can't specify ">" as last word in command}}
Xtest exec-8.7 {errors in exec invocation} {
X list [catch {exec cat <<} msg] $msg
X} {1 {can't specify "<<" as last word in command}}
Xtest exec-8.8 {errors in exec invocation} {
X list [catch {exec cat < a/b/c} msg] [string tolower $msg]
X} {1 {couldn't read file "a/b/c": no such file or directory}}
Xtest exec-8.9 {errors in exec invocation} {
X list [catch {exec cat << foo > a/b/c} msg] [string tolower $msg]
X} {1 {couldn't write file "a/b/c": no such file or directory}}
X
X# Commands in background.
X
Xtest exec-9.1 {commands in background} {
X set x [lindex [time {exec sleep 5 &}] 0]
X expr $x<1000000
X} 1
Xtest exec-9.2 {commands in background} {
X list [catch {exec echo a &b} msg] $msg
X} {0 {a &b}}
X
X# Make sure "errorCode" is set correctly.
X
Xtest exec-10.1 {setting errorCode variable} {
X list [catch {exec cat < a/b/c} msg] [string tolower $errorCode]
X} {1 {unix enoent {no such file or directory}}}
Xtest exec-10.2 {setting errorCode variable} {
X list [catch {exec cat > a/b/c} msg] [string tolower $errorCode]
X} {1 {unix enoent {no such file or directory}}}
Xtest exec-10.3 {setting errorCode variable} {
X set x [catch {exec _weirdo_command_} msg]
X list $x $msg [lindex $errorCode 0] [lrange $errorCode 2 end]
X} {1 {couldn't find "_weirdo_command_" to execute} CHILDSTATUS 1}
X
Xcatch {exec rm -f gorp.file}
Xcatch {exec rm -f gorp.file2}
Xreturn {}
END_OF_FILE
if test 6291 -ne `wc -c <'tcl6.1/tests/exec.test'`; then
echo shar: \"'tcl6.1/tests/exec.test'\" unpacked with wrong size!
fi
# end of 'tcl6.1/tests/exec.test'
fi
if test -f 'tcl6.1/tests/upvar.test' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/tests/upvar.test'\"
else
echo shar: Extracting \"'tcl6.1/tests/upvar.test'\" \(5410 characters\)
sed "s/^X//" >'tcl6.1/tests/upvar.test' <<'END_OF_FILE'
X# Commands covered: upvar


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/upvar.test,v 1.1 91/10/03 16:47:56 ouster Exp $ (Berkeley)


X
Xif {[string compare test [info procs test]] == 1} then {source defs}
X

Xtest upvar-1.1 {reading variables with upvar} {
X proc p1 {a b} {set c 22; set d 33; p2}
X proc p2 {} {upvar a x1 b x2 c x3 d x4; set a abc; list $x1 $x2 $x3 $x4 $a}
X p1 foo bar
X} {foo bar 22 33 abc}
Xtest upvar-1.2 {reading variables with upvar} {
X proc p1 {a b} {set c 22; set d 33; p2}
X proc p2 {} {p3}
X proc p3 {} {upvar 2 a x1 b x2 c x3 d x4; set a abc; list $x1 $x2 $x3 $x4 $a}
X p1 foo bar
X} {foo bar 22 33 abc}
Xtest upvar-1.3 {reading variables with upvar} {
X proc p1 {a b} {set c 22; set d 33; p2}
X proc p2 {} {p3}
X proc p3 {} {
X upvar #1 a x1 b x2 c x3 d x4
X set a abc
X list $x1 $x2 $x3 $x4 $a
X }
X p1 foo bar
X} {foo bar 22 33 abc}
Xtest upvar-1.4 {reading variables with upvar} {
X set x1 44
X set x2 55
X proc p1 {} {p2}
X proc p2 {} {
X upvar 2 x1 x1 x2 a
X upvar #0 x1 b
X set c $b
X incr b 3
X list $x1 $a $b
X }
X p1
X} {47 55 47}
X
Xtest upvar-2.1 {writing variables with upvar} {
X proc p1 {a b} {set c 22; set d 33; p2; list $a $b $c $d}
X proc p2 {} {
X upvar a x1 b x2 c x3 d x4
X set x1 14
X set x4 88
X }
X p1 foo bar
X} {14 bar 22 88}
Xtest upvar-2.2 {writing variables with upvar} {
X set x1 44
X set x2 55
X proc p1 {x1 x2} {
X upvar #0 x1 a
X upvar x2 b
X set a $x1
X set b $x2
X }
X p1 newbits morebits
X list $x1 $x2
X} {newbits morebits}
Xtest upvar-2.3 {writing variables with upvar} {
X catch {unset x1}
X catch {unset x2}
X proc p1 {x1 x2} {
X upvar #0 x1 a
X upvar x2 b
X set a $x1
X set b $x2
X }
X p1 newbits morebits
X list [catch {set x1} msg] $msg [catch {set x2} msg] $msg
X} {0 newbits 0 morebits}
X
Xtest upvar-3.1 {unsetting variables with upvar} {
X proc p1 {a b} {set c 22; set d 33; p2; lsort [info vars]}
X proc p2 {} {
X upvar 1 a x1 d x2
X unset x1 x2
X }
X p1 foo bar
X} {b c}
Xtest upvar-3.2 {unsetting variables with upvar} {
X proc p1 {a b} {set c 22; set d 33; p2; lsort [info vars]}
X proc p2 {} {
X upvar 1 a x1 d x2
X unset x1 x2
X set x2 28
X }
X p1 foo bar
X} {b c d}
Xtest upvar-3.3 {unsetting variables with upvar} {
X set x1 44
X set x2 55
X proc p1 {} {p2}
X proc p2 {} {
X upvar 2 x1 a
X upvar #0 x2 b
X unset a b
X }
X p1
X list [info exists x1] [info exists x2]
X} {0 0}
Xtest upvar-3.4 {unsetting variables with upvar} {
X set x1 44
X set x2 55
X proc p1 {} {
X upvar x1 a x2 b
X unset a b
X set b 118
X }
X p1
X list [info exists x1] [catch {set x2} msg] $msg
X} {0 0 118}
X
Xtest upvar-4.1 {nested upvars} {
X set x1 88
X proc p1 {a b} {set c 22; set d 33; p2}
X proc p2 {} {global x1; upvar c x2; p3}
X proc p3 {} {
X upvar x1 a x2 b
X list $a $b
X }
X p1 14 15
X} {88 22}
Xtest upvar-4.2 {nested upvars} {
X set x1 88
X proc p1 {a b} {set c 22; set d 33; p2; list $a $b $c $d}
X proc p2 {} {global x1; upvar c x2; p3}
X proc p3 {} {
X upvar x1 a x2 b
X set a foo
X set b bar
X }
X list [p1 14 15] $x1
X} {{14 15 bar 33} foo}
X
Xproc tproc {args} {global x; set x [list $args [uplevel info vars]]}
Xtest upvar-5.1 {traces involving upvars} {
X proc p1 {a b} {set c 22; set d 33; trace var c rw tproc; p2}
X proc p2 {} {upvar c x1; set x1 22}
X set x ---
X p1 foo bar
X set x
X} {{x1 {} w} x1}
Xtest upvar-5.2 {traces involving upvars} {
X proc p1 {a b} {set c 22; set d 33; trace var c rw tproc; p2}
X proc p2 {} {upvar c x1; set x1}
X set x ---
X p1 foo bar
X set x
X} {{x1 {} r} x1}
Xtest upvar-5.3 {traces involving upvars} {
X proc p1 {a b} {set c 22; set d 33; trace var c rwu tproc; p2}
X proc p2 {} {upvar c x1; unset x1}
X set x ---
X p1 foo bar
X set x
X} {{x1 {} u} x1}
X
Xtest upvar-6.1 {errors in upvar command} {
X list [catch upvar msg] $msg
X} {1 {wrong # args: should be "upvar ?level? otherVar localVar ?otherVar localVar ...?"}}
Xtest upvar-6.2 {errors in upvar command} {
X list [catch {upvar 1} msg] $msg
X} {1 {wrong # args: should be "upvar ?level? otherVar localVar ?otherVar localVar ...?"}}
Xtest upvar-6.3 {errors in upvar command} {
X list [catch {upvar a b} msg] $msg


X} {1 {already at top level}}

Xtest upvar-6.4 {errors in upvar command} {
X list [catch {upvar 1 a b} msg] $msg


X} {1 {already at top level}}

Xtest upvar-6.5 {errors in upvar command} {
X list [catch {upvar #0 a b} msg] $msg


X} {1 {already at top level}}

Xtest upvar-6.6 {errors in upvar command} {
X proc p1 {} {upvar a b c}
X list [catch p1 msg] $msg
X} {1 {wrong # args: should be "a ?level? otherVar localVar ?otherVar localVar ...?"}}
Xtest upvar-6.7 {errors in upvar command} {
X proc p1 {} {set a 33; upvar b a}
X list [catch p1 msg] $msg
X} {1 {variable "a" already exists}}
END_OF_FILE
if test 5410 -ne `wc -c <'tcl6.1/tests/upvar.test'`; then
echo shar: \"'tcl6.1/tests/upvar.test'\" unpacked with wrong size!
fi
# end of 'tcl6.1/tests/upvar.test'
fi
echo shar: End of archive 4 \(of 33\).
cp /dev/null ark4isdone

Karl Lehenbauer

unread,
Nov 14, 1991, 3:27:16 PM11/14/91
to
Submitted-by: ka...@sugar.neosoft.com (Karl Lehenbauer)
Posting-number: Volume 25, Issue 73
Archive-name: tcl/part05
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 5 (of 33)."
# Contents: tcl6.1/doc/AssembCmd.man tcl6.1/doc/CrtPipelin.man
# tcl6.1/doc/Eval.man tcl6.1/doc/ExprLong.man tcl6.1/doc/GetInt.man
# tcl6.1/tclUnix.h
# Wrapped by karl@one on Tue Nov 12 19:44:14 1991


PATH=/bin:/usr/bin:/usr/ucb ; export PATH

if test -f 'tcl6.1/doc/AssembCmd.man' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/doc/AssembCmd.man'\"
else
echo shar: Extracting \"'tcl6.1/doc/AssembCmd.man'\" \(6500 characters\)
sed "s/^X//" >'tcl6.1/doc/AssembCmd.man' <<'END_OF_FILE'


X'\" Copyright 1989 Regents of the University of California
X'\" Permission to use, copy, modify, and distribute this
X'\" documentation for any purpose and without fee is hereby
X'\" granted, provided that this notice appears in all copies.
X'\" The University of California makes no representations about

X'\" the suitability of this material for any purpose. It is
X'\" provided "as is" without express or implied warranty.
X'\"
X'\" $Header: /sprite/src/lib/tcl/RCS/Tcl_AssembleCmd.man,v 1.1 90/03/11 10:30:28 ouster Exp $ SPRITE (Berkeley)

X.HS Tcl_AssembleCmd tcl
X.BS
X.SH NAME
XTcl_CreateCmdBuf, Tcl_AssembleCmd, Tcl_DeleteCmdBuf \- buffer pieces of Tcl commands


X.SH SYNOPSIS
X.nf
X\fB#include <tcl.h>\fR
X.sp

XTcl_CmdBuf
X\fBTcl_CreateCmdBuf\fR()
X.sp
X\fBTcl_DeleteCmdBuf\fR(\fIbuffer\fR)
X.sp
Xchar *
X\fBTcl_AssembleCmd\fR(\fIbuffer\fR, \fIstring\fR)
X.SH ARGUMENTS
X.AS Tcl_CmdBuf *string;
X.AP Tcl_CmdBuf buffer in
XToken for a command buffer (the result of some previous call to
X\fBTcl_CreateCmdBuf\fR).
X.AP char *string in
XAdditional piece of command input to be added to anything currently
Xbuffered.


X.BE
X
X.SH DESCRIPTION
X.PP

XThese three procedures provide a convenient mechanism for assembling
XTcl commands from an input source where command boundaries are not
Xobvious. For example, if input is being read from a terminal, a user
Xmay type commands that span multiple lines. In situations like
Xthis, \fBTcl_AssembleCmd\fR can be called with the individual lines
Xas they are received. It buffers the lines internally and returns
Xfull commands when they are complete.
X.PP
XA command buffer is created by calling \fBTcl_CreateCmdBuf\fR, and
Xit is deleted by calling \fBTcl_DeleteCmdBuf\fR. There may be any
Xnumber of command buffers for a particular program or even for a
Xparticular interpreter; in most cases there should be one
Xbuffer for each independent source of command input.
X.PP
XWhen input arrives from a source you should call \fBTcl_AssembleCmd\fR,
Xpassing it the new input as the \fIstring\fR argument.
X\fBTcl_AssembleCmd\fR will add the new input to anything currently
Xbuffered in \fIbuffer\fR. If the information now buffered represents
Xa complete Tcl command (i.e. the whole command ends with a newline
Xcharacter and there are no unmatched quotes, braces, or brackets),
Xthen \fBTcl_AssembleCmd\fR returns a pointer to the complete command
Xand arranges for the buffer to be cleared on the next call to
X\fBTcl_AssembleCmd\fR. If the command is still incomplete (because,
Xfor example, there are unmatched braces) then \fBTcl_AssembleCmd\fR
Xreturns NULL. \fBTcl_AssembleCmd\fR keeps a private copy of the
Xcommand being assembled, so that the caller need not preserve the
Xcontents of \fIstring\fR between calls to \fBTcl_AssembleCmd\fR.
X\fBTcl_AssembleCmd\fR supports commands of arbitrary length (up to
Xthe total memory limit imposed by the operating system, if any).
X
X.SH KEYWORDS
Xassemble, buffer, partial command
END_OF_FILE
if test 6500 -ne `wc -c <'tcl6.1/doc/AssembCmd.man'`; then
echo shar: \"'tcl6.1/doc/AssembCmd.man'\" unpacked with wrong size!
fi
# end of 'tcl6.1/doc/AssembCmd.man'
fi
if test -f 'tcl6.1/doc/CrtPipelin.man' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/doc/CrtPipelin.man'\"
else
echo shar: Extracting \"'tcl6.1/doc/CrtPipelin.man'\" \(8122 characters\)
sed "s/^X//" >'tcl6.1/doc/CrtPipelin.man' <<'END_OF_FILE'


X'\" Copyright 1989 Regents of the University of California
X'\" Permission to use, copy, modify, and distribute this
X'\" documentation for any purpose and without fee is hereby
X'\" granted, provided that this notice appears in all copies.
X'\" The University of California makes no representations about

X'\" the suitability of this material for any purpose. It is
X'\" provided "as is" without express or implied warranty.
X'\"
X'\" $Header: /user6/ouster/tcl/doc/RCS/CrtPipelin.man,v 1.1 91/07/20 11:21:26 ouster Exp $ SPRITE (Berkeley)

X.HS Tcl_CreatePipeline tcl
X.VS
X.BS
X.SH NAME
XTcl_CreatePipeline \- create one or more child processes, with I/O redirection


X.SH SYNOPSIS
X.nf
X\fB#include <tcl.h>\fR
X.sp

Xint
X\fBTcl_CreatePipeline\fR(\fIinterp, argc, argv, pidArrayPtr, inPipePtr, outPipePtr, errFilePtr\fR)
X.SH ARGUMENTS
X.AS Tcl_Interp **pidArrayPtr
X.AP Tcl_Interp *interp in
XInterpreter to use for error reporting.
X.AP int argc in
XNumber of strings in \fIargv\fR array.
X.AP char **argv in
XArray of strings describing command(s) and I/O redirection.
X.AP int **pidArrayPtr out
XThe value at \fI*pidArrayPtr\fR is modified to hold a pointer to
Xan array of process identifiers. The array is dynamically
Xallocated and must be freed by the caller.
X.AP char *inPipePtr out
XIf this argument is NULL then standard input for the first command
Xin the pipeline comes from the current standard input.
XIf \fIinPipePtr\fR is not NULL then \fBTcl_CreatePipeline\fR will
Xcreate a pipe, arrange for it to be used for standard input
Xto the first command,
Xand store a file id for writing to that pipe at \fI*inPipePtr\fR.
XIf the command specified its own input using redirection, then
Xno pipe is created and -1 is stored at \fI*inPipePtr\fR.
X.AP char *outPipePtr out
XIf this argument is NULL then standard output for the last command
Xin the pipeline goes to the current standard output.
XIf \fIoutPipePtr\fR is not NULL then \fBTcl_CreatePipeline\fR will
Xcreate a pipe, arrange for it to be used for standard output from
Xthe last command, and store a file id for reading from that
Xpipe at \fI*outPipePtr\fR.
XIf the command specified its own output using redirection then
Xno pipe is created and -1 is stored at \fI*outPipePtr\fR.
X.AP char *errFilePtr out
XIf this argument is NULL then error output for all the commands
Xin the pipeline will go to the current standard error file.
XIf \fIerrFilePtr\fR is not NULL, error output from all the commands
Xin the pipeline will go to a temporary file created by
X\fBTcl_CreatePipeline\fR.
XA file id to read from that file will be stored at \fI*errFilePtr\fR.
XThe file will already have been removed, so closing the file
Xdescriptor at \fI*errFilePtr\fR will cause the file to be flushed
Xcompletely.


X.BE
X
X.SH DESCRIPTION
X.PP

X\fBTcl_CreatePipeline\fR processes the \fIargv\fR array and sets
Xup one or more child processes in a pipeline configuration.
X\fBTcl_CreatePipeline\fR handles pipes specified with ``|'',
Xinput redirection specified with ``<'' or ``<<'', and output
Xredirection specified with ``>''; see the documentation for
Xthe \fBexec\fR command for details on these specifications.
XThe return value from \fBTcl_CreatePipeline\fR is a count of
Xthe number of child processes created; the process identifiers
Xfor those processes are stored in a \fImalloc\fR-ed array and
Xa pointer to that array is stored at \fI*pidArrayPtr\fR.
XIt is the caller's responsibility to free the array when finished
Xwith it.
X.PP
XIf the \fIinPipePtr\fR, \fIoutPipePtr\fR, and \fIerrFilePtr\fR
Xarguments are NULL then the pipeline's standard input, standard
Xoutput, and standard error are taken from the corresponding
Xstreams of the process. Non-NULL values may be specified for
Xthese arguments to use pipes for standard input and standard
Xoutput and a file for standard error. \fBTcl_CreatePipeline\fR
Xwill create the requested pipes or file and return file identifiers
Xthat may be used to read or write them. It is the caller's
Xresponsibility to close all of these files when they are no
Xlonger needed. If \fIargv\fR specifies redirection for standard
Xinput or standard output, then pipes will not be created even
Xif requested by the \fIinPipePtr\fR and \fIoutPipePtr\fR
Xarguments.
X.PP
XIf an error occurs in \fBTcl_CreatePipeline\fR (e.g. ``|'' or
X``<'' was the last argument in \fIargv\fR, or it wasn't possible
Xto fork off a child), then -1 is returned
Xand \fIinterp->result\fR is set to an error message.
X
X.SH "SEE ALSO"
X\fBTcl_WaitPids\fR, \fBTcl_DetachPids\fR
X
X.SH KEYWORDS
Xbackground, child, detach, fork, process, status, wait
X.VE
END_OF_FILE
if test 8122 -ne `wc -c <'tcl6.1/doc/CrtPipelin.man'`; then
echo shar: \"'tcl6.1/doc/CrtPipelin.man'\" unpacked with wrong size!
fi
# end of 'tcl6.1/doc/CrtPipelin.man'
fi
if test -f 'tcl6.1/doc/Eval.man' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/doc/Eval.man'\"
else
echo shar: Extracting \"'tcl6.1/doc/Eval.man'\" \(8197 characters\)
sed "s/^X//" >'tcl6.1/doc/Eval.man' <<'END_OF_FILE'


X'\" Copyright 1989 Regents of the University of California
X'\" Permission to use, copy, modify, and distribute this
X'\" documentation for any purpose and without fee is hereby
X'\" granted, provided that this notice appears in all copies.
X'\" The University of California makes no representations about

X'\" the suitability of this material for any purpose. It is
X'\" provided "as is" without express or implied warranty.
X'\"
X'\" $Header: /user6/ouster/tcl/doc/RCS/Eval.man,v 1.6 91/10/24 16:23:51 ouster Exp $ SPRITE (Berkeley)

X.HS Tcl_Eval tcl
X.BS
X.SH NAME
XTcl_Eval, Tcl_VarEval, Tcl_EvalFile \- execute Tcl commands


X.SH SYNOPSIS
X.nf
X\fB#include <tcl.h>\fR
X.sp

Xint
X\fBTcl_Eval\fR(\fIinterp, cmd, flags, termPtr\fR)
X.sp
Xint
X\fBTcl_VarEval\fR(\fIinterp, string, string, ... \fB(char *) NULL\fR)
X.sp
Xint
X\fBTcl_EvalFile\fR(\fIinterp, fileName\fR)
X.SH ARGUMENTS
X.AS Tcl_Interp **termPtr;
X.AP Tcl_Interp *interp in
XInterpreter in which to execute the command. String result will be
Xstored in \fIinterp->result\fR.


X.AP char *cmd in
XCommand (or sequence of commands) to execute.

X.AP int flags in
XEither \fBTCL_BRACKET_TERM\fR or 0.
XIf 0, then \fBTcl_Eval\fR will process commands from \fIcmd\fR until
Xit reaches the null character at the end of the string.
XIf \fBTCL_BRACKET_TERM\fR,
Xthen \fBTcl_Eval\fR will process comands from \fIcmd\fR until either it
Xreaches a null character or it encounters a close bracket that isn't
Xbackslashed or enclosed in braces, at which point it will return.
XUnder normal conditions, \fIflags\fR should be 0.
X.AP char **termPtr out
XIf \fItermPtr\fR is non-NULL, \fBTcl_Eval\fR fills in *\fItermPtr\fR with
Xthe address of the character just after the last one in the last command
Xsuccessfully executed (normally the null character at the end of \fIcmd\fR).
XIf an error occurs in the first command in \fIcmd\fR, then \fI*termPtr\fR
Xwill be set to \fIcmd\fR.
X.AP char *string in
XString forming part of Tcl command.
X.AP char *fileName in
XName of file containing Tcl command string.


X.BE
X
X.SH DESCRIPTION
X.PP

XAll three of these procedures execute Tcl commands.
X\fBTcl_Eval\fR is the core procedure: it parses commands
Xfrom \fIcmd\fR and executes them in
Xorder until either an error occurs or \fBTcl_Eval\fR reaches a terminating
Xcharacter (']' or '\e0', depending on the value of \fIflags\fR).
XThe return value from \fBTcl_Eval\fR is one
Xof the Tcl return codes \fBTCL_OK\fR, \fBTCL_ERROR\fR, \fBTCL_RETURN\fR, \fBTCL_BREAK\fR, or
X\fBTCL_CONTINUE\fR, and \fIinterp->result\fR will point to
Xa string with additional information (result value or error message).
XThis return information corresponds to the last command executed from
X\fIcmd\fR.
X.PP
X\fBTcl_VarEval\fR takes any number of string arguments
Xof any length, concatenates
Xthem into a single string, then calls \fBTcl_Eval\fR to
Xexecute that string as a Tcl command.
XIt returns the result of the command and also modifies
X\fIinterp->result\fR in the usual fashion for Tcl commands. The
Xlast argument to \fBTcl_VarEval\fR must be NULL to indicate the end
Xof arguments.
X.PP
X\fBTcl_EvalFile\fR reads the file given by \fIfileName\fR and evaluates
Xits contents as a Tcl command by calling \fBTcl_Eval\fR. It returns
Xa standard Tcl result that reflects the result of evaluating the
Xfile.
XIf the file couldn't be read then a Tcl error is returned to describe
Xwhy the file couldn't be read.
X.PP
XDuring the processing of a Tcl command it is legal to make nested
Xcalls to evaluate other commands (this is how conditionals, loops,
Xand procedures are implemented).
XIf a code other than
X\fBTCL_OK\fR is returned from a nested \fBTcl_Eval\fR invocation, then the
Xcaller should normally return immediately, passing that same
Xreturn code back to its caller, and so on until the top-level application is
Xreached. A few commands, like \fBfor\fR, will check for certain
Xreturn codes, like \fBTCL_BREAK\fR and \fBTCL_CONTINUE\fR, and process them
Xspecially without returning.
X.PP
X\fBTcl_Eval\fR keeps track of how many nested Tcl_Eval invocations are
Xin progress for \fIinterp\fR.
XIf a code of \fBTCL_RETURN\fR, \fBTCL_BREAK\fR, or \fBTCL_CONTINUE\fR is
Xabout to be returned from the topmost \fBTcl_Eval\fR invocation for
X\fIinterp\fR, then \fBTcl_Eval\fR converts the return code to \fBTCL_ERROR\fR
Xand sets \fIinterp->result\fR to point to an error message indicating that
Xthe \fBreturn\fR, \fBbreak\fR, or \fBcontinue\fR command was
Xinvoked in an inappropriate place. This means that top-level
Xapplications should never see a return code from \fBTcl_Eval\fR other then
X\fBTCL_OK\fR or \fBTCL_ERROR\fR.
X
X.SH KEYWORDS
Xcommand, execute, file, interpreter
END_OF_FILE
if test 8197 -ne `wc -c <'tcl6.1/doc/Eval.man'`; then
echo shar: \"'tcl6.1/doc/Eval.man'\" unpacked with wrong size!
fi
# end of 'tcl6.1/doc/Eval.man'
fi
if test -f 'tcl6.1/doc/ExprLong.man' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/doc/ExprLong.man'\"
else
echo shar: Extracting \"'tcl6.1/doc/ExprLong.man'\" \(7263 characters\)
sed "s/^X//" >'tcl6.1/doc/ExprLong.man' <<'END_OF_FILE'


X'\" Copyright 1989 Regents of the University of California
X'\" Permission to use, copy, modify, and distribute this
X'\" documentation for any purpose and without fee is hereby
X'\" granted, provided that this notice appears in all copies.
X'\" The University of California makes no representations about

X'\" the suitability of this material for any purpose. It is
X'\" provided "as is" without express or implied warranty.
X'\"
X'\" $Header: /user6/ouster/tcl/doc/RCS/ExprLong.man,v 1.2 91/05/31 11:52:56 ouster Exp $ SPRITE (Berkeley)

X.HS Tcl_ExprLong tcl
X.BS
X.SH NAME
XTcl_ExprLong, Tcl_ExprDouble, Tcl_ExprBool, Tcl_ExprString \- evaluate an expression


X.SH SYNOPSIS
X.nf
X\fB#include <tcl.h>\fR

X.VS
X.sp
Xint
X\fBTcl_ExprLong\fR(\fIinterp, string, longPtr\fR)
X.sp
Xint
X\fBTcl_ExprDouble\fR(\fIinterp, string, doublePtr\fR)
X.sp
Xint
X\fBTcl_ExprBoolean\fR(\fIinterp, string, booleanPtr\fR)
X.sp
Xint
X\fBTcl_ExprString\fR(\fIinterp, string\fR)


X.SH ARGUMENTS
X.AS Tcl_Interp *interp
X.AP Tcl_Interp *interp in

XInterpreter in whose context to evaluate \fIstring\fR.
X.AP char *string in
XExpression to be evaluated.
X.AP long *longPtr out
XPointer to location in which to store the integer value of the
Xexpression.
X.AP int *doublePtr out
XPointer to location in which to store the floating-point value of the
Xexpression.
X.AP int *booleanPtr out
XPointer to location in which to store the 0/1 boolean value of the
Xexpression.


X.BE
X
X.SH DESCRIPTION
X.PP

XThese four procedures all evaluate a string expression, returning
Xthe result in one of four different forms.
XThe expression is given by the \fIstring\fR argument, and it
Xcan have any of the forms accepted by the \fBexpr\fR command.
XThe \fIinterp\fR argument refers to an interpreter used to
Xevaluate the expression (e.g. for variables and nested Tcl
Xcommands) and to return error information. \fIInterp->result\fR
Xis assumed to be initialized in the standard fashion when any
Xof the procedures are invoked.
X.PP
XFor all of these procedures the return value is a standard
XTcl result: \fBTCL_OK\fR means the expression was succesfully
Xevaluated, and \fBTCL_ERROR\fR means that an error occurred while
Xevaluating the expression. If \fBTCL_ERROR\fR is returned then
X\fIinterp->result\fR will hold a message describing the error.
XIf an error occurs while executing a Tcl command embedded in
X\fIstring\fR, then that error will be returned.
X.PP
XIf the expression is successfully evaluated, then its value will
Xbe returned in one of four forms, depending on which procedure
Xis invoked.
X\fBTcl_ExprLong\fR stores an integer value at \fI*longPtr\fR.
XIf the expression's actual value was a floating-point number,
Xthen it is truncated to an integer.
XIf the expression's actual value was a non-numeric string then
Xan error is returned.
X.PP
X\fBTcl_ExprDouble\fR stores a floating-point value at \fI*doublePtr\fR.
XIf the expression's actual value was an integer, it is converted to
Xfloating-point.
XIf the expression's actual value was a non-numeric string then
Xan error is returned.
X.PP
X\fBTcl_ExprBoolean\fR stores a 0/1 integer value at \fI*booleanPtr\fR.
XIf the expression's actual value was an integer or floating-point
Xnumber, then \fBTcl_ExprBoolean\fR stores 0 at \fI*booleanPtr\fR if
Xthe value was zero and 1 otherwise.
XIf the expression's actual value was a non-numeric string then
Xan error is returned.
X.PP
X\fBTcl_ExprString\fR returns the value of the expression as a
Xstring stored in \fIinterp->result\fR.
XIf the expression's actual value was an integer or floating-point
Xnumber, then \fBTcl_ExprString\fR converts it to string (using \fBsprintf\fR
Xwith a ``%d'' or ``%g'' converter).
X
X.SH KEYWORDS
Xboolean, double, evaluate, expression, integer, string
X.VE
END_OF_FILE
if test 7263 -ne `wc -c <'tcl6.1/doc/ExprLong.man'`; then
echo shar: \"'tcl6.1/doc/ExprLong.man'\" unpacked with wrong size!
fi
# end of 'tcl6.1/doc/ExprLong.man'
fi
if test -f 'tcl6.1/doc/GetInt.man' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/doc/GetInt.man'\"
else
echo shar: Extracting \"'tcl6.1/doc/GetInt.man'\" \(6873 characters\)
sed "s/^X//" >'tcl6.1/doc/GetInt.man' <<'END_OF_FILE'


X'\" Copyright 1989 Regents of the University of California
X'\" Permission to use, copy, modify, and distribute this
X'\" documentation for any purpose and without fee is hereby
X'\" granted, provided that this notice appears in all copies.
X'\" The University of California makes no representations about

X'\" the suitability of this material for any purpose. It is
X'\" provided "as is" without express or implied warranty.
X'\"
X'\" $Header: /user6/ouster/tcl/doc/RCS/GetInt.man,v 1.2 90/07/28 10:59:43 ouster Exp $ SPRITE (Berkeley)

X.HS Tcl_GetInt tcl
X.BS
X.SH NAME
XTcl_GetInt, Tcl_GetDouble, Tcl_GetBoolean \- convert from string to integer, double, or boolean


X.SH SYNOPSIS
X.nf
X\fB#include <tcl.h>\fR
X.sp

Xint
X\fBTcl_GetInt\fR(\fIinterp, string, intPtr\fR)
X.sp
Xint
X\fBTcl_GetDouble\fR(\fIinterp, string, doublePtr\fR)
X.sp
Xint
X\fBTcl_GetBoolean\fR(\fIinterp, string, boolPtr\fR)


X.SH ARGUMENTS
X.AS Tcl_Interp *interp
X.AP Tcl_Interp *interp in

XInterpreter to use for error reporting.
X.AP char *string in
XTextual value to be converted.
X.AP int *intPtr out
XPoints to place to store integer value converted from \fIstring\fR.
X.AP double *doublePtr out
XPoints to place to store double-precision floating-point
Xvalue converted from \fIstring\fR.
X.AP int *boolPtr out
XPoints to place to store boolean value (0 or 1) converted from \fIstring\fR.


X.BE
X
X.SH DESCRIPTION
X.PP

XThese procedures convert from strings to integers or double-precision
Xfloating-point values or booleans (represented as 0- or 1-valued
Xintegers). Each of the procedures takes a \fIstring\fR argument,
Xconverts it to an internal form of a particular type, and stores
Xthe converted value at the location indicated by the procedure's
Xthird argument. If all goes well, each of the procedures returns
XTCL_OK. If \fIstring\fR doesn't have the proper syntax for the
Xdesired type then TCL_ERROR is returned, an error message is left
Xin \fIinterp->result\fR, and nothing is stored at *\fIintPtr\fR
Xor *\fIdoublePtr\fR or *\fIboolPtr\fR.
X.PP
X\fBTcl_GetInt\fR expects \fIstring\fR to consist of a collection
Xof integer digits, optionally signed and optionally preceded by
Xwhite space. If the first two characters of \fIstring\fR are ``0x''
Xthen \fIstring\fR is expected to be in hexadecimal form; otherwise,
Xif the first character of \fIstring\fR is ``0'' then \fIstring\fR
Xis expected to be in octal form; otherwise, \fIstring\fR is
Xexpected to be in decimal form.
X.PP
X\fBTcl_GetDouble\fR expects \fIstring\fR to consist of a floating-point
Xnumber, which is: white space; a sign; a sequence of digits; a
Xdecimal point; a sequence of digits; the letter ``e''; and a
Xsigned decimal exponent. Any of the fields may be omitted, except that
Xthe digits either before or after the decimal point must be present
Xand if the ``e'' is present then it must be followed by the
Xexponent number.
X.PP
X\fBTcl_GetBoolean\fR expects \fIstring\fR to specify a boolean
Xvalue. If \fIstring\fR is any of \fB0\fR, \fBfalse\fR, or
X\fBno\fR, then \fBTcl_GetBoolean\fR stores a zero value at
X\fI*boolPtr\fR. If \fIstring\fR is any of \fB1\fR, \fBtrue\fR,
Xor \fByes\fR, then 1 is stored at \fI*boolPtr\fR. Any of these
Xvalues may be abbreviated, and upper-case spellings are also
Xacceptable.
X
X.SH KEYWORDS
Xboolean, conversion, double, floating-point, integer
END_OF_FILE
if test 6873 -ne `wc -c <'tcl6.1/doc/GetInt.man'`; then
echo shar: \"'tcl6.1/doc/GetInt.man'\" unpacked with wrong size!
fi
# end of 'tcl6.1/doc/GetInt.man'
fi
if test -f 'tcl6.1/tclUnix.h' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/tclUnix.h'\"
else
echo shar: Extracting \"'tcl6.1/tclUnix.h'\" \(6487 characters\)
sed "s/^X//" >'tcl6.1/tclUnix.h' <<'END_OF_FILE'
X/*
X * tclUnix.h --
X *
X * This file reads in UNIX-related header files and sets up
X * UNIX-related macros for Tcl's UNIX core. It should be the
X * only file that contains #ifdefs to handle different flavors
X * of UNIX. This file sets up the union of all UNIX-related
X * things needed by any of the Tcl core files. This file
X * depends on configuration #defines in tclConfig.h
X *
X * The material in this file was originally contributed by
X * Karl Lehenbauer, Mark Diekhans and Peter da Silva.


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
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 * $Header: /user6/ouster/tcl/RCS/tclUnix.h,v 1.21 91/11/07 09:41:54 ouster Exp $ SPRITE (Berkeley)
X */
X
X#ifndef _TCLUNIX
X#define _TCLUNIX
X
X/*
X * The following #defines are used to distinguish between different
X * UNIX systems. These #defines are normally set by the "config" script
X * based on information it gets by looking in the include and library
X * areas. The defaults below are for BSD-based systems like SunOS
X * or Ultrix.
X *
X * TCL_GETTOD - 1 means there exists a library procedure
X * "gettimeofday" (e.g. BSD systems). 0 means
X * have to use "times" instead.
X * TCL_GETWD - 1 means there exists a library procedure
X * "getwd" (e.g. BSD systems). 0 means
X * have to use "getcwd" instead.
X * TCL_SYS_ERRLIST - 1 means that the array sys_errlist is
X * defined as part of the C library.
X * TCL_SYS_TIME_H - 1 means there exists an include file
X * <sys/time.h> (e.g. BSD derivatives).
X * TCL_SYS_WAIT_H - 1 means there exists an include file
X * <sys/wait.h> that defines constants related
X * to the results of "wait".
X * TCL_UNION_WAIT - 1 means that the "wait" system call returns
X * a structure of type "union wait" (e.g. BSD
X * systems). 0 means "wait" returns an int
X * (e.g. System V and POSIX).
X * TCL_PID_T - 1 means that <sys/types> defines types
X * pid_t and uid_t. 0 means that it doesn't.
X */
X
X#define TCL_GETTOD 0
X#define TCL_GETWD 0
X#define TCL_SYS_ERRLIST 1
X#define TCL_SYS_TIME_H 1
X#define TCL_SYS_WAIT_H 1
X#define TCL_UNION_WAIT 0
X#define TCL_PID_T 1
X
X#include <errno.h>
X#include <fcntl.h>
X#include <limits.h>
X#include <pwd.h>
X#include <signal.h>
X#include <sys/param.h>
X#include <sys/types.h>
X#include <dirent.h>
X#include <sys/file.h>
X#include <sys/stat.h>
X#if TCL_SYS_TIME_H
X# include <sys/time.h>
X#else
X# include <time.h>
X#endif
X#if TCL_SYS_WAIT_H
X# include <sys/wait.h>
X#endif
X
X/*
X * Not all systems declare the errno variable in errno.h. so this
X * file does it explicitly. The list of system error messages also
X * isn't generally declared in a header file anywhere.
X */
X
Xextern int errno;
Xextern int sys_nerr;
Xextern char *sys_errlist[];
X
X/*
X * The type of the status returned by wait varies from UNIX system
X * to UNIX system. The macro below defines it:
X */
X
X#if TCL_UNION_WAIT
X# define WAIT_STATUS_TYPE union wait
X#else
X# define WAIT_STATUS_TYPE int
X#endif
X
X/*
X * Supply definitions for macros to query wait status, if not already
X * defined in header files above.
X */
X
X#ifndef WIFEXITED
X# define WIFEXITED(stat) (((*((int *) &(stat))) & 0xff) == 0)
X#endif
X
X#ifndef WEXITSTATUS
X# define WEXITSTATUS(stat) (((*((int *) &(stat))) >> 8) & 0xff)
X#endif
X
X#ifndef WIFSIGNALED
X# define WIFSIGNALED(stat) (((*((int *) &(stat)))) && ((*((int *) &(stat))) == ((*((int *) &(stat))) & 0x00ff)))
X#endif
X
X#ifndef WTERMSIG
X# define WTERMSIG(stat) ((*((int *) &(stat))) & 0x7f)
X#endif
X
X#ifndef WIFSTOPPED
X# define WIFSTOPPED(stat) (((*((int *) &(stat))) & 0xff) == 0177)
X#endif
X
X#ifndef WSTOPSIG
X# define WSTOPSIG(stat) (((*((int *) &(stat))) >> 8) & 0xff)
X#endif
X
X/*
X * Supply macros for seek offsets, if they're not already provided by
X * an include file.
X */
X
X#ifndef SEEK_SET
X# define SEEK_SET 0
X#endif
X
X#ifndef SEEK_CUR
X# define SEEK_CUR 1
X#endif
X
X#ifndef SEEK_END
X# define SEEK_END 2
X#endif
X
X/*
X * The stuff below is needed by the "time" command. If this
X * system has no gettimeofday call, then must use times and the
X * CLK_TCK #define (from sys/param.h) to compute elapsed time.
X * Unfortunately, some systems only have HZ and no CLK_TCK, and
X * some might not even have HZ.
X */
X
X#if ! TCL_GETTOD
X# include <sys/times.h>
X# include <sys/param.h>
X# ifndef CLK_TCK
X# ifdef HZ
X# define CLK_TCK HZ
X# else
X# define CLK_TCK 60
X# endif
X# endif
X#endif
X
X/*
X * Define access mode constants if they aren't already defined.
X */
X
X#ifndef F_OK
X# define F_OK 00
X#endif
X#ifndef X_OK
X# define X_OK 01
X#endif
X#ifndef W_OK
X# define W_OK 02
X#endif
X#ifndef R_OK
X# define R_OK 04
X#endif
X
X/*
X * Make sure that MAXPATHLEN is defined.
X */
X
X#ifndef MAXPATHLEN
X# ifdef _POSIX_PATH_MAX
X# define MAXPATHLEN _POSIX_PATH_MAX
X# else
X# define MAXPATHLEN 2048
X# endif
X#endif
X
X/*
X * Define pid_t and uid_t if they're not already defined.
X */
X
X#if ! TCL_PID_T
X# define pid_t int
X# define uid_t int
X#endif
X
X/*
X * Variables provided by the C library:
X */
X
Xextern char **environ;
X
X/*
X * Library procedures used by Tcl but not declared in a header file:
X */
X
Xextern int access _ANSI_ARGS_((CONST char *path, int mode));
Xextern int chdir _ANSI_ARGS_((CONST char *path));
Xextern int close _ANSI_ARGS_((int fd));
Xextern int dup2 _ANSI_ARGS_((int src, int dst));
Xextern int execvp _ANSI_ARGS_((CONST char *name, char **argv));
Xextern void _exit _ANSI_ARGS_((int status));
Xextern pid_t fork _ANSI_ARGS_((void));
Xextern uid_t geteuid _ANSI_ARGS_((void));
Xextern pid_t getpid _ANSI_ARGS_((void));
Xextern char * getcwd _ANSI_ARGS_((char *buffer, int size));
Xextern char * getwd _ANSI_ARGS_((char *buffer));
Xextern int kill _ANSI_ARGS_((pid_t pid, int sig));
Xextern long lseek _ANSI_ARGS_((int fd, int offset, int whence));
Xextern char * mktemp _ANSI_ARGS_((char *template));
Xextern int open _ANSI_ARGS_((CONST char *path, int flags, int mode));
Xextern int pipe _ANSI_ARGS_((int *fdPtr));
Xextern int read _ANSI_ARGS_((int fd, char *buf, int numBytes));
Xextern int unlink _ANSI_ARGS_((CONST char *path));
Xextern int write _ANSI_ARGS_((int fd, char *buf, int numBytes));
X
X#endif /* _TCLUNIX */
END_OF_FILE
if test 6487 -ne `wc -c <'tcl6.1/tclUnix.h'`; then
echo shar: \"'tcl6.1/tclUnix.h'\" unpacked with wrong size!
fi
# end of 'tcl6.1/tclUnix.h'
fi
echo shar: End of archive 5 \(of 33\).
cp /dev/null ark5isdone

Karl Lehenbauer

unread,
Nov 14, 1991, 3:27:36 PM11/14/91
to
Submitted-by: ka...@sugar.neosoft.com (Karl Lehenbauer)
Posting-number: Volume 25, Issue 74
Archive-name: tcl/part06
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 6 (of 33)."
# Contents: tcl6.1/doc/AddErrInfo.man tcl6.1/doc/CrtCommand.man
# tcl6.1/doc/CrtTrace.man tcl6.1/doc/Fork.man
# tcl6.1/doc/SplitList.man
# Wrapped by karl@one on Tue Nov 12 19:44:15 1991


PATH=/bin:/usr/bin:/usr/ucb ; export PATH

if test -f 'tcl6.1/doc/AddErrInfo.man' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/doc/AddErrInfo.man'\"
else
echo shar: Extracting \"'tcl6.1/doc/AddErrInfo.man'\" \(8975 characters\)
sed "s/^X//" >'tcl6.1/doc/AddErrInfo.man' <<'END_OF_FILE'


X'\" Copyright 1989 Regents of the University of California
X'\" Permission to use, copy, modify, and distribute this
X'\" documentation for any purpose and without fee is hereby
X'\" granted, provided that this notice appears in all copies.
X'\" The University of California makes no representations about

X'\" the suitability of this material for any purpose. It is
X'\" provided "as is" without express or implied warranty.
X'\"
X'\" $Header: /user6/ouster/tcl/doc/RCS/AddErrInfo.man,v 1.6 91/08/20 09:47:45 ouster Exp $ SPRITE (Berkeley)

X.HS Tcl_AddErrorInfo tcl
X.BS
X.SH NAME
XTcl_AddErrorInfo, Tcl_SetErrorCode, Tcl_UnixError, Tcl_CheckStatus \- record information about errors


X.SH SYNOPSIS
X.nf
X\fB#include <tcl.h>\fR
X.sp

Xchar *
X\fBTcl_AddErrorInfo\fR(\fIinterp, message\fR)
X.sp
X.VS
Xvoid
X\fBTcl_SetErrorCode\fR(\fIinterp, element, element, ...\fR)
X.sp
Xchar
X\fBTcl_UnixError\fR(\fIinterp\fR)
X.VE


X.SH ARGUMENTS
X.AS Tcl_Interp *interp
X.AP Tcl_Interp *interp in

XInterpreter in which to record information.
X.AP char *message in
XIdentifying string to record in \fBerrorInfo\fR variable.
X.AP char *element in
X.VS
XString to record as one element of \fBerrorCode\fR variable.
XLast \fIelement\fR argument must be NULL.
X.VE


X.BE
X
X.SH DESCRIPTION
X.PP

X.VS
XThese procedures are used to manipulate two global variables
Xthat hold information about errors.
XThe variable \fBerrorInfo\fR holds a stack trace of the
Xoperations that were in progress when an error occurred, and
Xis intended to be human-readable.
XThe variable \fBerrorCode\fR holds a list of items that
Xare intended to be machine-readable.
XThe first item in \fBerrorCode\fR identifies the class of
Xerror that occurred (e.g. UNIX means an error occurred in
Xa Unix system call) and additional elements in \fBerrorCode\fR
Xhold additional pieces of information that depend on the class.
XSee the Tcl overview manual entry for details on the various
Xformats for \fBerrorCode\fR.
X.PP
XThe \fBerrorInfo\fR variable is gradually built up as an
Xerror unwinds through the nested operations.
XEach time an error code is returned to \fBTcl_Eval\fR
Xit calls the procedure \fBTcl_AddErrorInfo\fR to add
Xadditional text to \fBerrorInfo\fR describing the
Xcommand that was being executed when the error occurred.
XBy the time the error has been passed all the way back
Xto the application, it will contain a complete trace
Xof the activity in progress when the error occurred.
X.PP
XIt is sometimes useful to add additional information to
X\fBerrorInfo\fR beyond what can be supplied automatically
Xby \fBTcl_Eval\fR.
X\fBTcl_AddErrorInfo\fR may be used for this purpose:
Xits \fImessage\fR argument contains an additional
Xstring to be appended to \fBerrorInfo\fR.
XFor example, the \fBsource\fR command calls \fBTcl_AddErrorInfo\fR
Xto record the name of the file being processed and the
Xline number on which the error occurred; for Tcl procedures, the
Xprocedure name and line number within the procedure are recorded,
Xand so on.
XThe best time to call \fBTcl_AddErrorInfo\fR is just after
X\fBTcl_Eval\fR has returned \fBTCL_ERROR\fR.
XIn calling \fBTcl_AddErrorInfo\fR, you may find it useful to
Xuse the \fBerrorLine\fR field of the interpreter (see the
X\fBTcl_Interp\fR manual entry for details).
X.PP
XThe procedure \fBTcl_SetErrorCode\fR is used to set the
X\fBerrorCode\fR variable.
XIts \fIelement\fR arguments give one or more strings to record
Xin \fBerrorCode\fR: each \fIelement\fR will become one item
Xof a properly-formed Tcl list stored in \fBerrorCode\fR.
X\fBTcl_SetErrorCode\fR is typically invoked just before returning
Xan error.
XIf an error is returned without calling \fBTcl_SetErrorCode\fR
Xthen the Tcl interpreter automatically sets \fBerrorCode\fR
Xto \fBNONE\fR.
X.PP
X\fBTcl_UnixError\fR sets the \fBerrorCode\fR variable after an error
Xin a UNIX kernel call.
XIt reads the value of the \fBerrno\fR C variable and calls
X\fBTcl_SetErrorCode\fR to set \fBerrorCode\fR in the
X\fBUNIX\fR format.
XIn addition, \fBTcl_UnixError\fR returns a human-readable
Xdiagnostic message for the error (this is the same value that
Xwill appear as the third element in \fBerrorCode\fR).
XIt may be convenient to include this string as part of the
Xerror message returned to the application in \fIinterp->result\fR.
X.PP
XIt is important to call the procedures described here rather than
Xsetting \fBerrorInfo\fR or \fBerrorCode\fR directly with
X\fBTcl_SetVar\fR.
XThe reason for this is that the Tcl interpreter keeps information
Xabout whether these procedures have been called.
XFor example, the first time \fBTcl_AppendResult\fR is called
Xfor an error, it clears the existing value of \fBerrorInfo\fR
Xand adds the error message in \fIinterp->result\fR to the variable
Xbefore appending \fImessage\fR; in subsequent calls, it just
Xappends the new \fImessage\fR.
XWhen \fBTcl_SetErrorCode\fR is called, it sets a flag indicating
Xthat \fBerrorCode\fR has been set; this allows the Tcl interpreter
Xto set \fBerrorCode\fR to \fBNONE\fB if it receives an error return
Xwhen \fBTcl_SetErrorCode\fR hasn't been called.
X.PP
XIf the procedure \fBTcl_ResetResult\fR is called, it clears all
Xof the state associated with \fBerrorInfo\fR and \fBerrorCode\fR
X(but it doesn't actually modify the variables).
XIf an error had occurred, this will clear the error state to
Xmake it appear as if no error had occurred after all.
X.VE
X
X.SH "SEE ALSO"
XTcl_ResetResult, Tcl_Interp
X
X.SH KEYWORDS
Xerror, stack, trace, variable
END_OF_FILE
if test 8975 -ne `wc -c <'tcl6.1/doc/AddErrInfo.man'`; then
echo shar: \"'tcl6.1/doc/AddErrInfo.man'\" unpacked with wrong size!
fi
# end of 'tcl6.1/doc/AddErrInfo.man'
fi
if test -f 'tcl6.1/doc/CrtCommand.man' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/doc/CrtCommand.man'\"
else
echo shar: Extracting \"'tcl6.1/doc/CrtCommand.man'\" \(8815 characters\)
sed "s/^X//" >'tcl6.1/doc/CrtCommand.man' <<'END_OF_FILE'


X'\" Copyright 1989 Regents of the University of California
X'\" Permission to use, copy, modify, and distribute this
X'\" documentation for any purpose and without fee is hereby
X'\" granted, provided that this notice appears in all copies.
X'\" The University of California makes no representations about

X'\" the suitability of this material for any purpose. It is
X'\" provided "as is" without express or implied warranty.
X'\"
X'\" $Header: /user6/ouster/tcl/man/RCS/CrtCommand.man,v 1.5 91/11/01 14:41:04 ouster Exp $ SPRITE (Berkeley)

X.HS Tcl_CreateCommand tcl
X.BS
X.SH NAME
XTcl_CreateCommand, Tcl_DeleteCommand \- define application-specific command bindings


X.SH SYNOPSIS
X.nf
X\fB#include <tcl.h>\fR
X.sp

X\fBTcl_CreateCommand\fR(\fIinterp, cmdName, proc, clientData, deleteProc\fR)
X.sp
Xint
X\fBTcl_DeleteCommand\fR(\fIinterp, cmdName\fR)
X.SH ARGUMENTS
X.AS Tcl_CmdDeleteProc (*deleteProc)()
X.AP Tcl_Interp *interp in
XInterpreter in which to create new command.
X.AP char *cmdName in
XName of command to create or delete.
X.AP Tcl_CmdProc *proc in
XImplementation of new command: \fIproc\fR will be called whenever
X\fIcmdName\fR is invoked as a command.
X.AP ClientData clientData in
XArbitrary one-word value to pass to \fIproc\fR and \fIdeleteProc\fR.
X.AP Tcl_CmdDeleteProc *deleteProc in
XProcedure to call before \fIcmdName\fR is deleted from the interpreter;
Xallows for command-specific cleanup. If NULL, then no procedure is
Xcalled before the command is deleted.


X.BE
X
X.SH DESCRIPTION
X.PP

X\fBTcl_CreateCommand\fR defines a new command in \fIinterp\fR and associates
Xit with procedure \fIproc\fR such that whenever \fIcmdName\fR is
Xinvoked as a Tcl command (via a call to \fBTcl_Eval\fR) the Tcl interpreter
Xwill call \fIproc\fR
Xto process the command. If there is already a command \fIcmdName\fR
Xassociated with the interpreter, it is deleted. \fIProc\fP should
Xhave arguments and result that match the type \fBTcl_CmdProc\fR:
X.nf
X.RS
Xtypedef int Tcl_CmdProc(
X.RS
XClientData \fIclientData\fR,
XTcl_Interp *\fIinterp\fR,
Xint \fIargc\fR,
Xchar *\fIargv\fR[]);
X.RE
X.RE
X.fi
XWhen \fIproc\fR is invoked the \fIclientData\fP and \fIinterp\fR
Xparameters will be copies of the \fIclientData\fP and \fIinterp\fR
Xarguments given to \fBTcl_CreateCommand\fR.
XTypically, \fIclientData\fR points to an application-specific
Xdata structure that describes what to do when the command procedure
Xis invoked. \fIArgc\fR and \fIargv\fR describe the arguments to
Xthe command, \fIargc\fR giving the number of arguments (including
Xthe command name) and \fIargv\fR giving the values of the arguments
Xas strings. The \fIargv\fR array will contain \fIargc\fR+1 values;
Xthe first \fIargc\fR values point to the argument strings, and the
Xlast value is NULL.
X.PP
X\fIProc\fR must return an integer code that is either \fBTCL_OK\fR, \fBTCL_ERROR\fR,
X\fBTCL_RETURN\fR, \fBTCL_BREAK\fR, or \fBTCL_CONTINUE\fR. See the Tcl overview man page
Xfor details on what these codes mean. Most normal commands will only
Xreturn \fBTCL_OK\fR or \fBTCL_ERROR\fR. In addition, \fIproc\fR must set
X\fIinterp->result\fR to point to a string value;
Xin the case of a \fBTCL_OK\fR return code this gives the result
Xof the command, and in the case of \fBTCL_ERROR\fR it gives an error message.
XThe \fBTcl_SetResult\fR procedure provides an easy interface for setting
Xthe return value; for complete details on how the \fIinterp->result\fR
Xfield is managed, see the \fBTcl_Interp\fR man page.
XBefore invoking a command procedure,
X\fBTcl_Eval\fR sets \fIinterp->result\fR to point to an empty string, so simple
Xcommands can return an empty result by doing nothing at all.
X.PP
XThe contents of the \fIargv\fR array are copies made by the Tcl interpreter
Xfor the use of \fIproc\fR. \fIProc\fR may alter any of the strings
Xin \fIargv\fR. However, the \fIargv\fR array
Xis recycled as soon as \fIproc\fR returns, so \fIproc\fR must not set
X\fIinterp->result\fR to point anywhere within the \fIargv\fR values
X(call Tcl_SetResult
Xwith status \fBTCL_VOLATILE\fR if you want to return something from the
X\fIargv\fR array).
X.PP
X\fIDeleteProc\fR will be invoked when (if) \fIcmdName\fR is deleted.
XThis can occur through a call to \fBTcl_DeleteCommand\fR or \fBTcl_DeleteInterp\fR,
Xor by replacing \fIcmdName\fR in another call to Tcl_CreateCommand.
X\fIDeleteProc\fR is invoked before the command is deleted, and gives the
Xapplication an opportunity to release any structures associated
Xwith the command. \fIDeleteProc\fR should have arguments and
Xresult that match the type \fBTcl_CmdDeleteProc\fR:
X.nf
X.RS
X.sp
Xtypedef void Tcl_CmdDeleteProc(ClientData \fIclientData\fR);
X.sp
X.RE
X.fi
XThe \fIclientData\fR argument will be the same as the \fIclientData\fR
Xargument passed to \fBTcl_CreateCommand\fR.
X.PP
X\fBTcl_DeleteCommand\fR deletes a command from a command interpreter.
XOnce the call completes, attempts to invoke \fIcmdName\fR in
X\fIinterp\fR will result in errors.
XIf \fIcmdName\fR isn't bound as a command in \fIinterp\fR then
X\fBTcl_DeleteCommand\fR does nothing and returns -1; otherwise
Xit returns 0.
XThere are no restrictions on \fIcmdName\fR: it may refer to
Xa built-in command, an application-specific command, or a Tcl procedure.
X
X.SH KEYWORDS
Xbind, command, create, delete, interpreter
END_OF_FILE
if test 8815 -ne `wc -c <'tcl6.1/doc/CrtCommand.man'`; then
echo shar: \"'tcl6.1/doc/CrtCommand.man'\" unpacked with wrong size!
fi
# end of 'tcl6.1/doc/CrtCommand.man'
fi
if test -f 'tcl6.1/doc/CrtTrace.man' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/doc/CrtTrace.man'\"
else
echo shar: Extracting \"'tcl6.1/doc/CrtTrace.man'\" \(8294 characters\)
sed "s/^X//" >'tcl6.1/doc/CrtTrace.man' <<'END_OF_FILE'


X'\" Copyright 1989 Regents of the University of California
X'\" Permission to use, copy, modify, and distribute this
X'\" documentation for any purpose and without fee is hereby
X'\" granted, provided that this notice appears in all copies.
X'\" The University of California makes no representations about

X'\" the suitability of this material for any purpose. It is
X'\" provided "as is" without express or implied warranty.
X'\"
X'\" $Header: /user6/ouster/tcl/man/RCS/CrtTrace.man,v 1.4 91/11/01 14:41:15 ouster Exp $ SPRITE (Berkeley)

X.HS Tcl_CreateTrace tcl
X.BS
X.SH NAME
XTcl_CreateTrace, Tcl_DeleteTrace \- arrange for command execution to be traced


X.SH SYNOPSIS
X.nf
X\fB#include <tcl.h>\fR
X.sp

XTcl_Trace
X\fBTcl_CreateTrace\fR(\fIinterp, level, proc, clientData\fR)
X.sp
X\fBTcl_DeleteTrace\fR(\fIinterp, trace\fR)
X.SH ARGUMENTS
X.AS Tcl_CmdTraceProc (clientData)()
X.AP Tcl_Interp *interp in
XInterpreter containing command to be traced or untraced.
X.AP int level in
XOnly commands at or below this nesting level will be traced. 1 means
Xtop-level commands only, 2 means top-level commands or those that are
Xinvoked as immediate consequences of executing top-level commands
X(procedure bodies, bracketed commands, etc.) and so on.
X.AP Tcl_CmdTraceProc *proc in
XProcedure to call for each command that's executed. See below for
Xdetails on the calling sequence.
X.AP ClientData clientData in
XArbitrary one-word value to pass to \fIproc\fR.
X.AP Tcl_Trace trace in
XToken for trace to be removed (return value from previous call
Xto \fBTcl_CreateTrace\fR).


X.BE
X
X.SH DESCRIPTION
X.PP

X\fBTcl_CreateTrace\fR arranges for command tracing. From now on, \fIproc\fR
Xwill be invoked before Tcl calls command procedures to process
Xcommands in \fIinterp\fR. The return value from
X\fBTcl_CreateTrace\fR is a token for the trace,
Xwhich may be passed to \fBTcl_DeleteTrace\fR to remove the trace. There may
Xbe many traces in effect simultaneously for the same command interpreter.
X.PP
X\fIProc\fR should have arguments and result that match the
Xtype \fBTcl_CmdTraceProc\fR:
X.nf
X.sp
X.RS
Xtypedef void Tcl_CmdTraceProc(
X.RS
XClientData \fIclientData\fR,
XTcl_Interp *\fIinterp\fR,
Xint \fIlevel\fR,
Xchar *\fIcommand\fR,
XTcl_CmdProc *\fIcmdProc\fR,
XClientData \fIcmdClientData\fR,
Xint \fIargc\fR,
Xchar *\fIargv\fR[]));
X.sp
X.RE
X.RE
X.fi
XThe \fIclientData\fP and \fIinterp\fP parameters are
Xcopies of the corresponding arguments given to \fBTcl_CreateTrace\fR.
X\fIClientData\fR typically points to an application-specific
Xdata structure that describes what to do when \fIproc\fR
Xis invoked. \fILevel\fR gives the nesting level of the command
X(1 for top-level commands passed to \fBTcl_Eval\fR by the application,
X2 for the next-level commands passed to \fBTcl_Eval\fR as part of parsing
Xor interpreting level-1 commands, and so on). \fICommand\fR
Xpoints to a string containing the text of the
Xcommand, before any argument substitution.
X\fICmdProc\fR contains the address of the command procedure that
Xwill be called to process the command (i.e. the \fIproc\fR argument
Xof some previous call to \fBTcl_CreateCommand\fR) and \fIcmdClientData\fR
Xcontains the associated client data for \fIcmdProc\fR (the \fIclientData\fR
Xvalue passed to \fBTcl_CreateCommand\fR). \fIArgc\fR and \fIargv\fR give
Xthe final argument information that will be passed to \fIcmdProc\fR, after
Xcommand, variable, and backslash substitution.
X\fIProc\fR must not modify the \fIcommand\fR or \fIargv\fR strings.
X.PP
XTracing will only occur for commands at nesting level less than
Xor equal to the \fIlevel\fR parameter (i.e. the \fIlevel\fR
Xparameter to \fIproc\fR will always be less than or equal to the
X\fIlevel\fR parameter to \fBTcl_CreateTrace\fR).
X.PP
XCalls to \fIproc\fR will be made by the Tcl parser immediately before
Xit calls the command procedure for the command (\fIcmdProc\fR). This
Xoccurs after argument parsing and substitution, so tracing for
Xsubstituted commands occurs before tracing of the commands
Xcontaining the substitutions. If there is a syntax error in a
Xcommand, or if there is no command procedure associated with a
Xcommand name, then no tracing will occur for that command. If a
Xstring passed to Tcl_Eval contains multiple commands (bracketed, or
Xon different lines) then multiple calls to \fIproc\fR will occur,
Xone for each command. The \fIcommand\fR string for each of these
Xtrace calls will reflect only a single command, not the entire string
Xpassed to Tcl_Eval.
X.PP
X\fBTcl_DeleteTrace\fR removes a trace, so that no future calls will be
Xmade to the procedure associated with the trace. After \fBTcl_DeleteTrace\fR
Xreturns, the caller should never again use the \fItrace\fR token.
X
X.SH KEYWORDS
Xcommand, create, delete, interpreter, trace
END_OF_FILE
if test 8294 -ne `wc -c <'tcl6.1/doc/CrtTrace.man'`; then
echo shar: \"'tcl6.1/doc/CrtTrace.man'\" unpacked with wrong size!
fi
# end of 'tcl6.1/doc/CrtTrace.man'
fi
if test -f 'tcl6.1/doc/Fork.man' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/doc/Fork.man'\"
else
echo shar: Extracting \"'tcl6.1/doc/Fork.man'\" \(9119 characters\)
sed "s/^X//" >'tcl6.1/doc/Fork.man' <<'END_OF_FILE'


X'\" Copyright 1989 Regents of the University of California
X'\" Permission to use, copy, modify, and distribute this
X'\" documentation for any purpose and without fee is hereby
X'\" granted, provided that this notice appears in all copies.
X'\" The University of California makes no representations about

X'\" the suitability of this material for any purpose. It is
X'\" provided "as is" without express or implied warranty.
X'\"
X'\" $Header: /user6/ouster/tcl/doc/RCS/Fork.man,v 1.2 91/10/09 11:58:25 ouster Exp $ SPRITE (Berkeley)

X.HS Tcl_Fork tcl
X.BS
X.VS
X.SH NAME
XTcl_Fork, Tcl_WaitPids, Tcl_DetachPids \- manage child processes


X.SH SYNOPSIS
X.nf
X\fB#include <tcl.h>\fR
X.sp
Xint

X\fBTcl_Fork\fR( )
X.sp
Xint
X\fBTcl_WaitPids\fR(\fInumPids, pidPtr, statusPtr\fR)
X.sp
Xint
X\fBTcl_DetachPids\fR(\fInumPids, pidPtr\fR)
X.SH ARGUMENTS
X.AS Tcl_Interp *statusPtr
X.AP int numPids in
XNumber of process ids contained in the array pointed to by \fIpidPtr\fR.
X.AP int *pidPtr in
XAddress of array containing \fInumPids\fR process ids.
X.AP int *statusPtr out
XAddress of place to store status returned by exited/suspended process.


X.BE
X
X.SH DESCRIPTION
X.PP

XThese procedures keep track of child processes in order to make it
Xeasier for one application to manage several children.
XIf an application uses
Xthe UNIX \fIfork\fR and \fIwait\fR kernel calls directly,
Xproblems occur in situations like the following:
X.IP [1]
XOne part of an application creates child C1. It plans to
Xlet the child run in background, then later wait for it to
Xcomplete.
X.IP [2]
XSome other part of the application creates another child C2,
Xnot knowing anything about C1.
X.IP [3]
XThe second part of the application uses \fIwait\fR to wait for C2
Xto complete.
X.IP [4]
XC1 completes before C2, so C1 is returned by the
X\fIwait\fR kernel call.
X.IP [5]
XThe second part of the application doesn't recognize C1, so it
Xignores it and calls \fIwait\fR again. This time C2
Xcompletes.
X.IP [6]
XThe first part of the application eventually decides to wait
Xfor its child to complete. When it calls \fIwait\fR there are
Xno children left, so \fIwait\fR returns an error and the
Xapplication never gets to examine the exit status for C1.
X.PP
XThe procedures \fBTcl_Fork\fR, \fBTcl_WaitPids\fR, and \fBTcl_DetachPids\fR
Xget around this problem by keeping a table of child processes and
Xtheir exit statuses.
XThey also provide a more flexible waiting
Xmechanism than the \fIwait\fR kernel call.
XTcl-based applications should never call \fIfork\fR and
X\fIwait\fR directly; they should use \fBTcl_Fork\fR,
X\fBTcl_WaitPids\fR, and \fBTcl_DetachPids\fR.
X.PP
X\fBTcl_Fork\fR calls \fIfork\fR and returns the result of
Xthe \fIfork\fR kernel call.
XIf the \fIfork\fR call was successful then \fBTcl_Fork\fR also
Xenters the new process into its internal table of child
Xproceses.
XIf \fIfork\fR returns an error then \fBTcl_Fork\fR returns that
Xsame error.
X.PP
X\fBTcl_WaitPids\fR calls \fIwait\fR repeatedly until one of the processes
Xin the \fIpidPtr\fR array has exited or been killed or suspended by a
Xsignal.
XWhen this occurs, \fBTcl_WaitPids\fR returns the process
Xidentifier for the process and stores its wait status at
X\fI*statusPtr\fR.
XIf the process no longer exists (it exited or was killed by a signal),
Xthen \fBTcl_WaitPids\fR removes its entry from the internal
Xprocess table.
XIf \fIwait\fR returns a process that isn't
Xin the \fIpidPtr\fR array, \fBTcl_WaitPids\fR saves its wait
Xstatus in the internal process table and calls \fIwait\fR again.
XIf one of the processes in the \fIpidPtr\fR array has already
Xexited (or suspended or been killed) when \fBTcl_WaitPids\fR
Xis called, that process and its wait status are returned
Ximmediately without calling \fIwait\fR.
X.PP
X\fBTcl_WaitPids\fR provides two advantages. First, it allows
Xprocesses to exit in any order, and saves their wait statuses.
XSecond, it allows waiting on a number of processes simultaneously,
Xreturning when any of the processes is returned by \fIwait\fR.
X.PP
X\fBTcl_DetachPids\fR is used to indicate that the application
Xno longer cares about the processes given by the \fIpidPtr\fR
Xarray and will never use \fBTcl_WaitPids\fR to wait for them.
XThis occurs, for example, if one or more children are to be
Xexecuted in background and the parent doesn't care whether
Xthey complete successfully.
XWhen \fBTcl_DetachPids\fR is called, the internal process
Xtable entries for the processes are marked so that the
Xentries will be removed as soon as the processes exit or
Xare killed.
X.PP
XIf none of the pids passed to \fBTcl_WaitPids\fR exists in
Xthe internal process table, then -1 is returned and \fIerrno\fR
Xis set to ECHILD.
XIf a \fIwait\fR kernel call returns an error,
Xthen \fBTcl_WaitPids\fR returns that same error.
XIf a \fIwait\fR kernel call returns a process that isn't in
Xthe internal process table, \fBTcl_WaitPids\fR panics and
Xaborts the application.
XIf this situation occurs, it means that a process has been
Xcreated without calling \fBTcl_Fork\fR and that its exit
Xstatus is about to be lost.
X.PP
X\fBTcl_WaitPids\fR defines wait statuses to have type \fIint\fR,
Xwhich is correct for POSIX and many variants of UNIX.
XSome BSD-based UNIX systems still use type \fIunion wait\fR for
Xwait statuses; it should be safe to cast a pointer to a
X\fIunion wait\fR structure to \fI(int *)\fR before passing
Xit to \fBTcl_WaitPids\fR as in the following code:
X.nf
X.RS
X
X\fBunion wait status;
Xint pid1, pid2;
X\&...
Xpid2 = Tcl_WaitPids(1, &pid1, (int *) &status);\fR
X.RE
X.fi


X
X.SH KEYWORDS
Xbackground, child, detach, fork, process, status, wait
X.VE
END_OF_FILE

if test 9119 -ne `wc -c <'tcl6.1/doc/Fork.man'`; then
echo shar: \"'tcl6.1/doc/Fork.man'\" unpacked with wrong size!
fi
# end of 'tcl6.1/doc/Fork.man'
fi
if test -f 'tcl6.1/doc/SplitList.man' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/doc/SplitList.man'\"
else
echo shar: Extracting \"'tcl6.1/doc/SplitList.man'\" \(9107 characters\)
sed "s/^X//" >'tcl6.1/doc/SplitList.man' <<'END_OF_FILE'
X'\" Copyright 1989-1991 Regents of the University of California


X'\" Permission to use, copy, modify, and distribute this
X'\" documentation for any purpose and without fee is hereby
X'\" granted, provided that this notice appears in all copies.
X'\" The University of California makes no representations about

X'\" the suitability of this material for any purpose. It is
X'\" provided "as is" without express or implied warranty.
X'\"
X'\" $Header: /user6/ouster/tcl/doc/RCS/SplitList.man,v 1.5 91/07/10 11:08:18 ouster Exp $ SPRITE (Berkeley)

X.HS Tcl_SplitList tcl
X.BS
X.SH NAME
XTcl_SplitList, Tcl_Merge, Tcl_ScanElement, Tcl_ConvertElement \- manipulate Tcl lists


X.SH SYNOPSIS
X.nf
X\fB#include <tcl.h>\fR
X.sp
Xint

X\fBTcl_SplitList\fR(\fIinterp, list, argcPtr, argvPtr\fR)
X.sp
Xchar *
X\fBTcl_Merge\fR(\fIargc, argv\fR)
X.sp
X.VS
Xint
X\fBTcl_ScanElement\fR(\fIsrc, flagsPtr\fR)
X.sp
Xint
X\fBTcl_ConvertElement\fR(\fIsrc, dst, flags\fR)
X.VE
X.AS Tcl_Interp *argvPtr
X.SH ARGUMENTS
X.AP Tcl_Interp *interp out


XInterpreter to use for error reporting.

X.AP char *list in
XPointer to a string with proper list structure.
X.AP int *argcPtr out
XFilled in with number of elements in \fIlist\fR.
X.AP char ***argvPtr out
X\fI*argvPtr\fR will be filled in with the address of an array of
Xpointers to the strings that are the extracted elements of \fIlist\fR.
XThere will be \fI*argcPtr\fR valid entries in the array, followed by
Xa NULL entry.
X.AP int argc in
XNumber of elements in \fIargv\fR.
X.AP char **argv in
XArray of strings to merge together into a single list.
XEach string will become a separate element of the list.
X.AP char *src in
X.VS
XString that is to become an element of a list.
X.AP int *flagsPtr in
XPointer to word to fill in with information about \fIsrc\fR.
XThe value of *\fIflagsPtr\fR must be passed to \fBTcl_ConvertElement\fR.
X.AP char *dst in
XPlace to copy converted list element. Must contain enough characters
Xto hold converted string.
X.AP int flags in
XInformation about \fIsrc\fR, which must have been returned by previous
Xcall to \fBTcl_ScanElement\fR.
X.VE


X.BE
X
X.SH DESCRIPTION
X.PP

XThese procedures may be used to disassemble and reassemble Tcl lists.
X\fBTcl_SplitList\fR breaks a list up into its constituent elements,
Xreturning an array of pointers to the elements using
X\fIargcPtr\fR and \fIargvPtr\fR.
XWhile extracting the arguments, \fBTcl_SplitList\fR obeys the usual
Xrules for backslash substitutions and braces. The area of
Xmemory pointed to by \fI*argvPtr\fR is dynamically allocated; in
Xaddition to the array of pointers, it
Xalso holds copies of all the list elements. It is the caller's
Xresponsibility to free up all of this storage by calling
X.DS
X\fBfree\fR((char *) \fI*argvPtr\fR)
X.DE
Xwhen the list elements are no longer needed.
X.PP
X\fBTcl_SplitList\fR normally returns \fBTCL_OK\fR, which means the list was
Xsuccessfully parsed.
XIf there was a syntax error in \fIlist\fR, then \fBTCL_ERROR\fR is returned
Xand \fIinterp->result\fR will point to an error message describing the
Xproblem.
XIf \fBTCL_ERROR\fR is returned then no memory is allocated and \fI*argvPtr\fR
Xis not modified.
X.PP
X\fBTcl_Merge\fR is the inverse of \fBTcl_SplitList\fR: it
Xtakes a collection of strings given by \fIargc\fR
Xand \fIargv\fR and generates a result string
Xthat has proper list structure.
XThis means that commands like \fBindex\fR may be used to
Xextract the original elements again.
XIn addition, if the result of \fBTcl_Merge\fR is passed to \fBTcl_Eval\fR,
Xit will be parsed into \fIargc\fR words whose values will
Xbe the same as the \fIargv\fR strings passed to \fBTcl_Merge\fR.
X\fBTcl_Merge\fR will modify the list elements with braces and/or
Xbackslashes in order to produce proper Tcl list structure.


XThe result string is dynamically allocated
Xusing \fBmalloc()\fR; the caller must eventually release the space

Xusing \fBfree()\fR.
X.PP
XIf the result of \fBTcl_Merge\fR is passed to \fBTcl_SplitList\fR,
Xthe elements returned by \fBTcl_SplitList\fR will be identical to
Xthose passed into \fBTcl_Merge\fR.
XHowever, the converse is not true: if \fBTcl_SplitList\fR
Xis passed a given string, and the resulting \fIargc\fR and
X\fIargv\fR are passed to \fBTcl_Merge\fR, the resulting string
Xmay not be the same as the original string passed to \fBTcl_SplitList\fR.
XThis is because \fBTcl_Merge\fR may use backslashes and braces
Xdifferently than the original string.
X.PP
X.VS
X\fBTcl_ScanElement\fR and \fBTcl_ConvertElement\fR are the
Xprocedures that do all of the real work of \fBTcl_Merge\fR.
X\fBTcl_ScanElement\fR scans its \fIsrc\fR argument
Xand determines how to use backslashes and braces
Xwhen converting it to a list element.
XIt returns an overestimate of the number of characters
Xrequired to represent \fIsrc\fR as a list element, and
Xit stores information in \fI*flagsPtr\fR that is needed
Xby \fBTcl_ConvertElement\fR.
X.PP
X\fBTcl_ConvertElement\fR is a companion procedure to \fBTcl_ScanElement\fR.
XIt does the actual work of converting a string to a list element.
XIts \fIflags\fR argument must be the same as the value returned
Xby \fBTcl_ScanElement\fR.
X\fBTcl_ConvertElement\fR writes a proper list element to memory
Xstarting at *\fIdst\fR and returns a count of the total number
Xof characters written, which will be no more than the result
Xreturned by \fBTcl_ScanElement\fR.
X\fBTcl_ConvertElement\fR writes out only the actual list element
Xwithout any leading or trailing spaces: it is up to the caller to
Xinclude spaces between adjacent list elements.
X.VE
X
X.SH KEYWORDS
Xbackslash, convert, element, list, merge, split, strings
END_OF_FILE
if test 9107 -ne `wc -c <'tcl6.1/doc/SplitList.man'`; then
echo shar: \"'tcl6.1/doc/SplitList.man'\" unpacked with wrong size!
fi
# end of 'tcl6.1/doc/SplitList.man'
fi
echo shar: End of archive 6 \(of 33\).
cp /dev/null ark6isdone

Karl Lehenbauer

unread,
Nov 14, 1991, 3:28:00 PM11/14/91
to
Submitted-by: ka...@sugar.neosoft.com (Karl Lehenbauer)
Posting-number: Volume 25, Issue 75
Archive-name: tcl/part07
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 7 (of 33)."
# Contents: tcl6.1/config tcl6.1/doc/Interp.man tcl6.1/tests/file.test
# tcl6.1/tests/proc.test tcl6.1/tests/regexp.test
# Wrapped by karl@one on Tue Nov 12 19:44:16 1991


PATH=/bin:/usr/bin:/usr/ucb ; export PATH

if test -f 'tcl6.1/config' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/config'\"
else
echo shar: Extracting \"'tcl6.1/config'\" \(9141 characters\)
sed "s/^X//" >'tcl6.1/config' <<'END_OF_FILE'
X#!/bin/csh -f
X#
X# This script should be executed to configure the Tcl source directory
X# for a particular system. It probes the system for various header
X# files and library object files. Where things needed by Tcl are missing,
X# substitute versions are included from the "compat" subdirectory.
X#
X# $Header: /user6/ouster/tcl/RCS/config,v 1.19 91/11/07 10:33:05 ouster Exp $ SPRITE (Berkeley)


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
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# The variable definitions below configure this script: they
X# tell where system-defined things are kept (so this program
X# can tell whether the system contains certain features needed
X# by Tcl), and they indicate which Tcl files to modify to
X# reflect the configuration.
X
X# Directory containing system include files:
X
Xset includeDir="/usr/include"
X
X# Archive file containing object code for standard C library:
X
Xset libc="/lib/Llibc.a"
X
X# Makefile to modify:
X
Xset makefile="Makefile"
X
X# Header file to modify to hold #defines about system configuration:
X
Xset config="tclUnix.h"
X#--------------------------------------------------------------
X
Xset changes=0
Xunset time
X
X# First make sure that the configuration variables have been
X# set in a reasonable fashion.
X
Xif ( ! -r $includeDir/stdio.h ) then
X echo "- ERROR\!\! $includeDir doesn't seem to contain standard system"
X echo " include files. Please edit config to set the includeDir"
X echo " variable."
X exit(1)
Xendif
Xif ( ! -r $libc ) then
X echo "- ERROR\!\! C library $libc doesn\'t exist. Please edit config"
X echo " to set the libc variable."
X exit(1)
Xendif
Xnm -p $libc > tmp.libc
Xif ( $status != 0 ) then
X echo "- ERROR\!\! Nm failed to extract names of system-supplied library"
X echo " procedures from $libc. You'll have to modify config by hand to"
X echo " fix the problem (whatever it is)."
X exit(1)
Xendif
X
X# Since nm produces different output on different machines, the code
X# below attempts to guess what pattern to grep for in the nm output.
X
Xset pattern="[ADIT]"
Xset x=`grep printf tmp.libc | grep -c CODE`
Xif ( $x ) then
X set pattern=CODE
Xendif
X
X# Check in the C library for particular library procedures and
X# variables needed by Tcl.
X
Xset gettod=`grep gettimeofday tmp.libc | grep -c "$pattern"`
Xif ( $gettod > 1 ) set gettod=1
Xset getwd=`grep getwd tmp.libc | grep -c "$pattern"`
Xif ( $getwd > 1 ) set getwd=1
Xset opendir=`grep opendir tmp.libc | grep -c "$pattern"`
Xif ( $opendir > 1 ) set opendir=1
Xset strerror=`grep strerror tmp.libc | grep -c "$pattern"`
Xif ( $strerror > 1 ) set strerror=1
Xset strstr=`grep strstr tmp.libc | grep -c "$pattern"`
Xif ( $strstr > 1 ) set strstr=1
Xset strtol=`grep strtol tmp.libc | grep -c "$pattern"`
Xif ( $strtol > 1 ) set strtol=1
Xset strtoul=`grep strtoul tmp.libc | grep -c "$pattern"`
Xif ( $strtoul > 1 ) set strtoul=1
Xset sys_errlist=`grep sys_errlist tmp.libc | grep -c "$pattern"`
Xif ( $sys_errlist > 1 ) set sys_errlist=1
X\rm tmp.libc
X
X# Check in <sys/types.h> for definitions for pid_t and uid_t,
X# which are needed by Tcl.
X
Xset pid_t=0
Xset chk1=`grep -c pid_t $includeDir/sys/types.h`
Xset chk2=`grep -c uid_t $includeDir/sys/types.h`
Xif ( ( $chk1 > 0 ) && ( $chk2 > 0 ) ) then
X set pid_t=1
Xendif
X
X# Next, install header files that aren't present in /usr/include.
X
Xset extraHdrs=""
Xforeach i (dirent.h limits.h)
X \rm -f $i
X if ( ! -r $includeDir/$i ) then
X cp compat/$i .
X set extraHdrs="$extraHdrs $i"
X endif
Xend
Xset stdlibOK=0
X\rm -f stdlib.h
Xif ( -r $includeDir/stdlib.h ) then
X # The check below is needed because SunOS has a stdlib that
X # doesn't declare strtod and other procedures, so we have to
X # use ours instead.
X
X set chk1=`grep -c strtol $includeDir/stdlib.h`
X set chk2=`grep -c strtoul $includeDir/stdlib.h`
X set chk3=`grep -c strtod $includeDir/stdlib.h`
X if ( $chk1 > 0 && $chk2 > 0 && $chk3 > 0 ) then
X set stdlibOK=1
X endif
Xendif
Xif ( ! $stdlibOK ) then
X cp compat/stdlib.h .
X set extraHdrs="$extraHdrs stdlib.h"
Xendif
X
X# Even if string.h exists it's not complete on all systems. If
X# some of the procedures we need are missing from the library, then
X# also install a Tcl-specific string.h.
X
X\rm -f string.h
Xif ( ! $strstr || ! $strtoul || ! -r $includeDir/string.h ) then
X cp compat/string.h .
X set extraHdrs="$extraHdrs string.h"
Xendif
Xif ( "$extraHdrs" != "" ) then
X echo "- Substitutes will be used for the following header files,"
X echo " which aren't in ${includeDir} or aren't complete:"
X echo " $extraHdrs"
X set changes=1
Xendif
X
X# Next, install C procedures for missing library functions.
X
Xset extraLibs=""
X\rm -f strerror.c
Xif ( ! $strerror ) then
X set extraLibs="$extraLibs strerror"
X cp compat/strerror.c .
Xendif
X\rm -f opendir.c
Xif ( ! $opendir ) then
X set extraLibs="$extraLibs opendir"
X cp compat/opendir.c .
X \rm -f dirent.h
X cp compat/dirent2.h dirent.h
X echo "- No opendir/readdir/closedir library exists in this system,"
X echo " so substitutes will be provided. This system better have"
X echo " V7-style directories\!"
Xendif
X\rm -f strstr.c
Xif ( ! $strstr ) then
X set extraLibs="$extraLibs strstr"
X cp compat/strstr.c .
Xendif
X\rm -f strtol.c
Xif ( ! $strtol ) then
X set extraLibs="$extraLibs strtol"
X cp compat/strtol.c .
Xendif
X\rm -f strtoul.c
Xif ( ! $strtoul ) then
X set extraLibs="$extraLibs strtoul"
X cp compat/strtoul.c .
Xendif
Xif ( "$extraLibs" != "" ) then
X echo "- Substitutes will be used for the following library procedures,"
X echo " which aren't in ${libc}:"
X echo " $extraLibs"
X set changes=1
Xendif
X
X# The following statements determine whether ranlib should be used
X# in the Makefile. On System-V systems it shouldn't. The only way
X# to figure this out is to run ranlib and see if it complains (ranlib
X# actually exists on some Sys-V systems, but it returns an error if
X# you run it).
X
Xset ranlibOK=0
Xcat > ranlibtest.c << EOF
X#include <stdio.h>
Xmain (argc, argv)
X int argc;
X char **argv;
X{
X printf ("Hello, world.\n");
X}
XEOF
Xcc -c ranlibtest.c
Xar cru ranlibtest.a ranlibtest.o
Xranlib ranlibtest.a >& /dev/null
Xif ( $status == 0 ) then
X set ranlibOK=1
Xelse
X echo "- This system appears to be a System V one where ranlib isn't"
X echo " used. The ranlib commands will be removed from Makefile."
X set changes=1
Xendif
X\rm -f ranlibtest.*
X
X# Modify the Makefile to include supplemental library sources, if needed.
X
Xset compatObjs=""
Xforeach i ($extraLibs)
X set compatObjs="$compatObjs $i.o"
Xend
Xif ( ! -e $makefile.bak ) mv $makefile $makefile.bak
Xif ( $ranlibOK ) then
X sed -e "s/COMPAT_OBJS =/COMPAT_OBJS =$compatObjs/" $makefile.bak > $makefile
Xelse
X sed -e "s/COMPAT_OBJS =/COMPAT_OBJS =$compatObjs/" \
X -e "/ranlib/d" $makefile.bak > $makefile
Xendif
X
X# Set the #defines in tclConfig.h to provide various pieces of system
X# configuration information at compile time (existence of header files,
X# variables, type definitions, etc.)
X
Xif ( ! $gettod ) then
X echo "- There's no gettimeofday in ${libc} so Tcl will use"
X echo ' times for the "time" command.'
X set changes=1
Xendif
Xif ( ! $getwd ) then
X echo "- There's no getwd in ${libc} so Tcl will use"
X echo ' getcwd for the "pwd" command.'
X set changes=1
Xendif
Xset errlist=1
Xif ( ! $sys_errlist && ! $strerror ) then
X echo "- Neither strerror nor sys_errlist is defined in ${libc} so"
X echo " Tcl will make a guess about errno-related messages."
X set errlist=0
X set changes=1
Xendif
Xset sysTime=0
Xif ( -r $includeDir/sys/time.h ) then
X set sysTime=1
Xendif
Xset sysWait=0
Xset unionWait=0
Xif ( -r $includeDir/sys/wait.h ) then
X set sysWait=1
X cp compat/testwait.c test.c
X make test >& /dev/null
X if ( $status == 0 ) then
X set unionWait=1
X endif
X \rm -f a.out test.c
Xendif
Xset pid_t=1
Xcp compat/testpid.c test.c
Xmake test >& /dev/null
Xset chk1=$status
Xif ( $chk1 != 0 ) then
X set pid_t=0
X echo "- The types pid_t and uid_t aren't defined in <sys/types.h>"
X echo ' so Tcl will use "int" instead.'
Xendif
X\rm -f a.out test.c
Xif ( ! -e $config.bak ) mv $config $config.bak
Xset x=\.\*\$
Xsed -e "s/define TCL_GETTOD 1/define TCL_GETTOD $gettod/" \
X -e "s/define TCL_GETWD 1/define TCL_GETWD $getwd/" \
X -e "s/define TCL_SYS_ERRLIST 1/define TCL_SYS_ERRLIST $errlist/" \
X -e "s/define TCL_SYS_TIME_H 1/define TCL_SYS_TIME_H $sysTime/" \
X -e "s/define TCL_SYS_WAIT_H 1/define TCL_SYS_WAIT_H $sysWait/" \
X -e "s/define TCL_UNION_WAIT 1/define TCL_UNION_WAIT $unionWait/" \
X -e "s/define TCL_PID_T 1/define TCL_PID_T $pid_t/" \
X$config.bak > $config
X
Xif ( ! $changes ) then
X echo "- No special modifications were needed for this system."
Xendif
END_OF_FILE
if test 9141 -ne `wc -c <'tcl6.1/config'`; then
echo shar: \"'tcl6.1/config'\" unpacked with wrong size!
fi
chmod +x 'tcl6.1/config'
# end of 'tcl6.1/config'
fi
if test -f 'tcl6.1/doc/Interp.man' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/doc/Interp.man'\"
else
echo shar: Extracting \"'tcl6.1/doc/Interp.man'\" \(9204 characters\)
sed "s/^X//" >'tcl6.1/doc/Interp.man' <<'END_OF_FILE'


X'\" Copyright 1989 Regents of the University of California
X'\" Permission to use, copy, modify, and distribute this
X'\" documentation for any purpose and without fee is hereby
X'\" granted, provided that this notice appears in all copies.
X'\" The University of California makes no representations about

X'\" the suitability of this material for any purpose. It is
X'\" provided "as is" without express or implied warranty.
X'\"
X'\" $Header: /user6/ouster/tcl/doc/RCS/Interp.man,v 1.6 91/09/04 16:37:59 ouster Exp $ SPRITE (Berkeley)

X.HS Tcl_Interp tcl
X.BS
X.SH NAME
XTcl_Interp \- client-visible fields of interpreter structures


X.SH SYNOPSIS
X.nf
X\fB#include <tcl.h>\fR
X.sp

Xtypedef struct {
X char *\fIresult\fR;
X.VS
X Tcl_FreeProc *\fIfreeProc\fR;
X.VE
X int \fIerrorLine\fR;
X} Tcl_Interp;
X
X.VS
Xtypedef void Tcl_FreeProc(char *\fIblockPtr\fR);


X.VE
X.BE
X
X.SH DESCRIPTION
X.PP

XThe \fBTcl_CreateInterp\fR procedure returns a pointer to a Tcl_Interp
Xstructure. This pointer is then passed into other Tcl procedures
Xto process commands in the interpreter and perform other operations
Xon the interpreter. Interpreter structures contain many many fields
Xthat are used by Tcl, but only three that may be accessed by
X.VS
Xclients: \fIresult\fR, \fIfreeProc\fR, and \fIerrorLine\fR.
X.PP
XThe \fIresult\fR and \fIfreeProc\fR fields are used to return
Xresults or error messages from commands.
XThis information is returned by command procedures back to \fBTcl_Eval\fR,
Xand by \fBTcl_Eval\fR back to its callers.
XThe \fIresult\fR field points to the string that represents the
Xresult or error message, and the \fIfreeProc\fR field tells how
Xto dispose of the storage for the string when it isn't needed anymore.
XThe easiest way for command procedures to manipulate these
Xfields is to call procedures like \fBTcl_SetResult\fR
Xor \fBTcl_AppendResult\fR; they
Xwill hide all the details of managing the fields.
XThe description below is for those procedures that manipulate the
Xfields directly.
X.PP
XWhenever a command procedure returns, it must ensure
Xthat the \fIresult\fR field of its interpreter points to the string
Xbeing returned by the command.
XThe \fIresult\fR field must always point to a valid string.
XIf a command wishes to return no result then \fIinterp->result\fR
Xshould point to an empty string.
XNormally, results are assumed to be statically allocated,
Xwhich means that the contents will not change before the next time
X\fBTcl_Eval\fR is called or some other command procedure is invoked.
XIn this case, the \fIfreeProc\fR field must be zero.
XAlternatively, a command procedure may dynamically
Xallocate its return value (e.g. using \fBmalloc\fR)
Xand store a pointer to it in \fIinterp->result\fR.
XIn this case, the command procedure must also set \fIinterp->freeProc\fR
Xto the address of a procedure that can free the value (usually \fBfree\fR).
XIf \fIinterp->freeProc\fR is non-zero, then Tcl will call \fIfreeProc\fR
Xto free the space pointed to by \fIinterp->result\fR before it
Xinvokes the next command.
XIf a client procedure overwrites \fIinterp->result\fR when
X\fIinterp->freeProc\fR is non-zero, then it is responsible for calling
X\fIfreeProc\fR to free the old \fIinterp->result\fR (the \fBTcl_FreeResult\fR
Xmacro should be used for this purpose).
X.PP
X\fIFreeProc\fR should have arguments and result that match the
X\fBTcl_FreeProc\fR declaration above: it receives a single
Xargument which is a pointer to the result value to free.
XIn most applications \fBfree\fR is the only non-zero value ever
Xused for \fIfreeProc\fR.
XHowever, an application may store a different procedure address
Xin \fIfreeProc\fR in order to use an alternate memory allocator
Xor in order to do other cleanup when the result memory is freed.
X.PP
XAs part of processing each command, \fBTcl_Eval\fR initializes
X\fIinterp->result\fR
Xand \fIinterp->freeProc\fR just before calling the command procedure for
Xthe command. The \fIfreeProc\fR field will be initialized to zero,
Xand \fIinterp->result\fR will point to an empty string. Commands that
Xdo not return any value can simply leave the fields alone.
X.VE
XFurthermore, the empty string pointed to by \fIresult\fR is actually
Xpart of an array of \fBTCL_RESULT_SIZE\fR characters (approximately 200).
XIf a command wishes to return a short string, it can simply copy
Xit to the area pointed to by \fIinterp->result\fR. Or, it can use
Xthe sprintf procedure to generate a short result string at the location
Xpointed to by \fIinterp->result\fR.
X.PP
XIt is a general convention in Tcl-based applications that the result
Xof an interpreter is normally in the initialized state described
Xin the previous paragraph.
XProcedures that manipulate an interpreter's result (e.g. by
Xreturning an error) will generally assume that the result
Xhas been initialized when the procedure is called.
XIf such a procedure is to be called after the result has been
Xchanged, then \fBTcl_ResetResult\fR should be called first to
Xreset the result to its initialized state.
X.PP
XThe \fIerrorLine\fR
Xfield is valid only after \fBTcl_Eval\fR returns
Xa \fBTCL_ERROR\fR return code. In this situation the \fIerrorLine\fR
Xfield identifies the line number of the command being executed when
Xthe error occurred. The line numbers are relative to the command
Xbeing executed: 1 means the first line of the command passed to
X\fBTcl_Eval\fR, 2 means the second line, and so on.
XThe \fIerrorLine\fR field is typically used in conjunction with
X\fBTcl_AddErrorInfo\fR to report information about where an error
Xoccurred.
X\fIErrorLine\fR should not normally be modified except by \fBTcl_Eval\fR.
X
X.SH KEYWORDS
Xfree, initialized, interpreter, malloc, result
END_OF_FILE
if test 9204 -ne `wc -c <'tcl6.1/doc/Interp.man'`; then
echo shar: \"'tcl6.1/doc/Interp.man'\" unpacked with wrong size!
fi
# end of 'tcl6.1/doc/Interp.man'
fi
if test -f 'tcl6.1/tests/file.test' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/tests/file.test'\"
else
echo shar: Extracting \"'tcl6.1/tests/file.test'\" \(9253 characters\)
sed "s/^X//" >'tcl6.1/tests/file.test' <<'END_OF_FILE'
X# Commands covered: file


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/file.test,v 1.13 91/10/17 16:22:34 ouster Exp $ (Berkeley)


X
Xif {[string compare test [info procs test]] == 1} then {source defs}
X

X# rootname and ext
X
Xtest file-1.1 {rootname and extension options} {file ext abc.def} .def
Xtest file-1.2 {rootname and extension options} {file ro abc.def} abc
Xtest file-1.3 {rootname and extension options} {file extension a/b/c.d} .d
Xtest file-1.4 {rootname and extension options} {file rootname a/b/c.d} a/b/c
Xtest file-1.5 {rootname and extension options} {file extension a/b.c/d} {}
Xtest file-1.6 {rootname and extension options} {file rootname a/b.c/d} a/b.c/d
Xset num 7
Xforeach outer { {} a .a a. a.a } {
X foreach inner { {} a .a a. a.a } {
X set thing [format %s/%s $outer $inner]
X test file-1.$num {rootname and extension options} {
X format %s%s [file rootname $thing] [file ext $thing]
X } $thing


X set num [expr $num+1]
X }

X}
X
X# dirname and tail
X
Xtest file-2.1 {dirname and tail options} {file dirname .def} .
Xtest file-2.2 {dirname and tail options} {file tail abc.def} abc.def
Xtest file-2.3 {dirname and tail options} {file d a/b/c.d} a/b
Xtest file-2.4 {dirname and tail options} {file t a/b/c.d} c.d
Xtest file-2.5 {dirname and tail options} {file dirname a/b.c/d} a/b.c
Xtest file-2.6 {dirname and tail options} {file tail a/b.c/d} d
Xset num 7
Xforeach outer { a .a a. a.a } {
X foreach inner { {} a .a a. a.a } {
X set thing [format %s/%s $outer $inner]
X test file-2.$num {dirname and tail options} {
X format %s/%s [file dirname $thing] [file tail $thing]
X } $thing


X set num [expr $num+1]
X }

X}
X
X# exists
X
Xcatch {exec chmod 777 dir.file}
Xcatch {exec rm -f dir.file/gorp.file}


Xcatch {exec rm -f gorp.file}

Xcatch {exec rmdir dir.file}
Xtest file-3.1 {exists option} {file exists gorp.file} 0
Xtest file-3.2 {exists option} {file exists dir.file/gorp.file} 0
Xexec cat > gorp.file << abcde
Xexec mkdir dir.file
Xexec cat > dir.file/gorp.file << 12345
Xtest file-3.3 {exists option} {file exists gorp.file} 1
Xtest file-3.4 {exists option} {file exi dir.file/gorp.file} 1
X
X# The test below has to be done in /tmp rather than the current
X# directory in order to guarantee (?) a local file system: some
X# NFS file systems won't do the stuff below correctly.
X
Xcatch {exec rm /tmp/tcl.foo.dir/file}
Xcatch {exec rmdir /tmp/tcl.foo.dir}
Xexec mkdir /tmp/tcl.foo.dir
Xexec cat > /tmp/tcl.foo.dir/file << 12345
Xexec chmod 000 /tmp/tcl.foo.dir
Xif {$user != "root"} {
X test file-3.5 {exists option} {file exists /tmp/tcl.foo.dir/file} 0
X}
Xexec chmod 775 /tmp/tcl.foo.dir
Xexec rm /tmp/tcl.foo.dir/file
Xexec rmdir /tmp/tcl.foo.dir
X
X# executable
X
Xexec chmod 000 dir.file
Xif {$user != "root"} {
X test file-4.1 {executable option} {file executable gorp.file} 0
X}
Xexec chmod 775 gorp.file
Xtest file-4.2 {executable option} {file exe gorp.file} 1
X
X# isdirectory
X
Xtest file-5.1 {isdirectory option} {file isdirectory gorp.file} 0
Xtest file-5.2 {isdirectory option} {file isd dir.file} 1
X
X# isfile
X
Xtest file-6.1 {isfile option} {file isfile gorp.file} 1
Xtest file-6.2 {isfile option} {file isfile dir.file} 0
X
X# isowned
X
Xtest file-7.1 {owned option} {file owned gorp.file} 1
Xif {$user != "root"} {
X test file-7.2 {owned option} {file owned /} 0
X}
X
X# readable
X
Xexec chmod 444 gorp.file
Xtest file-8.1 {readable option} {file readable gorp.file} 1
Xexec chmod 333 gorp.file
Xif {$user != "root"} {
X test file-8.2 {readable option} {file re gorp.file} 0
X}
X
X# writable
X
Xexec chmod 555 gorp.file
Xif {$user != "root"} {
X test file-9.1 {writable option} {file writable gorp.file} 0
X}
Xexec chmod 222 gorp.file
Xtest file-9.2 {writable option} {file w gorp.file} 1
X
Xexec chmod 777 dir.file
Xexec rm dir.file/gorp.file gorp.file
Xexec rmdir dir.file
X
X# stat
X
Xexec cat > gorp.file << "Test string"
Xexec chmod 765 gorp.file
Xtest file-10.1 {stat option} {
X catch {unset stat}
X file stat gorp.file stat
X lsort [array names stat]
X} {atime ctime dev gid ino mode mtime nlink size uid}
Xtest file-10.2 {stat option} {
X catch {unset stat}
X file stat gorp.file stat
X list $stat(nlink) $stat(size) [expr $stat(mode)&0777]
X} {1 11 501}
Xtest file-10.3 {stat option} {
X string tolower [list [catch {file stat _non_existent_ stat} msg] \
X $msg $errorCode]
X} {1 {couldn't stat "_non_existent_": no such file or directory} {unix enoent {no such file or directory}}}
Xtest file-10.4 {stat option} {
X list [catch {file stat _non_existent_} msg] $msg $errorCode
X} {1 {wrong # args: should be "file stat name varName"} NONE}
Xtest file-10.5 {stat option} {
X list [catch {file stat _non_existent_ a b} msg] $msg $errorCode
X} {1 {wrong # args: should be "file stat name varName"} NONE}
Xtest file-10.6 {stat option} {
X catch {unset x}
X set x 44
X list [catch {file stat gorp.file x} msg] $msg $errorCode
X} {1 {couldn't store stat information in variable "x"} NONE}
Xcatch {unset stat}
X
X# mtime, and size (I've given up trying to find a test for "atime": there
X# seem to be too many quirks in the way file systems handle this to come
X# up with a reproducible test.
X
Xtest file-11.1 {mtime and atime and size options} {
X catch {unset stat}
X file stat gorp.file stat
X list [expr {[file mtime gorp.file] == $stat(mtime)}] \
X [expr {[file atime gorp.file] == $stat(atime)}] \
X [file size gorp.file]
X} {1 1 11}
Xtest file-11.2 {mtime option} {
X set old [file mtime gorp.file]
X exec sleep 2
X set f [open gorp.file w]
X puts $f "More text"
X close $f
X set new [file mtime gorp.file]
X expr {($new > $old) && ($new <= ($old+5))}
X} {1}
Xtest file-11.3 {size option} {
X set oldsize [file size gorp.file]
X set f [open gorp.file a]
X puts $f "More text"
X close $f
X expr {[file size gorp.file] - $oldsize}
X} {10}
Xtest file-11.4 {errors in atime option} {
X list [catch {file atime _non_existent_ x} msg] $msg $errorCode
X} {1 {wrong # args: should be "file atime name"} NONE}
Xtest file-11.5 {errors in atime option} {
X string tolower [list [catch {file atime _non_existent_} msg] \
X $msg $errorCode]
X} {1 {couldn't stat "_non_existent_": no such file or directory} {unix enoent {no such file or directory}}}
Xtest file-11.6 {errors in mtime option} {
X list [catch {file mtime _non_existent_ x} msg] $msg $errorCode
X} {1 {wrong # args: should be "file mtime name"} NONE}
Xtest file-11.7 {errors in mtime option} {
X string tolower [list [catch {file mtime _non_existent_} msg] $msg \
X $errorCode]
X} {1 {couldn't stat "_non_existent_": no such file or directory} {unix enoent {no such file or directory}}}
Xtest file-11.8 {errors in size option} {
X list [catch {file size _non_existent_ x} msg] $msg $errorCode
X} {1 {wrong # args: should be "file size name"} NONE}
Xtest file-11.9 {errors in size option} {
X string tolower [list [catch {file size _non_existent_} msg] $msg \
X $errorCode]
X} {1 {couldn't stat "_non_existent_": no such file or directory} {unix enoent {no such file or directory}}}
X
Xexec rm -f gorp.file
X
X# Error conditions
X
Xtest file-12.1 {error conditions} {
X list [catch file msg] $msg
X} {1 {wrong # args: should be "file option name ?arg ...?"}}
Xtest file-12.2 {error conditions} {
X list [catch {file x} msg] $msg
X} {1 {wrong # args: should be "file option name ?arg ...?"}}
Xtest file-12.3 {error conditions} {
X list [catch {file exists x too} msg] $msg
X} {1 {wrong # args: should be "file exists name"}}
Xtest file-12.4 {error conditions} {
X list [catch {file gorp x} msg] $msg
X} {1 {bad option "gorp": should be atime, dirname, executable, exists, \
Xextension, isdirectory, isfile, mtime, owned, readable, root, size, stat, \
Xtail, or writable}}
Xtest file-12.5 {error conditions} {
X list [catch {file ex x} msg] $msg
X} {1 {bad option "ex": should be atime, dirname, executable, exists, \
Xextension, isdirectory, isfile, mtime, owned, readable, root, size, stat, \
Xtail, or writable}}
Xtest file-12.6 {error conditions} {
X list [catch {file is x} msg] $msg
X} {1 {bad option "is": should be atime, dirname, executable, exists, \
Xextension, isdirectory, isfile, mtime, owned, readable, root, size, stat, \
Xtail, or writable}}
Xtest file-12.7 {error conditions} {
X list [catch {file r x} msg] $msg
X} {1 {bad option "r": should be atime, dirname, executable, exists, \
Xextension, isdirectory, isfile, mtime, owned, readable, root, size, stat, \
Xtail, or writable}}
Xtest file-12.8 {error conditions} {
X list [catch {file s x} msg] $msg
X} {1 {bad option "s": should be atime, dirname, executable, exists, \
Xextension, isdirectory, isfile, mtime, owned, readable, root, size, stat, \
Xtail, or writable}}
END_OF_FILE
if test 9253 -ne `wc -c <'tcl6.1/tests/file.test'`; then
echo shar: \"'tcl6.1/tests/file.test'\" unpacked with wrong size!
fi
# end of 'tcl6.1/tests/file.test'
fi
if test -f 'tcl6.1/tests/proc.test' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/tests/proc.test'\"
else
echo shar: Extracting \"'tcl6.1/tests/proc.test'\" \(9157 characters\)
sed "s/^X//" >'tcl6.1/tests/proc.test' <<'END_OF_FILE'
X# Commands covered: proc, return, global


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/proc.test,v 1.9 91/10/31 16:40:55 ouster Exp $ (Berkeley)


X
Xif {[string compare test [info procs test]] == 1} then {source defs}
X

Xproc tproc {} {return a; return b}
Xtest proc-1.1 {simple procedure call and return} {tproc} a
Xproc tproc x {
X set x [expr $x+1]
X return $x
X}
Xtest proc-1.2 {simple procedure call and return} {tproc 2} 3
Xtest proc-1.3 {simple procedure call and return} {
X proc tproc {} {return foo}
X} {}
Xtest proc-1.4 {simple procedure call and return} {
X proc tproc {} {return}
X tproc
X} {}
X
Xtest proc-2.1 {local and global variables} {
X proc tproc x {
X set x [expr $x+1]
X return $x
X }
X set x 42
X list [tproc 6] $x
X} {7 42}
Xtest proc-2.2 {local and global variables} {
X proc tproc x {
X set y [expr $x+1]
X return $y
X }
X set y 18
X list [tproc 6] $y
X} {7 18}
Xtest proc-2.3 {local and global variables} {
X proc tproc x {
X global y
X set y [expr $x+1]
X return $y
X }
X set y 189
X list [tproc 6] $y
X} {7 7}
Xtest proc-2.4 {local and global variables} {
X proc tproc x {
X global y
X return [expr $x+$y]
X }
X set y 189
X list [tproc 6] $y
X} {195 189}
Xcatch {unset _undefined_}
Xtest proc-2.5 {local and global variables} {
X proc tproc x {
X global _undefined_
X return $_undefined_
X }
X list [catch {tproc xxx} msg] $msg
X} {1 {can't read "_undefined_": no such variable}}
Xtest proc-2.6 {local and global variables} {
X set a 114
X set b 115
X global a b
X list $a $b
X} {114 115}
X
Xproc do {cmd} {eval $cmd}
Xtest proc-3.1 {local and global arrays} {


X catch {unset a}
X set a(0) 22

X list [catch {do {global a; set a(0)}} msg] $msg
X} {0 22}
Xtest proc-3.2 {local and global arrays} {
X catch {unset a}
X set a(x) 22
X list [catch {do {global a; set a(x) newValue}} msg] $msg $a(x)
X} {0 newValue newValue}
Xtest proc-3.3 {local and global arrays} {
X catch {unset a}
X set a(x) 22
X set a(y) 33
X list [catch {do {global a; unset a(y)}; array names a} msg] $msg
X} {0 x}
Xtest proc-3.4 {local and global arrays} {
X catch {unset a}
X set a(x) 22
X set a(y) 33
X list [catch {do {global a; unset a; info exists a}} msg] $msg \
X [info exists a]
X} {0 0 0}
Xtest proc-3.5 {local and global arrays} {
X catch {unset a}
X set a(x) 22
X set a(y) 33
X list [catch {do {global a; unset a(y); array names a}} msg] $msg
X} {0 x}
Xcatch {unset a}
Xtest proc-3.6 {local and global arrays} {
X catch {unset a}
X set a(x) 22
X set a(y) 33
X do {global a; do {global a; unset a}; set a(z) 22}
X list [catch {array names a} msg] $msg
X} {0 z}
Xtest proc-3.7 {local and global arrays} {
X proc t1 {args} {global info; set info 1}
X catch {unset a}
X set info {}
X do {global a; trace var a(1) w t1}
X set a(1) 44
X set info
X} 1
Xtest proc-3.8 {local and global arrays} {
X proc t1 {args} {global info; set info 1}
X catch {unset a}
X trace var a(1) w t1
X set info {}
X do {global a; trace vdelete a(1) w t1}
X set a(1) 44
X set info
X} {}
Xtest proc-3.9 {local and global arrays} {
X proc t1 {args} {global info; set info 1}
X catch {unset a}
X trace var a(1) w t1
X do {global a; trace vinfo a(1)}
X} {{w t1}}
Xcatch {unset a}
X
Xtest proc-3.1 {arguments and defaults} {
X proc tproc {x y z} {
X return [list $x $y $z]
X }
X tproc 11 12 13
X} {11 12 13}
Xtest proc-3.2 {arguments and defaults} {
X proc tproc {x y z} {
X return [list $x $y $z]
X }
X list [catch {tproc 11 12} msg] $msg
X} {1 {no value given for parameter "z" to "tproc"}}
Xtest proc-3.3 {arguments and defaults} {
X proc tproc {x y z} {
X return [list $x $y $z]
X }
X list [catch {tproc 11 12 13 14} msg] $msg
X} {1 {called "tproc" with too many arguments}}
Xtest proc-3.4 {arguments and defaults} {
X proc tproc {x {y y-default} {z z-default}} {
X return [list $x $y $z]
X }
X tproc 11 12 13
X} {11 12 13}
Xtest proc-3.5 {arguments and defaults} {
X proc tproc {x {y y-default} {z z-default}} {
X return [list $x $y $z]
X }
X tproc 11 12
X} {11 12 z-default}
Xtest proc-3.6 {arguments and defaults} {
X proc tproc {x {y y-default} {z z-default}} {
X return [list $x $y $z]
X }
X tproc 11
X} {11 y-default z-default}
Xtest proc-3.7 {arguments and defaults} {
X proc tproc {x {y y-default} {z z-default}} {
X return [list $x $y $z]
X }
X list [catch {tproc} msg] $msg
X} {1 {no value given for parameter "x" to "tproc"}}
Xtest proc-3.8 {arguments and defaults} {
X list [catch {
X proc tproc {x {y y-default} z} {
X return [list $x $y $z]
X }
X tproc 2 3
X } msg] $msg
X} {1 {no value given for parameter "z" to "tproc"}}
Xtest proc-3.9 {arguments and defaults} {
X proc tproc {x {y y-default} args} {
X return [list $x $y $args]
X }
X tproc 2 3 4 5
X} {2 3 {4 5}}
Xtest proc-3.10 {arguments and defaults} {
X proc tproc {x {y y-default} args} {
X return [list $x $y $args]
X }
X tproc 2 3
X} {2 3 {}}
Xtest proc-3.11 {arguments and defaults} {
X proc tproc {x {y y-default} args} {
X return [list $x $y $args]
X }
X tproc 2
X} {2 y-default {}}
Xtest proc-3.12 {arguments and defaults} {
X proc tproc {x {y y-default} args} {
X return [list $x $y $args]
X }
X list [catch {tproc} msg] $msg
X} {1 {no value given for parameter "x" to "tproc"}}
X
Xtest proc-4.1 {variable numbers of arguments} {
X proc tproc args {return $args}
X tproc
X} {}
Xtest proc-4.2 {variable numbers of arguments} {
X proc tproc args {return $args}
X tproc 1 2 3 4 5 6 7 8
X} {1 2 3 4 5 6 7 8}
Xtest proc-4.3 {variable numbers of arguments} {
X proc tproc args {return $args}
X tproc 1 {2 3} {4 {5 6} {{{7}}}} 8
X} {1 {2 3} {4 {5 6} {{{7}}}} 8}
Xtest proc-4.4 {variable numbers of arguments} {
X proc tproc {x y args} {return $args}
X tproc 1 2 3 4 5 6 7
X} {3 4 5 6 7}
Xtest proc-4.5 {variable numbers of arguments} {
X proc tproc {x y args} {return $args}
X tproc 1 2
X} {}
Xtest proc-4.6 {variable numbers of arguments} {
X proc tproc {x missing args} {return $args}
X list [catch {tproc 1} msg] $msg
X} {1 {no value given for parameter "missing" to "tproc"}}
X
Xtest proc-5.1 {error conditions} {
X list [catch {proc} msg] $msg
X} {1 {wrong # args: should be "proc name args body"}}
Xtest proc-5.2 {error conditions} {
X list [catch {proc tproc b} msg] $msg
X} {1 {wrong # args: should be "proc name args body"}}
Xtest proc-5.3 {error conditions} {
X list [catch {proc tproc b c d e} msg] $msg
X} {1 {wrong # args: should be "proc name args body"}}
Xtest proc-5.4 {error conditions} {
X list [catch {proc tproc \{xyz {return foo}} msg] $msg


X} {1 {unmatched open brace in list}}

Xtest proc-5.5 {error conditions} {
X list [catch {proc tproc {{} y} {return foo}} msg] $msg
X} {1 {procedure "tproc" has argument with no name}}
Xtest proc-5.6 {error conditions} {
X list [catch {proc tproc {{} y} {return foo}} msg] $msg
X} {1 {procedure "tproc" has argument with no name}}
Xtest proc-5.7 {error conditions} {
X list [catch {proc tproc {{x 1 2} y} {return foo}} msg] $msg
X} {1 {too many fields in argument specifier "x 1 2"}}
Xtest proc-5.8 {error conditions} {
X catch {return}
X} 2
Xtest proc-5.9 {error conditions} {
X list [catch {return 1 2} msg] $msg
X} {1 {wrong # args: should be "return ?value?"}}
Xtest proc-5.10 {error conditions} {
X list [catch {global} msg] $msg
X} {1 {wrong # args: should be "global varName ?varName ...?"}}
Xproc tproc {} {
X set a 22
X global a
X}
Xtest proc-5.11 {error conditions} {
X list [catch {tproc} msg] $msg


X} {1 {variable "a" already exists}}

Xtest proc-5.12 {error conditions} {
X catch {rename tproc {}}
X catch {
X proc tproc {x {} z} {return foo}
X }
X list [catch {tproc 1} msg] $msg
X} {1 {invalid command name: "tproc"}}
Xtest proc-5.13 {error conditions} {
X proc tproc {} {
X set a 22
X error "error in procedure"
X return
X }
X list [catch tproc msg] $msg
X} {1 {error in procedure}}
Xtest proc-5.14 {error conditions} {
X proc tproc {} {
X set a 22
X error "error in procedure"
X return
X }
X catch tproc msg
X set errorInfo
X} {error in procedure
X while executing
X"error "error in procedure""
X (procedure "tproc" line 3)
X invoked from within
X"tproc"}
Xtest proc-5.15 {error conditions} {
X proc tproc {} {
X set a 22
X break
X return
X }
X catch tproc msg
X set errorInfo
X} {invoked "break" outside of a loop
X while executing
X"tproc"}
Xtest proc-5.16 {error conditions} {
X proc tproc {} {
X set a 22
X continue
X return
X }
X catch tproc msg
X set errorInfo
X} {invoked "continue" outside of a loop
X while executing
X"tproc"}
END_OF_FILE
if test 9157 -ne `wc -c <'tcl6.1/tests/proc.test'`; then
echo shar: \"'tcl6.1/tests/proc.test'\" unpacked with wrong size!
fi
# end of 'tcl6.1/tests/proc.test'
fi
if test -f 'tcl6.1/tests/regexp.test' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/tests/regexp.test'\"
else
echo shar: Extracting \"'tcl6.1/tests/regexp.test'\" \(9482 characters\)
sed "s/^X//" >'tcl6.1/tests/regexp.test' <<'END_OF_FILE'
X# Commands covered: regexp, regsub


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/regexp.test,v 1.5 91/10/27 15:20:14 ouster Exp $ (Berkeley)


X
Xif {[string compare test [info procs test]] == 1} then {source defs}
X

Xcatch {unset foo}
Xtest regexp-1.1 {basic regexp operation} {
X regexp ab*c abbbc
X} 1
Xtest regexp-1.2 {basic regexp operation} {
X regexp ab*c ac
X} 1
Xtest regexp-1.3 {basic regexp operation} {
X regexp ab*c ab
X} 0
X
Xtest regexp-2.1 {getting substrings back from regexp} {
X set foo {}
X list [regexp ab*c abbbbc foo] $foo
X} {1 abbbbc}
Xtest regexp-2.2 {getting substrings back from regexp} {
X set foo {}
X set f2 {}
X list [regexp a(b*)c abbbbc foo f2] $foo $f2
X} {1 abbbbc bbbb}
Xtest regexp-2.3 {getting substrings back from regexp} {
X set foo {}
X set f2 {}
X list [regexp a(b*)(c) abbbbc foo f2] $foo $f2
X} {1 abbbbc bbbb}
Xtest regexp-2.4 {getting substrings back from regexp} {
X set foo {}
X set f2 {}
X set f3 {}
X list [regexp a(b*)(c) abbbbc foo f2 f3] $foo $f2 $f3
X} {1 abbbbc bbbb c}
Xtest regexp-2.5 {getting substrings back from regexp} {
X set foo {}; set f1 {}; set f2 {}; set f3 {}; set f4 {}; set f5 {};
X set f6 {}; set f7 {}; set f8 {}; set f9 {}
X list [regexp (1*)(2*)(3*)(4*)(5*)(6*)(7*)(8*)(9*) 12223345556789999 \
X foo f1 f2 f3 f4 f5 f6 f7 f8 f9] $foo $f1 $f2 $f3 $f4 $f5 \
X $f6 $f7 $f8 $f9
X} {1 12223345556789999 1 222 33 4 555 6 7 8 9999}
Xtest regexp-2.6 {getting substrings back from regexp} {
X set foo 2; set f2 2; set f3 2; set f4 2
X list [regexp (a)(b)? xay foo f2 f3 f4] $foo $f2 $f3 $f4
X} {1 a a {} {}}
Xtest regexp-2.7 {getting substrings back from regexp} {
X set foo 1; set f2 1; set f3 1; set f4 1
X list [regexp (a)(b)?(c) xacy foo f2 f3 f4] $foo $f2 $f3 $f4
X} {1 ac a {} c}
X
Xtest regexp-3.1 {-indices option to regexp} {
X set foo {}
X list [regexp -indices ab*c abbbbc foo] $foo
X} {1 {0 5}}
Xtest regexp-3.2 {-indices option to regexp} {
X set foo {}
X set f2 {}
X list [regexp -indices a(b*)c abbbbc foo f2] $foo $f2
X} {1 {0 5} {1 4}}
Xtest regexp-3.3 {-indices option to regexp} {
X set foo {}
X set f2 {}
X list [regexp -indices a(b*)(c) abbbbc foo f2] $foo $f2
X} {1 {0 5} {1 4}}
Xtest regexp-3.4 {-indices option to regexp} {
X set foo {}
X set f2 {}
X set f3 {}
X list [regexp -indices a(b*)(c) abbbbc foo f2 f3] $foo $f2 $f3
X} {1 {0 5} {1 4} {5 5}}
Xtest regexp-3.5 {-indices option to regexp} {
X set foo {}; set f1 {}; set f2 {}; set f3 {}; set f4 {}; set f5 {};
X set f6 {}; set f7 {}; set f8 {}; set f9 {}
X list [regexp -indices (1*)(2*)(3*)(4*)(5*)(6*)(7*)(8*)(9*) \
X 12223345556789999 \
X foo f1 f2 f3 f4 f5 f6 f7 f8 f9] $foo $f1 $f2 $f3 $f4 $f5 \
X $f6 $f7 $f8 $f9
X} {1 {0 16} {0 0} {1 3} {4 5} {6 6} {7 9} {10 10} {11 11} {12 12} {13 16}}
Xtest regexp-3.6 {getting substrings back from regexp} {
X set foo 2; set f2 2; set f3 2; set f4 2
X list [regexp -indices (a)(b)? xay foo f2 f3 f4] $foo $f2 $f3 $f4
X} {1 {1 1} {1 1} {-1 -1} {-1 -1}}
Xtest regexp-3.7 {getting substrings back from regexp} {
X set foo 1; set f2 1; set f3 1; set f4 1
X list [regexp -indices (a)(b)?(c) xacy foo f2 f3 f4] $foo $f2 $f3 $f4
X} {1 {1 2} {1 1} {-1 -1} {2 2}}
X
Xtest regexp-4.1 {-nocase option to regexp} {
X regexp -nocase foo abcFOo
X} 1
Xtest regexp-4.2 {-nocase option to regexp} {
X set f1 22
X set f2 33
X set f3 44
X list [regexp -nocase {a(b*)([xy]*)z} aBbbxYXxxZ22 f1 f2 f3] $f1 $f2 $f3
X} {1 aBbbxYXxxZ Bbb xYXxx}
X
Xtest regexp-5.1 {exercise cache of compiled expressions} {
X regexp .*a b
X regexp .*b c
X regexp .*c d
X regexp .*d e
X regexp .*e f
X regexp .*a bbba
X} 1
Xtest regexp-5.2 {exercise cache of compiled expressions} {
X regexp .*a b
X regexp .*b c
X regexp .*c d
X regexp .*d e
X regexp .*e f
X regexp .*b xxxb
X} 1
Xtest regexp-5.3 {exercise cache of compiled expressions} {
X regexp .*a b
X regexp .*b c
X regexp .*c d
X regexp .*d e
X regexp .*e f
X regexp .*c yyyc
X} 1
Xtest regexp-5.4 {exercise cache of compiled expressions} {
X regexp .*a b
X regexp .*b c
X regexp .*c d
X regexp .*d e
X regexp .*e f
X regexp .*d 1d
X} 1
Xtest regexp-5.5 {exercise cache of compiled expressions} {
X regexp .*a b
X regexp .*b c
X regexp .*c d
X regexp .*d e
X regexp .*e f
X regexp .*e xe
X} 1
X
Xtest regexp-6.1 {regexp errors} {
X list [catch {regexp a} msg] $msg
X} {1 {wrong # args: should be "regexp ?-nocase? exp string ?matchVar? ?subMatchVar subMatchVar ...?"}}
Xtest regexp-6.2 {regexp errors} {
X list [catch {regexp -nocase a} msg] $msg
X} {1 {wrong # args: should be "regexp ?-nocase? exp string ?matchVar? ?subMatchVar subMatchVar ...?"}}
Xtest regexp-6.3 {regexp errors} {
X list [catch {regexp -nocas a} msg] $msg
X} {0 0}
Xtest regexp-6.4 {regexp errors} {
X list [catch {regexp a( b} msg] $msg
X} {1 {couldn't compile regular expression pattern: unmatched ()}}
Xtest regexp-6.5 {regexp errors} {
X list [catch {regexp a( b} msg] $msg
X} {1 {couldn't compile regular expression pattern: unmatched ()}}
Xtest regexp-6.6 {regexp errors} {
X list [catch {regexp a a f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1} msg] $msg
X} {1 {too many substring variables}}
Xtest regexp-6.7 {regexp errors} {
X set f1 44
X list [catch {regexp abc abc f1(f2)} msg] $msg
X} {1 {couldn't set variable "f1(f2)"}}
X
Xtest regexp-7.1 {basic regsub operation} {
X list [regsub aa+ xaxaaaxaa 111&222 foo] $foo
X} {1 xax111aaa222xaa}
Xtest regexp-7.2 {basic regsub operation} {
X list [regsub aa+ aaaxaa &111 foo] $foo
X} {1 aaa111xaa}
Xtest regexp-7.3 {basic regsub operation} {
X list [regsub aa+ xaxaaa 111& foo] $foo
X} {1 xax111aaa}
Xtest regexp-7.4 {basic regsub operation} {
X list [regsub aa+ aaa 11&2&333 foo] $foo
X} {1 11aaa2aaa333}
Xtest regexp-7.5 {basic regsub operation} {
X list [regsub aa+ xaxaaaxaa &2&333 foo] $foo
X} {1 xaxaaa2aaa333xaa}
Xtest regexp-7.6 {basic regsub operation} {
X list [regsub aa+ xaxaaaxaa 1&22& foo] $foo
X} {1 xax1aaa22aaaxaa}
Xtest regexp-7.7 {basic regsub operation} {
X list [regsub a(a+) xaxaaaxaa {1\122\1} foo] $foo
X} {1 xax1aa22aaxaa}
Xtest regexp-7.8 {basic regsub operation} {
X list [regsub a(a+) xaxaaaxaa {1\\\122\1} foo] $foo
X} "1 {xax1\\aa22aaxaa}"
Xtest regexp-7.9 {basic regsub operation} {
X list [regsub a(a+) xaxaaaxaa {1\\122\1} foo] $foo
X} "1 {xax1\\122aaxaa}"
Xtest regexp-7.10 {basic regsub operation} {
X list [regsub a(a+) xaxaaaxaa {1\\&\1} foo] $foo
X} "1 {xax1\\aaaaaxaa}"
Xtest regexp-7.11 {basic regsub operation} {
X list [regsub a(a+) xaxaaaxaa {1\&\1} foo] $foo
X} {1 xax1&aaxaa}
Xtest regexp-7.12 {basic regsub operation} {
X list [regsub a(a+) xaxaaaxaa {\1\1\1\1&&} foo] $foo
X} {1 xaxaaaaaaaaaaaaaaxaa}
Xtest regexp-7.13 {basic regsub operation} {
X set foo xxx
X list [regsub abc xyz 111 foo] $foo
X} {0 xxx}
X
Xtest regexp-8.1 {case conversion in regsub} {
X list [regsub -nocase a(a+) xaAAaAAay & foo] $foo
X} {1 xaAAaAAay}
Xtest regexp-8.2 {case conversion in regsub} {
X list [regsub -nocase a(a+) xaAAaAAay & foo] $foo
X} {1 xaAAaAAay}
Xtest regexp-8.3 {case conversion in regsub} {
X set foo 123
X list [regsub a(a+) xaAAaAAay & foo] $foo
X} {0 123}
X
Xtest regexp-9.1 {-all option to regsub} {
X set foo 86
X list [regsub -all x+ axxxbxxcxdx |&| foo] $foo
X} {1 a|xxx|b|xx|c|x|d|x|}
Xtest regexp-9.2 {-all option to regsub} {
X set foo 86
X list [regsub -nocase -all x+ aXxXbxxcXdx |&| foo] $foo
X} {1 a|XxX|b|xx|c|X|d|x|}
Xtest regexp-9.3 {-all option to regsub} {
X set foo 86
X list [regsub x+ axxxbxxcxdx |&| foo] $foo
X} {1 a|xxx|bxxcxdx}
Xtest regexp-9.4 {-all option to regsub} {
X set foo 86
X list [regsub -all bc axxxbxxcxdx |&| foo] $foo
X} {0 86}
Xtest regexp-9.5 {-all option to regsub} {
X set foo xxx
X list [regsub -all node "node node more" yy foo] $foo
X} {1 {yy yy more}}
X
Xtest regexp-10.1 {regsub errors} {
X list [catch {regsub a b c} msg] $msg
X} {1 {wrong # args: should be "regsub ?-nocase? ?-all? exp string subSpec varName"}}
Xtest regexp-10.2 {regsub errors} {
X list [catch {regsub -nocase a b c} msg] $msg
X} {1 {wrong # args: should be "regsub ?-nocase? ?-all? exp string subSpec varName"}}
Xtest regexp-10.3 {regsub errors} {
X list [catch {regsub -nocase -all a b c} msg] $msg
X} {1 {wrong # args: should be "regsub ?-nocase? ?-all? exp string subSpec varName"}}
Xtest regexp-10.4 {regsub errors} {
X list [catch {regsub a b c d e f} msg] $msg
X} {1 {wrong # args: should be "regsub ?-nocase? ?-all? exp string subSpec varName"}}
Xtest regexp-10.5 {regsub errors} {
X list [catch {regsub -nocas a b c} msg] $msg
X} {0 0}
Xtest regexp-10.6 {regsub errors} {
X list [catch {regsub -nocase a( b c d} msg] $msg
X} {1 {couldn't compile regular expression pattern: unmatched ()}}
Xtest regexp-10.7 {regsub errors} {
X list [catch {regsub -nocase aaa aaa xxx f1(f2)} msg] $msg
X} {1 {couldn't set variable "f1(f2)"}}
END_OF_FILE
if test 9482 -ne `wc -c <'tcl6.1/tests/regexp.test'`; then
echo shar: \"'tcl6.1/tests/regexp.test'\" unpacked with wrong size!
fi
# end of 'tcl6.1/tests/regexp.test'
fi
echo shar: End of archive 7 \(of 33\).
cp /dev/null ark7isdone

Karl Lehenbauer

unread,
Nov 14, 1991, 3:28:31 PM11/14/91
to
Submitted-by: ka...@sugar.neosoft.com (Karl Lehenbauer)
Posting-number: Volume 25, Issue 76
Archive-name: tcl/part08
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 8 (of 33)."
# Contents: tcl6.1/README tcl6.1/doc/SetResult.man
# tcl6.1/doc/SetVar.man tcl6.1/tests/string.test
# Wrapped by karl@one on Tue Nov 12 19:44:17 1991


PATH=/bin:/usr/bin:/usr/ucb ; export PATH

if test -f 'tcl6.1/README' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl6.1/README'\"
else
echo shar: Extracting \"'tcl6.1/README'\" \(10992 characters\)
sed "s/^X//" >'tcl6.1/README' <<'END_OF_FILE'
XTcl
X
Xby John Ousterhout
XUniversity of California at Berkeley
Xou...@sprite.berkeley.edu
X
X1. Introduction
X---------------
X
XThis directory contains the sources and documentation for Tcl, an
Xembeddable tool command language. The information here corresponds
Xto release 6.1. The 6.x releases of Tcl are different in many ways
Xfrom releases before 6.0. See below for general information on potential
Xincompatibilies. The file "changes" has a complete list of all changes
Xmade to Tcl, with incompatible changes specially marked. Tcl 6.1 has
Xonly one incompatible change relative to 6.0, concerning the "regexp"
Xcommand.
X
XFor an introduction to the facilities provided by Tcl, see the paper
X``Tcl: An Embeddable Command Language'', in the Proceedings of the
X1990 Winter USENIX Conference. A copy of that paper is included here
Xin Postscript form in the file "doc/usenix.ps" and in text form in the
Xfile "doc/usenix.text". However, the paper corresponds to a much
Xearlier version of Tcl (approximately version 3.0), so some details
Xof the paper may not be correct anymore and there are many new features
Xnot documented in the paper.
X
X2. Documentation
X----------------
X
XThe "doc" subdirectory contains a complete set of manual entries
Xfor Tcl. The file "doc/Tcl.man" gives an overall description of the
XTcl language and describes the core Tcl commands. The other ".man"
Xfiles in "doc" describe the library procedures that Tcl provides for
XTcl-based applications. Read the "Tcl" man page first. To print any
Xof the man pages, cd to the "doc" directory and invoke your favorite
Xvariant of troff using the normal -man macros, for example
X
X ditroff -man <file>
X
Xwhere <file> is the name of the man page you'd like to print.
X
X3. Machines supported
X---------------------
X
XIf you follow the directions below, this release should compile
Xand run on the following configurations either "out of the box"
Xor with only trivial changes:
X
X - Sun-3's, Sun-4's, SPARCstation-1's and SPARCstation-2's running
X many variants of SunOS, such as 4.1.
X - DECstation-3100's and DECstation-5000's running many versions of
X Ultrix, such as 2.0 and 4.2.
X - DEC VAXes running many versions of Ultrix or BSD UNIX.
X - Intel 386 based systems running SCO Unix 3.2v2.
X - Intel 386 based systems running SCO Xenix 2.3.3.
X - Intel 386 based systems running Bell-Tech (now Intel) Unix 3.2.0.
X - Silicon Graphics systems running IRIX 4.0.
X - Various H-P machines running versions of HP-UX such as 7.05
X
XIf you find problems running Tcl on any of the above configurations,
Xplease let me know. Also, if you are able to compile Tcl and run the
Xtest suite successfully on configurations not listed above, please
Xlet me know and tell me what changes, if any, you needed to make to
Xdo it. I'd like to keep the above list up-to-date and continue to
Ximprove the portability of Tcl.
X
X4. Compiling Tcl
X----------------
X
XTo compile Tcl on any of the configurations listed above, or systems
Xsimilar to them, do the following:
X
X (a) Edit the "set" commands at the beginning of the file "config"
X if necessary to correspond to your system configuration (they
X should already be right for most versions of Unix).
X
X (b) Type "./config" in the top-level directory. "Config" is a script
X that pokes around in your system to see if certain almost-standard
X things are missing (header files, library procedures, etc.);
X if your system doesn't seem to have them, it configures Tcl to
X use its own copies of these things instead (Tcl's copies are
X kept in the "compat" subdirectory). Config prints out messages
X for all the substitutions it made. You can ignore any of the
X messages unless they say "ERROR!!"; in this case something is
X fundamentally wrong and the config script couldn't handle your
X system configuration.
X
X (c) Type "make" to compile the library. This will create the Tcl
X library in "libtcl.a". The Makefile should work without any
X modifications but you may wish to personalize it, e.g. to
X turn on compiler optimization.
X
X (d) If the combination of "config" and "make" doesn't work for you,
X then I suggest the following approach:
X - Start again with a fresh copy of the distribution.
X - Set the #defines that appear at the very front of
X tclUnix.h (before the first #include) to correspond
X to your system.
X - Modify Makefile to set CC, CFLAGS, etc. for your system.
X - If things don't compile or don't link, then you may need
X to copy some of the .c or .h files from the "compat"
X directory into the main Tcl directory to compensate for
X files missing from your system. Modify the COMPAT_OBJS
X definition in Makefile to include a .o name for each of
X the .c files that you copied up from the compat directory.
X
X (e) Create a directory /usr/local/lib/tcl and copy all the files
X from the "library" subdirectory to /usr/local/lib/tcl. Or,
X you can use some other directory as library, but you'll need
X to modify the Makefile to reflect this fact (change the
X TCL_LIBRARY definition).
X
X (f) Type "make tclTest", which will create a simple test program that
X you can use to try out the Tcl facilities. TclTest is just a
X main-program sandwich around the Tcl library. It reads standard
X input until it reaches the end of a line where parentheses and
X backslashes are balanced, then sends everything it's read to the
X Tcl interpreter. When the Tcl interpreter returns, tclTest prints
X the return value or error message. TclTest defines a few other
X additional commands, most notably:
X
X echo arg arg ...
X
X The "echo" command prints its arguments on standard output,
X separated by spaces.
X
X5. Test suite
X-------------
X
XThere is a relatively complete test suite for all of the Tcl core in
Xthe subdirectory "tests". To use it, run tclTest in this directory
Xand then type the following commands:
X
X cd tests
X source all
X
XYou should then see a printout of the test files processed. If any
Xerrors occur, you'll see a much more substantial printout for each
Xerror. Tcl should pass the test suite cleanly on all of the systems
Xlisted in Section 3. See the README file in the "tests" directory
Xfor more information on the test suite.
X
X6. Compiling on non-UNIX systems
X--------------------------------
X
XThe Tcl features that depend on system calls peculiar to UNIX (stat,
Xfork, exec, times, etc.) are now separate from the main body of Tcl,
Xwhich only requires a few generic library procedures such as malloc
Xand strcpy. Thus it should be relatively easy to compile Tcl for
Xthese machines, although a number of UNIX-specific commands will
Xbe absent (e.g. exec, time, and glob). See the comments at the
Xtop of Makefile for information on how to compile without the UNIX
Xfeatures.
X
X7. Major changes for release 6.0
X--------------------------------
X
XVersion 6.0 is a major new release with a number of improvements over
Xearlier releases and several changes that are not backward compatible.
XIf you've been using earlier releases of Tcl you'll need to make changes
Xto both your Tcl scripts and to your C application code in order to
Xuse this release. In general, a change in the major release number
X(e.g. from 5.x to 6.x) means that there are significant incompatibilities
Xbetween the new release and old releases.
X
XA complete list of all changes to Tcl can be found in the file "changes",
Xin chronological order. In addition, the manual entries contain change
Xbars in the right margins for all recent changes (the "changes" file
Xindicates the last time that all the change bars were removed from the
Xdocumentation). Here is a short list of some of the most significant
Xenhancements in Tcl 6.0:
X
X - Floating-point support in expressions
X - Associative arrays
X - Support in "exec" for pipelines, background, redirection
X - Support for regular expressions and other forms of string manipulation
X - New commands for file I/O (open, close, gets, puts, etc.)
X - Support for demand-loading of Tcl scripts
X - Several new list-manipulation commands
X - Improved portability, especially to System-V systems
X - ANSI C function prototypes
X - Improved test suite
X - Many other new commands
X
XHere is a list of the most important incompatibilities introduced by
XTcl 6.0:
X
X - Newlines inside bracketed commands used to be treated as word
X separators; they are now treated as command separators (this is
X consistent with the way newlines are treated elsewhere in Tcl).
X - The order of arguments to the "file" command has been changed so
X that the "option" argument is first instead of second (this makes
X "file" consistent with all other Tcl commands).
X - The "index", "length", "print", and "range" commands have all been
X deleted (similar effects can be achieved using other commands).
X - Command abbreviations are no longer supported directly (but they
X can be added using the "unknown" command and are supported in the
X library version of "unknown").
X - The "<" notation in "exec" has been changed to "<<".
X - The "exec" command deletes the last character of program output if
X it is a newline (in most cases this makes it easier to parse the
X program output).
X - The variable-tracing mechanism has been totally changed to accommodate
X associative arrays; most of the C interfaces to Tcl variables have
X changed at least slightly.
X - The C interfaces to the expression evaluator and to Tcl_Eval have
X changed slightly.
X
X8. Special thanks
X-----------------
X
XMark Diekhans and Karl Lehenbauer of Santa Cruz Operation deserve special
Xthanks for all their help during the development of Tcl 6.0. Many of the
Xnew features in Tcl 6.0 were inspired by an enhanced version of Tcl 3.3
Xcalled Extended Tcl 4.0, which was created by Mark, Karl, and Peter
Xda Silva. Mark and Karl explained these features to me and provided
Xexcellent (and challenging) feedback during the 6.0 development process.
XThey were also a great help in finding and fixing portability problems.
XWithout their ideas and assistance Tcl 6.0 would be much less powerful.
X
X9. Support
X----------
X
XThere is no official support organization for Tcl, and I can't promise
Xto provide much hand-holding to people learning Tcl. However, I'm very
Xinterested in receiving bug reports and suggestions for improvements.
XBugs usually get fixed quickly (particularly if they are serious), but
Xenhancements may take a while and may not happen at all unless there
Xis widespread support for them.
X
X10. Tcl mailing list
X--------------------
X
XI maintain a mail alias of people interested in exchangin