diff options
Diffstat (limited to 'generic/tclIOCmd.c')
| -rw-r--r-- | generic/tclIOCmd.c | 66 | 
1 files changed, 44 insertions, 22 deletions
| diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index 005713d..14910d7 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -181,6 +181,7 @@ Tcl_PutsObjCmd(  	return TCL_ERROR;      } +    Tcl_Preserve(chan);      result = Tcl_WriteObj(chan, string);      if (result < 0) {  	goto error; @@ -191,6 +192,7 @@ Tcl_PutsObjCmd(  	    goto error;  	}      } +    Tcl_Release(chan);      return TCL_OK;      /* @@ -205,6 +207,7 @@ Tcl_PutsObjCmd(  	Tcl_SetObjResult(interp, Tcl_ObjPrintf("error writing \"%s\": %s",  		TclGetString(chanObjPtr), Tcl_PosixError(interp)));      } +    Tcl_Release(chan);      return TCL_ERROR;  } @@ -252,6 +255,7 @@ Tcl_FlushObjCmd(  	return TCL_ERROR;      } +    Tcl_Preserve(chan);      if (Tcl_Flush(chan) != TCL_OK) {  	/*  	 * TIP #219. @@ -265,8 +269,10 @@ Tcl_FlushObjCmd(  		    "error flushing \"%s\": %s",  		    TclGetString(chanObjPtr), Tcl_PosixError(interp)));  	} +	Tcl_Release(chan);  	return TCL_ERROR;      } +    Tcl_Release(chan);      return TCL_OK;  } @@ -299,6 +305,7 @@ Tcl_GetsObjCmd(      int lineLen;		/* Length of line just read. */      int mode;			/* Mode in which channel is opened. */      Tcl_Obj *linePtr, *chanObjPtr; +    int code = TCL_OK;      if ((objc != 2) && (objc != 3)) {  	Tcl_WrongNumArgs(interp, 1, objv, "channelId ?varName?"); @@ -315,6 +322,7 @@ Tcl_GetsObjCmd(  	return TCL_ERROR;      } +    Tcl_Preserve(chan);      linePtr = Tcl_NewObj();      lineLen = Tcl_GetsObj(chan, linePtr);      if (lineLen < 0) { @@ -333,7 +341,8 @@ Tcl_GetsObjCmd(  			"error reading \"%s\": %s",  			TclGetString(chanObjPtr), Tcl_PosixError(interp)));  	    } -	    return TCL_ERROR; +	    code = TCL_ERROR; +	    goto done;  	}  	lineLen = -1;      } @@ -346,7 +355,9 @@ Tcl_GetsObjCmd(      } else {  	Tcl_SetObjResult(interp, linePtr);      } -    return TCL_OK; +  done: +    Tcl_Release(chan); +    return code;  }  /* @@ -453,6 +464,7 @@ Tcl_ReadObjCmd(      resultPtr = Tcl_NewObj();      Tcl_IncrRefCount(resultPtr); +    Tcl_Preserve(chan);      charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0);      if (charactersRead < 0) {  	/* @@ -467,6 +479,7 @@ Tcl_ReadObjCmd(  		    "error reading \"%s\": %s",  		    TclGetString(chanObjPtr), Tcl_PosixError(interp)));  	} +	Tcl_Release(chan);  	Tcl_DecrRefCount(resultPtr);  	return TCL_ERROR;      } @@ -485,6 +498,7 @@ Tcl_ReadObjCmd(  	}      }      Tcl_SetObjResult(interp, resultPtr); +    Tcl_Release(chan);      Tcl_DecrRefCount(resultPtr);      return TCL_OK;  } @@ -544,6 +558,7 @@ Tcl_SeekObjCmd(  	mode = modeArray[optionIndex];      } +    Tcl_Preserve(chan);      result = Tcl_Seek(chan, offset, mode);      if (result == Tcl_LongAsWide(-1)) {  	/* @@ -558,8 +573,10 @@ Tcl_SeekObjCmd(  		    "error during seek on \"%s\": %s",  		    TclGetString(objv[1]), Tcl_PosixError(interp)));  	} +	Tcl_Release(chan);  	return TCL_ERROR;      } +    Tcl_Release(chan);      return TCL_OK;  } @@ -590,6 +607,7 @@ Tcl_TellObjCmd(  {      Tcl_Channel chan;		/* The channel to tell on. */      Tcl_WideInt newLoc; +    int code;      if (objc != 2) {  	Tcl_WrongNumArgs(interp, 1, objv, "channelId"); @@ -605,6 +623,7 @@ Tcl_TellObjCmd(  	return TCL_ERROR;      } +    Tcl_Preserve(chan);      newLoc = Tcl_Tell(chan);      /* @@ -613,7 +632,10 @@ Tcl_TellObjCmd(       * them into the regular interpreter result.       */ -    if (TclChanCaughtErrorBypass(interp, chan)) { + +    code  = TclChanCaughtErrorBypass(interp, chan); +    Tcl_Release(chan); +    if (code) {  	return TCL_ERROR;      } @@ -1952,25 +1974,25 @@ TclInitChanCmd(       * function at the moment.       */      static const EnsembleImplMap initMap[] = { -	{"blocked",	Tcl_FblockedObjCmd, NULL, NULL, NULL, 0}, -	{"close",	Tcl_CloseObjCmd, NULL, NULL, NULL, 0}, -	{"copy",	Tcl_FcopyObjCmd, NULL, NULL, NULL, 0}, -	{"create",	TclChanCreateObjCmd, NULL, NULL, NULL, 0},		/* TIP #219 */ -	{"eof",		Tcl_EofObjCmd, NULL, NULL, NULL, 0}, -	{"event",	Tcl_FileEventObjCmd, NULL, NULL, NULL, 0}, -	{"flush",	Tcl_FlushObjCmd, NULL, NULL, NULL, 0}, -	{"gets",	Tcl_GetsObjCmd, NULL, NULL, NULL, 0}, -	{"names",	TclChannelNamesCmd, NULL, NULL, NULL, 0}, -	{"pending",	ChanPendingObjCmd, NULL, NULL, NULL, 0},		/* TIP #287 */ -	{"pop",		TclChanPopObjCmd, NULL, NULL, NULL, 0},		/* TIP #230 */ -	{"postevent",	TclChanPostEventObjCmd, NULL, NULL, NULL, 0},	/* TIP #219 */ -	{"push",	TclChanPushObjCmd, NULL, NULL, NULL, 0},		/* TIP #230 */ -	{"puts",	Tcl_PutsObjCmd, NULL, NULL, NULL, 0}, -	{"read",	Tcl_ReadObjCmd, NULL, NULL, NULL, 0}, -	{"seek",	Tcl_SeekObjCmd, NULL, NULL, NULL, 0}, -	{"pipe",	ChanPipeObjCmd, NULL, NULL, NULL, 0},		/* TIP #304 */ -	{"tell",	Tcl_TellObjCmd, NULL, NULL, NULL, 0}, -	{"truncate",	ChanTruncateObjCmd, NULL, NULL, NULL, 0},		/* TIP #208 */ +	{"blocked",	Tcl_FblockedObjCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0}, +	{"close",	Tcl_CloseObjCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0}, +	{"copy",	Tcl_FcopyObjCmd,	NULL, NULL, NULL, 0}, +	{"create",	TclChanCreateObjCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},		/* TIP #219 */ +	{"eof",		Tcl_EofObjCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0}, +	{"event",	Tcl_FileEventObjCmd,	TclCompileBasic2Or3ArgCmd, NULL, NULL, 0}, +	{"flush",	Tcl_FlushObjCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0}, +	{"gets",	Tcl_GetsObjCmd,		TclCompileBasic1Or2ArgCmd, NULL, NULL, 0}, +	{"names",	TclChannelNamesCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, +	{"pending",	ChanPendingObjCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},		/* TIP #287 */ +	{"pipe",	ChanPipeObjCmd,		TclCompileBasic0ArgCmd, NULL, NULL, 0},		/* TIP #304 */ +	{"pop",		TclChanPopObjCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},		/* TIP #230 */ +	{"postevent",	TclChanPostEventObjCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},	/* TIP #219 */ +	{"push",	TclChanPushObjCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},		/* TIP #230 */ +	{"puts",	Tcl_PutsObjCmd,		NULL, NULL, NULL, 0}, +	{"read",	Tcl_ReadObjCmd,		NULL, NULL, NULL, 0}, +	{"seek",	Tcl_SeekObjCmd,		TclCompileBasic2Or3ArgCmd, NULL, NULL, 0}, +	{"tell",	Tcl_TellObjCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0}, +	{"truncate",	ChanTruncateObjCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},		/* TIP #208 */  	{NULL, NULL, NULL, NULL, NULL, 0}      };      static const char *const extras[] = { | 
