diff options
Diffstat (limited to 'generic/tclIO.c')
-rw-r--r-- | generic/tclIO.c | 50 |
1 files changed, 29 insertions, 21 deletions
diff --git a/generic/tclIO.c b/generic/tclIO.c index d7ed3ac..d6fea64 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -7335,7 +7335,7 @@ Tcl_GetChannelBufferSize( * An error message is generated in interp's result object to indicate * that a command was invoked with the a bad option. The message has the * form: - * bad option "blah": should be one of + * bad/ambiguous option "blah": should be one of * <...generic options...>+<...specific options...> * "blah" is the optionName argument and "<specific options>" is a space * separated list of specific option words. The function takes good care @@ -7357,7 +7357,8 @@ Tcl_BadChannelOption( const char *genericopt = "blocking buffering buffersize encoding eofchar translation"; const char **argv; - int argc, i; + char *problemType = "bad"; + int argc, i, len = strlen(optionName); Tcl_DString ds; Tcl_Obj *errObj; @@ -7372,8 +7373,14 @@ Tcl_BadChannelOption( Tcl_Panic("malformed option list in channel driver"); } Tcl_ResetResult(interp); - errObj = Tcl_ObjPrintf("bad option \"%s\": should be one of ", - optionName); + for (i = 0; i < argc; i++) { + if (optionName[0]=='-' && strncmp(argv[i], optionName, len)==0) { + problemType = "ambiguous"; + break; + } + } + errObj = Tcl_ObjPrintf("%s option \"%s\": should be one of ", + problemType, optionName); argc--; for (i = 0; i < argc; i++) { Tcl_AppendPrintfToObj(errObj, "-%s, ", argv[i]); @@ -7709,8 +7716,9 @@ Tcl_SetChannelOption( SetFlag(statePtr, CHANNEL_UNBUFFERED); } else if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "bad value for -buffering: must be one of" + "bad value for -buffering: should be one of" " full, line, or none", -1)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "BUFFERING", NULL); return TCL_ERROR; } return TCL_OK; @@ -7769,8 +7777,9 @@ Tcl_SetChannelOption( if (inValue & 0x80 || outValue & 0x80) { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "bad value for -eofchar: must be non-NUL ASCII" + "bad value for -eofchar: should be non-NUL ASCII" " character", -1)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "EOFCHAR", NULL); } ckfree(argv); return TCL_ERROR; @@ -7786,6 +7795,7 @@ Tcl_SetChannelOption( Tcl_SetObjResult(interp, Tcl_NewStringObj( "bad value for -eofchar: should be a list of zero," " one, or two elements", -1)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "EOFCHAR", NULL); } ckfree(argv); return TCL_ERROR; @@ -7818,8 +7828,9 @@ Tcl_SetChannelOption( } else { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "bad value for -translation: must be a one or two" + "bad value for -translation: should be a one or two" " element list", -1)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "TRANSLATION", NULL); } ckfree(argv); return TCL_ERROR; @@ -7846,13 +7857,7 @@ Tcl_SetChannelOption( } else if (strcmp(readMode, "platform") == 0) { translation = TCL_PLATFORM_TRANSLATION; } else { - if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "bad value for -translation: must be one of " - "auto, binary, cr, lf, crlf, or platform", -1)); - } - ckfree(argv); - return TCL_ERROR; + goto badTranslation; } /* @@ -7896,17 +7901,20 @@ Tcl_SetChannelOption( } else if (strcmp(writeMode, "platform") == 0) { statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION; } else { - if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "bad value for -translation: must be one of " - "auto, binary, cr, lf, crlf, or platform", -1)); - } - ckfree(argv); - return TCL_ERROR; + goto badTranslation; } } ckfree(argv); return TCL_OK; + badTranslation: + if (interp) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "bad value for -translation: should be one of " + "auto, binary, cr, lf, crlf, or platform", -1)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "TRANSLATION", NULL); + } + ckfree(argv); + return TCL_ERROR; } else if (chanPtr->typePtr->setOptionProc != NULL) { return chanPtr->typePtr->setOptionProc(chanPtr->instanceData, interp, optionName, newValue); |