more cross-testing of dictionary-powered compression; describe package configuration

2 files changed, 235 insertions, 45 deletions

diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index dc9a895..5c90c01 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -166,6 +166,7 @@ static Tcl_ObjCmdProc		ZlibStreamCmd;
 
 static void		ConvertError(Tcl_Interp *interp, int code,
 			    uLong adler);
+static Tcl_Obj *	ConvertErrorToList(int code, uLong adler);
 static void		ExtractHeader(gz_header *headerPtr, Tcl_Obj *dictObj);
 static int		GenerateHeader(Tcl_Interp *interp, Tcl_Obj *dictObj,
 			    GzipHeader *headerPtr, int *extraSizePtr);
@@ -232,41 +233,130 @@ ConvertError(
     int code,			/* The zlib error code. */
     uLong adler)		/* The checksum expected (for Z_NEED_DICT) */
 {
+    const char *codeStr, *codeStr2 = NULL;
+    char codeStrBuf[TCL_INTEGER_SPACE];
+
     if (interp == NULL) {
 	return;
     }
 
-    if (code == Z_ERRNO) {
+    switch (code) {
+	/*
+	 * Firstly, the case that is *different* because it's really coming
+	 * from the OS and is just being reported via zlib. It should be
+	 * really uncommon because Tcl handles all I/O rather than delegating
+	 * it to zlib, but proving it can't happen is hard.
+	 */
+
+    case Z_ERRNO:
 	Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_PosixError(interp),-1));
-    } else {
-	const char *codeStr, *codeStr2 = NULL;
-	char codeStrBuf[TCL_INTEGER_SPACE];
-
-	switch (code) {
-	case Z_STREAM_ERROR:	codeStr = "STREAM";	break;
-	case Z_DATA_ERROR:	codeStr = "DATA";	break;
-	case Z_MEM_ERROR:	codeStr = "MEM";	break;
-	case Z_BUF_ERROR:	codeStr = "BUF";	break;
-	case Z_VERSION_ERROR:	codeStr = "VERSION";	break;
-	case Z_NEED_DICT:
-	    codeStr = "NEED_DICT";
-	    codeStr2 = codeStrBuf;
-	    sprintf(codeStrBuf, "%lu", adler);
-	    break;
-	default:
-	    codeStr = "unknown";
-	    codeStr2 = codeStrBuf;
-	    sprintf(codeStrBuf, "%d", code);
-	    break;
-	}
-	Tcl_SetObjResult(interp, Tcl_NewStringObj(zError(code), -1));
+	return;
+
+	/*
+	 * Normal errors/conditions, some of which have additional detail and
+	 * some which don't. (This is not defined by array lookup because zlib
+	 * error codes are sometimes negative.)
+	 */
+
+    case Z_STREAM_ERROR:
+	codeStr = "STREAM";
+	break;
+    case Z_DATA_ERROR:
+	codeStr = "DATA";
+	break;
+    case Z_MEM_ERROR:
+	codeStr = "MEM";
+	break;
+    case Z_BUF_ERROR:
+	codeStr = "BUF";
+	break;
+    case Z_VERSION_ERROR:
+	codeStr = "VERSION";
+	break;
+    case Z_NEED_DICT:
+	codeStr = "NEED_DICT";
+	codeStr2 = codeStrBuf;
+	sprintf(codeStrBuf, "%lu", adler);
+	break;
+    default:
+	codeStr = "unknown";
+	codeStr2 = codeStrBuf;
+	sprintf(codeStrBuf, "%d", code);
+	break;
+
+	/*
+	 * Finally, these should _not_ happen! This function is for dealing
+	 * with error cases, not non-errors!
+	 */
+
+    case Z_OK:
+	Tcl_Panic("unexpected zlib result in error handler: Z_OK");
+    case Z_STREAM_END:
+	Tcl_Panic("unexpected zlib result in error handler: Z_STREAM_END");
+    }
+    Tcl_SetObjResult(interp, Tcl_NewStringObj(zError(code), -1));
+
+    /*
+     * Tricky point! We might pass NULL twice here (and will when the error
+     * type is known).
+     */
+
+    Tcl_SetErrorCode(interp, "TCL", "ZLIB", codeStr, codeStr2, NULL);
+}
+
+static Tcl_Obj *
+ConvertErrorToList(
+    int code,			/* The zlib error code. */
+    uLong adler)		/* The checksum expected (for Z_NEED_DICT) */
+{
+    Tcl_Obj *objv[4];
+
+    TclNewLiteralStringObj(objv[0], "TCL");
+    TclNewLiteralStringObj(objv[1], "ZLIB");
+    switch (code) {
+    case Z_STREAM_ERROR:
+	TclNewLiteralStringObj(objv[2], "STREAM");
+	return Tcl_NewListObj(3, objv);
+    case Z_DATA_ERROR:
+	TclNewLiteralStringObj(objv[2], "DATA");
+	return Tcl_NewListObj(3, objv);
+    case Z_MEM_ERROR:
+	TclNewLiteralStringObj(objv[2], "MEM");
+	return Tcl_NewListObj(3, objv);
+    case Z_BUF_ERROR:
+	TclNewLiteralStringObj(objv[2], "BUF");
+	return Tcl_NewListObj(3, objv);
+    case Z_VERSION_ERROR:
+	TclNewLiteralStringObj(objv[2], "VERSION");
+	return Tcl_NewListObj(3, objv);
+    case Z_ERRNO:
+	TclNewLiteralStringObj(objv[2], "POSIX");
+	objv[3] = Tcl_NewStringObj(Tcl_ErrnoId(), -1);
+	return Tcl_NewListObj(4, objv);
+    case Z_NEED_DICT:
+	TclNewLiteralStringObj(objv[2], "NEED_DICT");
+	objv[3] = Tcl_NewWideIntObj((Tcl_WideInt) adler);
+	return Tcl_NewListObj(4, objv);
+
+	/*
+	 * These should _not_ happen! This function is for dealing with error
+	 * cases, not non-errors!
+	 */
+
+    case Z_OK:
+	Tcl_Panic("unexpected zlib result in error handler: Z_OK");
+    case Z_STREAM_END:
+	Tcl_Panic("unexpected zlib result in error handler: Z_STREAM_END");
 
 	/*
-	 * Tricky point! We might pass NULL twice here (and will when the
-	 * error type is known).
+	 * Catch-all. Should be unreachable because all cases are already
+	 * listed above.
 	 */
 
-	Tcl_SetErrorCode(interp, "TCL", "ZLIB", codeStr, codeStr2, NULL);
+    default:
+	TclNewLiteralStringObj(objv[2], "unknown");
+	TclNewIntObj(objv[3], code);
+	return Tcl_NewListObj(4, objv);
     }
 }
 
