Index: configure ================================================================== --- configure +++ configure @@ -1,8 +1,8 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.69 for sample 0.5. +# Generated by GNU Autoconf 2.69 for regexp2 0.1. # # # Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc. # # @@ -573,14 +573,14 @@ subdirs= MFLAGS= MAKEFLAGS= # Identity of this package. -PACKAGE_NAME='sample' -PACKAGE_TARNAME='sample' -PACKAGE_VERSION='0.5' -PACKAGE_STRING='sample 0.5' +PACKAGE_NAME='regexp2' +PACKAGE_TARNAME='regexp2' +PACKAGE_VERSION='0.1' +PACKAGE_STRING='regexp2 0.1' PACKAGE_BUGREPORT='' PACKAGE_URL='' # Factoring default headers for most tests. ac_includes_default="\ @@ -709,10 +709,11 @@ htmldir infodir docdir oldincludedir includedir +runstatedir localstatedir sharedstatedir sysconfdir datadir datarootdir @@ -789,10 +790,11 @@ datarootdir='${prefix}/share' datadir='${datarootdir}' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' +runstatedir='${localstatedir}/run' includedir='${prefix}/include' oldincludedir='/usr/include' docdir='${datarootdir}/doc/${PACKAGE_TARNAME}' infodir='${datarootdir}/info' htmldir='${docdir}' @@ -1040,10 +1042,19 @@ psdir=$ac_optarg ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) silent=yes ;; + + -runstatedir | --runstatedir | --runstatedi | --runstated \ + | --runstate | --runstat | --runsta | --runst | --runs \ + | --run | --ru | --r) + ac_prev=runstatedir ;; + -runstatedir=* | --runstatedir=* | --runstatedi=* | --runstated=* \ + | --runstate=* | --runstat=* | --runsta=* | --runst=* | --runs=* \ + | --run=* | --ru=* | --r=*) + runstatedir=$ac_optarg ;; -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ | --sbi=* | --sb=*) @@ -1178,11 +1189,11 @@ # Check all directory arguments for consistency. for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ datadir sysconfdir sharedstatedir localstatedir includedir \ oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ - libdir localedir mandir + libdir localedir mandir runstatedir do eval ac_val=\$$ac_var # Remove trailing slashes. case $ac_val in */ ) @@ -1291,11 +1302,11 @@ # if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF -\`configure' configures sample 0.5 to adapt to many kinds of systems. +\`configure' configures regexp2 0.1 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... To assign environment variables (e.g., CC, CFLAGS...), specify them as VAR=VALUE. See below for descriptions of some of the useful variables. @@ -1331,19 +1342,20 @@ --sbindir=DIR system admin executables [EPREFIX/sbin] --libexecdir=DIR program executables [EPREFIX/libexec] --sysconfdir=DIR read-only single-machine data [PREFIX/etc] --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] --localstatedir=DIR modifiable single-machine data [PREFIX/var] + --runstatedir=DIR modifiable per-process data [LOCALSTATEDIR/run] --libdir=DIR object code libraries [EPREFIX/lib] --includedir=DIR C header files [PREFIX/include] --oldincludedir=DIR C header files for non-gcc [/usr/include] --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] --datadir=DIR read-only architecture-independent data [DATAROOTDIR] --infodir=DIR info documentation [DATAROOTDIR/info] --localedir=DIR locale-dependent data [DATAROOTDIR/locale] --mandir=DIR man documentation [DATAROOTDIR/man] - --docdir=DIR documentation root [DATAROOTDIR/doc/sample] + --docdir=DIR documentation root [DATAROOTDIR/doc/regexp2] --htmldir=DIR html documentation [DOCDIR] --dvidir=DIR dvi documentation [DOCDIR] --pdfdir=DIR pdf documentation [DOCDIR] --psdir=DIR ps documentation [DOCDIR] _ACEOF @@ -1352,11 +1364,11 @@ _ACEOF fi if test -n "$ac_init_help"; then case $ac_init_help in - short | recursive ) echo "Configuration of sample 0.5:";; + short | recursive ) echo "Configuration of regexp2 0.1:";; esac cat <<\_ACEOF Optional Features: --disable-option-checking ignore unrecognized --enable/--with options @@ -1452,11 +1464,11 @@ fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF -sample configure 0.5 +regexp2 configure 0.1 generated by GNU Autoconf 2.69 Copyright (C) 2012 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. @@ -1817,11 +1829,11 @@ } # ac_fn_c_check_header_mongrel cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. -It was created by sample $as_me 0.5, which was +It was created by regexp2 $as_me 0.1, which was generated by GNU Autoconf 2.69. Invocation command line was $ $0 $@ _ACEOF @@ -2219,11 +2231,11 @@ do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_CYGPATH="cygpath -w" + ac_cv_prog_CYGPATH="cygpath -m" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done @@ -2244,13 +2256,12 @@ EXEEXT=".exe" TEA_PLATFORM="windows" ;; *CYGWIN_*) - CYGPATH=echo EXEEXT=".exe" - # TEA_PLATFORM is determined later in LOAD_TCLCONFIG + # CYGPATH and TEA_PLATFORM are determined later in LOAD_TCLCONFIG ;; *) CYGPATH=echo # Maybe we are cross-compiling.... case ${host_alias} in @@ -3354,13 +3365,55 @@ ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO"; then : - TEA_PLATFORM="unix" + + TEA_PLATFORM="unix" + CYGPATH=echo + else - TEA_PLATFORM="windows" + + TEA_PLATFORM="windows" + # Extract the first word of "cygpath", so it can be a program name with args. +set dummy cygpath; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CYGPATH+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CYGPATH"; then + ac_cv_prog_CYGPATH="$CYGPATH" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CYGPATH="cygpath -m" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + test -z "$ac_cv_prog_CYGPATH" && ac_cv_prog_CYGPATH="echo" +fi +fi +CYGPATH=$ac_cv_prog_CYGPATH +if test -n "$CYGPATH"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CYGPATH" >&5 +$as_echo "$CYGPATH" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext CC=$hold_cc { $as_echo "$as_me:${as_lineno-$LINENO}: result: $TEA_PLATFORM" >&5 @@ -5285,11 +5338,11 @@ # This defines PKG(_STUB)_SOURCES, PKG(_STUB)_OBJECTS, PKG_HEADERS # and PKG_TCL_SOURCES. #----------------------------------------------------------------------- - vars="sample.c tclsample.c" + vars="regexp2.c" for i in $vars; do case $i in \$*) # allow $-var names PKG_SOURCES="$PKG_SOURCES $i" @@ -6413,11 +6466,11 @@ runtime=-MT else runtime=-MD fi case "x`echo \${VisualStudioVersion}`" in - x14*) + x1[4-9]*) lflags="${lflags} -nodefaultlib:libucrt.lib" vars="ucrt.lib" for i in $vars; do if test "${TEA_PLATFORM}" = "windows" -a "$GCC" = "yes" ; then @@ -9160,11 +9213,11 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # Save the log message, to keep $0 and so on meaningful, and to # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" -This file was extended by sample $as_me 0.5, which was +This file was extended by regexp2 $as_me 0.1, which was generated by GNU Autoconf 2.69. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS CONFIG_LINKS = $CONFIG_LINKS @@ -9213,11 +9266,11 @@ _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" ac_cs_version="\\ -sample config.status 0.5 +regexp2 config.status 0.1 configured by $0, generated by GNU Autoconf 2.69, with options \\"\$ac_cs_config\\" Copyright (C) 2012 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation Index: configure.ac ================================================================== --- configure.ac +++ configure.ac @@ -17,11 +17,11 @@ # so you can encode the package version directly into the source files. # This will also define a special symbol for Windows (BUILD_ # so that we create the export library with the dll. #----------------------------------------------------------------------- -AC_INIT([sample], [0.5]) +AC_INIT([regexp2], [0.1]) #-------------------------------------------------------------------- # Call TEA_INIT as the first TEA_ macro to set up initial vars. # This will define a ${TEA_PLATFORM} variable == "unix" or "windows" # as well as PKG_LIB_FILE and PKG_STUB_LIB_FILE. @@ -69,11 +69,11 @@ # and runtime Tcl library files in TEA_ADD_TCL_SOURCES. # This defines PKG(_STUB)_SOURCES, PKG(_STUB)_OBJECTS, PKG_HEADERS # and PKG_TCL_SOURCES. #----------------------------------------------------------------------- -TEA_ADD_SOURCES([sample.c tclsample.c]) +TEA_ADD_SOURCES([regexp2.c]) TEA_ADD_HEADERS([]) TEA_ADD_INCLUDES([]) TEA_ADD_LIBS([]) TEA_ADD_CFLAGS([]) TEA_ADD_STUB_SOURCES([]) ADDED generic/regexp2.c Index: generic/regexp2.c ================================================================== --- generic/regexp2.c +++ generic/regexp2.c @@ -0,0 +1,406 @@ +/* + * gcc -shared -DUSE_TCL_STUBS -I/usr/include/tcl8.6 -L/usr/lib/tcl8.6 regexp2.c -ltclstub8.6 -o regexp2.so + */ +#include +#define DEBUG +#ifdef DEBUG +# define dprint(x,...) printf(x,##__VA_ARGS__) +#else +# define dprint(x,...) (void)0 +#endif + +int +Tcl_RegexpObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + int i, indices, match, about, offset, all, doinline, partial; + int cflags, eflags, numMatchesSaved, stringLength, matchLength; + Tcl_RegExp regExpr; + Tcl_Obj* partialVar; + Tcl_Obj *objPtr, *startIndex = NULL, *resultPtr = NULL; + Tcl_RegExpInfo info; + static const char *const options[] = { + "-all", "-about", "-indices", "-inline", + "-expanded", "-line", "-linestop", "-lineanchor", + "-nocase", "-start", "-partial", "--", + NULL + }; + enum options { + REGEXP_ALL, REGEXP_ABOUT, REGEXP_INDICES, REGEXP_INLINE, + REGEXP_EXPANDED,REGEXP_LINE, REGEXP_LINESTOP,REGEXP_LINEANCHOR, + REGEXP_NOCASE, REGEXP_START, REGEXP_PARTIAL, REGEXP_LAST + }; + + indices = 0; + about = 0; + cflags = TCL_REG_ADVANCED; + offset = 0; + all = 0; + doinline = 0; + partial = 0; + + for (i = 1; i < objc; i++) { + const char *name; + int index; + + name = Tcl_GetString(objv[i]); + if (name[0] != '-') { + break; + } + if (Tcl_GetIndexFromObj(interp, objv[i], options, "switch", TCL_EXACT, + &index) != TCL_OK) { + goto optionError; + } + switch ((enum options) index) { + case REGEXP_ALL: + all = 1; + break; + case REGEXP_INDICES: + indices = 1; + break; + case REGEXP_INLINE: + doinline = 1; + break; + case REGEXP_NOCASE: + cflags |= TCL_REG_NOCASE; + break; + case REGEXP_ABOUT: + about = 1; + break; + case REGEXP_EXPANDED: + cflags |= TCL_REG_EXPANDED; + break; + case REGEXP_LINE: + cflags |= TCL_REG_NEWLINE; + break; + case REGEXP_LINESTOP: + cflags |= TCL_REG_NLSTOP; + break; + case REGEXP_LINEANCHOR: + cflags |= TCL_REG_NLANCH; + break; + case REGEXP_START: { + int temp; + if (++i >= objc) { + goto endOfForLoop; + } + if (Tcl_GetIntFromObj(interp, objv[i], &temp) != TCL_OK) { + goto optionError; + } + if (startIndex) { + Tcl_DecrRefCount(startIndex); + } + startIndex = objv[i]; + Tcl_IncrRefCount(startIndex); + break; + } + case REGEXP_PARTIAL: + if (++i >= objc) { + goto endOfForLoop; + } + cflags |= TCL_REG_CANMATCH; + partial = 1; + partialVar = objv[i]; +dprint("Partial matching in %s\n", Tcl_GetString(objv[i])); + break; + case REGEXP_LAST: + i++; + goto endOfForLoop; + } + } + + endOfForLoop: + if ((objc - i) < (2 - about)) { + Tcl_WrongNumArgs(interp, 1, objv, + "?-switch ...? exp string ?matchVar? ?subMatchVar ...?"); + goto optionError; + } + objc -= i; + objv += i; + + /* + * Check if the user requested -inline, but specified match variables; a + * no-no. + */ + + if (doinline && ((objc - 2) != 0)) { + Tcl_AppendResult(interp, "regexp match variables not allowed" + " when using -inline", NULL); + goto optionError; + } + + /* + * Handle the odd about case separately. + */ + + if (about) { + regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags); + if ((regExpr == NULL) || (TclRegAbout(interp, regExpr) < 0)) { + optionError: + if (startIndex) { + Tcl_DecrRefCount(startIndex); + } + return TCL_ERROR; + } + return TCL_OK; + } + + /* + * Get the length of the string that we are matching against so we can do + * the termination test for -all matches. Do this before getting the + * regexp to avoid shimmering problems. + */ + + objPtr = objv[1]; + stringLength = Tcl_GetCharLength(objPtr); + + if (startIndex) { + Tcl_GetIntFromObj(interp, startIndex, &offset); + Tcl_DecrRefCount(startIndex); + if (offset < 0) { + offset = 0; + } + } + + regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags); + if (regExpr == NULL) { + return TCL_ERROR; + } + + objc -= 2; + objv += 2; + + if (doinline) { + /* + * Save all the subexpressions, as we will return them as a list + */ + + numMatchesSaved = -1; + } else { + /* + * Save only enough subexpressions for matches we want to keep, expect + * in the case of -all, where we need to keep at least one to know + * where to move the offset. + */ + + numMatchesSaved = (objc == 0) ? all : objc; + } + + /* + * The following loop is to handle multiple matches within the same source + * string; each iteration handles one match. If "-all" hasn't been + * specified then the loop body only gets executed once. We terminate the + * loop when the starting offset is past the end of the string. + */ + + while (1) { + /* + * Pass either 0 or TCL_REG_NOTBOL in the eflags. Passing + * TCL_REG_NOTBOL indicates that the character at offset should not be + * considered the start of the line. If for example the pattern {^} is + * passed and -start is positive, then the pattern will not match the + * start of the string unless the previous character is a newline. + */ + + if (offset == 0) { + eflags = 0; + } else if (offset > stringLength) { + eflags = TCL_REG_NOTBOL; + } else if (Tcl_GetUniChar(objPtr, offset-1) == (Tcl_UniChar)'\n') { + eflags = 0; + } else { + eflags = TCL_REG_NOTBOL; + } + + match = Tcl_RegExpExecObj(interp, regExpr, objPtr, offset, + numMatchesSaved, eflags); +dprint("Tcl_RegExpExecObj returns %d\n", match); + if (match < 0) { + return TCL_ERROR; + } + + if (match == 0) { + /* + * If partial-match reporting has been requested, store the offset + * of the partial match (or -1) in the given variable + */ + if(partial) { + int partialOffset; + Tcl_RegExpGetInfo(regExpr, &info); + partialOffset = info.extendStart; +dprint("partialOffset = %d, stringLength = %d, NLANCH = %d\n", partialOffset, stringLength, cflags & TCL_REG_NLANCH); + if(((cflags & TCL_REG_NLANCH) == 0) && (partialOffset == stringLength)) { + partialOffset = -1; + } +dprint("Storing partial match result %d\n", info.extendStart); + if(Tcl_ObjSetVar2(interp, partialVar, NULL, + Tcl_NewLongObj(partialOffset), + TCL_LEAVE_ERR_MSG) == NULL) { + return TCL_ERROR; + } + } + + /* + * We want to set the value of the intepreter result only when + * this is the first time through the loop. + */ + + if (all <= 1) { + /* + * If inlining, the interpreter's object result remains an + * empty list, otherwise set it to an integer object w/ value + * 0. + */ + + if (!doinline) { + Tcl_SetObjResult(interp, Tcl_NewIntObj(0)); + } + return TCL_OK; + } + break; + } + + /* + * If additional variable names have been specified, return index + * information in those variables. + */ + + Tcl_RegExpGetInfo(regExpr, &info); + if (doinline) { + /* + * It's the number of substitutions, plus one for the matchVar at + * index 0 + */ + + objc = info.nsubs + 1; + if (all <= 1) { + resultPtr = Tcl_NewObj(); + } + } + for (i = 0; i < objc; i++) { + Tcl_Obj *newPtr; + + if (indices) { + int start, end; + Tcl_Obj *objs[2]; + + /* + * Only adjust the match area if there was a match for that + * area. (Scriptics Bug 4391/SF Bug #219232) + */ + + if (i <= info.nsubs && info.matches[i].start >= 0) { + start = offset + info.matches[i].start; + end = offset + info.matches[i].end; + + /* + * Adjust index so it refers to the last character in the + * match instead of the first character after the match. + */ + + if (end >= offset) { + end--; + } + } else { + start = -1; + end = -1; + } + + objs[0] = Tcl_NewLongObj(start); + objs[1] = Tcl_NewLongObj(end); + + newPtr = Tcl_NewListObj(2, objs); + } else { + if (i <= info.nsubs) { + newPtr = Tcl_GetRange(objPtr, + offset + info.matches[i].start, + offset + info.matches[i].end - 1); + } else { + newPtr = Tcl_NewObj(); + } + } + if (doinline) { + if (Tcl_ListObjAppendElement(interp, resultPtr, newPtr) + != TCL_OK) { + Tcl_DecrRefCount(newPtr); + Tcl_DecrRefCount(resultPtr); + return TCL_ERROR; + } + } else { + if (Tcl_ObjSetVar2(interp, objv[i], NULL, newPtr, + TCL_LEAVE_ERR_MSG) == NULL) { + return TCL_ERROR; + } + } + } + + if (all == 0) { + break; + } + + /* + * Adjust the offset to the character just after the last one in the + * matchVar and increment all to count how many times we are making a + * match. We always increment the offset by at least one to prevent + * endless looping (as in the case: regexp -all {a*} a). Otherwise, + * when we match the NULL string at the end of the input string, we + * will loop indefinately (because the length of the match is 0, so + * offset never changes). + */ + + matchLength = (info.matches[0].end - info.matches[0].start); + + offset += info.matches[0].end; + + /* + * A match of length zero could happen for {^} {$} or {.*} and in + * these cases we always want to bump the index up one. + */ + + if (matchLength == 0) { + offset++; + } + all++; + if (offset >= stringLength) { + break; + } + } + + /* + * Set the interpreter's object result to an integer object with value 1 + * if -all wasn't specified, otherwise it's all-1 (the number of times + * through the while - 1). + */ + + if (doinline) { + Tcl_SetObjResult(interp, resultPtr); + } else { + Tcl_SetObjResult(interp, Tcl_NewIntObj(all ? all-1 : 1)); + } + return TCL_OK; +} + +int +Regexp2_Init(Tcl_Interp *interp) +{ + /* + * * This may work with 8.0, but we are using strictly stubs here, + * * which requires 8.1. + * */ + if (Tcl_InitStubs(interp, "8.5", 0) == NULL) { + return TCL_ERROR; + } + if (Tcl_PkgRequire(interp, "Tcl", "8.5", 0) == NULL) { + return TCL_ERROR; + } + if (Tcl_PkgProvide(interp, "regexp2", "0.1") != TCL_OK) { + return TCL_ERROR; + } + Tcl_CreateObjCommand(interp, "regexp2", (Tcl_ObjCmdProc *) Tcl_RegexpObjCmd, + (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL); + + return TCL_OK; +} DELETED generic/sample.c Index: generic/sample.c ================================================================== --- generic/sample.c +++ generic/sample.c @@ -1,326 +0,0 @@ -/* - * sample.c -- - * - * This file implements a secure hashing algorithm - * - * Copyright (c) 1999 Scriptics Corporation. - * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - */ - -/* - * SHA-1 in C - * By Steve Reid - * 100% Public Domain - * - * Test Vectors (from FIPS PUB 180-1) - * "abc" - * A9993E36 4706816A BA3E2571 7850C26C 9CD0D89D - * "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" - * 84983E44 1C3BD26E BAAE4AA1 F95129E5 E54670F1 - * A million repetitions of "a" - * 34AA973C D4C4DAA4 F61EEB2B DBAD2731 6534016F - */ - -/* - * If byte order known, #define LITTLE_ENDIAN or BIG_ENDIAN to be faster - */ - -/* - * Copy data before messing with it. - * #define SHA1HANDSOFF - */ - -#include -#include -#include -#include "sample.h" - -#define Rol(value, bits) (((value) << (bits)) | ((value) >> (32 - (bits)))) - -/* - * Blk0() and Blk() perform the initial expand. - * I got the idea of expanding during the round function from SSLeay - */ - -#ifdef LITTLE_ENDIAN -#define Blk0(i) (block->l[i] = (Rol(block->l[i],24)&0xFF00FF00) \ - |(Rol(block->l[i],8)&0x00FF00FF)) -#else -#ifdef BIG_ENDIAN -#define Blk0(i) block->l[i] -#else - -/* - * for unknown byte order, to work with either - * results in no change on big endian machines - * added by Dave Dykstra, 4/16/97 - */ - -#define Blk0(i) (p = (unsigned char *) (&block->l[i]), \ - block->l[i] = (*p << 24) \ - + (*(p+1) << 16) + (*(p+2) << 8) + *(p+3)) -#endif -#endif -#define Blk(i) (block->l[i&15] = Rol(block->l[(i+13)&15]^block->l[(i+8)&15] \ - ^block->l[(i+2)&15]^block->l[i&15],1)) - -/* - * (R0+R1), R2, R3, R4 are the different operations used in SHA1 - */ - -#define R0(v,w,x,y,z,i) z+=((w&(x^y))^y)+Blk0(i)+0x5A827999+Rol(v,5);w=Rol(w,30); -#define R1(v,w,x,y,z,i) z+=((w&(x^y))^y)+Blk(i)+0x5A827999+Rol(v,5);w=Rol(w,30); -#define R2(v,w,x,y,z,i) z+=(w^x^y)+Blk(i)+0x6ED9EBA1+Rol(v,5);w=Rol(w,30); -#define R3(v,w,x,y,z,i) z+=(((w|x)&y)|(w&x))+Blk(i)+0x8F1BBCDC+Rol(v,5);w=Rol(w,30); -#define R4(v,w,x,y,z,i) z+=(w^x^y)+Blk(i)+0xCA62C1D6+Rol(v,5);w=Rol(w,30); - -/* - *---------------------------------------------------------------------- - * - * SHA1Transform - * - * Hash a single 512-bit block. This is the core of the algorithm. - * - * Results: - * None. - * - * Side effects: - * Contents of state pointer are changed. - * - *---------------------------------------------------------------------- - */ - -void -SHA1Transform(state, buffer) - sha_uint32_t state[5]; /* State variable */ - unsigned char buffer[64]; /* Modified buffer */ -{ -#if (!defined(BIG_ENDIAN) && !defined(LITTLE_ENDIAN)) - unsigned char *p; -#endif - sha_uint32_t a, b, c, d, e; - typedef union { - unsigned char c[64]; - sha_uint32_t l[16]; - } CHAR64LONG16; - CHAR64LONG16* block; - -#ifdef SHA1HANDSOFF - static unsigned char workspace[64]; - block = (CHAR64LONG16*)workspace; - memcpy(block, buffer, 64); -#else - block = (CHAR64LONG16*)buffer; -#endif - - assert(sizeof(block->c) == sizeof(block->l)); - - /* - * Copy context->state[] to working vars - */ - - a = state[0]; - b = state[1]; - c = state[2]; - d = state[3]; - e = state[4]; - - /* - * 4 rounds of 20 operations each. Loop unrolled. - */ - - R0(a,b,c,d,e, 0); R0(e,a,b,c,d, 1); R0(d,e,a,b,c, 2); R0(c,d,e,a,b, 3); - R0(b,c,d,e,a, 4); R0(a,b,c,d,e, 5); R0(e,a,b,c,d, 6); R0(d,e,a,b,c, 7); - R0(c,d,e,a,b, 8); R0(b,c,d,e,a, 9); R0(a,b,c,d,e,10); R0(e,a,b,c,d,11); - R0(d,e,a,b,c,12); R0(c,d,e,a,b,13); R0(b,c,d,e,a,14); R0(a,b,c,d,e,15); - R1(e,a,b,c,d,16); R1(d,e,a,b,c,17); R1(c,d,e,a,b,18); R1(b,c,d,e,a,19); - R2(a,b,c,d,e,20); R2(e,a,b,c,d,21); R2(d,e,a,b,c,22); R2(c,d,e,a,b,23); - R2(b,c,d,e,a,24); R2(a,b,c,d,e,25); R2(e,a,b,c,d,26); R2(d,e,a,b,c,27); - R2(c,d,e,a,b,28); R2(b,c,d,e,a,29); R2(a,b,c,d,e,30); R2(e,a,b,c,d,31); - R2(d,e,a,b,c,32); R2(c,d,e,a,b,33); R2(b,c,d,e,a,34); R2(a,b,c,d,e,35); - R2(e,a,b,c,d,36); R2(d,e,a,b,c,37); R2(c,d,e,a,b,38); R2(b,c,d,e,a,39); - R3(a,b,c,d,e,40); R3(e,a,b,c,d,41); R3(d,e,a,b,c,42); R3(c,d,e,a,b,43); - R3(b,c,d,e,a,44); R3(a,b,c,d,e,45); R3(e,a,b,c,d,46); R3(d,e,a,b,c,47); - R3(c,d,e,a,b,48); R3(b,c,d,e,a,49); R3(a,b,c,d,e,50); R3(e,a,b,c,d,51); - R3(d,e,a,b,c,52); R3(c,d,e,a,b,53); R3(b,c,d,e,a,54); R3(a,b,c,d,e,55); - R3(e,a,b,c,d,56); R3(d,e,a,b,c,57); R3(c,d,e,a,b,58); R3(b,c,d,e,a,59); - R4(a,b,c,d,e,60); R4(e,a,b,c,d,61); R4(d,e,a,b,c,62); R4(c,d,e,a,b,63); - R4(b,c,d,e,a,64); R4(a,b,c,d,e,65); R4(e,a,b,c,d,66); R4(d,e,a,b,c,67); - R4(c,d,e,a,b,68); R4(b,c,d,e,a,69); R4(a,b,c,d,e,70); R4(e,a,b,c,d,71); - R4(d,e,a,b,c,72); R4(c,d,e,a,b,73); R4(b,c,d,e,a,74); R4(a,b,c,d,e,75); - R4(e,a,b,c,d,76); R4(d,e,a,b,c,77); R4(c,d,e,a,b,78); R4(b,c,d,e,a,79); - - /* - * Add the working vars back into context.state[] - */ - - state[0] += a; - state[1] += b; - state[2] += c; - state[3] += d; - state[4] += e; - - /* - * Wipe variables - */ - - a = b = c = d = e = 0; - - return; -} - -/* - *---------------------------------------------------------------------- - * - * SHA1Init -- - * - * Initialize new context - * - * Results: - * None. - * - * Side effects: - * Contents of context pointer are changed. - * - *---------------------------------------------------------------------- - */ - -void SHA1Init(context) - SHA1_CTX* context; /* Context to initialize */ -{ - /* - * SHA1 initialization constants - */ - - context->state[0] = 0x67452301; - context->state[1] = 0xEFCDAB89; - context->state[2] = 0x98BADCFE; - context->state[3] = 0x10325476; - context->state[4] = 0xC3D2E1F0; - context->count[0] = context->count[1] = 0; - - return; -} - -/* - *---------------------------------------------------------------------- - * - * SHA1Update - * - * Updates a context. - * - * Results: - * None. - * - * Side effects: - * Contents of context pointer are changed. - * - *---------------------------------------------------------------------- - */ - -void -SHA1Update(context, data, len) - SHA1_CTX* context; /* Context to update */ - unsigned char* data; /* Data used for update */ - unsigned int len; /* Length of data */ -{ - unsigned int i, j; - - j = (context->count[0] >> 3) & 63; - if ((context->count[0] += len << 3) < (len << 3)) { - context->count[1]++; - } - context->count[1] += (len >> 29); - if ((j + len) > 63) { - memcpy(&context->buffer[j], data, (i = 64-j)); - SHA1Transform(context->state, context->buffer); - for ( ; i + 63 < len; i += 64) { -#ifdef CANWRITEDATA - SHA1Transform(context->state, &data[i]); -#else - - /* - * else case added by Dave Dykstra 4/22/97 - */ - - memcpy(&context->buffer[0], &data[i], 64); - SHA1Transform(context->state, context->buffer); -#endif - } - j = 0; - } else { - i = 0; - } - - memcpy(&context->buffer[j], &data[i], len - i); - - return; -} - -/* - *---------------------------------------------------------------------- - * - * SHA1Final - * - * Add padding and return the message digest. - * - * Results: - * None. - * - * Side effects: - * Contents of context pointer are changed. - * - *---------------------------------------------------------------------- - */ - -void SHA1Final(context, digest) - SHA1_CTX* context; /* Context to pad */ - unsigned char digest[20]; /* Returned message digest */ -{ - sha_uint32_t i, j; - unsigned char finalcount[8]; - - for (i = 0; i < 8; i++) { - /* - * This statement is independent of the endianness - */ - - finalcount[i] = (unsigned char)((context->count[(i >= 4 ? 0 : 1)] - >> ((3-(i & 3)) * 8) ) & 255); - } - SHA1Update(context, (unsigned char *)"\200", 1); - while ((context->count[0] & 504) != 448) { - SHA1Update(context, (unsigned char *)"\0", 1); - } - - /* - * Should cause a SHA1Transform() - */ - - SHA1Update(context, finalcount, 8); - for (i = 0; i < 20; i++) { - digest[i] = (unsigned char) - ((context->state[i>>2] >> ((3-(i & 3)) * 8) ) & 255); - } - - /* - * Wipe variables - */ - - i = j = 0; - memset(context, 0, sizeof(SHA1_CTX)); - memset(&finalcount, 0, 8); - - /* - * Make SHA1Transform overwrite it's own static vars. - */ - -#ifdef SHA1HANDSOFF - SHA1Transform(context->state, context->buffer); -#endif - - return; -} DELETED generic/sample.h Index: generic/sample.h ================================================================== --- generic/sample.h +++ generic/sample.h @@ -1,63 +0,0 @@ -/* - * sample.h -- - * - * This header file contains the function declarations needed for - * all of the source files in this package. - * - * Copyright (c) 1998-1999 Scriptics Corporation. - * Copyright (c) 2003 ActiveState Corporation. - * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - */ - -#ifndef _SAMPLE -#define _SAMPLE - -#include - -#ifdef HAVE_INTTYPES_H -# include -typedef uint32_t sha_uint32_t; -#else -# if ((1<<31)<0) -typedef unsigned long sha_uint32_t; -# else -typedef unsigned int sha_uint32_t; -# endif -#endif - -/* - * For C++ compilers, use extern "C" - */ - -#ifdef __cplusplus -extern "C" { -#endif - -typedef struct { - sha_uint32_t state[5]; - sha_uint32_t count[2]; - unsigned char buffer[64]; -} SHA1_CTX; - -MODULE_SCOPE void SHA1Init(SHA1_CTX* context); -MODULE_SCOPE void SHA1Update(SHA1_CTX* context, unsigned char* data, unsigned int len); -MODULE_SCOPE void SHA1Final(SHA1_CTX* context, unsigned char digest[20]); - -/* - * Only the _Init function is exported. - */ - -extern DLLEXPORT int Sample_Init(Tcl_Interp * interp); - -/* - * end block for C++ - */ - -#ifdef __cplusplus -} -#endif - -#endif /* _SAMPLE */ DELETED generic/tclsample.c Index: generic/tclsample.c ================================================================== --- generic/tclsample.c +++ generic/tclsample.c @@ -1,367 +0,0 @@ -/* - * tclsample.c -- - * - * This file implements a Tcl interface to the secure hashing - * algorithm functions in sha1.c - * - * Copyright (c) 1999 Scriptics Corporation. - * Copyright (c) 2003 ActiveState Corporation. - * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - */ - -/* - * Modified from tclmd5.c by Dave Dykstra, dwd@bell-labs.com, 4/22/97 - */ - -#include -#include -#include -#include -#include "sample.h" - -#define TCL_READ_CHUNK_SIZE 4096 - -static unsigned char itoa64f[] = - "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_,"; - -static int numcontexts = 0; -static SHA1_CTX *sha1Contexts = NULL; -static int *ctxtotalRead = NULL; - -static int Sha1_Cmd(ClientData clientData, Tcl_Interp *interp, - int onjc, Tcl_Obj *const objv[]); - -#define DIGESTSIZE 20 - -/* - *---------------------------------------------------------------------- - * - * Sha1 -- - * - * Implements the new Tcl "sha1" command. - * - * Results: - * A standard Tcl result - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static int -Sha1_Cmd( - ClientData clientData, /* Not used. */ - Tcl_Interp *interp, /* Current interpreter */ - int objc, /* Number of arguments */ - Tcl_Obj *const objv[] /* Argument strings */ - ) -{ - /* - * The default base is hex - */ - - int log2base = 4; - int a; - Tcl_Obj *stringObj = NULL; - Tcl_Channel chan = (Tcl_Channel) NULL; - Tcl_Channel copychan = (Tcl_Channel) NULL; - int mode; - int contextnum = 0; -#define sha1Context (sha1Contexts[contextnum]) - char *bufPtr; - int maxbytes = 0; - int doinit = 1; - int dofinal = 1; - Tcl_Obj *descriptorObj = NULL; - int totalRead = 0; - int i, j, n, mask, bits, offset; - - /* - * For binary representation + null char - */ - - char buf[129]; - unsigned char digest[DIGESTSIZE]; - - static const char *options[] = { - "-chan", "-copychan", "-final", "-init", "-log2base", "-maxbytes", - "-string", "-update", NULL - }; - enum ShaOpts { - SHAOPT_CHAN, SHAOPT_COPY, SHAOPT_FINAL, SHAOPT_INIT, SHAOPT_LOG, - SHAOPT_MAXB, SHAOPT_STRING, SHAOPT_UPDATE - }; - - for (a = 1; a < objc; a++) { - int index; - - if (Tcl_GetIndexFromObj(interp, objv[a], options, "option", 0, - &index) != TCL_OK) { - return TCL_ERROR; - } - /* - * Everything except -init takes an argument... - */ - if ((index != SHAOPT_INIT) && (++a >= objc)) { - goto wrongArgs; - } - switch ((enum ShaOpts) index) { - case SHAOPT_INIT: - for (contextnum = 1; contextnum < numcontexts; contextnum++) { - if (ctxtotalRead[contextnum] < 0) { - break; - } - } - if (contextnum == numcontexts) { - /* - * Allocate a new context. - */ - - numcontexts++; - sha1Contexts = (SHA1_CTX *) realloc((void *) sha1Contexts, - numcontexts * sizeof(SHA1_CTX)); - ctxtotalRead = realloc((void *) ctxtotalRead, - numcontexts * sizeof(int)); - } - ctxtotalRead[contextnum] = 0; - SHA1Init(&sha1Context); - sprintf(buf, "sha1%d", contextnum); - Tcl_AppendResult(interp, buf, (char *)NULL); - return TCL_OK; - case SHAOPT_CHAN: - chan = Tcl_GetChannel(interp, Tcl_GetString(objv[a]), &mode); - if (chan == (Tcl_Channel) NULL) { - return TCL_ERROR; - } - if ((mode & TCL_READABLE) == 0) { - Tcl_AppendResult(interp, "chan \"", Tcl_GetString(objv[a]), - "\" wasn't opened for reading", (char *) NULL); - return TCL_ERROR; - } - continue; - case SHAOPT_COPY: - copychan = Tcl_GetChannel(interp, Tcl_GetString(objv[a]), &mode); - if (copychan == (Tcl_Channel) NULL) { - return TCL_ERROR; - } - if ((mode & TCL_WRITABLE) == 0) { - Tcl_AppendResult(interp, "copychan \"", Tcl_GetString(objv[a]), - "\" wasn't opened for writing", (char *) NULL); - return TCL_ERROR; - } - continue; - case SHAOPT_FINAL: - descriptorObj = objv[a]; - doinit = 0; - continue; - case SHAOPT_LOG: - if (Tcl_GetIntFromObj(interp, objv[a], &log2base) != TCL_OK) { - return TCL_ERROR; - } else if ((log2base < 1) || (log2base > 6)) { - Tcl_AppendResult(interp, "parameter to -log2base \"", - Tcl_GetString(objv[a]), - "\" must be integer in range 1...6", (char *) NULL); - return TCL_ERROR; - } - continue; - case SHAOPT_MAXB: - if (Tcl_GetIntFromObj(interp, objv[a], &maxbytes) != TCL_OK) { - return TCL_ERROR; - } - continue; - case SHAOPT_STRING: - stringObj = objv[a]; - continue; - case SHAOPT_UPDATE: - descriptorObj = objv[a]; - doinit = 0; - dofinal = 0; - continue; - } - } - - if (descriptorObj != NULL) { - if ((sscanf(Tcl_GetString(descriptorObj), "sha1%d", - &contextnum) != 1) || (contextnum >= numcontexts) || - (ctxtotalRead[contextnum] < 0)) { - Tcl_AppendResult(interp, "invalid sha1 descriptor \"", - Tcl_GetString(descriptorObj), "\"", (char *) NULL); - return TCL_ERROR; - } - } - - if (doinit) { - SHA1Init(&sha1Context); - } - - if (stringObj != NULL) { - char *string; - if (chan != (Tcl_Channel) NULL) { - goto wrongArgs; - } - string = Tcl_GetStringFromObj(stringObj, &totalRead); - SHA1Update(&sha1Context, (unsigned char *) string, totalRead); - } else if (chan != (Tcl_Channel) NULL) { - bufPtr = ckalloc((unsigned) TCL_READ_CHUNK_SIZE); - totalRead = 0; - while ((n = Tcl_Read(chan, bufPtr, - maxbytes == 0 - ? TCL_READ_CHUNK_SIZE - : (TCL_READ_CHUNK_SIZE < maxbytes - ? TCL_READ_CHUNK_SIZE - : maxbytes))) != 0) { - if (n < 0) { - ckfree(bufPtr); - Tcl_AppendResult(interp, Tcl_GetString(objv[0]), ": ", - Tcl_GetChannelName(chan), Tcl_PosixError(interp), - (char *) NULL); - return TCL_ERROR; - } - - totalRead += n; - - SHA1Update(&sha1Context, (unsigned char *) bufPtr, (unsigned int) n); - - if (copychan != (Tcl_Channel) NULL) { - n = Tcl_Write(copychan, bufPtr, n); - if (n < 0) { - ckfree(bufPtr); - Tcl_AppendResult(interp, Tcl_GetString(objv[0]), ": ", - Tcl_GetChannelName(copychan), - Tcl_PosixError(interp), (char *) NULL); - return TCL_ERROR; - } - } - - if ((maxbytes > 0) && ((maxbytes -= n) <= 0)) { - break; - } - } - ckfree(bufPtr); - } else if (descriptorObj == NULL) { - goto wrongArgs; - } - - if (!dofinal) { - ctxtotalRead[contextnum] += totalRead; - Tcl_SetObjResult(interp, Tcl_NewIntObj(totalRead)); - return TCL_OK; - } - - if (stringObj == NULL) { - totalRead += ctxtotalRead[contextnum]; - Tcl_SetObjResult(interp, Tcl_NewIntObj(totalRead)); - } - - SHA1Final(&sha1Context, digest); - - /* - * Take the 20 byte array and print it in the requested base - * e.g. log2base=1 => binary, log2base=4 => hex - */ - - n = log2base; - i = j = bits = 0; - - /* - * if 160 bits doesn't divide exactly by n then the first character of - * the output represents the residual bits. e.g for n=6 (base 64) the - * first character can only take the values 0..f - */ - - offset = (DIGESTSIZE * 8) % n; - if (offset > 0) { - offset = n - offset; - } - mask = (2 << (n-1)) - 1; - while (1) { - bits <<= n; - if (offset <= n) { - if (i == DIGESTSIZE) { - break; - } - bits += (digest[i++] << (n - offset)); - offset += 8; - } - offset -= n; - buf[j++] = itoa64f[(bits>>8)&mask]; - } - buf[j++] = itoa64f[(bits>>8)&mask]; - buf[j++] = '\0'; - Tcl_AppendResult (interp, buf, (char *)NULL); - if (contextnum > 0) { - ctxtotalRead[contextnum] = -1; - } - return TCL_OK; - -wrongArgs: - Tcl_AppendResult (interp, "wrong # args: should be either:\n", - " ", - Tcl_GetString(objv[0]), - " ?-log2base log2base? -string string\n", - " or\n", - " ", - Tcl_GetString(objv[0]), - " ?-log2base log2base? ?-copychan chanID? -chan chanID\n", - " or\n", - " ", - Tcl_GetString(objv[0]), - " -init (returns descriptor)\n", - " ", - Tcl_GetString(objv[0]), - " -update descriptor ?-maxbytes n? ?-copychan chanID? -chan chanID\n", - " (any number of -update calls, returns number of bytes read)\n", - " ", - Tcl_GetString(objv[0]), - " ?-log2base log2base? -final descriptor\n", - " The default log2base is 4 (hex)", - (char *) NULL); - return TCL_ERROR; -} - -/* - *---------------------------------------------------------------------- - * - * Sample_Init -- - * - * Initialize the new package. The string "Sample" in the - * function name must match the PACKAGE declaration at the top of - * configure.ac. - * - * Results: - * A standard Tcl result - * - * Side effects: - * The Sample package is created. - * One new command "sha1" is added to the Tcl interpreter. - * - *---------------------------------------------------------------------- - */ - -int -Sample_Init(Tcl_Interp *interp) -{ - /* - * This may work with 8.0, but we are using strictly stubs here, - * which requires 8.1. - */ - if (Tcl_InitStubs(interp, "8.1", 0) == NULL) { - return TCL_ERROR; - } - if (Tcl_PkgProvide(interp, PACKAGE_NAME, PACKAGE_VERSION) != TCL_OK) { - return TCL_ERROR; - } - Tcl_CreateObjCommand(interp, "sha1", (Tcl_ObjCmdProc *) Sha1_Cmd, - (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL); - - numcontexts = 1; - sha1Contexts = (SHA1_CTX *) malloc(sizeof(SHA1_CTX)); - ctxtotalRead = (int *) malloc(sizeof(int)); - ctxtotalRead[0] = 0; - - return TCL_OK; -} DELETED tests/sample.test Index: tests/sample.test ================================================================== --- tests/sample.test +++ tests/sample.test @@ -1,30 +0,0 @@ -# Commands covered: sha1 -# -# This file contains a collection of tests for one or more of the Tcl -# built-in commands. Sourcing this file into Tcl runs the tests and -# generates output for errors. No output means no errors were found. -# -# Copyright (c) 2000 by Scriptics Corporation. -# -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. - -if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest - namespace import ::tcltest::* -} - -package require sample - -test sha-1.1 {Use of -string operand} { - set result [sha1 -string foo] -} {0beec7b5ea3f0fdbc95d0dd47f3c5bc275da8a33} - -test sha-1.2 {Use of -init operand} { - set result [catch {sha1 -init}] -} {0} - - -# cleanup -::tcltest::cleanupTests -return DELETED tests/tclsample.test Index: tests/tclsample.test ================================================================== --- tests/tclsample.test +++ tests/tclsample.test @@ -1,38 +0,0 @@ -# Commands covered: sha1 -# -# This file contains a collection of tests for one or more of the Tcl -# built-in commands. Sourcing this file into Tcl runs the tests and -# generates output for errors. No output means no errors were found. -# -# Copyright (c) 2000 by Scriptics Corporation. -# -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. - -if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest - namespace import ::tcltest::* -} - -package require sample - -test sha-1.1 {incorrect command usage} { - list [catch {sha1} errMsg] $errMsg -} {1 {wrong # args: should be either: - sha1 ?-log2base log2base? -string string - or - sha1 ?-log2base log2base? ?-copychan chanID? -chan chanID - or - sha1 -init (returns descriptor) - sha1 -update descriptor ?-maxbytes n? ?-copychan chanID? -chan chanID - (any number of -update calls, returns number of bytes read) - sha1 ?-log2base log2base? -final descriptor - The default log2base is 4 (hex)}} - -test sha-1.2 {incorrect usage of -log2base option} { - list [catch {sha1 -log2base 0 -string foo} errMsg] $errMsg -} {1 {parameter to -log2base "0" must be integer in range 1...6}} - -# cleanup -::tcltest::cleanupTests -return