diff options
| -rw-r--r-- | jim-aio.c | 29 | ||||
| -rw-r--r-- | jimiocompat.h | 2 | ||||
| -rw-r--r-- | tclcompat.tcl | 2 | ||||
| -rw-r--r-- | tests/io.test | 26 |
4 files changed, 58 insertions, 1 deletions
@@ -1666,6 +1666,28 @@ static int aio_cmd_buffering(Jim_Interp *interp, int argc, Jim_Obj *const *argv) return JIM_OK; } +static int aio_cmd_translation(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + enum {OPT_BINARY, OPT_TEXT}; + static const char * const options[] = { + "binary", + "text", + NULL + }; + int opt; + + if (Jim_GetEnum(interp, argv[0], options, &opt, NULL, JIM_ERRMSG) != JIM_OK) { + return JIM_ERR; + } +#if defined(Jim_SetMode) + else { + AioFile *af = Jim_CmdPrivData(interp); + Jim_SetMode(af->fd, opt == OPT_BINARY ? O_BINARY : O_TEXT); + } +#endif + return JIM_OK; +} + static int aio_cmd_readsize(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { AioFile *af = Jim_CmdPrivData(interp); @@ -2182,6 +2204,13 @@ static const jim_subcmd_type aio_command_table[] = { 2, /* Description: Sets or returns write buffering */ }, + { "translation", + "binary|text", + aio_cmd_translation, + 1, + 1, + /* Description: Sets output translation mode */ + }, { "readsize", "?size?", aio_cmd_readsize, diff --git a/jimiocompat.h b/jimiocompat.h index 32db56e..c384f81 100644 --- a/jimiocompat.h +++ b/jimiocompat.h @@ -70,6 +70,8 @@ int Jim_OpenForRead(const char *filename); #define Jim_FileStat _fstat64 #define Jim_Lseek _lseeki64 #define O_TEXT _O_TEXT + #define O_BINARY _O_BINARY + #define Jim_SetMode _setmode #ifndef STDIN_FILENO #define STDIN_FILENO 0 #endif diff --git a/tclcompat.tcl b/tclcompat.tcl index fb22190..14ce688 100644 --- a/tclcompat.tcl +++ b/tclcompat.tcl @@ -48,7 +48,7 @@ if {[exists -command stdout]} { $f buffering $v } -tr* { - # Just ignore -translation + $f translation $v } default { return -code error "fconfigure: unknown option $n" diff --git a/tests/io.test b/tests/io.test new file mode 100644 index 0000000..1b06439 --- /dev/null +++ b/tests/io.test @@ -0,0 +1,26 @@ +source [file dirname [info script]]/testing.tcl + +# This is a proxy for tcl || tclcompat +constraint cmd fconfigure + +# The tests in this file are intended to test Tcl-compatible I/O features + +test io-1.1 {translation binary} -body { + # write a file via stdout in binary mode + # This will always work on Unix + set script { + fconfigure stdout -translation binary + puts line1 + puts line2 + } + exec [info nameofexecutable] << $script >binary.out + # Read it back in binary mode + set f [open binary.out rb] + set buf [read $f] + close $f + set buf +} -cleanup { + file delete binary.out +} -result "line1\nline2\n" + +testreport |