@@ -1832,7 +1922,7 @@ ZlibCmd(
 	}
 	data = Tcl_GetByteArrayFromObj(objv[2], &dlen);
 	Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)
-		Tcl_ZlibAdler32(start, data, dlen)));
+		(uLong) Tcl_ZlibAdler32(start, data, dlen)));
 	return TCL_OK;
     case CMD_CRC:			/* crc32 str ?startvalue?
 					 * -> checksum */
@@ -1849,7 +1939,7 @@ ZlibCmd(
 	}
 	data = Tcl_GetByteArrayFromObj(objv[2], &dlen);
 	Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)
-		Tcl_ZlibCRC32(start, data, dlen)));
+		(uLong) Tcl_ZlibCRC32(start, data, dlen)));
 	return TCL_OK;
     case CMD_DEFLATE:			/* deflate data ?level?
 					 * -> rawCompressedData */
@@ -2637,7 +2727,7 @@ ZlibStreamCmd(
 	    return TCL_ERROR;
 	}
 	Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)
-		Tcl_ZlibStreamChecksum(zstream)));
+		(uLong) Tcl_ZlibStreamChecksum(zstream)));
 	return TCL_OK;
     case zs_reset:		/* $strm reset */
 	if (objc != 2) {
@@ -2924,6 +3014,7 @@ ZlibTransformOutput(
     Tcl_DriverOutputProc *outProc =
 	    Tcl_ChannelOutputProc(Tcl_GetChannelType(cd->parent));
     int e, produced;
+    Tcl_Obj *errObj;
 
     if (cd->mode == TCL_ZLIB_STREAM_INFLATE) {
 	return outProc(Tcl_GetChannelInstanceData(cd->parent), buf, toWrite,
@@ -2947,14 +3038,19 @@ ZlibTransformOutput(
 	}
     } while (e == Z_OK && produced > 0 && cd->outStream.avail_in > 0);
 
-    if (e != Z_OK) {
-	Tcl_SetChannelError(cd->parent,
-		Tcl_NewStringObj(cd->outStream.msg, -1));
-	*errorCodePtr = EINVAL;
-	return -1;
+    if (e == Z_OK) {
+	return toWrite - cd->outStream.avail_in;
     }
 
-    return toWrite - cd->outStream.avail_in;
+    errObj = Tcl_NewListObj(0, NULL);
+    Tcl_ListObjAppendElement(NULL, errObj, Tcl_NewStringObj("-errorcode",-1));
+    Tcl_ListObjAppendElement(NULL, errObj,
+	    ConvertErrorToList(e, cd->outStream.adler));
+    Tcl_ListObjAppendElement(NULL, errObj,
+	    Tcl_NewStringObj(cd->outStream.msg, -1));
+    Tcl_SetChannelError(cd->parent, errObj);
+    *errorCodePtr = EINVAL;
+    return -1;
 }
 
 /*
@@ -2993,12 +3089,19 @@ ZlibTransformSetOption(			/* not used */
 	    TclDecrRefCount(cd->compDictObj);
 	}
 	cd->compDictObj = compDictObj;
+	code = Z_OK;
 	if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) {
 	    code = SetDeflateDictionary(&cd->outStream, compDictObj);
 	    if (code != Z_OK) {
 		ConvertError(interp, code, cd->outStream.adler);
 		return TCL_ERROR;
 	    }
+	} else if (cd->format == TCL_ZLIB_FORMAT_RAW) {
+	    code = SetInflateDictionary(&cd->inStream, compDictObj);
+	    if (code != Z_OK) {
+		ConvertError(interp, code, cd->inStream.adler);
+		return TCL_ERROR;
+	    }
 	}
 	return TCL_OK;
     }
