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

Text File | 1991-11-14 | 50.5 KB | 1,557 lines

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

Submitted-by: [e-mail] (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'\"
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_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
MISSING=""
for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 ; do
    if test ! -f ark${I}isdone ; then
    MISSING="${MISSING} ${I}"
    fi
done
if test "${MISSING}" = "" ; then
    echo You have unpacked all 33 archives.
    rm -f ark[1-9]isdone ark[1-9][0-9]isdone
else
    echo You still need to unpack the following archives:
    echo "        " ${MISSING}
fi
##  End of shell archive.
exit 0

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