ADDED build/test/tests/15-mk4vfsfcopy.sh Index: build/test/tests/15-mk4vfsfcopy.sh ================================================================== --- /dev/null +++ build/test/tests/15-mk4vfsfcopy.sh @@ -0,0 +1,23 @@ +#! /bin/bash + +TMPFILE="${TMPDIR:-/tmp}/DELETEME_testmk4vfs-$$${RANDOM}${RANDOM}${RANDOM}.mk" +export TMPFILE + +cat << \__EOF__ | base64 -d | gzip -dc > "${TMPFILE}" +H4sICMoPukwCA3Rlc3QubWsA8/KRYmBgYKu3KcrPL7FjYGcAgf8NDQ2N7R1t/Q2NU5umNexJySwq +js5LzE21CtYpSCxKzSux8tRJy8xJhYsWZ1alAsVSEktAVHJ+Xj9TQ2PXnzbGtoYmxp4Wxj7Wfvb5 +TTcQxk69xaycXJRfXKxXkJfOwAW2tp/pAe8un84AP3deLimQEK+nh0sQkBYAYQ42ICn/+X8ikGJJ +d/R1ZGBYf8KcteslkC9Z4hpREpyfVlIOdB2DY0p+UqqCZ25iempQamJKZeHJVBsGBiZFTxfHEIvT +Uye/9hMOFGnt7DzZeX5BWGfbiYkNR6Sdotk01vJyqF343Rq3pGHL0rdLfBeaveL3rRGaz+1y9N6G +SzPLrC4/XTfDS1f14XG/cynnfn1bs/U7D4PEDp+r152un7MrjxcwttK6F/6Gv+jm297rOX7O+gt0 +z71ZNPWcU7d6tUJpfMN15kQTs20fXj899fzVo0t76xv2Jz25v9B1qaqLifl2a4Gbu4+ttJ510WLC +6cW1dmbRj59KXp4a7KB1NoozMPvtPka7uqZpZ7cyZrA4xXz7YVnavkmW+cXeN/wPKv7tjBJ7tq4s +8kIS57J9fStnzWC8V98wy2uxHE/zLuebXUw399o/7zrp9CiyLK/j7Am17JZrV9NK2t/sYf32SeUM +40ydlH7+qZabo+bNS/y7vEBKbHJMHG/kpsffGPnMFZYFzpx73cut8W/9fnYFS9u3gYwmvDfmHOiS +veE5KZ+bSzj4j1PDk4Lik08bhfoYPCe2aCq4lWk4VF7t23Sv433y4z8xDmffPZp0mVd1C98FCdV2 +bpFpUXOMMtS7TzukMG8VP61hU9NzeGHiPdYFZx9dkfX6IFrq67DIf/mGK4+WNIrO89mw+KN71tUU +tibFORFrLKQkjx5c63iP8UIap+lsZi8FlsyrjFzeunaXy5l+mxkd28d3P7xeitXjGusfidqGv9JW +C08z5U4LiI1wOmmwNjDCNlP+nmxSPNv7FelHbRWnfXFb+KFk0tffM/lKtt/893X2odbkPTl/2Yp2 +Lzl+++0+EVBi9HT1c1nnlNCEmZAZJzWxLUSk5Glsi8nKISVARcVWTrGxjT1sOxvAGYC5HUg7AWlX +Lx9Q+md6MZoZRjPDIMoMFCb07veQdM6WD6SBSZZNDwAplnesfwYAAA== +__EOF__ ADDED build/test/tests/15-mk4vfsfcopy.tcl Index: build/test/tests/15-mk4vfsfcopy.tcl ================================================================== --- /dev/null +++ build/test/tests/15-mk4vfsfcopy.tcl @@ -0,0 +1,35 @@ +#! /usr/bin/env tclsh + +set haveMk4vfs 0 +catch { + package require vfs::mk4 + set haveMk4vfs 1 +} + +if {!$haveMk4vfs} { + # This test only applies to kits that include Mk4vfs + exit 0 +} + +set TMPFILE $::env(TMPFILE) + +set ::fcopy_complete 0 +proc fcopy_complete {args} { + set ::fcopy_complete 1 +} + +vfs::mk4::Mount $TMPFILE /TEST +set fd [open /TEST/cross.png] +fconfigure $fd -translation binary +set out [open /dev/null w] +fcopy $fd $out -command fcopy_complete +after 3000 +update + +if {$::fcopy_complete != 1} { + puts "Expected: Fcopy Complete = 1" + puts "Got: Fcopy Complete = $::fcopy_complete" + exit 1 +} + +exit 0 ADDED mk4tcl/patches/all/metakit-2.4.9.7-fixeventchannels-1pt.diff Index: mk4tcl/patches/all/metakit-2.4.9.7-fixeventchannels-1pt.diff ================================================================== --- /dev/null +++ mk4tcl/patches/all/metakit-2.4.9.7-fixeventchannels-1pt.diff @@ -0,0 +1,169 @@ +diff -uNr metakit-2.4.9.7.orig/tcl/mk4tcl.cpp metakit-2.4.9.7-1ptrsk/tcl/mk4tcl.cpp +--- metakit-2.4.9.7.orig/tcl/mk4tcl.cpp 2007-06-18 16:05:24.000000000 -0500 ++++ metakit-2.4.9.7-1ptrsk/tcl/mk4tcl.cpp 2010-10-16 16:21:41.000000000 -0500 +@@ -182,6 +182,8 @@ + Tcl_Channel _chan; + int _validMask; + int _watchMask; ++ int _flags; ++ SiasStrategy *_next; + Tcl_Interp *_interp; + + SiasStrategy(c4_Storage &storage_, const c4_View &view_, const c4_BytesProp +@@ -259,23 +261,58 @@ + /////////////////////////////////////////////////////////////////////////////// + // New in 1.2: channel interface to memo fields + +-typedef SiasStrategy MkChannel; +- + typedef struct { + Tcl_Event header; + MkChannel *chan; ++ int flags; + } MkEvent; + ++#define CHANNEL_FLAG_PENDING (1<<1) ++ + static int mkEventProc(Tcl_Event *evPtr, int flags) { + MkEvent *me = (MkEvent*)evPtr; + +- if (!(flags &TCL_FILE_EVENTS)) ++ if (!(flags & TCL_FILE_EVENTS)) + return 0; + +- Tcl_NotifyChannel(me->chan->_chan, me->chan->_watchMask); ++ me->chan->_flags &= ~CHANNEL_FLAG_PENDING; ++ Tcl_NotifyChannel(me->chan->_chan, me->chan->_watchMask & me->flags); + return 1; + } + ++static void SetupProc(ClientData clientData, int flags) { ++ MkWorkspace *ws = (MkWorkspace *)clientData; ++ int msec = 10000; ++ Tcl_Time blockTime = {0, 0}; ++ if (!(flags & TCL_FILE_EVENTS)) ++ return; ++ for (MkChannel *chan = ws->_chanList; chan != NULL; chan = chan->_next) { ++ msec = 10; ++ } ++ blockTime.sec = msec / 1000; ++ blockTime.usec = (msec % 1000) * 1000; ++ Tcl_SetMaxBlockTime(&blockTime); ++} ++ ++static void CheckProc(ClientData clientData, int flags) { ++ MkWorkspace *ws = (MkWorkspace *)clientData; ++ if (!(flags & TCL_FILE_EVENTS)) ++ return; ++ for (MkChannel *chan = ws->_chanList; chan != NULL; chan = chan->_next) { ++ if (chan->_watchMask == 0) ++ continue; ++ int mask = TCL_WRITABLE | TCL_READABLE; ++ if (chan->_watchMask & mask) { ++ MkEvent *me = (MkEvent *)ckalloc(sizeof(MkEvent)); ++ chan->_flags |= CHANNEL_FLAG_PENDING; ++ me->header.proc = mkEventProc; ++ me->chan = chan; ++ me->flags = mask; ++ Tcl_QueueEvent((Tcl_Event *)me, TCL_QUEUE_TAIL); ++ } ++ } ++} ++ + static int mkEventFilter(Tcl_Event *evPtr, ClientData instanceData) { + MkEvent *me = (MkEvent*)evPtr; + MkChannel *chan = (MkChannel*)instanceData; +@@ -285,6 +322,16 @@ + static int mkClose(ClientData instanceData, Tcl_Interp *interp) { + MkChannel *chan = (MkChannel*)instanceData; + ++ /* remove this channel from the package list */ ++ if (interp) { ++ MkWorkspace *ws = (MkWorkspace*)Tcl_GetAssocData(interp, "mk4tcl", 0); ++ MkChannel **tmpPtrPtr = &ws->_chanList; ++ while (*tmpPtrPtr && *tmpPtrPtr != chan) { ++ tmpPtrPtr = &(*tmpPtrPtr)->_next; ++ } ++ *tmpPtrPtr = chan->_next; ++ } ++ + Tcl_DeleteEvents(mkEventFilter, (ClientData)chan); + chan->_chan = 0; + delete chan; +@@ -726,7 +773,7 @@ + ++generation; // make sure all cached paths refresh on next access + } + +-MkWorkspace::MkWorkspace(Tcl_Interp *ip_): _interp(ip_) { ++MkWorkspace::MkWorkspace(Tcl_Interp *ip_): _interp(ip_), _chanList(NULL) { + new Item("", "", 0, _items, 0); + + // never uses entry zero (so atoi failure in ForgetPath is harmless) +@@ -741,6 +788,7 @@ + delete Nth(i); + + // need this to prevent recursion in Tcl_DeleteAssocData in 8.2 (not 8.0!) ++ Tcl_DeleteEventSource(SetupProc, CheckProc, this); + Tcl_SetAssocData(_interp, "mk4tcl", 0, 0); + Tcl_DeleteAssocData(_interp, "mk4tcl"); + } +@@ -2371,6 +2419,7 @@ + + mkChan->_watchMask = 0; + mkChan->_validMask = mode; ++ mkChan->_flags = 0; + mkChan->_interp = interp; + mkChan->_chan = Tcl_CreateChannel(&mkChannelType, buffer, (ClientData)mkChan, + mode); +@@ -2380,6 +2429,10 @@ + + Tcl_RegisterChannel(interp, mkChan->_chan); + ++ /* insert this channel at the front of the workspace channels list */ ++ mkChan->_next = work._chanList; ++ work._chanList = mkChan; ++ + if (_error) + return _error; + +@@ -2603,6 +2656,7 @@ + // since that does not seem to trigger exitproc handling (!) + Tcl_SetAssocData(interp, "mk4tcl", DelProc, ws); + Tcl_CreateExitHandler(ExitProc, ws); ++ Tcl_CreateEventSource(SetupProc, CheckProc, ws); + } + + // this list must match the "CmdDef defTab []" above. +@@ -2648,3 +2702,11 @@ + } + + /////////////////////////////////////////////////////////////////////////////// ++ ++/* ++ * Local variables: ++ * mode: c ++ * c-basic-offset: 2 ++ * indent-tabs-mode: nil ++ * End: ++ */ +diff -uNr metakit-2.4.9.7.orig/tcl/mk4tcl.h metakit-2.4.9.7-1ptrsk/tcl/mk4tcl.h +--- metakit-2.4.9.7.orig/tcl/mk4tcl.h 2007-06-15 18:26:40.000000000 -0500 ++++ metakit-2.4.9.7-1ptrsk/tcl/mk4tcl.h 2010-10-16 16:19:00.000000000 -0500 +@@ -205,6 +205,9 @@ + /////////////////////////////////////////////////////////////////////////////// + // A workspace manages a number of storage objects and their associated paths. + ++class SiasStrategy; ++typedef SiasStrategy MkChannel; ++ + class MkWorkspace { + c4_PtrArray _items; // items, or null if released + c4_Bytes _usedBuffer; // buffer, using 1 byte per entry +@@ -213,6 +216,7 @@ + + public: + Tcl_Interp *_interp; ++ MkChannel *_chanList; + + struct Item { + const c4_String _name; // the alias for this storage