@@ -3391,6 +3494,14 @@ ZlibStackChannelTransform(
 		goto error;
 	    }
 	}
+	if (cd->format == TCL_ZLIB_FORMAT_RAW && cd->compDictObj) {
+	    e = SetInflateDictionary(&cd->inStream, cd->compDictObj);
+	    if (e != Z_OK) {
+		goto error;
+	    }
+	    TclDecrRefCount(cd->compDictObj);
+	    cd->compDictObj = NULL;
+	}
     } else {
 	e = deflateInit2(&cd->outStream, level, Z_DEFLATED, wbits,
 		MAX_MEM_LEVEL, Z_DEFAULT_STRATEGY);
@@ -3525,7 +3636,8 @@ ResultGenerate(
 {
 #define MAXBUF	1024
     unsigned char buf[MAXBUF];
-    int e, written;
+    int e, written,total=0;
+    Tcl_Obj *errObj;
 
     cd->inStream.next_in = (Bytef *) cd->inBuffer;
     cd->inStream.avail_in = n;
@@ -3578,13 +3690,7 @@ ResultGenerate(
 	 */
 
 	if ((e != Z_OK) && (e != Z_BUF_ERROR)) {
-	    Tcl_Obj *errObj = Tcl_NewListObj(0, NULL);
-
-	    Tcl_ListObjAppendElement(NULL, errObj,
-		    Tcl_NewStringObj(cd->inStream.msg, -1));
-	    Tcl_SetChannelError(cd->parent, errObj);
-	    *errorCodePtr = EINVAL;
-	    return TCL_ERROR;
+	    goto handleError;
 	}
 
 	/*
@@ -3595,6 +3701,17 @@ ResultGenerate(
 	    return TCL_OK;
 	}
     }
+
+  handleError:
+    errObj = Tcl_NewListObj(0, NULL);
+    Tcl_ListObjAppendElement(NULL, errObj, Tcl_NewStringObj("-errorcode",-1));
+    Tcl_ListObjAppendElement(NULL, errObj,
+	    ConvertErrorToList(e, cd->inStream.adler));
+    Tcl_ListObjAppendElement(NULL, errObj,
+	    Tcl_NewStringObj(cd->inStream.msg, -1));
+    Tcl_SetChannelError(cd->parent, errObj);
+    *errorCodePtr = EINVAL;
+    return TCL_ERROR;
 }
 
 /*
@@ -3607,6 +3724,8 @@ int
 TclZlibInit(
     Tcl_Interp *interp)
 {
+    Tcl_Config cfg[2];
+
     /*
      * This does two things. It creates a counter used in the creation of
      * stream commands, and it creates the namespace that will contain those
@@ -3620,6 +3739,23 @@ TclZlibInit(
      */
 
     Tcl_CreateObjCommand(interp, "zlib", ZlibCmd, 0, 0);
+
+    /*
+     * Store the underlying configuration information.
+     *
+     * TODO: Describe whether we're using the system version of the library or
+     * a compatibility version built into Tcl?
+     */
+
+    cfg[0].key = "zlibVersion";
+    cfg[0].value = zlibVersion();
+    cfg[1].key = NULL;
+    Tcl_RegisterConfig(interp, "zlib", cfg, "ascii");
+
+    /*
+     * Formally provide the package as a Tcl built-in.
+     */
+
     return Tcl_PkgProvide(interp, "zlib", TCL_ZLIB_VERSION);
 }
 
diff --git a/tests/zlib.test b/tests/zlib.test
index 9058817..e63bd84 100644
--- a/tests/zlib.test
+++ b/tests/zlib.test
@@ -23,6 +23,9 @@ test zlib-1.1 {zlib basics} -constraints zlib -returnCodes error -body {
 test zlib-1.2 {zlib basics} -constraints zlib -returnCodes error -body {
     zlib ? {}
 } -result {bad command "?": must be adler32, compress, crc32, decompress, deflate, gunzip, gzip, inflate, push, or stream}
+test zlib-1.3 {zlib basics} -constraints zlib -body {
+    zlib::pkgconfig list
+} -result zlibVersion
 
 test zlib-2.1 {zlib compress/decompress} zlib {
     zlib decompress [zlib compress abcdefghijklm]
@@ -252,14 +255,15 @@ test zlib-8.9 {transformtion and fconfigure} -setup {
     fconfigure $outSide -blocking 0 -translation binary -buffering none
     fconfigure $inSide -blocking 0 -translation binary
     puts -nonewline $outSide $spdyHeaders
+    set result [fconfigure $outSide -checksum]
     chan pop $outSide
     $strm put -dictionary $spdyDict [read $inSide]
-    list [string length $spdyHeaders] [string length [$strm get]]
+    lappend result [string length $spdyHeaders] [string length [$strm get]]
 } -cleanup {
     catch {close $outSide}
     catch {close $inSide}
     catch {$strm close}
-} -result {358 358}
+} -result {3064818174 358 358}
 test zlib-8.10 {transformtion and fconfigure} -setup {
     lassign [chan pipe] inSide outSide
 } -constraints zlib -body {
@@ -303,6 +307,56 @@ test zlib-8.12 {transformtion and fconfigure} -setup {
     fconfigure $inSide -translation binary -dictionary $spdyDict
     puts -nonewline $outSide [$strm get]
     close $outSide
+    list [string length $spdyHeaders] [string length [read $inSide]] \
+	[fconfigure $inSide -checksum]
+} -cleanup {
+    catch {close $outSide}
+    catch {close $inSide}
+    catch {$strm close}
+} -result {358 358 3064818174}
+test zlib-8.13 {transformtion and fconfigure} -setup {
+    lassign [chan pipe] inSide outSide
+    set strm [zlib stream compress]
+} -constraints zlib -body {
+    $strm put -dictionary $spdyDict -finalize $spdyHeaders
+    zlib push decompress $inSide -dictionary $spdyDict
+    fconfigure $outSide -blocking 0 -translation binary
+    fconfigure $inSide -translation binary
+    puts -nonewline $outSide [$strm get]
+    close $outSide
+    list [string length $spdyHeaders] [string length [read $inSide]] \
+	[fconfigure $inSide -checksum]
+} -cleanup {
+    catch {close $outSide}
+    catch {close $inSide}
+    catch {$strm close}
+} -result {358 358 3064818174}
+test zlib-8.14 {transformtion and fconfigure} -setup {
+    lassign [chan pipe] inSide outSide
+    set strm [zlib stream deflate]
+} -constraints zlib -body {
+    $strm put -finalize -dictionary $spdyDict $spdyHeaders
+    zlib push inflate $inSide
+    fconfigure $outSide -blocking 0 -buffering none -translation binary
+    fconfigure $inSide -translation binary -dictionary $spdyDict
+    puts -nonewline $outSide [$strm get]
+    close $outSide
+    list [string length $spdyHeaders] [string length [read $inSide]]
+} -cleanup {
+    catch {close $outSide}
+    catch {close $inSide}
+    catch {$strm close}
+} -result {358 358}
+test zlib-8.15 {transformtion and fconfigure} -setup {
+    lassign [chan pipe] inSide outSide
+    set strm [zlib stream deflate]
+} -constraints zlib -body {
+    $strm put -finalize -dictionary $spdyDict $spdyHeaders
+    zlib push inflate $inSide -dictionary $spdyDict
+    fconfigure $outSide -blocking 0 -buffering none -translation binary
+    fconfigure $inSide -translation binary
+    puts -nonewline $outSide [$strm get]
+    close $outSide
     list [string length $spdyHeaders] [string length [read $inSide]]
 } -cleanup {
     catch {close $outSide}