Usenet 1994 January

home *** CD-ROM | disk | FTP | other *** search

/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / misc / volume25 / tcl / part03 < prev next >

Wrap

Text File | 1991-11-14 | 51.4 KB | 1,730 lines

Newsgroups: comp.sources.misc From: karl@sugar.neosoft.com (Karl Lehenbauer) Subject: v25i071: tcl - tool command language, version 6.1, Part03/33 Message-ID: <1991Nov14.202607.23225@sparky.imd.sterling.com> X-Md4-Signature: 5431be559e1574f4be32411910916f5d Date: Thu, 14 Nov 1991 20:26:07 GMT Approved: kent@sparky.imd.sterling.com Submitted-by: karl@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 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: kent@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 kent@uunet.uu.net.