index : tcl.git	8_5_with_8_6_regexp Coverity_CID_1251203 ISC_peephole activestate_nre_excised_variant_1_roll_forward activestate_nre_excised_variant_2_subtracted adjust_fix ajuba_ajuba2_2_0_synthetic ajuba_ajuba2_2_1_base_synthetic aku_mem_debug_allow_regular aku_review aku_tip_280_cl_perf_trial aku_tkt_6141c15186 amg_array_enum_c_api amg_string_insert androwish apn_hash_opt array_search_unset aspect_async_pipe aspect_bug_391bc0fd2c aspect_lreplace_cleanup aspect_lreplace_fix aspect_lreplace_refix aspect_shimmer_singleton_lists aspect_string_match aspect_tip288 avl_strcat_fix avl_tip_282 backout_memaccounting bch_coverity better_deprecation better_deprecation_85 bg_tip_282 bsg_0d_radix_prefix bug3036566 bug_010f4162ef bug_0520d17284 bug_05489ce335 bug_0b874c344d bug_0b874c344d_ak_info_frame_coro bug_0b8c387cf7 bug_0c043a175 bug_0e4d88b650 bug_0f42ff7871 bug_1189293 bug_1224888 bug_12b0997ce7 bug_13d3af3ad5 bug_13d3af3ad5_fork bug_1493a43044 bug_1536227 bug_16828b3744 bug_1712098 bug_1758a0b603 bug_1a25fdfec6 bug_1b0266d8bb bug_2152292 bug_219866c1e9 bug_2413550 bug_2502002 bug_25842c161f bug_272e866f1e bug_2902268 bug_2911139 bug_2992970 bug_2a94652ee1 bug_2f7cbd01c3 bug_2f9df4c4fa bug_3024359 bug_3033307 bug_3092089 bug_3154ea2759 bug_31661d2135 bug_3173086 bug_3185407 bug_3202171 bug_3216070 bug_3288345 bug_3293874 bug_32ae34e63a bug_3362446 bug_336441ed59 bug_3365156 bug_3389764 bug_3392070 bug_3397515 bug_3401704 bug_3413857 bug_3414754 bug_3418547 bug_3466099 bug_3475569 bug_3480599 bug_3484402 bug_3485833 bug_3493120 bug_3496014 bug_3508771 bug_3511806 bug_3514475 bug_3519357 bug_3522560 bug_3525762 bug_3525907 bug_3530536 bug_3532959 bug_3536888 bug_3544685 bug_3545363 bug_3555001 bug_3562640 bug_3562640_alt bug_3564735 bug_3566106 bug_3567063 bug_3588687 bug_3592747 bug_3598300 bug_3598580 bug_3599789 bug_3600057 bug_3600057_85 bug_3600058_td bug_3600328 bug_3601260 bug_3602706 bug_3603434 bug_3603553 bug_3603695 bug_3604074 bug_3604576 bug_3605401 bug_3605447 bug_3606121 bug_3606683 bug_3606683_84 bug_3606683_85 bug_3607246 bug_3607372 bug_3608360 bug_3608714 bug_3609693 bug_3610026 bug_3610383 bug_3610404 bug_3611974 bug_3613609 bug_3613671 bug_3614342 bug_39f6304c2e bug_46f801ea5a bug_473946 bug_47d66253c9 bug_4a0c163d24 bug_4b61afd660 bug_4dbdd9af14 bug_50750c735a bug_510001 bug_547989 bug_57945b574a bug_57945b574a_without_stub bug_581937ab1e bug_58b96f6744 bug_593baa032c bug_5adc350683 bug_5adc350683_86 bug_5d170b5ca5 bug_5f71353740 bug_67aa9a2070 bug_6ca52aec14 bug_716b427f76 bug_734138ded8 bug_75b8433707 bug_7a87a9bc5b bug_7f02ff1efa bug_80304238ac bug_85ce4bf928 bug_86ceb4e2b6 bug_879a0747be bug_894da183c8 bug_8bd13f07bd bug_900cb0284bc bug_96c3f3b47d1 bug_97069ea11a bug_9b47029467631832 bug_a3309d01db bug_adb198c256 bug_af08e89777 bug_b26e38a3e4 bug_b5ced5865b bug_b87ad7e914 bug_b9b2079e6d bug_ba44e415a0 bug_bbc304f61a bug_bc1a96407a bug_bd7f17bce8 bug_bdd91c7e43 bug_c4e230f29b bug_c7d0bc9a549714e0 bug_d2ffcca163 bug_d3071887dbc7aeac bug_d4e464ae48 bug_d4e7780ca1 bug_d5ddbc7f49 bug_db0a5f6417 bug_dcc03414f5 bug_dfc08326e3 bug_e0a7b3e5f8 bug_e21fc32c2aa bug_e711ffb458 bug_f1253530cd bug_f1253530cd_alt bug_f4f44174e bug_f97d4ee020 bug_f9fe90d0fa bug_io_32_11 bug_itcl_1b2865 bug_unknown_no_errorcode bugfix_832a1994c7_for_precompiled_bc cjo_hydra compile_ensemble contrib_patrick_fradin_code_cleanup core_8_0_2_synthetic core_8_0_3_pr core_8_0_4_synthetic core_8_0_5_base_synthetic core_8_0_5_branch core_8_0_5_synthetic core_8_0_6_branch core_8_1_0_synthetic core_8_1_b1_synthetic core_8_1_b2_synthetic core_8_1_b3_synthetic core_8_1_branch_old core_8_2_1_branch core_8_2_b1_synthetic core_8_2_b3_branch core_8_3_1_branch core_8_3_1_io_rewrite core_8_3_1_synthetic core_8_4_20_rc core_8_4_a2_synthetic core_8_4_branch core_8_5_10_rc core_8_5_11_rc core_8_5_12_rc core_8_5_13_rc core_8_5_14rc core_8_5_15_rc core_8_5_16_rc core_8_5_17_rc core_8_5_18_rc core_8_5_19_rc core_8_5_a5_synthetic core_8_5_branch core_8_5_branch_fix_1997007 core_8_6_0_rc core_8_6_1_rc core_8_6_2_rc core_8_6_3_rc core_8_6_4_rc core_8_6_5_rc core_8_6_6_rc core_8_6_7_rc core_8_6_b2_rc core_8_6_b3_rc core_8_6_branch core_8_6_branch_fork core_8_7_a1_rc core_stabilizer_branch core_stabilizer_merge_synthetic core_zip_vfs core_zip_vfs_c_encoder core_zip_vfs_static cpuid_on_unix cygwin_environment_changes dah_proc_arg_upvar damkerngt_file_utime daves_chop_branch daves_mk_branch dev_8_1_stubs_branch dev_hobbs_branch dev_stubs_branch dgp_3401704 dgp_async_socket dgp_bug_find dgp_bye_ctx_eval_flag dgp_bye_location_eval_list dgp_channel_flag_repair dgp_cmd_epoch dgp_compile_list_shimmer dgp_defer_string_rep dgp_demo dgp_dup_encoding_fix dgp_ecr dgp_encoding_flags dgp_ensemble_rewrite dgp_eof dgp_experiment dgp_flush_channel dgp_hoehrmann_decoder dgp_init_bytecode dgp_list_simplify dgp_literal_reform dgp_may_be_pointless dgp_move_buffers dgp_no_buffer_recycle dgp_optimize_output_stage dgp_pkg_migration dgp_properbytearray dgp_purge_NRRunObjProc dgp_read_bytes dgp_read_bytes_detour dgp_read_chars dgp_refactor dgp_refactor_merge_synthetic dgp_remove_string_result dgp_review dgp_revise_parsedvarnametype dgp_scan_element dgp_slow_read dgp_sprintf dgp_stack_depth_tester dgp_stackedstdchan dgp_stop_regexp_test_crash dgp_string_cat dgp_string_find dgp_stringcat_delaystringrep dgp_switch_compile dgp_tailcall_errorinfo dgp_tailcall_errorinfo_alt dgp_tcs_rewrite dgp_thread_leaks dgp_trunk_flag_repair dgp_trunk_read dgp_win_specific_strict dgp_writebytes_optimize dkf_64bit_support_branch dkf_alias_encoding dkf_asm_crash_20131022 dkf_bcc_optimize dkf_better_try_compilation dkf_bytecode_8_6 dkf_bytecode_8_6_eval dkf_bytecode_8_6_join dkf_bytecode_8_6_next dkf_bytecode_8_6_string_is dkf_bytecode_8_6_string_replace dkf_bytecode_8_6_yield dkf_bytecode_optimizer dkf_command_type dkf_compile_improvements dkf_dict_with_compiled dkf_documentation_figures dkf_expose_ptrgetvar dkf_expose_ptrgetvar_8_6 dkf_http_cookies dkf_improved_disassembler dkf_loop_exception_range_work dkf_namespace_as_ensemble dkf_notifier_poll dkf_oo_override_definition_namespaces dkf_quieter_compiles dkf_review dkf_utf16_branch dkf_wait_with_poll dogeen_assembler_branch dogeen_assembler_merge_synthetic drh_micro_optimization editorconfig empty_bodies experiment experimental ferrieux_nacl fix_1997007 fix_42202ba1e5ff566e fix_8_5_578155d5a19b348d fix_win_native_access fix_windows_zlib forgiving_pkgconfig freq_3010352_impl frq_3527238 frq_3544967 frq_3579001 frq_3599786 gahr_split_install gahr_ticket_dee3d66bc7 gahr_ticket_e6f27aa56f gahr_tip_447 griffin_numlevels htmlCopyrightsFix htmlhelpFix http3 hypnotoad hypnotoad_bug_3598385 hypnotoad_prefer_native_8_6 hypnotoad_vexpr info_linkedname initsubsystems initsubsystems2 initsubsystems2_split iocmd_leaks ios irontcl jcr_notifier_poll je_tty_cleanup jenglish_termios_cleanup jn_0d_radix_prefix jn_Tcl_requirement jn_emptystring jn_frq_3257396 jn_no_struct_names jn_unc_vfs jn_wide_printf kbk_clock_encoding_ensembles kennykb_numerics_branch kennykb_tip_22_33 kennykb_tip_22_33_botched lanam_array_for_impl libtommath libtommath_1_0 libtommath_1_0_1 libtommath_tcl_fixes_75 little macosx_8_4_branch master merge_tzdata_to_trunk micro_opt mig_alloc_reform mig_catch_compiler mig_err mig_no280 mig_nre_mods mig_opt2 mig_opt2_tmp mig_opt_foreach mig_optimize mig_review mig_stacklevels mig_strip_brutal mig_tailcall_cleanup mig_tmp mig_tmp_optimize minimal_fix_for_3598300_problems miniz mistachkin_review mistake mistake_20110314 mistake_20110314a mistkae mod_8_3_4_branch more_macros msgcat_dyn_locale msofer_bcEngine msofer_wcodes_branch msvc_with_64bit_zlib1_dll no_shimmer_string_length no_smartref nonmonotonic_obj_alloc notifier novem novem_64bit_sizes novem_ak_iframe_direct novem_ak_preserve_experiments novem_bighash novem_bug_3598300 novem_demo_bug_3588687 novem_freeifrefcountzero novem_more_memory_API novem_no_register_objtypes novem_no_shimmer_string_length novem_no_startcmd novem_numbers_eias novem_purge_literals novem_reduced_bytecodes novem_reduced_symbol_export novem_remove_string_result novem_remove_va novem_rename_memory_API novem_review novem_saveresult_as_macro novem_support novem_two_layer_list novem_unversioned_stub off_8_4_branch off_trunk on_hold_84 on_hold_85 on_hold_trunk oo_copy_ns other_64bit_candidates package_files panic_noreturn prevent_inline private pseudotrunk_2011_03_08 pyk_emptystring pyk_expr_numeric pyk_listdictstringrep pyk_pkgrequirenre pyk_trunk remove_pathappend_intrep remove_trim_header revert_3396731 rfe_1711975 rfe_3216010 rfe_3389978 rfe_3432962 rfe_3464401 rfe_3473670 rfe_6c0d7aec67 rfe_854941 rfe_b42b208ba4 rfe_dfc08326e3 rfe_notifier_fork rmax_ipv6_branch rmax_ipv6_merge_synthetic robust_async_connect_tests scriptics_sc_1_0_branch scriptics_sc_1_1_branch scriptics_sc_2_0_b2_synthetic scriptics_sc_2_0_b5_synthetic scriptics_sc_2_0_fixed_synthetic scriptics_tclpro_1_2 scriptics_tclpro_1_2_old scriptics_tclpro_1_2_synthetic scriptics_tclpro_1_3_b2_branch scriptics_tclpro_1_3_b3_synthetic sebres_8_5_event_perf_branch sebres_8_5_timerate sebres_8_6_clock_speedup sebres_8_6_clock_speedup_cr1 sebres_8_6_event_perf_branch sebres_8_6_timerate sebres_clean_core_8_5 sebres_clock_speedup sebres_clock_tz_fix sebres_event_perf_fix_busy_wait sebres_optimized_8_5 sebres_trunk_clock_speedup sebres_trunk_timerate semver stwo_dev86 tclPlatformEngine tcl_nosize tclchan_assertions tclpro_1_5_0_synthetic tcltest_verbose_desc tgl_pg_re thread_leaks ticket_9b2e636361 ticket_e770d92d6 tip280_test_coverage tip404_tcl8_5 tip429_only_id tip_106_impl tip_162_branch tip_257_implementation_branch tip_257_implementation_branch_root_synthetic tip_257_merge1_branch_20061020T1300 tip_278_branch tip_282 tip_302 tip_312 tip_318_update tip_388_impl tip_389_impl tip_395_with_alt_name tip_398_impl tip_400_impl tip_401 tip_404 tip_405_impl_td tip_427 tip_428 tip_429 tip_436 tip_440_alt tip_440_backport tip_444 tip_445 tip_445_fork tip_445_reject tip_452 tip_456 tip_456_fork tip_457 tip_458 tip_458_experiment tip_463 tip_465 tip_468 tip_468_bis tip_469 tip_470 tip_473 tip_59_implementation tip_improve_exec tk_bug_9eb55debc5 tkt3328635_posix_monotonic_clock tkt_04e26c02c0 tkt_414d10346b tkt_4d5ae7d88a unbreak_tclcompiler unknown_rewrite unproven unsetThreadData unwanted updateextended vc_reform vs_ide_compile werner_utf_max_6 win32_arm winFixes win_console_panic win_sock_async_connect_race_fix z_modifier zipfs zippy_fifo zlib_1_2_6
	Tcl is a high-level, general-purpose, interpreted, dynamic programming language. It was designed with the goal of being very simple but powerful.

summaryrefslogtreecommitdiffstats

log msg author committer range

path: root/tests/io.test

blob: e3ac4a1026af66282cf36170a64dec66b5eff020 (plain)

if (PyErr_ExceptionMatches(PyExc_KeyError)) PyErr_Clear(); else return -1; } } else { if (PyObject_SetItem(dict, key, value) != 0) return -1; } } return 0; } /* Copy values from the "locals" dict into the fast locals. dict is an input argument containing string keys representing variables names and arbitrary PyObject* as values. map and values are input arguments. map is a tuple of strings. values is an array of PyObject*. At index i, map[i] is the name of the variable with value values[i]. The function copies the first nmap variable from map/values into dict. If values[i] is NULL, the variable is deleted from dict. If deref is true, then the values being copied are cell variables and the value is extracted from the cell variable before being put in dict. If clear is true, then variables in map but not in dict are set to NULL in map; if clear is false, variables missing in dict are ignored. Exceptions raised while modifying the dict are silently ignored, because there is no good way to report them. */ static void dict_to_map(PyObject *map, Py_ssize_t nmap, PyObject *dict, PyObject **values, int deref, int clear) { Py_ssize_t j; assert(PyTuple_Check(map)); assert(PyDict_Check(dict)); assert(PyTuple_Size(map) >= nmap); for (j=0; j < nmap; j++) { PyObject *key = PyTuple_GET_ITEM(map, j); PyObject *value = PyObject_GetItem(dict, key); assert(PyUnicode_Check(key)); /* We only care about NULLs if clear is true. */ if (value == NULL) { PyErr_Clear(); if (!clear) continue; } if (deref) { assert(PyCell_Check(values[j])); if (PyCell_GET(values[j]) != value) { if (PyCell_Set(values[j], value) < 0) PyErr_Clear(); } } else if (values[j] != value) { Py_XINCREF(value); Py_XSETREF(values[j], value); } Py_XDECREF(value); } } int PyFrame_FastToLocalsWithError(PyFrameObject *f) { /* Merge fast locals into f->f_locals */ PyObject *locals, *map; PyObject **fast; PyCodeObject *co; Py_ssize_t j; Py_ssize_t ncells, nfreevars; if (f == NULL) { PyErr_BadInternalCall(); return -1; } locals = f->f_locals; if (locals == NULL) { locals = f->f_locals = PyDict_New(); if (locals == NULL) return -1; } co = f->f_code; map = co->co_varnames; if (!PyTuple_Check(map)) { PyErr_Format(PyExc_SystemError, "co_varnames must be a tuple, not %s", Py_TYPE(map)->tp_name); return -1; } fast = f->f_localsplus; j = PyTuple_GET_SIZE(map); if (j > co->co_nlocals) j = co->co_nlocals; if (co->co_nlocals) { if (map_to_dict(map, j, locals, fast, 0) < 0) return -1; } ncells = PyTuple_GET_SIZE(co->co_cellvars); nfreevars = PyTuple_GET_SIZE(co->co_freevars); if (ncells || nfreevars) { if (map_to_dict(co->co_cellvars, ncells, locals, fast + co->co_nlocals, 1)) return -1; /* If the namespace is unoptimized, then one of the following cases applies: 1. It does not contain free variables, because it uses import * or is a top-level namespace. 2. It is a class namespace. We don't want to accidentally copy free variables into the locals dict used by the class. */ if (co->co_flags & CO_OPTIMIZED) { if (map_to_dict(co->co_freevars, nfreevars, locals, fast + co->co_nlocals + ncells, 1) < 0) return -1; } } return 0; } void PyFrame_FastToLocals(PyFrameObject *f) { int res; assert(!PyErr_Occurred()); res = PyFrame_FastToLocalsWithError(f); if (res < 0) PyErr_Clear(); } void PyFrame_LocalsToFast(PyFrameObject *f, int clear) { /* Merge f->f_locals into fast locals */ PyObject *locals, *map; PyObject **fast; PyObject *error_type, *error_value, *error_traceback; PyCodeObject *co; Py_ssize_t j; Py_ssize_t ncells, nfreevars; if (f == NULL) return; locals = f->f_locals; co = f->f_code; map = co->co_varnames; if (locals == NULL) return; if (!PyTuple_Check(map)) return; PyErr_Fetch(&error_type, &error_value, &error_traceback); fast = f->f_localsplus; j = PyTuple_GET_SIZE(map); if (j > co->co_nlocals) j = co->co_nlocals; if (co->co_nlocals) dict_to_map(co->co_varnames, j, locals, fast, 0, clear); ncells = PyTuple_GET_SIZE(co->co_cellvars); nfreevars = PyTuple_GET_SIZE(co->co_freevars); if (ncells || nfreevars) { dict_to_map(co->co_cellvars, ncells, locals, fast + co->co_nlocals, 1, clear); /* Same test as in PyFrame_FastToLocals() above. */ if (co->co_flags & CO_OPTIMIZED) { dict_to_map(co->co_freevars, nfreevars, locals, fast + co->co_nlocals + ncells, 1, clear); } } PyErr_Restore(error_type, error_value, error_traceback); } /* Clear out the free list */ void _PyFrame_ClearFreeList(void) { while (free_list != NULL) { PyFrameObject *f = free_list; free_list = free_list->f_back; PyObject_GC_Del(f); --numfree; } assert(numfree == 0); } void _PyFrame_Fini(void) { _PyFrame_ClearFreeList(); } /* Print summary info about the state of the optimized allocator */ void _PyFrame_DebugMallocStats(FILE *out) { _PyDebugAllocatorStats(out, "free PyFrameObject", numfree, sizeof(PyFrameObject)); } PyCodeObject * PyFrame_GetCode(PyFrameObject *frame) { assert(frame != NULL); PyCodeObject *code = frame->f_code; assert(code != NULL); Py_INCREF(code); return code; } PyFrameObject* PyFrame_GetBack(PyFrameObject *frame) { assert(frame != NULL); PyFrameObject *back = frame->f_back; Py_XINCREF(back); return back; }

generated by cgit v0.12 at 2024-12-04 03:59:29 (GMT)

# Functionality covered: operation of all IO commands, and all procedures
# defined in generic/tclIO.c.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: io.test,v 1.16 2001/04/04 17:35:25 andreas_kupries Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

if {"[info commands testchannel]" != "testchannel"} {
    puts "Skipping io tests. This application does not seem to have the"
    puts "testchannel command that is needed to run these tests."
    return
}

::tcltest::saveState

removeFile test1
removeFile pipe

catch {unset u}

# set up a long data file for some of the following tests

set f [open longfile w]
fconfigure $f -eofchar {} -translation lf
for { set i 0 } { $i < 100 } { incr i} {
    puts $f "#123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef
\#123456789abcdef01
\#"
    }
close $f

makeFile {
    set f stdin
    if {$argv != ""} {
	set f [open $argv]
    }
    fconfigure $f -encoding binary -translation lf -blocking 0 -eofchar \x1a
    fconfigure stdout -encoding binary -translation lf -buffering none
    fileevent $f readable "foo $f"
    proc foo {f} {
	set x [read $f]
	catch {puts -nonewline $x}
	if {[eof $f]} {
	    close $f
	    exit 0
	}
    }
    vwait forever
} cat

set thisScript [file join [pwd] [info script]]

proc contents {file} {
    set f [open $file]
    fconfigure $f -translation binary
    set a [read $f]
    close $f
    return $a
}

test io-1.5 {Tcl_WriteChars: CheckChannelErrors} {emptyTest} {
    # no test, need to cause an async error.
} {}
test io-1.6 {Tcl_WriteChars: WriteBytes} {
    set f [open test1 w]
    fconfigure $f -encoding binary
    puts -nonewline $f "a\u4e4d\0"
    close $f
    contents test1
} "a\x4d\x00"
test io-1.7 {Tcl_WriteChars: WriteChars} {
    set f [open test1 w]
    fconfigure $f -encoding shiftjis
    puts -nonewline $f "a\u4e4d\0"
    close $f
    contents test1
} "a\x93\xe1\x00"

test io-2.1 {WriteBytes} {
    # loop until all bytes are written
    
    set f [open test1 w]
    fconfigure $f  -encoding binary -buffersize 16 -translation crlf
    puts $f "abcdefghijklmnopqrstuvwxyz"
    close $f
    contents test1
} "abcdefghijklmnopqrstuvwxyz\r\n"
test io-2.2 {WriteBytes: savedLF > 0} {
    # After flushing buffer, there was a \n left over from the last
    # \n -> \r\n expansion.  It gets stuck at beginning of this buffer.

    set f [open test1 w]
    fconfigure $f -encoding binary -buffersize 16 -translation crlf
    puts -nonewline $f "123456789012345\n12"
    set x [list [contents test1]]
    close $f
    lappend x [contents test1]
} [list "123456789012345\r" "123456789012345\r\n12"]
test io-2.3 {WriteBytes: flush on line} {
    # Tcl "line" buffering has weird behavior: if current buffer contains
    # a \n, entire buffer gets flushed.  Logical behavior would be to flush
    # only up to the \n.
    
    set f [open test1 w]
    fconfigure $f -encoding binary -buffering line -translation crlf
    puts -nonewline $f "\n12"
    set x [contents test1]
    close $f
    set x
} "\r\n12"
test io-2.4 {WriteBytes: reset sawLF after each buffer} {
    set f [open test1 w]
     fconfigure $f -encoding binary -buffering line -translation lf \
	     -buffersize 16
    puts -nonewline $f "abcdefg\nhijklmnopqrstuvwxyz"
    set x [list [contents test1]]
    close $f
    lappend x [contents test1]
} [list "abcdefg\nhijklmno" "abcdefg\nhijklmnopqrstuvwxyz"]

test io-3.1 {WriteChars: compatibility with WriteBytes} {
    # loop until all bytes are written
    
    set f [open test1 w]
    fconfigure $f -encoding ascii -buffersize 16 -translation crlf
    puts $f "abcdefghijklmnopqrstuvwxyz"
    close $f
    contents test1
} "abcdefghijklmnopqrstuvwxyz\r\n"
test io-3.2 {WriteChars: compatibility with WriteBytes: savedLF > 0} {
    # After flushing buffer, there was a \n left over from the last
    # \n -> \r\n expansion.  It gets stuck at beginning of this buffer.

    set f [open test1 w]
    fconfigure $f -encoding ascii -buffersize 16 -translation crlf
    puts -nonewline $f "123456789012345\n12"
    set x [list [contents test1]]
    close $f
    lappend x [contents test1]
} [list "123456789012345\r" "123456789012345\r\n12"]
test io-3.3 {WriteChars: compatibility with WriteBytes: flush on line} {
    # Tcl "line" buffering has weird behavior: if current buffer contains
    # a \n, entire buffer gets flushed.  Logical behavior would be to flush
    # only up to the \n.
    
    set f [open test1 w]
    fconfigure $f -encoding ascii -buffering line -translation crlf
    puts -nonewline $f "\n12"
    set x [contents test1]
    close $f
    set x
} "\r\n12"
test io-3.4 {WriteChars: loop over stage buffer} {
    # stage buffer maps to more than can be queued at once.

    set f [open test1 w]
    fconfigure $f -encoding jis0208 -buffersize 16 
    puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
    set x [list [contents test1]]
    close $f
    lappend x [contents test1]
} [list "!)!)!)!)!)!)!)!)" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
test io-3.5 {WriteChars: saved != 0} {
    # Bytes produced by UtfToExternal from end of last channel buffer
    # had to be moved to beginning of next channel buffer to preserve
    # requested buffersize.

    set f [open test1 w]
    fconfigure $f -encoding jis0208 -buffersize 17 
    puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
    set x [list [contents test1]]
    close $f
    lappend x [contents test1]
} [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
test io-3.6 {WriteChars: (stageRead + dstWrote == 0)} {
    # One incomplete UTF-8 character at end of staging buffer.  Backup
    # in src to the beginning of that UTF-8 character and try again.
    #
    # Translate the first 16 bytes, produce 14 bytes of output, 2 left over
    # (first two bytes of \uff21 in UTF-8).  Given those two bytes try
    # translating them again, find that no bytes are read produced, and break
    # to outer loop where those two bytes will have the remaining 4 bytes
    # (the last byte of \uff21 plus the all of \uff22) appended.

    set f [open test1 w]
    fconfigure $f -encoding shiftjis -buffersize 16
    puts -nonewline $f "12345678901234\uff21\uff22"
    set x [list [contents test1]]
    close $f
    lappend x [contents test1]
} [list "12345678901234\x82\x60" "12345678901234\x82\x60\x82\x61"]
test io-3.7 {WriteChars: (bufPtr->nextAdded > bufPtr->length)} {
    # When translating UTF-8 to external, the produced bytes went past end
    # of the channel buffer.  This is done purpose -- we then truncate the
    # bytes at the end of the partial character to preserve the requested
    # blocksize on flush.  The truncated bytes are moved to the beginning
    # of the next channel buffer.

    set f [open test1 w]
    fconfigure $f -encoding jis0208 -buffersize 17 
    puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
    set x [list [contents test1]]
    close $f
    lappend x [contents test1]
} [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
test io-3.8 {WriteChars: reset sawLF after each buffer} {
    set f [open test1 w]
    fconfigure $f -encoding ascii -buffering line -translation lf \
	     -buffersize 16
    puts -nonewline $f "abcdefg\nhijklmnopqrstuvwxyz"
    set x [list [contents test1]]
    close $f
    lappend x [contents test1]
} [list "abcdefg\nhijklmno" "abcdefg\nhijklmnopqrstuvwxyz"]

test io-4.1 {TranslateOutputEOL: lf} {
    # search for \n

    set f [open test1 w]
    fconfigure $f -buffering line -translation lf
    puts $f "abcde"
    set x [list [contents test1]]
    close $f
    lappend x [contents test1]
} [list "abcde\n" "abcde\n"]
test io-4.2 {TranslateOutputEOL: cr} {
    # search for \n, replace with \r

    set f [open test1 w]
    fconfigure $f -buffering line -translation cr
    puts $f "abcde"
    set x [list [contents test1]]
    close $f
    lappend x [contents test1]
} [list "abcde\r" "abcde\r"]
test io-4.3 {TranslateOutputEOL: crlf} {
    # simple case: search for \n, replace with \r

    set f [open test1 w]
    fconfigure $f -buffering line -translation crlf
    puts $f "abcde"
    set x [list [contents test1]]
    close $f
    lappend x [contents test1]
} [list "abcde\r\n" "abcde\r\n"]
test io-4.4 {TranslateOutputEOL: crlf} {
    # keep storing more bytes in output buffer until output buffer is full.
    # We have 13 bytes initially that would turn into 18 bytes.  Fill
    # dest buffer while (dstEnd < dstMax).

    set f [open test1 w]
    fconfigure $f -translation crlf -buffersize 16
    puts -nonewline $f "1234567\n\n\n\n\nA"
    set x [list [contents test1]]
    close $f
    lappend x [contents test1]
} [list "1234567\r\n\r\n\r\n\r\n\r" "1234567\r\n\r\n\r\n\r\n\r\nA"]
test io-4.5 {TranslateOutputEOL: crlf} {
    # Check for overflow of the destination buffer

    set f [open test1 w]
    fconfigure $f -translation crlf -buffersize 12
    puts -nonewline $f "12345678901\n456789012345678901234"
    close $f
    set x [contents test1]
} "12345678901\r\n456789012345678901234"

test io-5.1 {CheckFlush: not full} {
    set f [open test1 w]
    fconfigure $f 
    puts -nonewline $f "12345678901234567890"
    set x [list [contents test1]]
    close $f
    lappend x [contents test1]
} [list "" "12345678901234567890"]
test io-5.2 {CheckFlush: full} {
    set f [open test1 w]
    fconfigure $f -buffersize 16
    puts -nonewline $f "12345678901234567890"
    set x [list [contents test1]]
    close $f
    lappend x [contents test1]
} [list "1234567890123456" "12345678901234567890"]
test io-5.3 {CheckFlush: not line} {
    set f [open test1 w]
    fconfigure $f -buffering line
    puts -nonewline $f "12345678901234567890"
    set x [list [contents test1]]
    close $f
    lappend x [contents test1]
} [list "" "12345678901234567890"]
test io-5.4 {CheckFlush: line} {
    set f [open test1 w]
    fconfigure $f -buffering line -translation lf -encoding ascii
    puts -nonewline $f "1234567890\n1234567890"
    set x [list [contents test1]]
    close $f
    lappend x [contents test1]
} [list "1234567890\n1234567890" "1234567890\n1234567890"]
test io-5.5 {CheckFlush: none} {
    set f [open test1 w]
    fconfigure $f -buffering none
    puts -nonewline $f "1234567890"
    set x [list [contents test1]]
    close $f
    lappend x [contents test1]
} [list "1234567890" "1234567890"]

test io-6.1 {Tcl_GetsObj: working} {
    set f [open test1 w]
    puts $f "foo\nboo"
    close $f
    set f [open test1]
    set x [gets $f]
    close $f
    set x
} {foo}
test io-6.2 {Tcl_GetsObj: CheckChannelErrors() != 0} {
    # no test, need to cause an async error.
} {}
test io-6.3 {Tcl_GetsObj: how many have we used?} {
    # if (bufPtr != NULL) {oldRemoved = bufPtr->nextRemoved}

    set f [open test1 w]
    fconfigure $f -translation crlf
    puts $f "abc\ndefg"
    close $f
    set f [open test1]
    set x [list [tell $f] [gets $f line] [tell $f] [gets $f line] $line]
    close $f
    set x
} {0 3 5 4 defg}
test io-6.4 {Tcl_GetsObj: encoding == NULL} {
    set f [open test1 w]
    fconfigure $f -translation binary
    puts $f "\x81\u1234\0"
    close $f
    set f [open test1]
    fconfigure $f -translation binary
    set x [list [gets $f line] $line]
    close $f
    set x
} [list 3 "\x81\x34\x00"]
test io-6.5 {Tcl_GetsObj: encoding != NULL} {
    set f [open test1 w]
    fconfigure $f -translation binary
    puts $f "\x88\xea\x92\x9a"
    close $f
    set f [open test1]
    fconfigure $f -encoding shiftjis
    set x [list [gets $f line] $line]
    close $f
    set x
} [list 2 "\u4e00\u4e01"]
set a "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
append a $a
append a $a
test io-6.6 {Tcl_GetsObj: loop test} {
    # if (dst >= dstEnd) 

    set f [open test1 w]
    puts $f $a
    puts $f hi
    close $f
    set f [open test1]
    set x [list [gets $f line] $line]
    close $f
    set x
} [list 256 $a]
test io-6.7 {Tcl_GetsObj: error in input} {stdio} {
    # if (FilterInputBytes(chanPtr, &gs) != 0)

    set f [open "|[list $::tcltest::tcltest cat]" w+]
    puts -nonewline $f "hi\nwould"
    flush $f
    gets $f
    fconfigure $f -blocking 0
    set x [gets $f line]
    close $f
    set x
} {-1}
test io-6.8 {Tcl_GetsObj: remember if EOF is seen} {
    set f [open test1 w]
    puts $f "abcdef\x1aghijk\nwombat"
    close $f
    set f [open test1]
    fconfigure $f -eofchar \x1a
    set x [list [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} {6 abcdef -1 {}}
test io-6.9 {Tcl_GetsObj: remember if EOF is seen} {
    set f [open test1 w]
    puts $f "abcdefghijk\nwom\u001abat"
    close $f
    set f [open test1]
    fconfigure $f -eofchar \x1a
    set x [list [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} {11 abcdefghijk 3 wom}

# Comprehensive tests

test io-6.10 {Tcl_GetsObj: lf mode: no chars} {
    set f [open test1 w]
    close $f
    set f [open test1]
    fconfigure $f -translation lf
    set x [list [gets $f line] $line]
    close $f
    set x
} {-1 {}}
test io-6.11 {Tcl_GetsObj: lf mode: lone \n} {
    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "\n"
    close $f
    set f [open test1]
    fconfigure $f -translation lf
    set x [list [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} {0 {} -1 {}}
test io-6.12 {Tcl_GetsObj: lf mode: lone \r} {
    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "\r"
    close $f
    set f [open test1]
    fconfigure $f -translation lf
    set x [list [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} [list 1 "\r" -1 ""]
test io-6.13 {Tcl_GetsObj: lf mode: 1 char} {
    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f a
    close $f
    set f [open test1]
    fconfigure $f -translation lf
    set x [list [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} {1 a -1 {}}
test io-6.14 {Tcl_GetsObj: lf mode: 1 char followed by EOL} {
    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "a\n"
    close $f
    set f [open test1]
    fconfigure $f -translation lf
    set x [list [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} {1 a -1 {}}
test io-6.15 {Tcl_GetsObj: lf mode: several chars} {
    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "abcd\nefgh\rijkl\r\nmnop"
    close $f
    set f [open test1]
    fconfigure $f -translation lf
    set x [list [gets $f line] $line [gets $f line] $line [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} [list 4 "abcd" 10 "efgh\rijkl\r" 4 "mnop" -1 ""]
test io-6.16 {Tcl_GetsObj: cr mode: no chars} {
    set f [open test1 w]
    close $f
    set f [open test1]
    fconfigure $f -translation cr
    set x [list [gets $f line] $line]
    close $f
    set x
} {-1 {}}
test io-6.17 {Tcl_GetsObj: cr mode: lone \n} {
    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "\n"
    close $f
    set f [open test1]
    fconfigure $f -translation cr
    set x [list [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} [list 1 "\n" -1 ""]
test io-6.18 {Tcl_GetsObj: cr mode: lone \r} {
    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "\r"
    close $f
    set f [open test1]
    fconfigure $f -translation cr
    set x [list [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} {0 {} -1 {}}
test io-6.19 {Tcl_GetsObj: cr mode: 1 char} {
    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f a
    close $f
    set f [open test1]
    fconfigure $f -translation cr
    set x [list [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} {1 a -1 {}}
test io-6.20 {Tcl_GetsObj: cr mode: 1 char followed by EOL} {
    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "a\r"
    close $f
    set f [open test1]
    fconfigure $f -translation cr
    set x [list [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} {1 a -1 {}}
test io-6.21 {Tcl_GetsObj: cr mode: several chars} {
    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "abcd\nefgh\rijkl\r\nmnop"
    close $f
    set f [open test1]
    fconfigure $f -translation cr
    set x [list [gets $f line] $line [gets $f line] $line [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} [list 9 "abcd\nefgh" 4 "ijkl" 5 "\nmnop" -1 ""]
test io-6.22 {Tcl_GetsObj: crlf mode: no chars} {
    set f [open test1 w]
    close $f
    set f [open test1]
    fconfigure $f -translation crlf
    set x [list [gets $f line] $line]
    close $f
    set x
} {-1 {}}
test io-6.23 {Tcl_GetsObj: crlf mode: lone \n} {
    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "\n"
    close $f
    set f [open test1]
    fconfigure $f -translation crlf
    set x [list [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} [list 1 "\n" -1 ""]
test io-6.24 {Tcl_GetsObj: crlf mode: lone \r} {
    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "\r"
    close $f
    set f [open test1]
    fconfigure $f -translation crlf
    set x [list [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} [list 1 "\r" -1 ""]
test io-6.25 {Tcl_GetsObj: crlf mode: \r\r} {
    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "\r\r"
    close $f
    set f [open test1]
    fconfigure $f -translation crlf
    set x [list [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} [list 2 "\r\r" -1 ""]
test io-6.26 {Tcl_GetsObj: crlf mode: \r\n} {
    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "\r\n"
    close $f
    set f [open test1]
    fconfigure $f -translation crlf
    set x [list [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} [list 0 "" -1 ""]
test io-6.27 {Tcl_GetsObj: crlf mode: 1 char} {
    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f a
    close $f
    set f [open test1]
    fconfigure $f -translation crlf
    set x [list [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} {1 a -1 {}}
test io-6.28 {Tcl_GetsObj: crlf mode: 1 char followed by EOL} {
    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "a\r\n"
    close $f
    set f [open test1]
    fconfigure $f -translation crlf
    set x [list [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} {1 a -1 {}}
test io-6.29 {Tcl_GetsObj: crlf mode: several chars} {
    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "abcd\nefgh\rijkl\r\nmnop"
    close $f
    set f [open test1]
    fconfigure $f -translation crlf
    set x [list [gets $f line] $line [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} [list 14 "abcd\nefgh\rijkl" 4 "mnop" -1 ""]
test io-6.30 {Tcl_GetsObj: crlf mode: buffer exhausted} {
    # if (eol >= dstEnd)

    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "123456789012345\r\nabcdefghijklmnoprstuvwxyz"
    close $f
    set f [open test1]
    fconfigure $f -translation crlf -buffersize 16
    set x [list [gets $f line] $line [testchannel inputbuffered $f]]
    close $f
    set x
} [list 15 "123456789012345" 15]
test io-6.31 {Tcl_GetsObj: crlf mode: buffer exhausted, blocked} {stdio} {
    # (FilterInputBytes() != 0)

    set f [open "|[list $::tcltest::tcltest cat]" w+]
    fconfigure $f -translation {crlf lf} -buffering none
    puts -nonewline $f "bbbbbbbbbbbbbb\r\n123456789012345\r"
    fconfigure $f -buffersize 16
    set x [gets $f]
    fconfigure $f -blocking 0
    lappend x [gets $f line] $line [fblocked $f] [testchannel inputbuffered $f]
    close $f
    set x
} [list "bbbbbbbbbbbbbb" -1 "" 1 16]
test io-6.32 {Tcl_GetsObj: crlf mode: buffer exhausted, more data} {
    # not (FilterInputBytes() != 0)

    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "123456789012345\r\n123"
    close $f
    set f [open test1]
    fconfigure $f -translation crlf -buffersize 16
    set x [list [gets $f line] $line [tell $f] [testchannel inputbuffered $f]]
    close $f
    set x
} [list 15 "123456789012345" 17 3]
test io-6.33 {Tcl_GetsObj: crlf mode: buffer exhausted, at eof} {
    # eol still equals dstEnd
    
    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "123456789012345\r"
    close $f
    set f [open test1]
    fconfigure $f -translation crlf -buffersize 16
    set x [list [gets $f line] $line [eof $f]]
    close $f
    set x
} [list 16 "123456789012345\r" 1]
test io-6.34 {Tcl_GetsObj: crlf mode: buffer exhausted, not followed by \n} {
    # not (*eol == '\n') 
    
    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "123456789012345\rabcd\r\nefg"
    close $f
    set f [open test1]
    fconfigure $f -translation crlf -buffersize 16
    set x [list [gets $f line] $line [tell $f]]
    close $f
    set x
} [list 20 "123456789012345\rabcd" 22]
test io-6.35 {Tcl_GetsObj: auto mode: no chars} {
    set f [open test1 w]
    close $f
    set f [open test1]
    fconfigure $f -translation auto
    set x [list [gets $f line] $line]
    close $f
    set x
} {-1 {}}
test io-6.36 {Tcl_GetsObj: auto mode: lone \n} {
    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "\n"
    close $f
    set f [open test1]
    fconfigure $f -translation auto
    set x [list [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} [list 0 "" -1 ""]
test io-6.37 {Tcl_GetsObj: auto mode: lone \r} {
    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "\r"
    close $f
    set f [open test1]
    fconfigure $f -translation auto
    set x [list [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} [list 0 "" -1 ""]
test io-6.38 {Tcl_GetsObj: auto mode: \r\r} {
    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "\r\r"
    close $f
    set f [open test1]
    fconfigure $f -translation auto
    set x [list [gets $f line] $line [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} [list 0 "" 0 "" -1 ""]
test io-6.39 {Tcl_GetsObj: auto mode: \r\n} {
    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "\r\n"
    close $f
    set f [open test1]
    fconfigure $f -translation auto
    set x [list [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} [list 0 "" -1 ""]
test io-6.40 {Tcl_GetsObj: auto mode: 1 char} {
    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f a
    close $f
    set f [open test1]
    fconfigure $f -translation auto
    set x [list [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} {1 a -1 {}}
test io-6.41 {Tcl_GetsObj: auto mode: 1 char followed by EOL} {
    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "a\r\n"
    close $f
    set f [open test1]
    fconfigure $f -translation auto
    set x [list [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} {1 a -1 {}}
test io-6.42 {Tcl_GetsObj: auto mode: several chars} {
    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "abcd\nefgh\rijkl\r\nmnop"
    close $f
    set f [open test1]
    fconfigure $f -translation auto
    set x [list [gets $f line] $line [gets $f line] $line]
    lappend x [gets $f line] $line [gets $f line] $line [gets $f line] $line
    close $f
    set x
} [list 4 "abcd" 4 "efgh" 4 "ijkl" 4 "mnop" -1 ""]
test io-6.43 {Tcl_GetsObj: input saw cr} {stdio} {
    # if (chanPtr->flags & INPUT_SAW_CR)

    set f [open "|[list $::tcltest::tcltest cat]" w+]
    fconfigure $f -translation {auto lf} -buffering none
    puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
    fconfigure $f -buffersize 16
    set x [list [gets $f]]
    fconfigure $f -blocking 0
    lappend x [gets $f line] $line [testchannel queuedcr $f] 
    fconfigure $f -blocking 1
    puts -nonewline $f "\nabcd\refg\x1a"
    lappend x [gets $f line] $line [testchannel queuedcr $f]
    lappend x [gets $f line] $line
    close $f
    set x
} [list "bbbbbbbbbbbbbbb" 15 "123456789abcdef" 1 4 "abcd" 0 3 "efg"]
test io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio} {
    # not (*eol == '\n') 

    set f [open "|[list $::tcltest::tcltest cat]" w+]
    fconfigure $f -translation {auto lf} -buffering none
    puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
    fconfigure $f -buffersize 16
    set x [list [gets $f]]
    fconfigure $f -blocking 0
    lappend x [gets $f line] $line [testchannel queuedcr $f] 
    fconfigure $f -blocking 1
    puts -nonewline $f "abcd\refg\x1a"
    lappend x [gets $f line] $line [testchannel queuedcr $f]
    lappend x [gets $f line] $line
    close $f
    set x
} [list "bbbbbbbbbbbbbbb" 15 "123456789abcdef" 1 4 "abcd" 0 3 "efg"]
test io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} {stdio} {
    # Tcl_ExternalToUtf()

    set f [open "|[list $::tcltest::tcltest cat]" w+]
    fconfigure $f -translation {auto lf} -buffering none
    fconfigure $f -encoding unicode
    puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
    fconfigure $f -buffersize 16
    gets $f
    fconfigure $f -blocking 0
    set x [list [gets $f line] $line [testchannel queuedcr $f]]
    fconfigure $f -blocking 1
    puts -nonewline $f "\nabcd\refg"
    lappend x [gets $f line] $line [testchannel queuedcr $f]
    close $f
    set x
} [list 15 "123456789abcdef" 1 4 "abcd" 0]
test io-6.46 {Tcl_GetsObj: input saw cr, followed by just \n should give eof} {stdio} {
    # memmove()

    set f [open "|[list $::tcltest::tcltest cat]" w+]
    fconfigure $f -translation {auto lf} -buffering none
    puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
    fconfigure $f -buffersize 16
    gets $f
    fconfigure $f -blocking 0
    set x [list [gets $f line] $line [testchannel queuedcr $f]]
    fconfigure $f -blocking 1
    puts -nonewline $f "\n\x1a"
    lappend x [gets $f line] $line [testchannel queuedcr $f]
    close $f
    set x
} [list 15 "123456789abcdef" 1 -1 "" 0]
test io-6.47 {Tcl_GetsObj: auto mode: \r at end of buffer, peek for \n} {
    # (eol == dstEnd)

    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "123456789012345\r\nabcdefghijklmnopq"
    close $f
    set f [open test1]
    fconfigure $f -translation auto -buffersize 16
    set x [list [gets $f] [testchannel inputbuffered $f]]
    close $f
    set x
} [list "123456789012345" 15]    
test io-6.48 {Tcl_GetsObj: auto mode: \r at end of buffer, no more avail} {
    # PeekAhead() did not get any, so (eol >= dstEnd)
    
    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "123456789012345\r"
    close $f
    set f [open test1]
    fconfigure $f -translation auto -buffersize 16
    set x [list [gets $f] [testchannel queuedcr $f]]
    close $f
    set x
} [list "123456789012345" 1]
test io-6.49 {Tcl_GetsObj: auto mode: \r followed by \n} {
    # if (*eol == '\n') {skip++}
    
    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "123456\r\n78901"
    close $f
    set f [open test1]
    set x [list [gets $f] [testchannel queuedcr $f] [tell $f] [gets $f]]
    close $f
    set x
} [list "123456" 0 8 "78901"]
test io-6.50 {Tcl_GetsObj: auto mode: \r not followed by \n} {
    # not (*eol == '\n') 
    
    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "123456\r78901"
    close $f
    set f [open test1]
    set x [list [gets $f] [testchannel queuedcr $f] [tell $f] [gets $f]]
    close $f
    set x
} [list "123456" 0 7 "78901"]
test io-6.51 {Tcl_GetsObj: auto mode: \n} {
    # else if (*eol == '\n') {goto gotoeol;}
    
    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "123456\n78901"
    close $f
    set f [open test1]
    set x [list [gets $f] [tell $f] [gets $f]]
    close $f
    set x
} [list "123456" 7 "78901"]
test io-6.52 {Tcl_GetsObj: saw EOF character} {
    # if (eof != NULL)

    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "123456\x1ak9012345\r"
    close $f
    set f [open test1]
    fconfigure $f -eofchar \x1a
    set x [list [gets $f] [testchannel queuedcr $f] [tell $f] [gets $f]]
    close $f
    set x
} [list "123456" 0 6 ""]
test io-6.53 {Tcl_GetsObj: device EOF} {
    # didn't produce any bytes

    set f [open test1 w]
    close $f
    set f [open test1]
    set x [list [gets $f line] $line [eof $f]]
    close $f
    set x
} {-1 {} 1}
test io-6.54 {Tcl_GetsObj: device EOF} {
    # got some bytes before EOF.

    set f [open test1 w]
    puts -nonewline $f abc
    close $f
    set f [open test1]
    set x [list [gets $f line] $line [eof $f]]
    close $f
    set x
} {3 abc 1}
test io-6.55 {Tcl_GetsObj: overconverted} {
    # Tcl_ExternalToUtf(), make sure state updated

    set f [open test1 w]
    fconfigure $f -encoding iso2022-jp
    puts $f "there\u4e00ok\n\u4e01more bytes\nhere"
    close $f
    set f [open test1]
    fconfigure $f -encoding iso2022-jp
    set x [list [gets $f line] $line [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} [list 8 "there\u4e00ok" 11 "\u4e01more bytes" 4 "here"]
test io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} {stdio} {
    update
    set f [open "|[list $::tcltest::tcltest cat]" w+]
    fconfigure $f -buffering none
    puts -nonewline $f "foobar"
    fconfigure $f -blocking 0
    set x {}
    after 500 { lappend x timeout }
    fileevent $f readable { lappend x [gets $f] }
    vwait x
    vwait x
    fconfigure $f -blocking 1
    puts -nonewline $f "baz\n"
    after 500 { lappend x timeout }
    fconfigure $f -blocking 0
    vwait x
    vwait x
    close $f
    set x
} {{} timeout foobarbaz timeout}

test io-7.1 {FilterInputBytes: split up character at end of buffer} {
    # (result == TCL_CONVERT_MULTIBYTE)

    set f [open test1 w]
    fconfigure $f -encoding shiftjis
    puts $f "1234567890123\uff10\uff11\uff12\uff13\uff14\nend"
    close $f
    set f [open test1]
    fconfigure $f -encoding shiftjis -buffersize 16
    set x [gets $f]
    close $f
    set x
} "1234567890123\uff10\uff11\uff12\uff13\uff14"
test io-7.2 {FilterInputBytes: split up character in middle of buffer} {
    # (bufPtr->nextAdded < bufPtr->bufLength)
    
    set f [open test1 w]
    fconfigure $f -encoding binary
    puts -nonewline $f "1234567890\n123\x82\x4f\x82\x50\x82"
    close $f
    set f [open test1]
    fconfigure $f -encoding shiftjis
    set x [list [gets $f line] $line [eof $f]]
    close $f
    set x
} [list 10 "1234567890" 0]
test io-7.3 {FilterInputBytes: split up character at EOF} {
    set f [open test1 w]
    fconfigure $f -encoding binary
    puts -nonewline $f "1234567890123\x82\x4f\x82\x50\x82"
    close $f
    set f [open test1]
    fconfigure $f -encoding shiftjis
    set x [list [gets $f line] $line]
    lappend x [tell $f] [testchannel inputbuffered $f] [eof $f]
    lappend x [gets $f line] $line
    close $f
    set x
} [list 15 "1234567890123\uff10\uff11" 18 0 1 -1 ""]
test io-7.4 {FilterInputBytes: recover from split up character} {stdio} {
    set f [open "|[list $::tcltest::tcltest cat]" w+]
    fconfigure $f -encoding binary -buffering none
    puts -nonewline $f "1234567890123\x82\x4f\x82\x50\x82"
    fconfigure $f -encoding shiftjis -blocking 0
    fileevent $f read "ready $f"
    set x {}
    proc ready {f} {
	lappend ::x [gets $f line] $line [fblocked $f]
    }
    vwait x
    fconfigure $f -encoding binary -blocking 1
    puts $f "\x51\x82\x52"
    fconfigure $f -encoding shiftjis
    vwait x
    close $f
    set x
} [list -1 "" 1 17 "1234567890123\uff10\uff11\uff12\uff13" 0]

test io-8.1 {PeekAhead: only go to device if no more cached data} {
    # (bufPtr->nextPtr == NULL)

    set f [open "test1" w]
    fconfigure $f -encoding ascii -translation lf
    puts -nonewline $f "123456789012345\r\n2345678"
    close $f
    set f [open "test1"]
    fconfigure $f -encoding ascii -translation auto -buffersize 16
    # here
    gets $f
    set x [testchannel inputbuffered $f]
    close $f
    set x
} "7"
test io-8.2 {PeekAhead: only go to device if no more cached data} {stdio} {
    # not (bufPtr->nextPtr == NULL)

    set f [open "|[list $::tcltest::tcltest cat]" w+]
    fconfigure $f -translation lf -encoding ascii -buffering none
    puts -nonewline $f "123456789012345\r\nbcdefghijklmnopqrstuvwxyz"
    set x {}
    fileevent $f read "ready $f"
    proc ready {f} {
	lappend ::x [gets $f line] $line [testchannel inputbuffered $f]
    }
    fconfigure $f -encoding unicode -buffersize 16 -blocking 0
    vwait x
    fconfigure $f -translation auto -encoding ascii -blocking 1
    # here
    vwait x
    close $f
    set x
} [list -1 "" 42 15 "123456789012345" 25]
test io-8.3 {PeekAhead: no cached data available} {stdio} {
    # (bytesLeft == 0)

    set f [open "|[list $::tcltest::tcltest cat]" w+]
    fconfigure $f -translation {auto binary}
    puts -nonewline $f "abcdefghijklmno\r"
    flush $f
    set x [list [gets $f line] $line [testchannel queuedcr $f]]
    close $f
    set x
} [list 15 "abcdefghijklmno" 1]
set a "123456789012345678901234567890"
append a "123456789012345678901234567890"
append a "1234567890123456789012345678901"
test io-8.4 {PeekAhead: cached data available in this buffer} {
    # not (bytesLeft == 0)

    set f [open test1 w+]
    fconfigure $f -translation binary
    puts $f "${a}\r\nabcdef"
    close $f
    set f [open test1]
    fconfigure $f -encoding binary -translation auto

    # "${a}\r" was converted in one operation (because ENCODING_LINESIZE
    # is 30).  To check if "\n" follows, calls PeekAhead and determines
    # that cached data is available in buffer w/o having to call driver.

    set x [gets $f]
    close $f
    set x    
} $a
unset a
test io-8.5 {PeekAhead: don't peek if last read was short} {stdio} {
    # (bufPtr->nextAdded < bufPtr->length)

    set f [open "|[list $::tcltest::tcltest cat]" w+]
    fconfigure $f -translation {auto binary}
    puts -nonewline $f "abcdefghijklmno\r"
    flush $f
    # here
    set x [list [gets $f line] $line [testchannel queuedcr $f]]
    close $f
    set x
} {15 abcdefghijklmno 1}
test io-8.6 {PeekAhead: change to non-blocking mode} {stdio} {
    # ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0) 

    set f [open "|[list $::tcltest::tcltest cat]" w+]
    fconfigure $f -translation {auto binary} -buffersize 16
    puts -nonewline $f "abcdefghijklmno\r"
    flush $f
    # here
    set x [list [gets $f line] $line [testchannel queuedcr $f]]
    close $f
    set x
} {15 abcdefghijklmno 1}
test io-8.7 {PeekAhead: cleanup} {stdio} {
    # Make sure bytes are removed from buffer.

    set f [open "|[list $::tcltest::tcltest cat]" w+]
    fconfigure $f -translation {auto binary} -buffering none
    puts -nonewline $f "abcdefghijklmno\r"
    # here
    set x [list [gets $f line] $line [testchannel queuedcr $f]]
    puts -nonewline $f "\x1a"
    lappend x [gets $f line] $line
    close $f
    set x
} {15 abcdefghijklmno 1 -1 {}}
    

test io-9.1 {CommonGetsCleanup} {
} {}

test io-10.1 {Tcl_ReadChars: CheckChannelErrors} {
    # no test, need to cause an async error.
} {}
test io-10.2 {Tcl_ReadChars: loop until enough copied} {
    # one time
    # for (copied = 0; (unsigned) toRead > 0; )

    set f [open "test1" w]
    puts $f abcdefghijklmnop
    close $f

    set f [open "test1"]
    set x [read $f 5]
    close $f
    set x
} {abcde}
test io-10.3 {Tcl_ReadChars: loop until enough copied} {
    # multiple times
    # for (copied = 0; (unsigned) toRead > 0; )

    set f [open "test1" w]
    puts $f abcdefghijklmnopqrstuvwxyz
    close $f

    set f [open "test1"]
    fconfigure $f -buffersize 16
    # here
    set x [read $f 19]
    close $f
    set x
} {abcdefghijklmnopqrs}
test io-10.4 {Tcl_ReadChars: no more in channel buffer} {
    # (copiedNow < 0)

    set f [open "test1" w]
    puts -nonewline $f abcdefghijkl
    close $f

    set f [open "test1"]
    # here
    set x [read $f 1000]
    close $f
    set x
} {abcdefghijkl}
test io-10.5 {Tcl_ReadChars: stop on EOF} {
    # (chanPtr->flags & CHANNEL_EOF)

    set f [open "test1" w]
    puts -nonewline $f abcdefghijkl
    close $f

    set f [open "test1"]
    # here
    set x [read $f 1000]
    close $f
    set x
} {abcdefghijkl}

test io-11.1 {ReadBytes: want to read a lot} {
    # ((unsigned) toRead > (unsigned) srcLen)

    set f [open "test1" w]
    puts -nonewline $f abcdefghijkl
    close $f
    set f [open "test1"]
    fconfigure $f -encoding binary
    # here
    set x [read $f 1000]
    close $f
    set x
} {abcdefghijkl}
test io-11.2 {ReadBytes: want to read all} {
    # ((unsigned) toRead > (unsigned) srcLen)

    set f [open "test1" w]
    puts -nonewline $f abcdefghijkl
    close $f
    set f [open "test1"]
    fconfigure $f -encoding binary
    # here
    set x [read $f]
    close $f
    set x
} {abcdefghijkl}
test io-11.3 {ReadBytes: allocate more space} {
    # (toRead > length - offset - 1)

    set f [open "test1" w]
    puts -nonewline $f abcdefghijklmnopqrstuvwxyz
    close $f
    set f [open "test1"]
    fconfigure $f -buffersize 16 -encoding binary
    # here
    set x [read $f]
    close $f
    set x
} {abcdefghijklmnopqrstuvwxyz}
test io-11.4 {ReadBytes: EOF char found} {
    # (TranslateInputEOL() != 0)

    set f [open "test1" w]
    puts $f abcdefghijklmnopqrstuvwxyz
    close $f
    set f [open "test1"]
    fconfigure $f -eofchar m -encoding binary
    # here
    set x [list [read $f] [eof $f] [read $f] [eof $f]]
    close $f
    set x
} [list "abcdefghijkl" 1 "" 1]
    
test io-12.1 {ReadChars: want to read a lot} {
    # ((unsigned) toRead > (unsigned) srcLen)

    set f [open "test1" w]
    puts -nonewline $f abcdefghijkl
    close $f
    set f [open "test1"]
    # here
    set x [read $f 1000]
    close $f
    set x
} {abcdefghijkl}
test io-12.2 {ReadChars: want to read all} {
    # ((unsigned) toRead > (unsigned) srcLen)

    set f [open "test1" w]
    puts -nonewline $f abcdefghijkl
    close $f
    set f [open "test1"]
    # here
    set x [read $f]
    close $f
    set x
} {abcdefghijkl}
test io-12.3 {ReadChars: allocate more space} {
    # (toRead > length - offset - 1)

    set f [open "test1" w]
    puts -nonewline $f abcdefghijklmnopqrstuvwxyz
    close $f
    set f [open "test1"]
    fconfigure $f -buffersize 16
    # here
    set x [read $f]
    close $f
    set x
} {abcdefghijklmnopqrstuvwxyz}
test io-12.4 {ReadChars: split-up char} {stdio} {
    # (srcRead == 0)

    set f [open "|[list $::tcltest::tcltest cat]" w+]
    fconfigure $f -encoding binary -buffering none -buffersize 16
    puts -nonewline $f "123456789012345\x96"
    fconfigure $f -encoding shiftjis -blocking 0

    fileevent $f read "ready $f"
    proc ready {f} {
	lappend ::x [read $f] [testchannel inputbuffered $f]
    }
    set x {}

    fconfigure $f -encoding shiftjis
    vwait x
    fconfigure $f -encoding binary -blocking 1
    puts -nonewline $f "\x7b"
    after 500			;# Give the cat process time to catch up
    fconfigure $f -encoding shiftjis -blocking 0
    vwait x
    close $f
    set x
} [list "123456789012345" 1 "\u672c" 0]
test io-12.5 {ReadChars: fileevents on partial characters} {stdio} {
    makeFile {
	fconfigure stdout -encoding binary -buffering none
	gets stdin; puts -nonewline "\xe7"
	gets stdin; puts -nonewline "\x89"
	gets stdin; puts -nonewline "\xa6"
    } test1
    set f [open "|[list $::tcltest::tcltest test1]" r+]
    fileevent $f readable {
	lappend x [read $f]
	if {[eof $f]} {
	    lappend x eof
	}
    }
    puts $f "go1"
    flush $f
    fconfigure $f -blocking 0 -encoding utf-8
    set x {}
    vwait x
    after 500 { lappend x timeout }
    vwait x
    puts $f "go2"
    flush $f
    vwait x
    after 500 { lappend x timeout }
    vwait x
    puts $f "go3"
    flush $f
    vwait x
    vwait x
    lappend x [catch {close $f} msg] $msg
    set x
} "{} timeout {} timeout \u7266 {} eof 0 {}"

test io-13.1 {TranslateInputEOL: cr mode} {} {
    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "abcd\rdef\r"
    close $f
    set f [open test1]
    fconfigure $f -translation cr
    set x [read $f]
    close $f
    set x
} "abcd\ndef\n"
test io-13.2 {TranslateInputEOL: crlf mode} {
    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "abcd\r\ndef\r\n"
    close $f
    set f [open test1]
    fconfigure $f -translation crlf
    set x [read $f]
    close $f
    set x
} "abcd\ndef\n"
test io-13.3 {TranslateInputEOL: crlf mode: naked cr} {
    # (src >= srcMax) 

    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "abcd\r\ndef\r"
    close $f
    set f [open test1]
    fconfigure $f -translation crlf
    set x [read $f]
    close $f
    set x
} "abcd\ndef\r"
test io-13.4 {TranslateInputEOL: crlf mode: cr followed by not \n} {
    # (src >= srcMax) 

    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "abcd\r\ndef\rfgh"
    close $f
    set f [open test1]
    fconfigure $f -translation crlf
    set x [read $f]
    close $f
    set x
} "abcd\ndef\rfgh"
test io-13.5 {TranslateInputEOL: crlf mode: naked lf} {
    # (src >= srcMax) 

    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "abcd\r\ndef\nfgh"
    close $f
    set f [open test1]
    fconfigure $f -translation crlf
    set x [read $f]
    close $f
    set x
} "abcd\ndef\nfgh"
test io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} {stdio} {
    # (chanPtr->flags & INPUT_SAW_CR)
    # This test may fail on slower machines.

    set f [open "|[list $::tcltest::tcltest cat]" w+]
    fconfigure $f -blocking 0 -buffering none -translation {auto lf}

    fileevent $f read "ready $f"
    proc ready {f} {
	lappend ::x [read $f] [testchannel queuedcr $f]
    }
    set x {}

    puts -nonewline $f "abcdefghj\r"
    after 500 {set y ok}
    vwait y

    puts -nonewline $f "\n01234"
    after 500 {set y ok}
    vwait y

    close $f
    set x
} [list "abcdefghj\n" 1 "01234" 0]
test io-13.7 {TranslateInputEOL: auto mode: naked \r} {
    # (src >= srcMax)

    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "abcd\r"
    close $f
    set f [open test1]
    fconfigure $f -translation auto
    set x [list [read $f] [testchannel queuedcr $f]]
    close $f
    set x
} [list "abcd\n" 1]
test io-13.8 {TranslateInputEOL: auto mode: \r\n} {
    # (*src == '\n')

    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "abcd\r\ndef"
    close $f
    set f [open test1]
    fconfigure $f -translation auto
    set x [read $f]
    close $f
    set x
} "abcd\ndef"
test io-13.9 {TranslateInputEOL: auto mode: \r followed by not \n} {
    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "abcd\rdef"
    close $f
    set f [open test1]
    fconfigure $f -translation auto
    set x [read $f]
    close $f
    set x
} "abcd\ndef"
test io-13.10 {TranslateInputEOL: auto mode: \n} {
    # not (*src == '\r') 

    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "abcd\ndef"
    close $f
    set f [open test1]
    fconfigure $f -translation auto
    set x [read $f]
    close $f
    set x
} "abcd\ndef"
test io-13.11 {TranslateInputEOL: EOF char} {
    # (*chanPtr->inEofChar != '\0')

    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "abcd\ndefgh"
    close $f
    set f [open test1]
    fconfigure $f -translation auto -eofchar e
    set x [read $f]
    close $f
    set x
} "abcd\nd"
test io-13.12 {TranslateInputEOL: find EOF char in src} {
    # (*chanPtr->inEofChar != '\0')

    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "\r\n\r\n\r\nab\r\n\r\ndef\r\n\r\n\r\n"
    close $f
    set f [open test1]
    fconfigure $f -translation auto -eofchar e
    set x [read $f]
    close $f
    set x
} "\n\n\nab\n\nd"
    
# Test standard handle management. The functions tested are
# Tcl_SetStdChannel and Tcl_GetStdChannel. Incidentally we are
# also testing channel table management.

if {$tcl_platform(platform) == "macintosh"} {
    set consoleFileNames [list console0 console1 console2]
} else {
    set consoleFileNames [lsort [testchannel open]]
}
test io-14.1 {Tcl_SetStdChannel and Tcl_GetStdChannel} {
    set l ""
    lappend l [fconfigure stdin -buffering]
    lappend l [fconfigure stdout -buffering]
    lappend l [fconfigure stderr -buffering]
    lappend l [lsort [testchannel open]]
    set l
} [list line line none $consoleFileNames]
test io-14.2 {Tcl_SetStdChannel and Tcl_GetStdChannel} {
    interp create x
    set l ""
    lappend l [x eval {fconfigure stdin -buffering}]
    lappend l [x eval {fconfigure stdout -buffering}]
    lappend l [x eval {fconfigure stderr -buffering}]
    interp delete x
    set l
} {line line none}
test io-14.3 {Tcl_SetStdChannel & Tcl_GetStdChannel} {stdio} {
    set f [open test1 w]
    puts $f {
	close stdin
	close stdout
	close stderr
	set f [open test1 r]
	set f2 [open test2 w]
	set f3 [open test3 w]
	puts stdout [gets stdin]
	puts stdout out
	puts stderr err
	close $f
	close $f2
	close $f3
    }
    close $f
    set result [exec $::tcltest::tcltest test1]
    set f [open test2 r]
    set f2 [open test3 r]
    lappend result [read $f] [read $f2]
    close $f
    close $f2
    set result
} {{
out
} {err
}}
# This test relies on the fact that the smallest available fd is used first.
test io-14.4 {Tcl_SetStdChannel & Tcl_GetStdChannel} {unixOnly} {
    set f [open test1 w]
    puts $f { close stdin
	close stdout
	close stderr
	set f [open test1 r]
	set f2 [open test2 w]
	set f3 [open test3 w]
	puts stdout [gets stdin]
	puts stdout $f2
	puts stderr $f3
	close $f
	close $f2
	close $f3
    }
    close $f
    set result [exec $::tcltest::tcltest test1]
    set f [open test2 r]
    set f2 [open test3 r]
    lappend result [read $f] [read $f2]
    close $f
    close $f2
    set result
} {{ close stdin
file1
} {file2
}}
catch {interp delete z}
test io-14.5 {Tcl_GetChannel: stdio name translation} {
    interp create z
    eof stdin
    catch {z eval flush stdin} msg1
    catch {z eval close stdin} msg2
    catch {z eval flush stdin} msg3
    set result [list $msg1 $msg2 $msg3]
    interp delete z
    set result
} {{channel "stdin" wasn't opened for writing} {} {can not find channel named "stdin"}}
test io-14.6 {Tcl_GetChannel: stdio name translation} {
    interp create z
    eof stdout
    catch {z eval flush stdout} msg1
    catch {z eval close stdout} msg2
    catch {z eval flush stdout} msg3
    set result [list $msg1 $msg2 $msg3]
    interp delete z
    set result
} {{} {} {can not find channel named "stdout"}}
test io-14.7 {Tcl_GetChannel: stdio name translation} {
    interp create z
    eof stderr
    catch {z eval flush stderr} msg1
    catch {z eval close stderr} msg2
    catch {z eval flush stderr} msg3
    set result [list $msg1 $msg2 $msg3]
    interp delete z
    set result
} {{} {} {can not find channel named "stderr"}}
test io-14.8 {reuse of stdio special channels} {stdio} {
    removeFile script
    removeFile test1
    set f [open script w]
    puts $f {
	close stderr
	set f [open test1 w]
	puts stderr hello
	close $f
	set f [open test1 r]
	puts [gets $f]
    }
    close $f
    set f [open "|[list $::tcltest::tcltest script]" r]
    set c [gets $f]
    close $f
    set c
} hello
test io-14.9 {reuse of stdio special channels} {stdio} {
    removeFile script
    removeFile test1
    set f [open script w]
    puts $f {
	set f [open test1 w]
	puts $f hello
	close $f
	close stderr
	set f [open "|[list [info nameofexecutable] cat test1]" r]
	puts [gets $f]
    }
    close $f
    set f [open "|[list $::tcltest::tcltest script]" r]
    set c [gets $f]
    close $f
    set c
} hello

test io-15.1 {Tcl_CreateCloseHandler} {
} {}

test io-16.1 {Tcl_DeleteCloseHandler} {
} {}

# Test channel table management. The functions tested are
# GetChannelTable, DeleteChannelTable, Tcl_RegisterChannel,
# Tcl_UnregisterChannel, Tcl_GetChannel and Tcl_CreateChannel.
#
# These functions use "eof stdin" to ensure that the standard
# channels are added to the channel table of the interpreter.

test io-17.1 {GetChannelTable, DeleteChannelTable on std handles} {
    set l1 [testchannel refcount stdin]
    eof stdin
    interp create x
    set l ""
    lappend l [expr [testchannel refcount stdin] - $l1]
    x eval {eof stdin}
    lappend l [expr [testchannel refcount stdin] - $l1]
    interp delete x
    lappend l [expr [testchannel refcount stdin] - $l1]
    set l
} {0 1 0}
test io-17.2 {GetChannelTable, DeleteChannelTable on std handles} {
    set l1 [testchannel refcount stdout]
    eof stdin
    interp create x
    set l ""
    lappend l [expr [testchannel refcount stdout] - $l1]
    x eval {eof stdout}
    lappend l [expr [testchannel refcount stdout] - $l1]
    interp delete x
    lappend l [expr [testchannel refcount stdout] - $l1]
    set l
} {0 1 0}
test io-17.3 {GetChannelTable, DeleteChannelTable on std handles} {
    set l1 [testchannel refcount stderr]
    eof stdin
    interp create x
    set l ""
    lappend l [expr [testchannel refcount stderr] - $l1]
    x eval {eof stderr}
    lappend l [expr [testchannel refcount stderr] - $l1]
    interp delete x
    lappend l [expr [testchannel refcount stderr] - $l1]
    set l
} {0 1 0}

test io-18.1 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {
    removeFile test1
    set l ""
    set f [open test1 w]
    lappend l [lindex [testchannel info $f] 15]
    close $f
    if {[catch {lindex [testchannel info $f] 15} msg]} {
	lappend l $msg
    } else {
	lappend l "very broken: $f found after being closed"
    }
    string compare [string tolower $l] \
	[list 1 [format "can not find channel named \"%s\"" $f]]
} 0
test io-18.2 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {
    removeFile test1
    set l ""
    set f [open test1 w]
    lappend l [lindex [testchannel info $f] 15]
    interp create x
    interp share "" $f x
    lappend l [lindex [testchannel info $f] 15]
    x eval close $f
    lappend l [lindex [testchannel info $f] 15]
    interp delete x
    lappend l [lindex [testchannel info $f] 15]
    close $f
    if {[catch {lindex [testchannel info $f] 15} msg]} {
	lappend l $msg
    } else {
	lappend l "very broken: $f found after being closed"
    }
    string compare [string tolower $l] \
	[list 1 2 1 1 [format "can not find channel named \"%s\"" $f]]
} 0
test io-18.3 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {
    removeFile test1
    set l ""
    set f [open test1 w]
    lappend l [lindex [testchannel info $f] 15]
    interp create x
    interp share "" $f x
    lappend l [lindex [testchannel info $f] 15]
    interp delete x
    lappend l [lindex [testchannel info $f] 15]
    close $f
    if {[catch {lindex [testchannel info $f] 15} msg]} {
	lappend l $msg
    } else {
	lappend l "very broken: $f found after being closed"
    }
    string compare [string tolower $l] \
	[list 1 2 1 [format "can not find channel named \"%s\"" $f]]
} 0

test io-19.1 {Tcl_GetChannel->Tcl_GetStdChannel, standard handles} {
    eof stdin
} 0
test io-19.2 {testing Tcl_GetChannel, user opened handle} {
    removeFile test1
    set f [open test1 w]
    set x [eof $f]
    close $f
    set x
} 0
test io-19.3 {Tcl_GetChannel, channel not found} {
    list [catch {eof file34} msg] $msg
} {1 {can not find channel named "file34"}}
test io-19.4 {Tcl_CreateChannel, insertion into channel table} {
    removeFile test1
    set f [open test1 w]
    set l ""
    lappend l [eof $f]
    close $f
    if {[catch {lindex [testchannel info $f] 15} msg]} {
	lappend l $msg
    } else {
	lappend l "very broken: $f found after being closed"
    }
    string compare [string tolower $l] \
	[list 0 [format "can not find channel named \"%s\"" $f]]
} 0

test io-20.1 {Tcl_CreateChannel: initial settings} {
	set a [open test2 w]
    set old [encoding system]
    encoding system ascii
    set f [open test1 w]
    set x [fconfigure $f -encoding]
    close $f
    encoding system $old
	close $a
    set x
} {ascii}    
test io-20.2 {Tcl_CreateChannel: initial settings} {pcOnly} {
    set f [open test1 w+]
    set x [list [fconfigure $f -eofchar] [fconfigure $f -translation]]
    close $f
    set x
} [list [list \x1a ""] {auto crlf}]
test io-20.3 {Tcl_CreateChannel: initial settings} {unixOnly} {
    set f [open test1 w+]
    set x [list [fconfigure $f -eofchar] [fconfigure $f -translation]]
    close $f
    set x
} {{{} {}} {auto lf}}
test io-20.4 {Tcl_CreateChannel: initial settings} {macOnly} {
    set f [open test1 w+]
    set x [list [fconfigure $f -eofchar] [fconfigure $f -translation]]
    close $f
    set x
} {{{} {}} {auto cr}}
test io-20.5 {Tcl_CreateChannel: install channel in empty slot} {stdio} {
    set f [open script w]
    puts $f {
	close stdout
	set f1 [open stdout w]
	fconfigure $f1 -buffersize 777
	puts stderr [fconfigure stdout -buffersize]
    }
    close $f
    set f [open "|[list $::tcltest::tcltest script]"]
    catch {close $f} msg
    set msg
} {777}
	
test io-21.1 {CloseChannelsOnExit} {
} {}
    
# Test management of attributes associated with a channel, such as
# its default translation, its name and type, etc. The functions
# tested in this group are Tcl_GetChannelName,
# Tcl_GetChannelType and Tcl_GetChannelFile. Tcl_GetChannelInstanceData
# not tested because files do not use the instance data.

test io-22.1 {Tcl_GetChannelMode} {
    # Not used anywhere in Tcl.
} {}

test io-23.1 {Tcl_GetChannelName} {
    removeFile test1
    set f [open test1 w]
    set n [testchannel name $f]
    close $f
    string compare $n $f
} 0

test io-24.1 {Tcl_GetChannelType} {
    removeFile test1
    set f [open test1 w]
    set t [testchannel type $f]
    close $f
    string compare $t file
} 0

test io-25.1 {Tcl_GetChannelHandle, input} {
    set f [open test1 w]
    fconfigure $f -translation lf -eofchar {}
    puts $f "1234567890\n098765432"
    close $f
    set f [open test1 r]
    gets $f
    set l ""
    lappend l [testchannel inputbuffered $f]
    lappend l [tell $f]
    close $f
    set l
} {10 11}
test io-25.2 {Tcl_GetChannelHandle, output} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf
    puts $f hello
    set l ""
    lappend l [testchannel outputbuffered $f]
    lappend l [tell $f]
    flush $f
    lappend l [testchannel outputbuffered $f]
    lappend l [tell $f]
    close $f
    removeFile test1
    set l
} {6 6 0 6}

test io-26.1 {Tcl_GetChannelInstanceData} {stdio} {
    # "pid" command uses Tcl_GetChannelInstanceData
    # Don't care what pid is (but must be a number), just want to exercise it.

    set f [open "|[list $::tcltest::tcltest << exit]"]
    expr [pid $f]
    close $f
} {}    

# Test flushing. The functions tested here are FlushChannel.

test io-27.1 {FlushChannel, no output buffered} {
    removeFile test1
    set f [open test1 w]
    flush $f
    set s [file size test1]
    close $f
    set s
} 0
test io-27.2 {FlushChannel, some output buffered} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf -eofchar {}
    set l ""
    puts $f hello
    lappend l [file size test1]
    flush $f
    lappend l [file size test1]
    close $f
    lappend l [file size test1]
    set l
} {0 6 6}
test io-27.3 {FlushChannel, implicit flush on close} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf -eofchar {}
    set l ""
    puts $f hello
    lappend l [file size test1]
    close $f
    lappend l [file size test1]
    set l
} {0 6}
test io-27.4 {FlushChannel, implicit flush when buffer fills} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf -eofchar {}
    fconfigure $f -buffersize 60
    set l ""
    lappend l [file size test1]
    for {set i 0} {$i < 12} {incr i} {
	puts $f hello
    }
    lappend l [file size test1]
    flush $f
    lappend l [file size test1]
    close $f
    set l
} {0 60 72}
test io-27.5 {FlushChannel, implicit flush when buffer fills and on close} \
	{unixOrPc} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf -buffersize 60 -eofchar {}
    set l ""
    lappend l [file size test1]
    for {set i 0} {$i < 12} {incr i} {
	puts $f hello
    }
    lappend l [file size test1]
    close $f
    lappend l [file size test1]
    set l
} {0 60 72}
test io-27.6 {FlushChannel, async flushing, async close} \
	{stdio asyncPipeClose } {
    removeFile pipe
    removeFile output
    set f [open pipe w]
    puts $f {
	set f [open output w]
	fconfigure $f -translation lf -buffering none -eofchar {}
	while {![eof stdin]} {
	    after 20
	    puts -nonewline $f [read stdin 1024]
	}
	close $f
    }
    close $f
    set x 01234567890123456789012345678901
    for {set i 0} {$i < 11} {incr i} {
        set x "$x$x"
    }
    set f [open output w]
    close $f
    set f [open "|[list $::tcltest::tcltest pipe]" w]
    fconfigure $f -blocking off
    puts -nonewline $f $x
    close $f
    set counter 0
    while {([file size output] < 65536) && ($counter < 1000)} {
        incr counter
        after 20
        update
    }
    if {$counter == 1000} {
        set result "file size only [file size output]"
    } else {
        set result ok
    }
} ok

# Tests closing a channel. The functions tested are CloseChannel and Tcl_Close.

test io-28.1 {CloseChannel called when all references are dropped} {
    removeFile test1
    set f [open test1 w]
    interp create x
    interp share "" $f x
    set l ""
    lappend l [testchannel refcount $f]
    x eval close $f
    interp delete x
    lappend l [testchannel refcount $f]
    close $f
    set l
} {2 1}
test io-28.2 {CloseChannel called when all references are dropped} {
    removeFile test1
    set f [open test1 w]
    interp create x
    interp share "" $f x
    puts -nonewline $f abc
    close $f
    x eval puts $f def
    x eval close $f
    interp delete x
    set f [open test1 r]
    set l [gets $f]
    close $f
    set l
} abcdef
test io-28.3 {CloseChannel, not called before output queue is empty} \
	{stdio asyncPipeClose nonPortable} {
    removeFile pipe
    removeFile output
    set f [open pipe w]
    puts $f {

	# Need to not have eof char appended on close, because the other
	# side of the pipe already closed, so that writing would cause an
	# error "invalid file".

	fconfigure stdout -eofchar {}
	fconfigure stderr -eofchar {}

	set f [open output w]
	fconfigure $f -translation lf -buffering none
	for {set x 0} {$x < 20} {incr x} {
	    after 20
	    puts -nonewline $f [read stdin 1024]
	}
	close $f
    }
    close $f
    set x 01234567890123456789012345678901
    for {set i 0} {$i < 11} {incr i} {
        set x "$x$x"
    }
    set f [open output w]
    close $f
    set f [open "|[list $::tcltest::tcltest pipe]" r+]
    fconfigure $f -blocking off -eofchar {}

    puts -nonewline $f $x
    close $f
    set counter 0
    while {([file size output] < 20480) && ($counter < 1000)} {
        incr counter
        after 20
        update
    }
    if {$counter == 1000} {
        set result probably_broken
    } else {
        set result ok
    }
} ok
test io-28.4 {Tcl_Close} {
    removeFile test1
    set l ""
    lappend l [lsort [testchannel open]]
    set f [open test1 w]
    lappend l [lsort [testchannel open]]
    close $f
    lappend l [lsort [testchannel open]]
    set x [list $consoleFileNames \
		[lsort [eval list $consoleFileNames $f]] \
		$consoleFileNames]
    string compare $l $x
} 0
test io-28.5 {Tcl_Close vs standard handles} {stdio unixOnly} {
    removeFile script
    set f [open script w]
    puts $f {
	close stdin
	puts [testchannel open]
    }
    close $f
    set f [open "|[list $::tcltest::tcltest script]" r]
    set l [gets $f]
    close $f
    set l
} {file1 file2}

test io-29.1 {Tcl_WriteChars, channel not writable} {
    list [catch {puts stdin hello} msg] $msg
} {1 {channel "stdin" wasn't opened for writing}}
test io-29.2 {Tcl_WriteChars, empty string} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -eofchar {}
    puts -nonewline $f ""
    close $f
    file size test1
} 0
test io-29.3 {Tcl_WriteChars, nonempty string} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -eofchar {}
    puts -nonewline $f hello
    close $f
    file size test1
} 5
test io-29.4 {Tcl_WriteChars, buffering in full buffering mode} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf -buffering full -eofchar {}
    puts $f hello
    set l ""
    lappend l [testchannel outputbuffered $f]
    lappend l [file size test1]
    flush $f
    lappend l [testchannel outputbuffered $f]
    lappend l [file size test1]
    close $f
    set l
} {6 0 0 6}
test io-29.5 {Tcl_WriteChars, buffering in line buffering mode} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf -buffering line -eofchar {}
    puts -nonewline $f hello
    set l ""
    lappend l [testchannel outputbuffered $f]
    lappend l [file size test1]
    puts $f hello
    lappend l [testchannel outputbuffered $f]
    lappend l [file size test1]
    close $f
    set l
} {5 0 0 11}
test io-29.6 {Tcl_WriteChars, buffering in no buffering mode} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf -buffering none -eofchar {}
    puts -nonewline $f hello
    set l ""
    lappend l [testchannel outputbuffered $f]
    lappend l [file size test1]
    puts $f hello
    lappend l [testchannel outputbuffered $f]
    lappend l [file size test1]
    close $f
    set l
} {0 5 0 11}

test io-29.7 {Tcl_Flush, full buffering} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf -buffering full -eofchar {}
    puts -nonewline $f hello
    set l ""
    lappend l [testchannel outputbuffered $f]
    lappend l [file size test1]
    puts $f hello
    lappend l [testchannel outputbuffered $f]
    lappend l [file size test1]
    flush $f
    lappend l [testchannel outputbuffered $f]
    lappend l [file size test1]
    close $f
    set l
} {5 0 11 0 0 11}
test io-29.8 {Tcl_Flush, full buffering} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf -buffering line
    puts -nonewline $f hello
    set l ""
    lappend l [testchannel outputbuffered $f]
    lappend l [file size test1]
    flush $f
    lappend l [testchannel outputbuffered $f]
    lappend l [file size test1]
    puts $f hello
    lappend l [testchannel outputbuffered $f]
    lappend l [file size test1]
    flush $f
    lappend l [testchannel outputbuffered $f]
    lappend l [file size test1]
    close $f
    set l
} {5 0 0 5 0 11 0 11}
test io-29.9 {Tcl_Flush, channel not writable} {
    list [catch {flush stdin} msg] $msg
} {1 {channel "stdin" wasn't opened for writing}}
test io-29.10 {Tcl_WriteChars, looping and buffering} {
    removeFile test1
    set f1 [open test1 w]
    fconfigure $f1 -translation lf -eofchar {}
    set f2 [open longfile r]
    for {set x 0} {$x < 10} {incr x} {
	puts $f1 [gets $f2]
    }
    close $f2
    close $f1
    file size test1
} 387
test io-29.11 {Tcl_WriteChars, no newline, implicit flush} {
    removeFile test1
    set f1 [open test1 w]
    fconfigure $f1 -eofchar {}
    set f2 [open longfile r]
    for {set x 0} {$x < 10} {incr x} {
	puts -nonewline $f1 [gets $f2]
    }
    close $f1
    close $f2
    file size test1
} 377
test io-29.12 {Tcl_WriteChars on a pipe} {stdio} {
    removeFile test1
    removeFile pipe
    set f1 [open pipe w]
    puts $f1 {
	set f1 [open longfile r]
	for {set x 0} {$x < 10} {incr x} {
	    puts [gets $f1]
	}
    }
    close $f1
    set f1 [open "|[list $::tcltest::tcltest pipe]" r]
    set f2 [open longfile r]
    set y ok
    for {set x 0} {$x < 10} {incr x} {
	set l1 [gets $f1]
	set l2 [gets $f2]
	if {"$l1" != "$l2"} {
	    set y broken
	}
    }
    close $f1
    close $f2
    set y
} ok
test io-29.13 {Tcl_WriteChars to a pipe, line buffered} {stdio} {
    removeFile test1
    removeFile pipe
    set f1 [open pipe w]
    puts $f1 {
	puts [gets stdin]
	puts [gets stdin]
    }
    close $f1
    set y ok
    set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
    fconfigure $f1 -buffering line
    set f2 [open longfile r]
    set line [gets $f2]
    puts $f1 $line
    set backline [gets $f1]
    if {"$line" != "$backline"} {
	set y broken
    }
    set line [gets $f2]
    puts $f1 $line
    set backline [gets $f1]
    if {"$line" != "$backline"} {
	set y broken
    }
    close $f1
    close $f2
    set y
} ok
test io-29.14 {Tcl_WriteChars, buffering and implicit flush at close} {
    removeFile test3
    set f [open test3 w]
    puts -nonewline $f "Text1"
    puts -nonewline $f " Text 2"
    puts $f " Text 3"
    close $f
    set f [open test3 r]
    set x [gets $f]
    close $f
    set x
} {Text1 Text 2 Text 3}
test io-29.15 {Tcl_Flush, channel not open for writing} {
    removeFile test1
    set fd [open test1 w]
    close $fd
    set fd [open test1 r]
    set x [list [catch {flush $fd} msg] $msg]
    close $fd
    string compare $x \
	[list 1 "channel \"$fd\" wasn't opened for writing"]
} 0
test io-29.16 {Tcl_Flush on pipe opened only for reading} {stdio} {
    set fd [open "|[list $::tcltest::tcltest cat longfile]" r]
    set x [list [catch {flush $fd} msg] $msg]
    catch {close $fd}
    string compare $x \
	[list 1 "channel \"$fd\" wasn't opened for writing"]
} 0
test io-29.17 {Tcl_WriteChars buffers, then Tcl_Flush flushes} {
    removeFile test1
    set f1 [open test1 w]
    fconfigure $f1 -translation lf
    puts $f1 hello
    puts $f1 hello
    puts $f1 hello
    flush $f1
    set x [file size test1]
    close $f1
    set x
} 18
test io-29.18 {Tcl_WriteChars and Tcl_Flush intermixed} {
    removeFile test1
    set x ""
    set f1 [open test1 w]
    fconfigure $f1 -translation lf
    puts $f1 hello
    puts $f1 hello
    puts $f1 hello
    flush $f1
    lappend x [file size test1]
    puts $f1 hello
    flush $f1
    lappend x [file size test1]
    puts $f1 hello
    flush $f1
    lappend x [file size test1]
    close $f1
    set x
} {18 24 30}
test io-29.19 {Explicit and implicit flushes} {
    removeFile test1
    set f1 [open test1 w]
    fconfigure $f1 -translation lf -eofchar {}
    set x ""
    puts $f1 hello
    puts $f1 hello
    puts $f1 hello
    flush $f1
    lappend x [file size test1]
    puts $f1 hello
    flush $f1
    lappend x [file size test1]
    puts $f1 hello
    close $f1
    lappend x [file size test1]
    set x
} {18 24 30}
test io-29.20 {Implicit flush when buffer is full} {
    removeFile test1
    set f1 [open test1 w]
    fconfigure $f1 -translation lf -eofchar {}
    set line "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
    for {set x 0} {$x < 100} {incr x} {
      puts $f1 $line
    }
    set z ""
    lappend z [file size test1]
    for {set x 0} {$x < 100} {incr x} {
	puts $f1 $line
    }
    lappend z [file size test1]
    close $f1
    lappend z [file size test1]
    set z
} {4096 12288 12600}
test io-29.21 {Tcl_Flush to pipe} {stdio} {
    removeFile pipe
    set f1 [open pipe w]
    puts $f1 {set x [read stdin 6]}
    puts $f1 {set cnt [string length $x]}
    puts $f1 {puts "read $cnt characters"}
    close $f1
    set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
    puts $f1 hello
    flush $f1
    set x [gets $f1]
    catch {close $f1}
    set x
} "read 6 characters"
test io-29.22 {Tcl_Flush called at other end of pipe} {stdio} {
    removeFile pipe
    set f1 [open pipe w]
    puts $f1 {
	fconfigure stdout -buffering full
	puts hello
	puts hello
	flush stdout
	gets stdin
	puts bye
	flush stdout
    }
    close $f1
    set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
    set x ""
    lappend x [gets $f1]
    lappend x [gets $f1]
    puts $f1 hello
    flush $f1
    lappend x [gets $f1]
    close $f1
    set x
} {hello hello bye}
test io-29.23 {Tcl_Flush and line buffering at end of pipe} {stdio} {
    removeFile pipe
    set f1 [open pipe w]
    puts $f1 {
	puts hello
	puts hello
	gets stdin
	puts bye
    }
    close $f1
    set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
    set x ""
    lappend x [gets $f1]
    lappend x [gets $f1]
    puts $f1 hello
    flush $f1
    lappend x [gets $f1]
    close $f1
    set x
} {hello hello bye}
test io-29.24 {Tcl_WriteChars and Tcl_Flush move end of file} {
    set f [open test3 w]
    puts $f "Line 1"
    puts $f "Line 2"
    set f2 [open test3]
    set x {}
    lappend x [read -nonewline $f2]
    close $f2
    flush $f
    set f2 [open test3]
    lappend x [read -nonewline $f2]
    close $f2
    close $f
    set x
} "{} {Line 1\nLine 2}"
test io-29.25 {Implicit flush with Tcl_Flush to command pipelines} {stdio} {
    removeFile test3
    set f [open "|[list $::tcltest::tcltest cat | $::tcltest::tcltest cat > test3]" w]
    puts $f "Line 1"
    puts $f "Line 2"
    close $f
    after 100
    set f [open test3 r]
    set x [read $f]
    close $f
    set x
} "Line 1\nLine 2\n"
test io-29.26 {Tcl_Flush, Tcl_Write on bidirectional pipelines} {stdio unixExecs} {
    set f [open "|[list cat -u]" r+]
    puts $f "Line1"
    flush $f
    set x [gets $f]
    close $f
    set x
} {Line1}
test io-29.27 {Tcl_Flush on closed pipeline} {stdio} {
    removeFile pipe
    set f [open pipe w]
    puts $f {exit}
    close $f
    set f [open "|[list $::tcltest::tcltest pipe]" r+]
    gets $f
    puts $f output
    after 50
    #
    # The flush below will get a SIGPIPE. This is an expected part of
    # test and indicates that the test operates correctly. If you run
    # this test under a debugger, the signal will by intercepted unless
    # you disable the debugger's signal interception.
    #
    if {[catch {flush $f} msg]} {
	set x [list 1 $msg $errorCode]
	catch {close $f}
    } else {
	if {[catch {close $f} msg]} {
	    set x [list 1 $msg $errorCode]
	} else {
	    set x {this was supposed to fail and did not}
	}
    }
    regsub {".*":} $x {"":} x
    string tolower $x
} {1 {error flushing "": broken pipe} {posix epipe {broken pipe}}}
test io-29.28 {Tcl_WriteChars, lf mode} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf -eofchar {}
    puts $f hello\nthere\nand\nhere
    flush $f
    set s [file size test1]
    close $f
    set s
} 21
test io-29.29 {Tcl_WriteChars, cr mode} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation cr -eofchar {}
    puts $f hello\nthere\nand\nhere
    close $f
    file size test1
} 21
test io-29.30 {Tcl_WriteChars, crlf mode} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation crlf -eofchar {}
    puts $f hello\nthere\nand\nhere
    close $f
    file size test1
} 25
test io-29.31 {Tcl_WriteChars, background flush} {stdio} {
    removeFile pipe
    removeFile output
    set f [open pipe w]
    puts $f {set f [open output w]}
    puts $f {fconfigure $f -translation lf}
    set x [list while {![eof stdin]}]
    set x "$x {"
    puts $f $x
    puts $f {  puts -nonewline $f [read stdin 4096]}
    puts $f {  flush $f}
    puts $f "}"
    puts $f {close $f}
    close $f
    set x 01234567890123456789012345678901
    for {set i 0} {$i < 11} {incr i} {
	set x "$x$x"
    }
    set f [open output w]
    close $f
    set f [open "|[list $::tcltest::tcltest pipe]" r+]
    fconfigure $f -blocking off
    puts -nonewline $f $x
    close $f
    set counter 0
    while {([file size output] < 65536) && ($counter < 1000)} {
	incr counter
	after 5
	update
    }
    if {$counter == 1000} {
	set result "file size only [file size output]"
    } else {
	set result ok
    }
} ok
test io-29.32 {Tcl_WriteChars, background flush to slow reader} \
	{stdio asyncPipeClose} {
    removeFile pipe
    removeFile output
    set f [open pipe w]
    puts $f {set f [open output w]}
    puts $f {fconfigure $f -translation lf}
    set x [list while {![eof stdin]}]
    set x "$x {"
    puts $f $x
    puts $f {  after 20}
    puts $f {  puts -nonewline $f [read stdin 1024]}
    puts $f {  flush $f}
    puts $f "}"
    puts $f {close $f}
    close $f
    set x 01234567890123456789012345678901
    for {set i 0} {$i < 11} {incr i} {
	set x "$x$x"
    }
    set f [open output w]
    close $f
    set f [open "|[list $::tcltest::tcltest pipe]" r+]
    fconfigure $f -blocking off
    puts -nonewline $f $x
    close $f
    set counter 0
    while {([file size output] < 65536) && ($counter < 1000)} {
	incr counter
	after 20
	update
    }
    if {$counter == 1000} {
	set result "file size only [file size output]"
    } else {
	set result ok
    }
} ok
test io-29.33 {Tcl_Flush, implicit flush on exit} {stdio} {
    set f [open script w]
    puts $f {
	set f [open test1 w]
	fconfigure $f -translation lf
	puts $f hello
	puts $f bye
	puts $f strange
    }
    close $f
    exec $::tcltest::tcltest script
    set f [open test1 r]
    set r [read $f]
    close $f
    set r
} "hello\nbye\nstrange\n"
test io-29.34 {Tcl_Close, async flush on close, using sockets} {socket tempNotMac} {
    set c 0
    set x running
    set l abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz
    proc writelots {s l} {
	for {set i 0} {$i < 2000} {incr i} {
	    puts $s $l
	}
    }
    proc accept {s a p} {
	global x
	fileevent $s readable [list readit $s]
	fconfigure $s -blocking off
	set x accepted
    }
    proc readit {s} {
	global c x
	set l [gets $s]
	
	if {[eof $s]} {
	    close $s
	    set x done
	} elseif {([string length $l] > 0) || ![fblocked $s]} {
	    incr c
	}
    }
    set ss [socket -server accept 2828]
    set cs [socket [info hostname] 2828]
    vwait x
    fconfigure $cs -blocking off
    writelots $cs $l
    close $cs
    close $ss
    vwait x
    set c
} 2000
test io-29.35 {Tcl_Close vs fileevent vs multiple interpreters} {socket tempNotMac} {
    # On Mac, this test screws up sockets such that subsequent tests using port 2828 
    # either cause errors or panic().
     
    catch {interp delete x}
    catch {interp delete y}
    interp create x
    interp create y
    set s [socket -server accept 2828]
    proc accept {s a p} {
	puts $s hello
	close $s
    }
    set c [socket [info hostname] 2828]
    interp share {} $c x
    interp share {} $c y
    close $c
    x eval {
	proc readit {s} {
	    gets $s
	    if {[eof $s]} {
		close $s
	    }
	}
    }
    y eval {
	proc readit {s} {
	    gets $s
	    if {[eof $s]} {
		close $s
	    }
	}
    }
    x eval "fileevent $c readable \{readit $c\}"
    y eval "fileevent $c readable \{readit $c\}"
    y eval [list close $c]
    update
    close $s
    interp delete x
    interp delete y
} ""

# Test end of line translations. Procedures tested are Tcl_Write, Tcl_Read.

test io-30.1 {Tcl_Write lf, Tcl_Read lf} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf
    puts $f hello\nthere\nand\nhere
    close $f
    set f [open test1 r]
    fconfigure $f -translation lf
    set x [read $f]
    close $f
    set x
} "hello\nthere\nand\nhere\n"
test io-30.2 {Tcl_Write lf, Tcl_Read cr} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf
    puts $f hello\nthere\nand\nhere
    close $f
    set f [open test1 r]
    fconfigure $f -translation cr
    set x [read $f]
    close $f
    set x
} "hello\nthere\nand\nhere\n"
test io-30.3 {Tcl_Write lf, Tcl_Read crlf} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf
    puts $f hello\nthere\nand\nhere
    close $f
    set f [open test1 r]
    fconfigure $f -translation crlf
    set x [read $f]
    close $f
    set x
} "hello\nthere\nand\nhere\n"
test io-30.4 {Tcl_Write cr, Tcl_Read cr} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation cr
    puts $f hello\nthere\nand\nhere
    close $f
    set f [open test1 r]
    fconfigure $f -translation cr
    set x [read $f]
    close $f
    set x
} "hello\nthere\nand\nhere\n"
test io-30.5 {Tcl_Write cr, Tcl_Read lf} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation cr
    puts $f hello\nthere\nand\nhere
    close $f
    set f [open test1 r]
    fconfigure $f -translation lf
    set x [read $f]
    close $f
    set x
} "hello\rthere\rand\rhere\r"
test io-30.6 {Tcl_Write cr, Tcl_Read crlf} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation cr
    puts $f hello\nthere\nand\nhere
    close $f
    set f [open test1 r]
    fconfigure $f -translation crlf
    set x [read $f]
    close $f
    set x 
} "hello\rthere\rand\rhere\r"
test io-30.7 {Tcl_Write crlf, Tcl_Read crlf} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation crlf
    puts $f hello\nthere\nand\nhere
    close $f
    set f [open test1 r]
    fconfigure $f -translation crlf
    set x [read $f]
    close $f
    set x
} "hello\nthere\nand\nhere\n"
test io-30.8 {Tcl_Write crlf, Tcl_Read lf} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation crlf
    puts $f hello\nthere\nand\nhere
    close $f
    set f [open test1 r]
    fconfigure $f -translation lf
    set x [read $f]
    close $f
    set x
} "hello\r\nthere\r\nand\r\nhere\r\n"
test io-30.9 {Tcl_Write crlf, Tcl_Read cr} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation crlf
    puts $f hello\nthere\nand\nhere
    close $f
    set f [open test1 r]
    fconfigure $f -translation cr
    set x [read $f]
    close $f
    set x
} "hello\n\nthere\n\nand\n\nhere\n\n"
test io-30.10 {Tcl_Write lf, Tcl_Read auto} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf
    puts $f hello\nthere\nand\nhere
    close $f
    set f [open test1 r]
    set c [read $f]
    set x [fconfigure $f -translation]
    close $f
    list $c $x
} {{hello
there
and
here
} auto}
test io-30.11 {Tcl_Write cr, Tcl_Read auto} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation cr
    puts $f hello\nthere\nand\nhere
    close $f
    set f [open test1 r]
    set c [read $f]
    set x [fconfigure $f -translation]
    close $f
    list $c $x
} {{hello
there
and
here
} auto}
test io-30.12 {Tcl_Write crlf, Tcl_Read auto} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation crlf
    puts $f hello\nthere\nand\nhere
    close $f
    set f [open test1 r]
    set c [read $f]
    set x [fconfigure $f -translation]
    close $f
    list $c $x
} {{hello
there
and
here
} auto}

test io-30.13 {Tcl_Write crlf on block boundary, Tcl_Read auto} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation crlf
    set line "123456789ABCDE"	;# 14 char plus crlf
    puts -nonewline $f x	;# shift crlf across block boundary
    for {set i 0} {$i < 700} {incr i} {
	puts $f $line
    }
    close $f
    set f [open test1 r]
    fconfigure $f -translation auto
    set c [read $f]
    close $f
    string length $c
} [expr 700*15+1]

test io-30.14 {Tcl_Write crlf on block boundary, Tcl_Read crlf} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation crlf
    set line "123456789ABCDE"	;# 14 char plus crlf
    puts -nonewline $f x	;# shift crlf across block boundary
    for {set i 0} {$i < 700} {incr i} {
	puts $f $line
    }
    close $f
    set f [open test1 r]
    fconfigure $f -translation crlf
    set c [read $f]
    close $f
    string length $c
} [expr 700*15+1]

test io-30.15 {Tcl_Write mixed, Tcl_Read auto} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf
    puts $f hello\nthere\nand\rhere
    close $f
    set f [open test1 r]
    fconfigure $f -translation auto
    set c [read $f]
    close $f
    set c
} {hello
there
and
here
}
test io-30.16 {Tcl_Write ^Z at end, Tcl_Read auto} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f hello\nthere\nand\rhere\n\x1a
    close $f
    set f [open test1 r]
    fconfigure $f -eofchar \x1a -translation auto
    set c [read $f]
    close $f
    set c
} {hello
there
and
here
}
test io-30.17 {Tcl_Write, implicit ^Z at end, Tcl_Read auto} {pcOnly} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -eofchar \x1a -translation lf
    puts $f hello\nthere\nand\rhere
    close $f
    set f [open test1 r]
    fconfigure $f -eofchar \x1a -translation auto
    set c [read $f]
    close $f
    set c
} {hello
there
and
here
}
test io-30.18 {Tcl_Write, ^Z in middle, Tcl_Read auto} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf
    set s [format "abc\ndef\n%cghi\nqrs" 26]
    puts $f $s
    close $f
    set f [open test1 r]
    fconfigure $f -eofchar \x1a -translation auto
    set l ""
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} {abc def 0 {} 1 {} 1}
test io-30.19 {Tcl_Write, ^Z no newline in middle, Tcl_Read auto} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf
    set s [format "abc\ndef\n%cghi\nqrs" 26]
    puts $f $s
    close $f
    set f [open test1 r]
    fconfigure $f -eofchar \x1a -translation auto
    set l ""
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} {abc def 0 {} 1 {} 1}
test io-30.20 {Tcl_Write, ^Z in middle ignored, Tcl_Read lf} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf -eofchar {}
    set s [format "abc\ndef\n%cghi\nqrs" 26]
    puts $f $s
    close $f
    set f [open test1 r]
    fconfigure $f -translation lf -eofchar {}
    set l ""
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} "abc def 0 \x1aghi 0 qrs 0 {} 1"
test io-30.21 {Tcl_Write, ^Z in middle ignored, Tcl_Read cr} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf -eofchar {}
    set s [format "abc\ndef\n%cghi\nqrs" 26]
    puts $f $s
    close $f
    set f [open test1 r]
    fconfigure $f -translation cr -eofchar {}
    set l ""
    set x [gets $f]
    lappend l [string compare $x "abc\ndef\n\x1aghi\nqrs\n"]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} {0 1 {} 1}
test io-30.22 {Tcl_Write, ^Z in middle ignored, Tcl_Read crlf} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf -eofchar {}
    set s [format "abc\ndef\n%cghi\nqrs" 26]
    puts $f $s
    close $f
    set f [open test1 r]
    fconfigure $f -translation crlf -eofchar {}
    set l ""
    set x [gets $f]
    lappend l [string compare $x "abc\ndef\n\x1aghi\nqrs\n"]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} {0 1 {} 1}
test io-30.23 {Tcl_Write lf, ^Z in middle, Tcl_Read auto} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf
    set c [format abc\ndef\n%cqrs\ntuv 26]
    puts $f $c
    close $f
    set f [open test1 r]
    fconfigure $f -translation auto -eofchar \x1a
    set c [string length [read $f]]
    set e [eof $f]
    close $f
    list $c $e
} {8 1}
test io-30.24 {Tcl_Write lf, ^Z in middle, Tcl_Read lf} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf
    set c [format abc\ndef\n%cqrs\ntuv 26]
    puts $f $c
    close $f
    set f [open test1 r]
    fconfigure $f -translation lf -eofchar \x1a
    set c [string length [read $f]]
    set e [eof $f]
    close $f
    list $c $e
} {8 1}
test io-30.25 {Tcl_Write cr, ^Z in middle, Tcl_Read auto} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation cr
    set c [format abc\ndef\n%cqrs\ntuv 26]
    puts $f $c
    close $f
    set f [open test1 r]
    fconfigure $f -translation auto -eofchar \x1a
    set c [string length [read $f]]
    set e [eof $f]
    close $f
    list $c $e
} {8 1}
test io-30.26 {Tcl_Write cr, ^Z in middle, Tcl_Read cr} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation cr
    set c [format abc\ndef\n%cqrs\ntuv 26]
    puts $f $c
    close $f
    set f [open test1 r]
    fconfigure $f -translation cr -eofchar \x1a
    set c [string length [read $f]]
    set e [eof $f]
    close $f
    list $c $e
} {8 1}
test io-30.27 {Tcl_Write crlf, ^Z in middle, Tcl_Read auto} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation crlf
    set c [format abc\ndef\n%cqrs\ntuv 26]
    puts $f $c
    close $f
    set f [open test1 r]
    fconfigure $f -translation auto -eofchar \x1a
    set c [string length [read $f]]
    set e [eof $f]
    close $f
    list $c $e
} {8 1}
test io-30.28 {Tcl_Write crlf, ^Z in middle, Tcl_Read crlf} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation crlf
    set c [format abc\ndef\n%cqrs\ntuv 26]
    puts $f $c
    close $f
    set f [open test1 r]
    fconfigure $f -translation crlf -eofchar \x1a
    set c [string length [read $f]]
    set e [eof $f]
    close $f
    list $c $e
} {8 1}

# Test end of line translations. Functions tested are Tcl_Write and Tcl_Gets.

test io-31.1 {Tcl_Write lf, Tcl_Gets auto} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf
    puts $f hello\nthere\nand\nhere
    close $f
    set f [open test1 r]
    set l ""
    lappend l [gets $f]
    lappend l [tell $f]
    lappend l [fconfigure $f -translation]
    lappend l [gets $f]
    lappend l [tell $f]
    lappend l [fconfigure $f -translation]
    close $f
    set l
} {hello 6 auto there 12 auto}
test io-31.2 {Tcl_Write cr, Tcl_Gets auto} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation cr
    puts $f hello\nthere\nand\nhere
    close $f
    set f [open test1 r]
    set l ""
    lappend l [gets $f]
    lappend l [tell $f]
    lappend l [fconfigure $f -translation]
    lappend l [gets $f]
    lappend l [tell $f]
    lappend l [fconfigure $f -translation]
    close $f
    set l
} {hello 6 auto there 12 auto}
test io-31.3 {Tcl_Write crlf, Tcl_Gets auto} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation crlf
    puts $f hello\nthere\nand\nhere
    close $f
    set f [open test1 r]
    set l ""
    lappend l [gets $f]
    lappend l [tell $f]
    lappend l [fconfigure $f -translation]
    lappend l [gets $f]
    lappend l [tell $f]
    lappend l [fconfigure $f -translation]
    close $f
    set l
} {hello 7 auto there 14 auto}
test io-31.4 {Tcl_Write lf, Tcl_Gets lf} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf
    puts $f hello\nthere\nand\nhere
    close $f
    set f [open test1 r]
    fconfigure $f -translation lf
    set l ""
    lappend l [gets $f]
    lappend l [tell $f]
    lappend l [fconfigure $f -translation]
    lappend l [gets $f]
    lappend l [tell $f]
    lappend l [fconfigure $f -translation]
    close $f
    set l
} {hello 6 lf there 12 lf}
test io-31.5 {Tcl_Write lf, Tcl_Gets cr} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf
    puts $f hello\nthere\nand\nhere
    close $f
    set f [open test1 r]
    fconfigure $f -translation cr
    set l ""
    lappend l [string length [gets $f]]
    lappend l [tell $f]
    lappend l [fconfigure $f -translation]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [tell $f]
    lappend l [fconfigure $f -translation]
    lappend l [eof $f]
    close $f
    set l
} {21 21 cr 1 {} 21 cr 1}
test io-31.6 {Tcl_Write lf, Tcl_Gets crlf} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf
    puts $f hello\nthere\nand\nhere
    close $f
    set f [open test1 r]
    fconfigure $f -translation crlf
    set l ""
    lappend l [string length [gets $f]]
    lappend l [tell $f]
    lappend l [fconfigure $f -translation]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [tell $f]
    lappend l [fconfigure $f -translation]
    lappend l [eof $f]
    close $f
    set l
} {21 21 crlf 1 {} 21 crlf 1}
test io-31.7 {Tcl_Write cr, Tcl_Gets cr} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation cr
    puts $f hello\nthere\nand\nhere
    close $f
    set f [open test1 r]
    fconfigure $f -translation cr
    set l ""
    lappend l [gets $f]
    lappend l [tell $f]
    lappend l [fconfigure $f -translation]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [tell $f]
    lappend l [fconfigure $f -translation]
    lappend l [eof $f]
    close $f
    set l
} {hello 6 cr 0 there 12 cr 0}
test io-31.8 {Tcl_Write cr, Tcl_Gets lf} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation cr
    puts $f hello\nthere\nand\nhere
    close $f
    set f [open test1 r]
    fconfigure $f -translation lf
    set l ""
    lappend l [string length [gets $f]]
    lappend l [tell $f]
    lappend l [fconfigure $f -translation]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [tell $f]
    lappend l [fconfigure $f -translation]
    lappend l [eof $f]
    close $f
    set l
} {21 21 lf 1 {} 21 lf 1}
test io-31.9 {Tcl_Write cr, Tcl_Gets crlf} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation cr
    puts $f hello\nthere\nand\nhere
    close $f
    set f [open test1 r]
    fconfigure $f -translation crlf
    set l ""
    lappend l [string length [gets $f]]
    lappend l [tell $f]
    lappend l [fconfigure $f -translation]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [tell $f]
    lappend l [fconfigure $f -translation]
    lappend l [eof $f]
    close $f
    set l
} {21 21 crlf 1 {} 21 crlf 1}
test io-31.10 {Tcl_Write crlf, Tcl_Gets crlf} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation crlf
    puts $f hello\nthere\nand\nhere
    close $f
    set f [open test1 r]
    fconfigure $f -translation crlf
    set l ""
    lappend l [gets $f]
    lappend l [tell $f]
    lappend l [fconfigure $f -translation]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [tell $f]
    lappend l [fconfigure $f -translation]
    lappend l [eof $f]
    close $f
    set l
} {hello 7 crlf 0 there 14 crlf 0}
test io-31.11 {Tcl_Write crlf, Tcl_Gets cr} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation crlf
    puts $f hello\nthere\nand\nhere
    close $f
    set f [open test1 r]
    fconfigure $f -translation cr
    set l ""
    lappend l [gets $f]
    lappend l [tell $f]
    lappend l [fconfigure $f -translation]
    lappend l [eof $f]
    lappend l [string length [gets $f]]
    lappend l [tell $f]
    lappend l [fconfigure $f -translation]
    lappend l [eof $f]
    close $f
    set l
} {hello 6 cr 0 6 13 cr 0}
test io-31.12 {Tcl_Write crlf, Tcl_Gets lf} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation crlf
    puts $f hello\nthere\nand\nhere
    close $f
    set f [open test1 r]
    fconfigure $f -translation lf
    set l ""
    lappend l [string length [gets $f]]
    lappend l [tell $f]
    lappend l [fconfigure $f -translation]
    lappend l [eof $f]
    lappend l [string length [gets $f]]
    lappend l [tell $f]
    lappend l [fconfigure $f -translation]
    lappend l [eof $f]
    close $f
    set l
} {6 7 lf 0 6 14 lf 0}
test io-31.13 {binary mode is synonym of lf mode} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation binary
    set x [fconfigure $f -translation]
    close $f
    set x
} lf
#
# Test io-9.14 has been removed because "auto" output translation mode is
# not supoprted.
#
test io-31.14 {Tcl_Write mixed, Tcl_Gets auto} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf
    puts $f hello\nthere\rand\r\nhere
    close $f
    set f [open test1 r]
    fconfigure $f -translation auto
    set l ""
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} {hello there and here 0 {} 1}
test io-31.15 {Tcl_Write mixed, Tcl_Gets auto} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f hello\nthere\rand\r\nhere\r
    close $f
    set f [open test1 r]
    fconfigure $f -translation auto
    set l ""
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} {hello there and here 0 {} 1}
test io-31.16 {Tcl_Write mixed, Tcl_Gets auto} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f hello\nthere\rand\r\nhere\n
    close $f
    set f [open test1 r]
    set l ""
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} {hello there and here 0 {} 1}
test io-31.17 {Tcl_Write mixed, Tcl_Gets auto} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f hello\nthere\rand\r\nhere\r\n
    close $f
    set f [open test1 r]
    fconfigure $f -translation auto
    set l ""
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} {hello there and here 0 {} 1}
test io-31.18 {Tcl_Write ^Z at end, Tcl_Gets auto} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf
    set s [format "hello\nthere\nand\rhere\n\%c" 26]
    puts $f $s
    close $f
    set f [open test1 r]
    fconfigure $f -eofchar \x1a -translation auto
    set l ""
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} {hello there and here 0 {} 1}
test io-31.19 {Tcl_Write, implicit ^Z at end, Tcl_Gets auto} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -eofchar \x1a -translation lf
    puts $f hello\nthere\nand\rhere
    close $f
    set f [open test1 r]
    fconfigure $f -eofchar \x1a -translation auto
    set l ""
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} {hello there and here 0 {} 1}
test io-31.20 {Tcl_Write, ^Z in middle, Tcl_Gets auto, eofChar} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf
    set s [format "abc\ndef\n%cqrs\ntuv" 26]
    puts $f $s
    close $f
    set f [open test1 r]
    fconfigure $f -eofchar \x1a
    fconfigure $f -translation auto
    set l ""
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} {abc def 0 {} 1}
test io-31.21 {Tcl_Write, no newline ^Z in middle, Tcl_Gets auto, eofChar} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf
    set s [format "abc\ndef\n%cqrs\ntuv" 26]
    puts $f $s
    close $f
    set f [open test1 r]
    fconfigure $f -eofchar \x1a -translation auto
    set l ""
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} {abc def 0 {} 1}
test io-31.22 {Tcl_Write, ^Z in middle ignored, Tcl_Gets lf} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf -eofchar {}
    set s [format "abc\ndef\n%cqrs\ntuv" 26]
    puts $f $s
    close $f
    set f [open test1 r]
    fconfigure $f -translation lf -eofchar {}
    set l ""
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} "abc def 0 \x1aqrs 0 tuv 0 {} 1"
test io-31.23 {Tcl_Write, ^Z in middle ignored, Tcl_Gets cr} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation cr -eofchar {}
    set s [format "abc\ndef\n%cqrs\ntuv" 26]
    puts $f $s
    close $f
    set f [open test1 r]
    fconfigure $f -translation cr -eofchar {}
    set l ""
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} "abc def 0 \x1aqrs 0 tuv 0 {} 1"
test io-31.24 {Tcl_Write, ^Z in middle ignored, Tcl_Gets crlf} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation crlf -eofchar {}
    set s [format "abc\ndef\n%cqrs\ntuv" 26]
    puts $f $s
    close $f
    set f [open test1 r]
    fconfigure $f -translation crlf -eofchar {}
    set l ""
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} "abc def 0 \x1aqrs 0 tuv 0 {} 1"
test io-31.25 {Tcl_Write lf, ^Z in middle, Tcl_Gets auto} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf
    set s [format "abc\ndef\n%cqrs\ntuv" 26]
    puts $f $s
    close $f
    set f [open test1 r]
    fconfigure $f -translation auto -eofchar \x1a
    set l ""
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} {abc def 0 {} 1}
test io-31.26 {Tcl_Write lf, ^Z in middle, Tcl_Gets lf} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf
    set s [format "abc\ndef\n%cqrs\ntuv" 26]
    puts $f $s
    close $f
    set f [open test1 r]
    fconfigure $f -translation lf -eofchar \x1a
    set l ""
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} {abc def 0 {} 1}
test io-31.27 {Tcl_Write cr, ^Z in middle, Tcl_Gets auto} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation cr -eofchar {}
    set s [format "abc\ndef\n%cqrs\ntuv" 26]
    puts $f $s
    close $f
    set f [open test1 r]
    fconfigure $f -translation auto -eofchar \x1a
    set l ""
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} {abc def 0 {} 1}
test io-31.28 {Tcl_Write cr, ^Z in middle, Tcl_Gets cr} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation cr -eofchar {}
    set s [format "abc\ndef\n%cqrs\ntuv" 26]
    puts $f $s
    close $f
    set f [open test1 r]
    fconfigure $f -translation cr -eofchar \x1a
    set l ""
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} {abc def 0 {} 1}
test io-31.29 {Tcl_Write crlf, ^Z in middle, Tcl_Gets auto} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation crlf -eofchar {}
    set s [format "abc\ndef\n%cqrs\ntuv" 26]
    puts $f $s
    close $f
    set f [open test1 r]
    fconfigure $f -translation auto -eofchar \x1a
    set l ""
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} {abc def 0 {} 1}
test io-31.30 {Tcl_Write crlf, ^Z in middle, Tcl_Gets crlf} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation crlf -eofchar {}
    set s [format "abc\ndef\n%cqrs\ntuv" 26]
    puts $f $s
    close $f
    set f [open test1 r]
    fconfigure $f -translation crlf -eofchar \x1a
    set l ""
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} {abc def 0 {} 1}
test io-31.31 {Tcl_Write crlf on block boundary, Tcl_Gets crlf} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation crlf
    set line "123456789ABCDE"	;# 14 char plus crlf
    puts -nonewline $f x	;# shift crlf across block boundary
    for {set i 0} {$i < 700} {incr i} {
	puts $f $line
    }
    close $f
    set f [open test1 r]
    fconfigure $f -translation crlf 
    set c ""
    while {[gets $f line] >= 0} {
	append c $line\n
    }
    close $f
    string length $c
} [expr 700*15+1]
test io-31.32 {Tcl_Write crlf on block boundary, Tcl_Gets auto} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation crlf
    set line "123456789ABCDE"	;# 14 char plus crlf
    puts -nonewline $f x	;# shift crlf across block boundary
    for {set i 0} {$i < 700} {incr i} {
	puts $f $line
    }
    close $f
    set f [open test1 r]
    fconfigure $f -translation auto
    set c ""
    while {[gets $f line] >= 0} {
	append c $line\n
    }
    close $f
    string length $c
} [expr 700*15+1]


# Test Tcl_Read and buffering.

test io-32.1 {Tcl_Read, channel not readable} {
    list [catch {read stdout} msg] $msg
} {1 {channel "stdout" wasn't opened for reading}}
test io-32.2 {Tcl_Read, zero byte count} {
    read stdin 0
} ""
test io-32.3 {Tcl_Read, negative byte count} {
    set f [open longfile r]
    set l [list [catch {read $f -1} msg] $msg]
    close $f
    set l
} {1 {bad argument "-1": should be "nonewline"}}
test io-32.4 {Tcl_Read, positive byte count} {
    set f [open longfile r]
    set x [read $f 1024]
    set s [string length $x]
    unset x
    close $f
    set s
} 1024
test io-32.5 {Tcl_Read, multiple buffers} {
    set f [open longfile r]
    fconfigure $f -buffersize 100
    set x [read $f 1024]
    set s [string length $x]
    unset x
    close $f
    set s
} 1024
test io-32.6 {Tcl_Read, very large read} {
    set f1 [open longfile r]
    set z [read $f1 1000000]
    close $f1
    set l [string length $z]
    set x ok
    set z [file size longfile]
    if {$z != $l} {
	set x broken
    }
    set x
} ok
test io-32.7 {Tcl_Read, nonblocking, file} {nonBlockFiles} {
    set f1 [open longfile r]
    fconfigure $f1 -blocking off
    set z [read $f1 20]
    close $f1
    set l [string length $z]
    set x ok
    if {$l != 20} {
	set x broken
    }
    set x
} ok
test io-32.8 {Tcl_Read, nonblocking, file} {nonBlockFiles} {
    set f1 [open longfile r]
    fconfigure $f1 -blocking off
    set z [read $f1 1000000]
    close $f1
    set x ok
    set l [string length $z]]
    set z [file size longfile]]
    if {$z != $l} {
	set x broken
    }
  set x
} ok
test io-32.9 {Tcl_Read, read to end of file} {
    set f1 [open longfile r]
    set z [read $f1]
    close $f1
    set l [string length $z]
    set x ok
    set z [file size longfile]
    if {$z != $l} {
	set x broken
    }
    set x
} ok
test io-32.10 {Tcl_Read from a pipe} {stdio} {
    removeFile pipe
    set f1 [open pipe w]
    puts $f1 {puts [gets stdin]}
    close $f1
    set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
    puts $f1 hello
    flush $f1
    set x [read $f1]
    close $f1
    set x
} "hello\n"
test io-32.11 {Tcl_Read from a pipe} {stdio} {
    removeFile pipe
    set f1 [open pipe w]
    puts $f1 {puts [gets stdin]}
    puts $f1 {puts [gets stdin]}
    close $f1
    set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
    puts $f1 hello
    flush $f1
    set x ""
    lappend x [read $f1 6]
    puts $f1 hello
    flush $f1
    lappend x [read $f1]
    close $f1
    set x
} {{hello
} {hello
}}
test io-32.12 {Tcl_Read, -nonewline} {
    removeFile test1
    set f1 [open test1 w]
    puts $f1 hello
    puts $f1 bye
    close $f1
    set f1 [open test1 r]
    set c [read -nonewline $f1]
    close $f1
    set c
} {hello
bye}
test io-32.13 {Tcl_Read, -nonewline} {
    removeFile test1
    set f1 [open test1 w]
    puts $f1 hello
    puts $f1 bye
    close $f1
    set f1 [open test1 r]
    set c [read -nonewline $f1]
    close $f1
    list [string length $c] $c
} {9 {hello
bye}}
test io-32.14 {Tcl_Read, reading in small chunks} {
    removeFile test1
    set f [open test1 w]
    puts $f "Two lines: this one"
    puts $f "and this one"
    close $f
    set f [open test1]
    set x [list [read $f 1] [read $f 2] [read $f]]
    close $f
    set x
} {T wo { lines: this one
and this one
}}
test io-32.15 {Tcl_Read, asking for more input than available} {
    removeFile test1
    set f [open test1 w]
    puts $f "Two lines: this one"
    puts $f "and this one"
    close $f
    set f [open test1]
    set x [read $f 100]
    close $f
    set x
} {Two lines: this one
and this one
}
test io-32.16 {Tcl_Read, read to end of file with -nonewline} {
    removeFile test1
    set f [open test1 w]
    puts $f "Two lines: this one"
    puts $f "and this one"
    close $f
    set f [open test1]
    set x [read -nonewline $f]
    close $f
    set x
} {Two lines: this one
and this one}

# Test Tcl_Gets.

test io-33.1 {Tcl_Gets, reading what was written} {
    removeFile test1
    set f1 [open test1 w]
    set y "first line"
    puts $f1 $y
    close $f1
    set f1 [open test1 r]
    set x [gets $f1]
    set z ok
    if {"$x" != "$y"} {
	set z broken
    }
    close $f1
    set z
} ok
test io-33.2 {Tcl_Gets into variable} {
    set f1 [open longfile r]
    set c [gets $f1 x]
    set l [string length x]
    set z ok
    if {$l != $l} {
	set z broken
    }
    close $f1
    set z
} ok
test io-33.3 {Tcl_Gets from pipe} {stdio} {
    removeFile pipe
    set f1 [open pipe w]
    puts $f1 {puts [gets stdin]}
    close $f1
    set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
    puts $f1 hello
    flush $f1
    set x [gets $f1]
    close $f1
    set z ok
    if {"$x" != "hello"} {
	set z broken
    }
    set z
} ok
test io-33.4 {Tcl_Gets with long line} {
    removeFile test3
    set f [open test3 w]
    puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
    puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
    puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
    puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
    puts $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
    close $f
    set f [open test3]
    set x [gets $f]
    close $f
    set x
} {abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
test io-33.5 {Tcl_Gets with long line} {
    set f [open test3]
    set x [gets $f y]
    close $f
    list $x $y
} {260 abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
test io-33.6 {Tcl_Gets and end of file} {
    removeFile test3
    set f [open test3 w]
    puts -nonewline $f "Test1\nTest2"
    close $f
    set f [open test3]
    set x {}
    set y {}
    lappend x [gets $f y] $y
    set y {}
    lappend x [gets $f y] $y
    set y {}
    lappend x [gets $f y] $y
    close $f
    set x
} {5 Test1 5 Test2 -1 {}}
test io-33.7 {Tcl_Gets and bad variable} {
    set f [open test3 w]
    puts $f "Line 1"
    puts $f "Line 2"
    close $f
    catch {unset x}
    set x 24
    set f [open test3 r]
    set result [list [catch {gets $f x(0)} msg] $msg]
    close $f
    set result
} {1 {can't set "x(0)": variable isn't array}}
test io-33.8 {Tcl_Gets, exercising double buffering} {
    set f [open test3 w]
    fconfigure $f -translation lf -eofchar {}
    set x ""
    for {set y 0} {$y < 99} {incr y} {set x "a$x"}
    for {set y 0} {$y < 100} {incr y} {puts $f $x}
    close $f
    set f [open test3 r]
    fconfigure $f -translation lf
    for {set y 0} {$y < 100} {incr y} {gets $f}
    close $f
    set y
} 100
test io-33.9 {Tcl_Gets, exercising double buffering} {
    set f [open test3 w]
    fconfigure $f -translation lf -eofchar {}
    set x ""
    for {set y 0} {$y < 99} {incr y} {set x "a$x"}
    for {set y 0} {$y < 200} {incr y} {puts $f $x}
    close $f
    set f [open test3 r]
    fconfigure $f -translation lf
    for {set y 0} {$y < 200} {incr y} {gets $f}
    close $f
    set y
} 200
test io-33.10 {Tcl_Gets, exercising double buffering} {
    set f [open test3 w]
    fconfigure $f -translation lf -eofchar {}
    set x ""
    for {set y 0} {$y < 99} {incr y} {set x "a$x"}
    for {set y 0} {$y < 300} {incr y} {puts $f $x}
    close $f
    set f [open test3 r]
    fconfigure $f -translation lf
    for {set y 0} {$y < 300} {incr y} {gets $f}
    close $f
    set y
} 300

# Test Tcl_Seek and Tcl_Tell.

test io-34.1 {Tcl_Seek to current position at start of file} {
    set f1 [open longfile r]
    seek $f1 0 current
    set c [tell $f1]
    close $f1
    set c
} 0
test io-34.2 {Tcl_Seek to offset from start} {
    removeFile test1
    set f1 [open test1 w]
    fconfigure $f1 -translation lf -eofchar {}
    puts $f1 "abcdefghijklmnopqrstuvwxyz"
    puts $f1 "abcdefghijklmnopqrstuvwxyz"
    close $f1
    set f1 [open test1 r]
    seek $f1 10 start
    set c [tell $f1]
    close $f1
    set c
} 10
test io-34.3 {Tcl_Seek to end of file} {
    removeFile test1
    set f1 [open test1 w]
    fconfigure $f1 -translation lf -eofchar {}
    puts $f1 "abcdefghijklmnopqrstuvwxyz"
    puts $f1 "abcdefghijklmnopqrstuvwxyz"
    close $f1
    set f1 [open test1 r]
    seek $f1 0 end
    set c [tell $f1]
    close $f1
    set c
} 54
test io-34.4 {Tcl_Seek to offset from end of file} {
    removeFile test1
    set f1 [open test1 w]
    fconfigure $f1 -translation lf -eofchar {}
    puts $f1 "abcdefghijklmnopqrstuvwxyz"
    puts $f1 "abcdefghijklmnopqrstuvwxyz"
    close $f1
    set f1 [open test1 r]
    seek $f1 -10 end
    set c [tell $f1]
    close $f1
    set c
} 44
test io-34.5 {Tcl_Seek to offset from current position} {
    removeFile test1
    set f1 [open test1 w]
    fconfigure $f1 -translation lf -eofchar {}
    puts $f1 "abcdefghijklmnopqrstuvwxyz"
    puts $f1 "abcdefghijklmnopqrstuvwxyz"
    close $f1
    set f1 [open test1 r]
    seek $f1 10 current
    seek $f1 10 current
    set c [tell $f1]
    close $f1
    set c
} 20
test io-34.6 {Tcl_Seek to offset from end of file} {
    removeFile test1
    set f1 [open test1 w]
    fconfigure $f1 -translation lf -eofchar {}
    puts $f1 "abcdefghijklmnopqrstuvwxyz"
    puts $f1 "abcdefghijklmnopqrstuvwxyz"
    close $f1
    set f1 [open test1 r]
    seek $f1 -10 end
    set c [tell $f1]
    set r [read $f1]
    close $f1
    list $c $r
} {44 {rstuvwxyz
}}
test io-34.7 {Tcl_Seek to offset from end of file, then to current position} {
    removeFile test1
    set f1 [open test1 w]
    fconfigure $f1 -translation lf -eofchar {}
    puts $f1 "abcdefghijklmnopqrstuvwxyz"
    puts $f1 "abcdefghijklmnopqrstuvwxyz"
    close $f1
    set f1 [open test1 r]
    seek $f1 -10 end
    set c1 [tell $f1]
    set r1 [read $f1 5]
    seek $f1 0 current
    set c2 [tell $f1]
    close $f1
    list $c1 $r1 $c2
} {44 rstuv 49}
test io-34.8 {Tcl_Seek on pipes: not supported} {stdio} {
    set f1 [open "|[list $::tcltest::tcltest]" r+]
    set x [list [catch {seek $f1 0 current} msg] $msg]
    close $f1
    regsub {".*":} $x {"":} x
    string tolower $x
} {1 {error during seek on "": invalid argument}}
test io-34.9 {Tcl_Seek, testing buffered input flushing} {
    removeFile test3
    set f [open test3 w]
    fconfigure $f -eofchar {}
    puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
    close $f
    set f [open test3 RDWR]
    set x [read $f 1]
    seek $f 3
    lappend x [read $f 1]
    seek $f 0 start
    lappend x [read $f 1]
    seek $f 10 current
    lappend x [read $f 1]
    seek $f -2 end
    lappend x [read $f 1]
    seek $f 50 end
    lappend x [read $f 1]
    seek $f 1
    lappend x [read $f 1]
    close $f
    set x
} {a d a l Y {} b}
test io-34.10 {Tcl_Seek testing flushing of buffered input} {
    set f [open test3 w]
    fconfigure $f -translation lf
    puts $f xyz\n123
    close $f
    set f [open test3 r+]
    fconfigure $f -translation lf
    set x [gets $f]
    seek $f 0 current
    puts $f 456
    close $f
    list $x [viewFile test3]
} "xyz {xyz
456}"
test io-34.11 {Tcl_Seek testing flushing of buffered output} {
    set f [open test3 w]
    puts $f xyz\n123
    close $f
    set f [open test3 w+]
    puts $f xyzzy
    seek $f 2
    set x [gets $f]
    close $f
    list $x [viewFile test3]
} "zzy xyzzy"
test io-34.12 {Tcl_Seek testing combination of write, seek back and read} {
    set f [open test3 w]
    fconfigure $f -translation lf -eofchar {}
    puts $f xyz\n123
    close $f
    set f [open test3 a+]
    fconfigure $f -translation lf -eofchar {}
    puts $f xyzzy
    flush $f
    set x [tell $f]
    seek $f -4 cur
    set y [gets $f]
    close $f
    list $x [viewFile test3] $y
} {14 {xyz
123
xyzzy} zzy}
test io-34.13 {Tcl_Tell at start of file} {
    removeFile test1
    set f1 [open test1 w]
    set p [tell $f1]
    close $f1
    set p
} 0
test io-34.14 {Tcl_Tell after seek to end of file} {
    removeFile test1
    set f1 [open test1 w]
    fconfigure $f1 -translation lf -eofchar {}
    puts $f1 "abcdefghijklmnopqrstuvwxyz"
    puts $f1 "abcdefghijklmnopqrstuvwxyz"
    close $f1
    set f1 [open test1 r]
    seek $f1 0 end
    set c1 [tell $f1]
    close $f1
    set c1
} 54
test io-34.15 {Tcl_Tell combined with seeking} {
    removeFile test1
    set f1 [open test1 w]
    fconfigure $f1 -translation lf -eofchar {}
    puts $f1 "abcdefghijklmnopqrstuvwxyz"
    puts $f1 "abcdefghijklmnopqrstuvwxyz"
    close $f1
    set f1 [open test1 r]
    seek $f1 10 start
    set c1 [tell $f1]
    seek $f1 10 current
    set c2 [tell $f1]
    close $f1
    list $c1 $c2
} {10 20}
test io-34.16 {Tcl_tell on pipe: always -1} {stdio} {
    set f1 [open "|[list $::tcltest::tcltest]" r+]
    set c [tell $f1]
    close $f1
    set c
} -1
test io-34.17 {Tcl_Tell on pipe: always -1} {stdio} {
    set f1 [open "|[list $::tcltest::tcltest]" r+]
    puts $f1 {puts hello}
    flush $f1
    set c [tell $f1]
    gets $f1
    close $f1
    set c
} -1
test io-34.18 {Tcl_Tell combined with seeking and reading} {
    removeFile test2
    set f [open test2 w]
    fconfigure $f -translation lf -eofchar {}
    puts -nonewline $f "line1\nline2\nline3\nline4\nline5\n"
    close $f
    set f [open test2]
    fconfigure $f -translation lf
    set x [tell $f]
    read $f 3
    lappend x [tell $f]
    seek $f 2
    lappend x [tell $f]
    seek $f 10 current
    lappend x [tell $f]
    seek $f 0 end
    lappend x [tell $f]
    close $f
    set x
} {0 3 2 12 30}
test io-34.19 {Tcl_Tell combined with opening in append mode} {
    set f [open test3 w]
    fconfigure $f -translation lf -eofchar {}
    puts $f "abcdefghijklmnopqrstuvwxyz"
    puts $f "abcdefghijklmnopqrstuvwxyz"
    close $f
    set f [open test3 a]
    set c [tell $f]
    close $f
    set c
} 54
test io-34.20 {Tcl_Tell combined with writing} {
    set f [open test3 w]
    set l ""
    seek $f 29 start
    lappend l [tell $f]
    puts -nonewline $f a
    seek $f 39 start
    lappend l [tell $f]
    puts -nonewline $f a
    lappend l [tell $f]
    seek $f 407 end
    lappend l [tell $f]
    close $f
    set l
} {29 39 40 447}

# Test Tcl_Eof

test io-35.1 {Tcl_Eof} {
    removeFile test1
    set f [open test1 w]
    puts $f hello
    puts $f hello
    close $f
    set f [open test1]
    set x [eof $f]
    lappend x [eof $f]
    gets $f
    lappend x [eof $f]
    gets $f
    lappend x [eof $f]
    gets $f
    lappend x [eof $f]
    lappend x [eof $f]
    close $f
    set x
} {0 0 0 0 1 1}
test io-35.2 {Tcl_Eof with pipe} {stdio} {
    removeFile pipe
    set f1 [open pipe w]
    puts $f1 {gets stdin}
    puts $f1 {puts hello}
    close $f1
    set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
    puts $f1 hello
    set x [eof $f1]
    flush $f1
    lappend x [eof $f1]
    gets $f1
    lappend x [eof $f1]
    gets $f1
    lappend x [eof $f1]
    close $f1
    set x
} {0 0 0 1}
test io-35.3 {Tcl_Eof with pipe} {stdio} {
    removeFile pipe
    set f1 [open pipe w]
    puts $f1 {gets stdin}
    puts $f1 {puts hello}
    close $f1
    set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
    puts $f1 hello
    set x [eof $f1]
    flush $f1
    lappend x [eof $f1]
    gets $f1
    lappend x [eof $f1]
    gets $f1
    lappend x [eof $f1]
    gets $f1
    lappend x [eof $f1]
    gets $f1
    lappend x [eof $f1]
    close $f1
    set x
} {0 0 0 1 1 1}
test io-35.4 {Tcl_Eof, eof detection on nonblocking file} {nonBlockFiles} {
    removeFile test1
    set f [open test1 w]
    close $f
    set f [open test1 r]
    fconfigure $f -blocking off
    set l ""
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} {{} 1}
test io-35.5 {Tcl_Eof, eof detection on nonblocking pipe} {stdio} {
    removeFile pipe
    set f [open pipe w]
    puts $f {
	exit
    }
    close $f
    set f [open "|[list $::tcltest::tcltest pipe]" r]
    set l ""
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} {{} 1}
test io-35.6 {Tcl_Eof, eof char, lf write, auto read} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf -eofchar \x1a
    puts $f abc\ndef
    close $f
    set s [file size test1]
    set f [open test1 r]
    fconfigure $f -translation auto -eofchar \x1a
    set l [string length [read $f]]
    set e [eof $f]
    close $f
    list $s $l $e
} {9 8 1}
test io-35.7 {Tcl_Eof, eof char, lf write, lf read} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf -eofchar \x1a
    puts $f abc\ndef
    close $f
    set s [file size test1]
    set f [open test1 r]
    fconfigure $f -translation lf -eofchar \x1a
    set l [string length [read $f]]
    set e [eof $f]
    close $f
    list $s $l $e
} {9 8 1}
test io-35.8 {Tcl_Eof, eof char, cr write, auto read} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation cr -eofchar \x1a
    puts $f abc\ndef
    close $f
    set s [file size test1]
    set f [open test1 r]
    fconfigure $f -translation auto -eofchar \x1a
    set l [string length [read $f]]
    set e [eof $f]
    close $f
    list $s $l $e
} {9 8 1}
test io-35.9 {Tcl_Eof, eof char, cr write, cr read} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation cr -eofchar \x1a
    puts $f abc\ndef
    close $f
    set s [file size test1]
    set f [open test1 r]
    fconfigure $f -translation cr -eofchar \x1a
    set l [string length [read $f]]
    set e [eof $f]
    close $f
    list $s $l $e
} {9 8 1}
test io-35.10 {Tcl_Eof, eof char, crlf write, auto read} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation crlf -eofchar \x1a
    puts $f abc\ndef
    close $f
    set s [file size test1]
    set f [open test1 r]
    fconfigure $f -translation auto -eofchar \x1a
    set l [string length [read $f]]
    set e [eof $f]
    close $f
    list $s $l $e
} {11 8 1}
test io-35.11 {Tcl_Eof, eof char, crlf write, crlf read} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation crlf -eofchar \x1a
    puts $f abc\ndef
    close $f
    set s [file size test1]
    set f [open test1 r]
    fconfigure $f -translation crlf -eofchar \x1a
    set l [string length [read $f]]
    set e [eof $f]
    close $f
    list $s $l $e
} {11 8 1}
test io-35.12 {Tcl_Eof, eof char in middle, lf write, auto read} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf -eofchar {}
    set i [format abc\ndef\n%cqrs\nuvw 26]
    puts $f $i
    close $f
    set c [file size test1]
    set f [open test1 r]
    fconfigure $f -translation auto -eofchar \x1a
    set l [string length [read $f]]
    set e [eof $f]
    close $f
    list $c $l $e
} {17 8 1}
test io-35.13 {Tcl_Eof, eof char in middle, lf write, lf read} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf -eofchar {}
    set i [format abc\ndef\n%cqrs\nuvw 26]
    puts $f $i
    close $f
    set c [file size test1]
    set f [open test1 r]
    fconfigure $f -translation lf -eofchar \x1a
    set l [string length [read $f]]
    set e [eof $f]
    close $f
    list $c $l $e
} {17 8 1}
test io-35.14 {Tcl_Eof, eof char in middle, cr write, auto read} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation cr -eofchar {}
    set i [format abc\ndef\n%cqrs\nuvw 26]
    puts $f $i
    close $f
    set c [file size test1]
    set f [open test1 r]
    fconfigure $f -translation auto -eofchar \x1a
    set l [string length [read $f]]
    set e [eof $f]
    close $f
    list $c $l $e
} {17 8 1}
test io-35.15 {Tcl_Eof, eof char in middle, cr write, cr read} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation cr -eofchar {}
    set i [format abc\ndef\n%cqrs\nuvw 26]
    puts $f $i
    close $f
    set c [file size test1]
    set f [open test1 r]
    fconfigure $f -translation cr -eofchar \x1a
    set l [string length [read $f]]
    set e [eof $f]
    close $f
    list $c $l $e
} {17 8 1}
test io-35.16 {Tcl_Eof, eof char in middle, crlf write, auto read} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation crlf -eofchar {}
    set i [format abc\ndef\n%cqrs\nuvw 26]
    puts $f $i
    close $f
    set c [file size test1]
    set f [open test1 r]
    fconfigure $f -translation auto -eofchar \x1a
    set l [string length [read $f]]
    set e [eof $f]
    close $f
    list $c $l $e
} {21 8 1}
test io-35.17 {Tcl_Eof, eof char in middle, crlf write, crlf read} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation crlf -eofchar {}
    set i [format abc\ndef\n%cqrs\nuvw 26]
    puts $f $i
    close $f
    set c [file size test1]
    set f [open test1 r]
    fconfigure $f -translation crlf -eofchar \x1a
    set l [string length [read $f]]
    set e [eof $f]
    close $f
    list $c $l $e
} {21 8 1}

# Test Tcl_InputBlocked

test io-36.1 {Tcl_InputBlocked on nonblocking pipe} {stdio} {
    set f1 [open "|[list $::tcltest::tcltest]" r+]
    puts $f1 {puts hello_from_pipe}
    flush $f1
    gets $f1
    fconfigure $f1 -blocking off -buffering full
    puts $f1 {puts hello}
    set x ""
    lappend x [gets $f1]
    lappend x [fblocked $f1]
    flush $f1
    after 200
    lappend x [gets $f1]
    lappend x [fblocked $f1]
    lappend x [gets $f1]
    lappend x [fblocked $f1]
    close $f1
    set x
} {{} 1 hello 0 {} 1}
test io-36.2 {Tcl_InputBlocked on blocking pipe} {stdio} {
    set f1 [open "|[list $::tcltest::tcltest]" r+]
    fconfigure $f1 -buffering line
    puts $f1 {puts hello_from_pipe}
    set x ""
    lappend x [gets $f1]
    lappend x [fblocked $f1]
    puts $f1 {exit}
    lappend x [gets $f1]
    lappend x [fblocked $f1]
    lappend x [eof $f1]
    close $f1
    set x
} {hello_from_pipe 0 {} 0 1}
test io-36.3 {Tcl_InputBlocked vs files, short read} {
    removeFile test1
    set f [open test1 w]
    puts $f abcdefghijklmnop
    close $f
    set f [open test1 r]
    set l ""
    lappend l [fblocked $f]
    lappend l [read $f 3]
    lappend l [fblocked $f]
    lappend l [read -nonewline $f]
    lappend l [fblocked $f]
    lappend l [eof $f]
    close $f
    set l
} {0 abc 0 defghijklmnop 0 1}
test io-36.4 {Tcl_InputBlocked vs files, event driven read} {
    proc in {f} {
        global l x
	lappend l [read $f 3]
	if {[eof $f]} {lappend l eof; close $f; set x done}
    }
    removeFile test1
    set f [open test1 w]
    puts $f abcdefghijklmnop
    close $f
    set f [open test1 r]
    set l ""
    fileevent $f readable [list in $f]
    vwait x
    set l
} {abc def ghi jkl mno {p
} eof}
test io-36.5 {Tcl_InputBlocked vs files, short read, nonblocking} {nonBlockFiles} {
    removeFile test1
    set f [open test1 w]
    puts $f abcdefghijklmnop
    close $f
    set f [open test1 r]
    fconfigure $f -blocking off
    set l ""
    lappend l [fblocked $f]
    lappend l [read $f 3]
    lappend l [fblocked $f]
    lappend l [read -nonewline $f]
    lappend l [fblocked $f]
    lappend l [eof $f]
    close $f
    set l
} {0 abc 0 defghijklmnop 0 1}
test io-36.6 {Tcl_InputBlocked vs files, event driven read} {nonBlockFiles} {
    proc in {f} {
        global l x
	lappend l [read $f 3]
	if {[eof $f]} {lappend l eof; close $f; set x done}
    }
    removeFile test1
    set f [open test1 w]
    puts $f abcdefghijklmnop
    close $f
    set f [open test1 r]
    fconfigure $f -blocking off
    set l ""
    fileevent $f readable [list in $f]
    vwait x
    set l
} {abc def ghi jkl mno {p
} eof}

# Test Tcl_InputBuffered

test io-37.1 {Tcl_InputBuffered} {
    set f [open longfile r]
    fconfigure $f -buffersize 4096
    read $f 3
    set l ""
    lappend l [testchannel inputbuffered $f]
    lappend l [tell $f]
    close $f
    set l
} {4093 3}
test io-37.2 {Tcl_InputBuffered, test input flushing on seek} {
    set f [open longfile r]
    fconfigure $f -buffersize 4096
    read $f 3
    set l ""
    lappend l [testchannel inputbuffered $f]
    lappend l [tell $f]
    seek $f 0 current
    lappend l [testchannel inputbuffered $f]
    lappend l [tell $f]
    close $f
    set l
} {4093 3 0 3}

# Test Tcl_SetChannelBufferSize, Tcl_GetChannelBufferSize

test io-38.1 {Tcl_GetChannelBufferSize, default buffer size} {
    set f [open longfile r]
    set s [fconfigure $f -buffersize]
    close $f
    set s
} 4096
test io-38.2 {Tcl_SetChannelBufferSize, Tcl_GetChannelBufferSize} {
    set f [open longfile r]
    set l ""
    lappend l [fconfigure $f -buffersize]
    fconfigure $f -buffersize 10000
    lappend l [fconfigure $f -buffersize]
    fconfigure $f -buffersize 1
    lappend l [fconfigure $f -buffersize]
    fconfigure $f -buffersize -1
    lappend l [fconfigure $f -buffersize]
    fconfigure $f -buffersize 0
    lappend l [fconfigure $f -buffersize]
    fconfigure $f -buffersize 100000
    lappend l [fconfigure $f -buffersize]
    fconfigure $f -buffersize 10000000
    lappend l [fconfigure $f -buffersize]
    close $f
    set l
} {4096 10000 4096 4096 4096 100000 4096}

# Test Tcl_SetChannelOption, Tcl_GetChannelOption

test io-39.1 {Tcl_GetChannelOption} {
    removeFile test1
    set f1 [open test1 w]
    set x [fconfigure $f1 -blocking]
    close $f1
    set x
} 1
#
# Test 17.2 was removed.
#
test io-39.2 {Tcl_GetChannelOption} {
    removeFile test1
    set f1 [open test1 w]
    set x [fconfigure $f1 -buffering]
    close $f1
    set x
} full
test io-39.3 {Tcl_GetChannelOption} {
    removeFile test1
    set f1 [open test1 w]
    fconfigure $f1 -buffering line
    set x [fconfigure $f1 -buffering]
    close $f1
    set x
} line
test io-39.4 {Tcl_GetChannelOption, Tcl_SetChannelOption} {
    removeFile test1
    set f1 [open test1 w]
    set l ""
    lappend l [fconfigure $f1 -buffering]
    fconfigure $f1 -buffering line
    lappend l [fconfigure $f1 -buffering]
    fconfigure $f1 -buffering none
    lappend l [fconfigure $f1 -buffering]
    fconfigure $f1 -buffering line
    lappend l [fconfigure $f1 -buffering]
    fconfigure $f1 -buffering full
    lappend l [fconfigure $f1 -buffering]
    close $f1
    set l
} {full line none line full}
test io-39.5 {Tcl_GetChannelOption, invariance} {
    removeFile test1
    set f1 [open test1 w]
    set l ""
    lappend l [fconfigure $f1 -buffering]
    lappend l [list [catch {fconfigure $f1 -buffering green} msg] $msg]
    lappend l [fconfigure $f1 -buffering]
    close $f1
    set l
} {full {1 {bad value for -buffering: must be one of full, line, or none}} full}
test io-39.6 {Tcl_SetChannelOption, multiple options} {
    removeFile test1
    set f1 [open test1 w]
    fconfigure $f1 -translation lf -buffering line
    puts $f1 hello
    puts $f1 bye
    set x [file size test1]
    close $f1
    set x
} 10
test io-39.7 {Tcl_SetChannelOption, buffering, translation} {
    removeFile test1
    set f1 [open test1 w]
    fconfigure $f1 -translation lf
    puts $f1 hello
    puts $f1 bye
    set x ""
    fconfigure $f1 -buffering line
    lappend x [file size test1]
    puts $f1 really_bye
    lappend x [file size test1]
    close $f1
    set x
} {0 21}
test io-39.8 {Tcl_SetChannelOption, different buffering options} {
    removeFile test1
    set f1 [open test1 w]
    set l ""
    fconfigure $f1 -translation lf -buffering none -eofchar {}
    puts -nonewline $f1 hello
    lappend l [file size test1]
    puts -nonewline $f1 hello
    lappend l [file size test1]
    fconfigure $f1 -buffering full
    puts -nonewline $f1 hello
    lappend l [file size test1]
    fconfigure $f1 -buffering none
    lappend l [file size test1]
    puts -nonewline $f1 hello
    lappend l [file size test1]
    close $f1
    lappend l [file size test1]
    set l
} {5 10 10 10 20 20}
test io-39.9 {Tcl_SetChannelOption, blocking mode} {nonBlockFiles} {
    removeFile test1
    set f1 [open test1 w]
    close $f1
    set f1 [open test1 r]
    set x ""
    lappend x [fconfigure $f1 -blocking]
    fconfigure $f1 -blocking off
    lappend x [fconfigure $f1 -blocking]
    lappend x [gets $f1]
    lappend x [read $f1 1000]
    lappend x [fblocked $f1]
    lappend x [eof $f1]
    close $f1
    set x
} {1 0 {} {} 0 1}
test io-39.10 {Tcl_SetChannelOption, blocking mode} {stdio} {
    removeFile pipe
    set f1 [open pipe w]
    puts $f1 {
	gets stdin
	after 100
	puts hi
	gets stdin
    }
    close $f1
    set x ""
    set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
    fconfigure $f1 -blocking off -buffering line
    lappend x [fconfigure $f1 -blocking]
    lappend x [gets $f1]
    lappend x [fblocked $f1]
    fconfigure $f1 -blocking on
    puts $f1 hello
    fconfigure $f1 -blocking off
    lappend x [gets $f1]
    lappend x [fblocked $f1]
    fconfigure $f1 -blocking on
    puts $f1 bye
    fconfigure $f1 -blocking off
    lappend x [gets $f1]
    lappend x [fblocked $f1]
    fconfigure $f1 -blocking on
    lappend x [fconfigure $f1 -blocking]
    lappend x [gets $f1]
    lappend x [fblocked $f1]
    lappend x [eof $f1]
    lappend x [gets $f1]
    lappend x [eof $f1]
    close $f1
    set x
} {0 {} 1 {} 1 {} 1 1 hi 0 0 {} 1}
test io-39.11 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -buffersize -10
    set x [fconfigure $f -buffersize]
    close $f
    set x
} 4096
test io-39.12 {Tcl_SetChannelOption, Tcl_GetChannelOption buffer size} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -buffersize 10000000
    set x [fconfigure $f -buffersize]
    close $f
    set x
} 4096
test io-39.13 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -buffersize 40000
    set x [fconfigure $f -buffersize]
    close $f
    set x
} 40000
test io-39.14 {Tcl_SetChannelOption: -encoding, binary & utf-8} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -encoding {} 
    puts -nonewline $f \xe7\x89\xa6
    close $f
    set f [open test1 r]
    fconfigure $f -encoding utf-8
    set x [read $f]
    close $f
    set x
} \u7266
test io-39.15 {Tcl_SetChannelOption: -encoding, binary & utf-8} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -encoding binary
    puts -nonewline $f \xe7\x89\xa6
    close $f
    set f [open test1 r]
    fconfigure $f -encoding utf-8
    set x [read $f]
    close $f
    set x
} \u7266
test io-39.16 {Tcl_SetChannelOption: -encoding, errors} {
    removeFile test1
    set f [open test1 w]
    set result [list [catch {fconfigure $f -encoding foobar} msg] $msg]
    close $f
    set result
} {1 {unknown encoding "foobar"}}
test io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} {stdio} {
    set f [open "|[list $::tcltest::tcltest cat]" r+]
    fconfigure $f -encoding binary
    puts -nonewline $f "\xe7"
    flush $f
    fconfigure $f -encoding utf-8 -blocking 0
    set x {}
    fileevent $f readable { lappend x [read $f] }
    vwait x
    after 300 { lappend x timeout }
    vwait x
    fconfigure $f -encoding utf-8
    vwait x
    after 300 { lappend x timeout }
    vwait x
    fconfigure $f -encoding binary
    vwait x
    after 300 { lappend x timeout }
    vwait x
    close $f
    set x
} "{} timeout {} timeout \xe7 timeout"

test io-39.18 {Tcl_SetChannelOption, setting read mode independently} \
	{socket} {
    proc accept {s a p} {close $s}
    set s1 [socket -server accept 0]
    set port [lindex [fconfigure $s1 -sockname] 2]
    set s2 [socket 127.0.0.1 $port]
    update
    fconfigure $s2 -translation {auto lf}
    set modes [fconfigure $s2 -translation]
    close $s1
    close $s2
    set modes
} {auto lf}
test io-39.19 {Tcl_SetChannelOption, setting read mode independently} \
	{socket} {
    proc accept {s a p} {close $s}
    set s1 [socket -server accept 0]
    set port [lindex [fconfigure $s1 -sockname] 2]
    set s2 [socket 127.0.0.1 $port]
    update
    fconfigure $s2 -translation {auto crlf}
    set modes [fconfigure $s2 -translation]
    close $s1
    close $s2
    set modes
} {auto crlf}
test io-39.20 {Tcl_SetChannelOption, setting read mode independently} \
	{socket} {
    proc accept {s a p} {close $s}
    set s1 [socket -server accept 0]
    set port [lindex [fconfigure $s1 -sockname] 2]
    set s2 [socket 127.0.0.1 $port]
    update
    fconfigure $s2 -translation {auto cr}
    set modes [fconfigure $s2 -translation]
    close $s1
    close $s2
    set modes
} {auto cr}
test io-39.21 {Tcl_SetChannelOption, setting read mode independently} \
	{socket} {
    proc accept {s a p} {close $s}
    set s1 [socket -server accept 0]
    set port [lindex [fconfigure $s1 -sockname] 2]
    set s2 [socket 127.0.0.1 $port]
    update
    fconfigure $s2 -translation {auto auto}
    set modes [fconfigure $s2 -translation]
    close $s1
    close $s2
    set modes
} {auto crlf}

test io-40.1 {POSIX open access modes: RDWR} {
    removeFile test3
    set f [open test3 w]
    puts $f xyzzy
    close $f
    set f [open test3 RDWR]
    puts -nonewline $f "ab"
    seek $f 0 current
    set x [gets $f]
    close $f
    set f [open test3 r]
    lappend x [gets $f]
    close $f
    set x
} {zzy abzzy}
test io-40.2 {POSIX open access modes: CREAT} {unixOnly} {
    removeFile test3
    set f [open test3 {WRONLY CREAT} 0600]
    file stat test3 stats
    set x [format "0%o" [expr $stats(mode)&0777]]
    puts $f "line 1"
    close $f
    set f [open test3 r]
    lappend x [gets $f]
    close $f
    set x
} {0600 {line 1}}

# some tests can only be run is umask is 2
# if "umask" cannot be run, the tests will be skipped.
catch {set ::tcltest::testConstraints(umask2) [expr {[exec umask] == 2}]}

test io-40.3 {POSIX open access modes: CREAT} {unixOnly umask2} {
    # This test only works if your umask is 2, like ouster's.
    removeFile test3
    set f [open test3 {WRONLY CREAT}]
    close $f
    file stat test3 stats
    format "0%o" [expr $stats(mode)&0777]
} 0664
test io-40.4 {POSIX open access modes: CREAT} {
    removeFile test3
    set f [open test3 w]
    fconfigure $f -eofchar {}
    puts $f xyzzy
    close $f
    set f [open test3 {WRONLY CREAT}]
    fconfigure $f -eofchar {}
    puts -nonewline $f "ab"
    close $f
    set f [open test3 r]
    set x [gets $f]
    close $f
    set x
} abzzy
test io-40.5 {POSIX open access modes: APPEND} {
    removeFile test3
    set f [open test3 w]
    fconfigure $f -translation lf -eofchar {}
    puts $f xyzzy
    close $f
    set f [open test3 {WRONLY APPEND}]
    fconfigure $f -translation lf
    puts $f "new line"
    seek $f 0
    puts $f "abc"
    close $f
    set f [open test3 r]
    fconfigure $f -translation lf
    set x ""
    seek $f 6 current
    lappend x [gets $f]
    lappend x [gets $f]
    close $f
    set x
} {{new line} abc}
test io-40.6 {POSIX open access modes: EXCL} {
    removeFile test3
    set f [open test3 w]
    puts $f xyzzy
    close $f
    set msg [list [catch {open test3 {WRONLY CREAT EXCL}} msg] $msg]
    regsub " already " $msg " " msg
    string tolower $msg
} {1 {couldn't open "test3": file exists}}
test io-40.7 {POSIX open access modes: EXCL} {
    removeFile test3
    set f [open test3 {WRONLY CREAT EXCL}]
    fconfigure $f -eofchar {}
    puts $f "A test line"
    close $f
    viewFile test3
} {A test line}
test io-40.8 {POSIX open access modes: TRUNC} {
    removeFile test3
    set f [open test3 w]
    puts $f xyzzy
    close $f
    set f [open test3 {WRONLY TRUNC}]
    puts $f abc
    close $f
    set f [open test3 r]
    set x [gets $f]
    close $f
    set x
} abc
test io-40.9 {POSIX open access modes: NONBLOCK} {nonPortable macOrUnix} {
    removeFile test3
    set f [open test3 {WRONLY NONBLOCK CREAT}]
    puts $f "NONBLOCK test"
    close $f
    set f [open test3 r]
    set x [gets $f]
    close $f
    set x
} {NONBLOCK test}
test io-40.10 {POSIX open access modes: RDONLY} {
    set f [open test1 w]
    puts $f "two lines: this one"
    puts $f "and this"
    close $f
    set f [open test1 RDONLY]
    set x [list [gets $f] [catch {puts $f Test} msg] $msg]
    close $f
    string compare [string tolower $x] \
	[list {two lines: this one} 1 \
		[format "channel \"%s\" wasn't opened for writing" $f]]
} 0
test io-40.11 {POSIX open access modes: RDONLY} {
    removeFile test3
    string tolower [list [catch {open test3 RDONLY} msg] $msg]
} {1 {couldn't open "test3": no such file or directory}}
test io-40.12 {POSIX open access modes: WRONLY} {
    removeFile test3
    string tolower [list [catch {open test3 WRONLY} msg] $msg]
} {1 {couldn't open "test3": no such file or directory}}
test io-40.13 {POSIX open access modes: WRONLY} {
    makeFile xyzzy test3
    set f [open test3 WRONLY]
    fconfigure $f -eofchar {}
    puts -nonewline $f "ab"
    seek $f 0 current
    set x [list [catch {gets $f} msg] $msg]
    close $f
    lappend x [viewFile test3]
    string compare [string tolower $x] \
	[list 1 "channel \"$f\" wasn't opened for reading" abzzy]
} 0
test io-40.14 {POSIX open access modes: RDWR} {
    removeFile test3
    string tolower [list [catch {open test3 RDWR} msg] $msg]
} {1 {couldn't open "test3": no such file or directory}}
test io-40.15 {POSIX open access modes: RDWR} {
    makeFile xyzzy test3
    set f [open test3 RDWR]
    puts -nonewline $f "ab"
    seek $f 0 current
    set x [gets $f]
    close $f
    lappend x [viewFile test3]
} {zzy abzzy}
if {![file exists ~/_test_] && [file writable ~]} {
    test io-40.16 {tilde substitution in open} {
	set f [open ~/_test_ w]
	puts $f "Some text"
	close $f
	set x [file exists [file join $env(HOME) _test_]]
	removeFile [file join $env(HOME) _test_]
	set x
    } 1
}
test io-40.17 {tilde substitution in open} {
    set home $env(HOME)
    unset env(HOME)
    set x [list [catch {open ~/foo} msg] $msg]
    set env(HOME) $home
    set x
} {1 {couldn't find HOME environment variable to expand path}}

test io-41.1 {Tcl_FileeventCmd: errors} {
    list [catch {fileevent foo} msg] $msg
} {1 {wrong # args: should be "fileevent channelId event ?script?"}}
test io-41.2 {Tcl_FileeventCmd: errors} {
    list [catch {fileevent foo bar baz q} msg] $msg
} {1 {wrong # args: should be "fileevent channelId event ?script?"}}
test io-41.3 {Tcl_FileeventCmd: errors} {
    list [catch {fileevent gorp readable} msg] $msg
} {1 {can not find channel named "gorp"}}
test io-41.4 {Tcl_FileeventCmd: errors} {
    list [catch {fileevent gorp writable} msg] $msg
} {1 {can not find channel named "gorp"}}
test io-41.5 {Tcl_FileeventCmd: errors} {
    list [catch {fileevent gorp who-knows} msg] $msg
} {1 {bad event name "who-knows": must be readable or writable}}

#
# Test fileevent on a file
#

set f [open foo w+]

test io-42.1 {Tcl_FileeventCmd: creating, deleting, querying} {
    list [fileevent $f readable] [fileevent $f writable]
} {{} {}}
test io-42.2 {Tcl_FileeventCmd: replacing} {
    set result {}
    fileevent $f r "first script"
    lappend result [fileevent $f readable]
    fileevent $f r "new script"
    lappend result [fileevent $f readable]
    fileevent $f r "yet another"
    lappend result [fileevent $f readable]
    fileevent $f r ""
    lappend result [fileevent $f readable]
} {{first script} {new script} {yet another} {}}
test io-42.3 {Tcl_FileeventCmd: replacing, with NULL chars in script} {
    set result {}
    fileevent $f r "first scr\0ipt"
    lappend result [string length [fileevent $f readable]]
    fileevent $f r "new scr\0ipt"
    lappend result [string length [fileevent $f readable]]
    fileevent $f r "yet ano\0ther"
    lappend result [string length [fileevent $f readable]]
    fileevent $f r ""
    lappend result [fileevent $f readable]
} {13 11 12 {}}

#
# Test fileevent on a pipe
#

catch {set f2 [open "|[list cat -u]" r+]}
catch {set f3 [open "|[list cat -u]" r+]}

test io-43.1 {Tcl_FileeventCmd: creating, deleting, querying} {stdio unixExecs} {
    set result {}
    fileevent $f readable "script 1"
    lappend result [fileevent $f readable] [fileevent $f writable]
    fileevent $f writable "write script"
    lappend result [fileevent $f readable] [fileevent $f writable]
    fileevent $f readable {}
    lappend result [fileevent $f readable] [fileevent $f writable]
    fileevent $f writable {}
    lappend result [fileevent $f readable] [fileevent $f writable]
} {{script 1} {} {script 1} {write script} {} {write script} {} {}}
test io-43.2 {Tcl_FileeventCmd: deleting when many present} {stdio unixExecs} {
    set result {}
    lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r]
    fileevent $f r "read f"
    fileevent $f2 r "read f2"
    fileevent $f3 r "read f3"
    lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r]
    fileevent $f2 r {}
    lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r]
    fileevent $f3 r {}
    lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r]
    fileevent $f r {}
    lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r]
} {{} {} {} {read f} {read f2} {read f3} {read f} {} {read f3} {read f} {} {} {} {} {}}

test io-44.1 {FileEventProc procedure: normal read event} {stdio unixExecs} {
    fileevent $f2 readable {
	set x [gets $f2]; fileevent $f2 readable {}
    }
    puts $f2 text; flush $f2
    set x initial
    vwait x
    set x
} {text}
test io-44.2 {FileEventProc procedure: error in read event} {stdio unixExecs} {
    proc bgerror args {
	global x
	set x $args
    }
    fileevent $f2 readable {error bogus}
    puts $f2 text; flush $f2
    set x initial
    vwait x
    rename bgerror {}
    list $x [fileevent $f2 readable]
} {bogus {}}
test io-44.3 {FileEventProc procedure: normal write event} {stdio unixExecs} {
    fileevent $f2 writable {
	lappend x "triggered"
	incr count -1
	if {$count <= 0} {
	    fileevent $f2 writable {}
	}
    }
    set x initial
    set count 3
    vwait x
    vwait x
    vwait x
    set x
} {initial triggered triggered triggered}
test io-44.4 {FileEventProc procedure: eror in write event} {stdio unixExecs} {
    proc bgerror args {
	global x
	set x $args
    }
    fileevent $f2 writable {error bad-write}
    set x initial
    vwait x
    rename bgerror {}
    list $x [fileevent $f2 writable]
} {bad-write {}}
test io-44.5 {FileEventProc procedure: end of file} {stdio unixExecs} {
    set f4 [open "|[list $::tcltest::tcltest cat << foo]" r]
    fileevent $f4 readable {
	if {[gets $f4 line] < 0} {
	    lappend x eof
	    fileevent $f4 readable {}
	} else {
	    lappend x $line
	}
    }
    set x initial
    vwait x
    vwait x
    close $f4
    set x
} {initial foo eof}

catch {close $f2}
catch {close $f3}


close $f
makeFile "foo bar" foo
test io-45.1 {DeleteFileEvent, cleanup on close} {
    set f [open foo r]
    fileevent $f readable {
	lappend x "binding triggered: \"[gets $f]\""
	fileevent $f readable {}
    }
    close $f
    set x initial
    after 100 { set y done }
    vwait y
    set x
} {initial}
test io-45.2 {DeleteFileEvent, cleanup on close} {
    set f [open foo r]
    set f2 [open foo r]
    fileevent $f readable {
	    lappend x "f triggered: \"[gets $f]\""
	    fileevent $f readable {}
	}
    fileevent $f2 readable {
	lappend x "f2 triggered: \"[gets $f2]\""
	fileevent $f2 readable {}
    }
    close $f
    set x initial
    vwait x
    close $f2
    set x
} {initial {f2 triggered: "foo bar"}}
test io-45.3 {DeleteFileEvent, cleanup on close} {
    set f [open foo r]
    set f2 [open foo r]
    set f3 [open foo r]
    fileevent $f readable {f script}
    fileevent $f2 readable {f2 script}
    fileevent $f3 readable {f3 script}
    set x {}
    close $f2
    lappend x [catch {fileevent $f readable} msg] $msg \
	    [catch {fileevent $f2 readable}] \
	    [catch {fileevent $f3 readable} msg] $msg
    close $f3
    lappend x [catch {fileevent $f readable} msg] $msg \
	    [catch {fileevent $f2 readable}] \
	    [catch {fileevent $f3 readable}]
    close $f
    lappend x [catch {fileevent $f readable}] \
	    [catch {fileevent $f2 readable}] \
	    [catch {fileevent $f3 readable}]
} {0 {f script} 1 0 {f3 script} 0 {f script} 1 1 1 1 1}

# Execute these tests only if the "testfevent" command is present.

if {[info commands testfevent] == "testfevent"} {

    test io-46.1 {Tcl event loop vs multiple interpreters} {} {
    testfevent create
    testfevent cmd {
        set f [open foo r]
        set x "no event"
        fileevent $f readable {
            set x "f triggered: [gets $f]"
            fileevent $f readable {}
        }
    } 
    after 1	;# We must delay because Windows takes a little time to notice
    update
    testfevent cmd {close $f}
    list [testfevent cmd {set x}] [testfevent cmd {info commands after}]
} {{f triggered: foo bar} after}
test io-46.2 {Tcl event loop vs multiple interpreters} {
    testfevent create
    testfevent cmd {
        set x 0
        after 100 {set x triggered}
        vwait x
        set x
    }
} {triggered}
test io-46.3 {Tcl event loop vs multiple interpreters} {
    testfevent create
    testfevent cmd {
        set x 0
        after 10 {lappend x timer}
        after 30
        set result $x
        update idletasks
        lappend result $x
        update
        lappend result $x
    }
} {0 0 {0 timer}}

test io-47.1 {fileevent vs multiple interpreters} {
    set f [open foo r]
    set f2 [open foo r]
    set f3 [open foo r]
    fileevent $f readable {script 1}
    testfevent create
    testfevent share $f2
    testfevent cmd "fileevent $f2 readable {script 2}"
    fileevent $f3 readable {sript 3}
    set x {}
    lappend x [fileevent $f2 readable]
    testfevent delete
    lappend x [fileevent $f readable] [fileevent $f2 readable] \
        [fileevent $f3 readable]
    close $f
    close $f2
    close $f3
    set x
} {{} {script 1} {} {sript 3}}
test io-47.2 {deleting fileevent on interpreter delete} {
    set f [open foo r]
    set f2 [open foo r]
    set f3 [open foo r]
    set f4 [open foo r]
    fileevent $f readable {script 1}
    testfevent create
    testfevent share $f2
    testfevent share $f3
    testfevent cmd "fileevent $f2 readable {script 2}
        fileevent $f3 readable {script 3}"
    fileevent $f4 readable {script 4}
    testfevent delete
    set x [list [fileevent $f readable] [fileevent $f2 readable] \
                [fileevent $f3 readable] [fileevent $f4 readable]]
    close $f
    close $f2
    close $f3
    close $f4
    set x
} {{script 1} {} {} {script 4}}
test io-47.3 {deleting fileevent on interpreter delete} {
    set f [open foo r]
    set f2 [open foo r]
    set f3 [open foo r]
    set f4 [open foo r]
    testfevent create
    testfevent share $f3
    testfevent share $f4
    fileevent $f readable {script 1}
    fileevent $f2 readable {script 2}
    testfevent cmd "fileevent $f3 readable {script 3}
      fileevent $f4 readable {script 4}"
    testfevent delete
    set x [list [fileevent $f readable] [fileevent $f2 readable] \
                [fileevent $f3 readable] [fileevent $f4 readable]]
    close $f
    close $f2
    close $f3
    close $f4
    set x
} {{script 1} {script 2} {} {}}
test io-47.4 {file events on shared files and multiple interpreters} {
    set f [open foo r]
    set f2 [open foo r]
    testfevent create
    testfevent share $f
    testfevent cmd "fileevent $f readable {script 1}"
    fileevent $f readable {script 2}
    fileevent $f2 readable {script 3}
    set x [list [fileevent $f2 readable] \
                [testfevent cmd "fileevent $f readable"] \
                [fileevent $f readable]]
    testfevent delete
    close $f
    close $f2
    set x
} {{script 3} {script 1} {script 2}}
test io-47.5 {file events on shared files, deleting file events} {
    set f [open foo r]
    testfevent create
    testfevent share $f
    testfevent cmd "fileevent $f readable {script 1}"
    fileevent $f readable {script 2}
    testfevent cmd "fileevent $f readable {}"
    set x [list [testfevent cmd "fileevent $f readable"] \
                [fileevent $f readable]]
    testfevent delete
    close $f
    set x
} {{} {script 2}}
test io-47.6 {file events on shared files, deleting file events} {
    set f [open foo r]
    testfevent create
    testfevent share $f
    testfevent cmd "fileevent $f readable {script 1}"
    fileevent $f readable {script 2}
    fileevent $f readable {}
    set x [list [testfevent cmd "fileevent $f readable"] \
                [fileevent $f readable]]
    testfevent delete
    close $f
    set x
} {{script 1} {}}

}

# The above curly closes the test for presence of the "testfevent" command.

test io-48.1 {testing readability conditions} {
    set f [open bar w]
    puts $f abcdefg
    puts $f abcdefg
    puts $f abcdefg
    puts $f abcdefg
    puts $f abcdefg
    close $f
    set f [open bar r]
    fileevent $f readable [list consume $f]
    proc consume {f} {
	global x l
	lappend l called
	if {[eof $f]} {
	    close $f
	    set x done
	} else {
	    gets $f
	}
    }
    set l ""
    set x not_done
    vwait x
    list $x $l
} {done {called called called called called called called}}
test io-48.2 {testing readability conditions} {nonBlockFiles} {
    set f [open bar w]
    puts $f abcdefg
    puts $f abcdefg
    puts $f abcdefg
    puts $f abcdefg
    puts $f abcdefg
    close $f
    set f [open bar r]
    fileevent $f readable [list consume $f]
    fconfigure $f -blocking off
    proc consume {f} {
	global x l
	lappend l called
	if {[eof $f]} {
	    close $f
	    set x done
	} else {
	    gets $f
	}
    }
    set l ""
    set x not_done
    vwait x
    list $x $l
} {done {called called called called called called called}}
test io-48.3 {testing readability conditions} {unixOnly nonBlockFiles} {
    set f [open bar w]
    puts $f abcdefg
    puts $f abcdefg
    puts $f abcdefg
    puts $f abcdefg
    puts $f abcdefg
    close $f
    set f [open my_script w]
    puts $f {
	proc copy_slowly {f} {
	    while {![eof $f]} {
		puts [gets $f]
		after 200
	    }
	    close $f
	}
    }
    close $f
    set f [open "|[list $::tcltest::tcltest]" r+]
    fileevent $f readable [list consume $f]
    fconfigure $f -buffering line
    fconfigure $f -blocking off
    proc consume {f} {
	global x l
	if {[eof $f]} {
	    set x done
	} else {
	    gets $f
	    lappend l [fblocked $f]
	    gets $f
	    lappend l [fblocked $f]
	}
    }
    set l ""
    set x not_done
    puts $f {source my_script}
    puts $f {set f [open bar r]}
    puts $f {copy_slowly $f}
    puts $f {exit}
    vwait x
    close $f
    list $x $l
} {done {0 1 0 1 0 1 0 1 0 1 0 1 0 0}}
test io-48.4 {lf write, testing readability, ^Z termination, auto read mode} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf
    set c [format "abc\ndef\n%c" 26]
    puts -nonewline $f $c
    close $f
    proc consume {f} {
	global c x l
	if {[eof $f]} {
	   set x done
	   close $f
	} else {
	   lappend l [gets $f]
	   incr c
	}
    }
    set c 0
    set l ""
    set f [open test1 r]
    fconfigure $f -translation auto -eofchar \x1a
    fileevent $f readable [list consume $f]
    vwait x
    list $c $l
} {3 {abc def {}}}
test io-48.5 {lf write, testing readability, ^Z in middle, auto read mode} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf
    set c [format "abc\ndef\n%cfoo\nbar\n" 26]
    puts -nonewline $f $c
    close $f
    proc consume {f} {
	global c x l
	if {[eof $f]} {
	   set x done
	   close $f
	} else {
	   lappend l [gets $f]
	   incr c
	}
    }
    set c 0
    set l ""
    set f [open test1 r]
    fconfigure $f -eofchar \x1a -translation auto
    fileevent $f readable [list consume $f]
    vwait x
    list $c $l
} {3 {abc def {}}}
test io-48.6 {cr write, testing readability, ^Z termination, auto read mode} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation cr
    set c [format "abc\ndef\n%c" 26]
    puts -nonewline $f $c
    close $f
    proc consume {f} {
	global c x l
	if {[eof $f]} {
	   set x done
	   close $f
	} else {
	   lappend l [gets $f]
	   incr c
	}
    }
    set c 0
    set l ""
    set f [open test1 r]
    fconfigure $f -translation auto -eofchar \x1a
    fileevent $f readable [list consume $f]
    vwait x
    list $c $l
} {3 {abc def {}}}
test io-48.7 {cr write, testing readability, ^Z in middle, auto read mode} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation cr
    set c [format "abc\ndef\n%cfoo\nbar\n" 26]
    puts -nonewline $f $c
    close $f
    proc consume {f} {
	global c x l
	if {[eof $f]} {
	   set x done
	   close $f
	} else {
	   lappend l [gets $f]
	   incr c
	}
    }
    set c 0
    set l ""
    set f [open test1 r]
    fconfigure $f -eofchar \x1a -translation auto
    fileevent $f readable [list consume $f]
    vwait x
    list $c $l
} {3 {abc def {}}}
test io-48.8 {crlf write, testing readability, ^Z termination, auto read mode} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation crlf
    set c [format "abc\ndef\n%c" 26]
    puts -nonewline $f $c
    close $f
    proc consume {f} {
	global c x l
	if {[eof $f]} {
	   set x done
	   close $f
	} else {
	   lappend l [gets $f]
	   incr c
	}
    }
    set c 0
    set l ""
    set f [open test1 r]
    fconfigure $f -translation auto -eofchar \x1a
    fileevent $f readable [list consume $f]
    vwait x
    list $c $l
} {3 {abc def {}}}
test io-48.9 {crlf write, testing readability, ^Z in middle, auto read mode} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation crlf
    set c [format "abc\ndef\n%cfoo\nbar\n" 26]
    puts -nonewline $f $c
    close $f
    proc consume {f} {
	global c x l
	if {[eof $f]} {
	   set x done
	   close $f
	} else {
	   lappend l [gets $f]
	   incr c
	}
    }
    set c 0
    set l ""
    set f [open test1 r]
    fconfigure $f -eofchar \x1a -translation auto
    fileevent $f readable [list consume $f]
    vwait x
    list $c $l
} {3 {abc def {}}}
test io-48.10 {lf write, testing readability, ^Z in middle, lf read mode} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf
    set c [format "abc\ndef\n%cfoo\nbar\n" 26]
    puts -nonewline $f $c
    close $f
    proc consume {f} {
	global c x l
	if {[eof $f]} {
	   set x done
	   close $f
	} else {
	   lappend l [gets $f]
	   incr c
	}
    }
    set c 0
    set l ""
    set f [open test1 r]
    fconfigure $f -eofchar \x1a -translation lf
    fileevent $f readable [list consume $f]
    vwait x
    list $c $l
} {3 {abc def {}}}
test io-48.11 {lf write, testing readability, ^Z termination, lf read mode} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf
    set c [format "abc\ndef\n%c" 26]
    puts -nonewline $f $c
    close $f
    proc consume {f} {
	global c x l
	if {[eof $f]} {
	   set x done
	   close $f
	} else {
	   lappend l [gets $f]
	   incr c
	}
    }
    set c 0
    set l ""
    set f [open test1 r]
    fconfigure $f -translation lf -eofchar \x1a
    fileevent $f readable [list consume $f]
    vwait x
    list $c $l
} {3 {abc def {}}}
test io-48.12 {cr write, testing readability, ^Z in middle, cr read mode} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation cr
    set c [format "abc\ndef\n%cfoo\nbar\n" 26]
    puts -nonewline $f $c
    close $f
    proc consume {f} {
	global c x l
	if {[eof $f]} {
	   set x done
	   close $f
	} else {
	   lappend l [gets $f]
	   incr c
	}
    }
    set c 0
    set l ""
    set f [open test1 r]
    fconfigure $f -eofchar \x1a -translation cr
    fileevent $f readable [list consume $f]
    vwait x
    list $c $l
} {3 {abc def {}}}
test io-48.13 {cr write, testing readability, ^Z termination, cr read mode} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation cr
    set c [format "abc\ndef\n%c" 26]
    puts -nonewline $f $c
    close $f
    proc consume {f} {
	global c x l
	if {[eof $f]} {
	   set x done
	   close $f
	} else {
	   lappend l [gets $f]
	   incr c
	}
    }
    set c 0
    set l ""
    set f [open test1 r]
    fconfigure $f -translation cr -eofchar \x1a
    fileevent $f readable [list consume $f]
    vwait x
    list $c $l
} {3 {abc def {}}}
test io-48.14 {crlf write, testing readability, ^Z in middle, crlf read mode} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation crlf
    set c [format "abc\ndef\n%cfoo\nbar\n" 26]
    puts -nonewline $f $c
    close $f
    proc consume {f} {
	global c x l
	if {[eof $f]} {
	   set x done
	   close $f
	} else {
	   lappend l [gets $f]
	   incr c
	}
    }
    set c 0
    set l ""
    set f [open test1 r]
    fconfigure $f -eofchar \x1a -translation crlf
    fileevent $f readable [list consume $f]
    vwait x
    list $c $l
} {3 {abc def {}}}
test io-48.15 {crlf write, testing readability, ^Z termi, crlf read mode} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation crlf
    set c [format "abc\ndef\n%c" 26]
    puts -nonewline $f $c
    close $f
    proc consume {f} {
	global c x l
	if {[eof $f]} {
	   set x done
	   close $f
	} else {
	   lappend l [gets $f]
	   incr c
	}
    }
    set c 0
    set l ""
    set f [open test1 r]
    fconfigure $f -translation crlf -eofchar \x1a
    fileevent $f readable [list consume $f]
    vwait x
    list $c $l
} {3 {abc def {}}}

test io-49.1 {testing crlf reading, leftover cr disgorgment} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "a\rb\rc\r\n"
    close $f
    set f [open test1 r]
    set l ""
    lappend l [file size test1]
    fconfigure $f -translation crlf
    lappend l [read $f 1]
    lappend l [tell $f]
    lappend l [read $f 1]
    lappend l [tell $f]
    lappend l [read $f 1]
    lappend l [tell $f]
    lappend l [read $f 1]
    lappend l [tell $f]
    lappend l [read $f 1]
    lappend l [tell $f]
    lappend l [read $f 1]
    lappend l [tell $f]
    lappend l [eof $f]
    lappend l [read $f 1]
    lappend l [eof $f]
    close $f
    set l
} "7 a 1 [list \r] 2 b 3 [list \r] 4 c 5 {
} 7 0 {} 1"
test io-49.2 {testing crlf reading, leftover cr disgorgment} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "a\rb\rc\r\n"
    close $f
    set f [open test1 r]
    set l ""
    lappend l [file size test1]
    fconfigure $f -translation crlf
    lappend l [read $f 2]
    lappend l [tell $f]
    lappend l [read $f 2]
    lappend l [tell $f]
    lappend l [read $f 2]
    lappend l [tell $f]
    lappend l [eof $f]
    lappend l [read $f 2]
    lappend l [tell $f]
    lappend l [eof $f]
    close $f
    set l
} "7 [list a\r] 2 [list b\r] 4 [list c\n] 7 0 {} 7 1"
test io-49.3 {testing crlf reading, leftover cr disgorgment} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "a\rb\rc\r\n"
    close $f
    set f [open test1 r]
    set l ""
    lappend l [file size test1]
    fconfigure $f -translation crlf
    lappend l [read $f 3]
    lappend l [tell $f]
    lappend l [read $f 3]
    lappend l [tell $f]
    lappend l [eof $f]
    lappend l [read $f 3]
    lappend l [tell $f]
    lappend l [eof $f]
    close $f
    set l
} "7 [list a\rb] 3 [list \rc\n] 7 0 {} 7 1"
test io-49.4 {testing crlf reading, leftover cr disgorgment} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "a\rb\rc\r\n"
    close $f
    set f [open test1 r]
    set l ""
    lappend l [file size test1]
    fconfigure $f -translation crlf
    lappend l [read $f 3]
    lappend l [tell $f]
    lappend l [gets $f]
    lappend l [tell $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [tell $f]
    lappend l [eof $f]
    close $f
    set l
} "7 [list a\rb] 3 [list \rc] 7 0 {} 7 1"
test io-49.5 {testing crlf reading, leftover cr disgorgment} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "a\rb\rc\r\n"
    close $f
    set f [open test1 r]
    set l ""
    lappend l [file size test1]
    fconfigure $f -translation crlf
    lappend l [set x [gets $f]]
    lappend l [tell $f]
    lappend l [gets $f]
    lappend l [tell $f]
    lappend l [eof $f]
    close $f
    set l
} [list 7 a\rb\rc 7 {} 7 1]
    
test io-50.1 {testing handler deletion} {} {
    removeFile test1
    set f [open test1 w]
    close $f
    set f [open test1 r]
    testchannelevent $f add readable [list delhandler $f]
    proc delhandler {f} {
	global z
	set z called
	testchannelevent $f delete 0
    }
    set z not_called
    update
    close $f
    set z
} called
test io-50.2 {testing handler deletion with multiple handlers} {} {
    removeFile test1
    set f [open test1 w]
    close $f
    set f [open test1 r]
    testchannelevent $f add readable [list delhandler $f 1]
    testchannelevent $f add readable [list delhandler $f 0]
    proc delhandler {f i} {
	global z
	lappend z "called delhandler $f $i"
	testchannelevent $f delete 0
    }
    set z ""
    update
    close $f
    string compare [string tolower $z] \
	[list [list called delhandler $f 0] [list called delhandler $f 1]]
} 0
test io-50.3 {testing handler deletion with multiple handlers} {} {
    removeFile test1
    set f [open test1 w]
    close $f
    set f [open test1 r]
    testchannelevent $f add readable [list notcalled $f 1]
    testchannelevent $f add readable [list delhandler $f 0]
    set z ""
    proc notcalled {f i} {
	global z
	lappend z "notcalled was called!! $f $i"
    }
    proc delhandler {f i} {
	global z
	testchannelevent $f delete 1
	lappend z "delhandler $f $i called"
	testchannelevent $f delete 0
	lappend z "delhandler $f $i deleted myself"
    }
    set z ""
    update
    close $f
    string compare [string tolower $z] \
	[list [list delhandler $f 0 called] \
	      [list delhandler $f 0 deleted myself]]
} 0
test io-50.4 {testing handler deletion vs reentrant calls} {} {
    removeFile test1
    set f [open test1 w]
    close $f
    set f [open test1 r]
    testchannelevent $f add readable [list delrecursive $f]
    proc delrecursive {f} {
	global z u
	if {"$u" == "recursive"} {
	    testchannelevent $f delete 0
	    lappend z "delrecursive deleting recursive"
	} else {
	    lappend z "delrecursive calling recursive"
	    set u recursive
	    update
	}
    }
    set u toplevel
    set z ""
    update
    close $f
    string compare [string tolower $z] \
	{{delrecursive calling recursive} {delrecursive deleting recursive}}
} 0
test io-50.5 {testing handler deletion vs reentrant calls} {} {
    removeFile test1
    set f [open test1 w]
    close $f
    set f [open test1 r]
    testchannelevent $f add readable [list notcalled $f]
    testchannelevent $f add readable [list del $f]
    proc notcalled {f} {
	global z
	lappend z "notcalled was called!! $f"
    }
    proc del {f} {
	global z u
	if {"$u" == "recursive"} {
	    testchannelevent $f delete 1
	    testchannelevent $f delete 0
	    lappend z "del deleted notcalled"
	    lappend z "del deleted myself"
	} else {
	    set u recursive
	    lappend z "del calling recursive"
	    update
	    lappend z "del after update"
	}
    }
    set z ""
    set u toplevel
    update
    close $f
    string compare [string tolower $z] \
	[list {del calling recursive} {del deleted notcalled} \
	      {del deleted myself} {del after update}]
} 0
test io-50.6 {testing handler deletion vs reentrant calls} {} {
    removeFile test1
    set f [open test1 w]
    close $f
    set f [open test1 r]
    testchannelevent $f add readable [list second $f]
    testchannelevent $f add readable [list first $f]
    proc first {f} {
	global u z
	if {"$u" == "toplevel"} {
	    lappend z "first called"
	    set u first
	    update
	    lappend z "first after update"
	} else {
	    lappend z "first called not toplevel"
	}
    }
    proc second {f} {
	global u z
	if {"$u" == "first"} {
	    lappend z "second called, first time"
	    set u second
	    testchannelevent $f delete 0
	} elseif {"$u" == "second"} {
	    lappend z "second called, second time"
	    testchannelevent $f delete 0
	} else {
	    lappend z "second called, cannot happen!"
	    testchannelevent $f removeall
	}
    }
    set z ""
    set u toplevel
    update
    close $f
    string compare [string tolower $z] \
	[list {first called} {first called not toplevel} \
	      {second called, first time} {second called, second time} \
	      {first after update}]
} 0

test io-51.1 {Test old socket deletion on Macintosh} {socket} {
    set x 0
    set result ""
    proc accept {s a p} {
	global x wait
	fconfigure $s -blocking off
	puts $s "sock[incr x]"
	close $s
	set wait done
    }
    set ss [socket -server accept 2831]
    set wait ""
    set cs [socket [info hostname] 2831]
    vwait wait
    lappend result [gets $cs]
    close $cs

    set wait ""
    set cs [socket [info hostname] 2831]
    vwait wait
    lappend result [gets $cs]
    close $cs

    set wait ""
    set cs [socket [info hostname] 2831]
    vwait wait
    lappend result [gets $cs]
    close $cs

    set wait ""
    set cs [socket [info hostname] 2831]
    vwait wait
    lappend result [gets $cs]
    close $cs
    close $ss
    set result
} {sock1 sock2 sock3 sock4}

test io-52.1 {TclCopyChannel} {
    removeFile test1
    set f1 [open $thisScript]
    set f2 [open test1 w]
    fcopy $f1 $f2 -command { # }
    catch { fcopy $f1 $f2 } msg
    close $f1
    close $f2
    string compare $msg "channel \"$f1\" is busy"
} {0}
test io-52.2 {TclCopyChannel} {
    removeFile test1
    set f1 [open $thisScript]
    set f2 [open test1 w]
    set f3 [open $thisScript]
    fcopy $f1 $f2 -command { # }
    catch { fcopy $f3 $f2 } msg
    close $f1
    close $f2
    close $f3
    string compare $msg "channel \"$f2\" is busy"
} {0}
test io-52.3 {TclCopyChannel} {
    removeFile test1
    set f1 [open $thisScript]
    set f2 [open test1 w]
    fconfigure $f1 -translation lf -blocking 0
    fconfigure $f2 -translation cr -blocking 0
    set s0 [fcopy $f1 $f2]
    set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
    close $f1
    close $f2
    set s1 [file size $thisScript]
    set s2 [file size test1]
    if {("$s1" == "$s2") && ($s0 == $s1)} {
        lappend result ok
    }
    set result
} {0 0 ok}
test io-52.4 {TclCopyChannel} {
    removeFile test1
    set f1 [open $thisScript]
    set f2 [open test1 w]
    fconfigure $f1 -translation lf -blocking 0
    fconfigure $f2 -translation cr -blocking 0
    fcopy $f1 $f2 -size 40
    set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
    close $f1
    close $f2
    lappend result [file size test1]
} {0 0 40}
test io-52.5 {TclCopyChannel} {
    removeFile test1
    set f1 [open $thisScript]
    set f2 [open test1 w]
    fconfigure $f1 -translation lf -blocking 0
    fconfigure $f2 -translation lf -blocking 0
    fcopy $f1 $f2 -size -1
    set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
    close $f1
    close $f2
    set s1 [file size $thisScript]
    set s2 [file size test1]
    if {"$s1" == "$s2"} {
        lappend result ok
    }
    set result
} {0 0 ok}
test io-52.6 {TclCopyChannel} {
    removeFile test1
    set f1 [open $thisScript]
    set f2 [open test1 w]
    fconfigure $f1 -translation lf -blocking 0
    fconfigure $f2 -translation lf -blocking 0
    set s0 [fcopy $f1 $f2 -size [expr [file size $thisScript] + 5]]
    set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
    close $f1
    close $f2
    set s1 [file size $thisScript]
    set s2 [file size test1]
    if {("$s1" == "$s2") && ($s0 == $s1)} {
        lappend result ok
    }
    set result
} {0 0 ok}
test io-52.7 {TclCopyChannel} {
    removeFile test1
    set f1 [open $thisScript]
    set f2 [open test1 w]
    fconfigure $f1 -translation lf -blocking 0
    fconfigure $f2 -translation lf -blocking 0
    fcopy $f1 $f2
    set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
    set s1 [file size $thisScript]
    set s2 [file size test1]
    close $f1
    close $f2
    if {"$s1" == "$s2"} {
        lappend result ok
    }
    set result
} {0 0 ok}
test io-52.8 {TclCopyChannel} {stdio} {
    removeFile test1
    removeFile pipe
    set f1 [open pipe w]
    fconfigure $f1 -translation lf
    puts $f1 "
	puts ready
	gets stdin
	set f1 \[open [list $thisScript] r\]
	fconfigure \$f1 -translation lf
	puts \[read \$f1 100\]
	close \$f1
    "
    close $f1
    set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
    fconfigure $f1 -translation lf
    gets $f1
    puts $f1 ready
    flush $f1
    set f2 [open test1 w]
    fconfigure $f2 -translation lf
    set s0 [fcopy $f1 $f2 -size 40]
    catch {close $f1}
    close $f2
    list $s0 [file size test1]
} {40 40}

test io-53.1 {CopyData} {
    removeFile test1
    set f1 [open $thisScript]
    set f2 [open test1 w]
    fconfigure $f1 -translation lf -blocking 0
    fconfigure $f2 -translation cr -blocking 0
    fcopy $f1 $f2 -size 0
    set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
    close $f1
    close $f2
    lappend result [file size test1]
} {0 0 0}
test io-53.2 {CopyData} {
    removeFile test1
    set f1 [open $thisScript]
    set f2 [open test1 w]
    fconfigure $f1 -translation lf -blocking 0
    fconfigure $f2 -translation cr -blocking 0
    fcopy $f1 $f2 -command {set s0}
    set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
    vwait s0
    close $f1
    close $f2
    set s1 [file size $thisScript]
    set s2 [file size test1]
    if {("$s1" == "$s2") && ($s0 == $s1)} {
        lappend result ok
    }
    set result
} {0 0 ok}
test io-53.3 {CopyData: background read underflow} {unixOnly} {
    removeFile test1
    removeFile pipe
    set f1 [open pipe w]
    puts $f1 {
	puts ready
	flush stdout				;# Don't assume line buffered!
	fcopy stdin stdout -command { set x }
	vwait x
	set f [open test1 w]
	fconfigure $f -translation lf
	puts $f "done"
	close $f
    }
    close $f1
    set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
    set result [gets $f1]
    puts $f1 line1
    flush $f1
    lappend result [gets $f1]
    puts $f1 line2
    flush $f1
    lappend result [gets $f1]
    close $f1
    after 500
    set f [open test1]
    lappend result [read $f]
    close $f
    set result
} "ready line1 line2 {done\n}"
test io-53.4 {CopyData: background write overflow} {unixOnly} {
    set big bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\n
    for {set x 0} {$x < 12} {incr x} {
	append big $big
    }
    removeFile test1
    removeFile pipe
    set f1 [open pipe w]
    puts $f1 {
	puts ready
	fcopy stdin stdout -command { set x }
	vwait x
	set f [open test1 w]
	fconfigure $f -translation lf
	puts $f "done"
	close $f
    }
    close $f1
    set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
    set result [gets $f1]
    fconfigure $f1 -blocking 0
    puts $f1 $big
    flush $f1
    after 500
    set result ""
    fileevent $f1 read {
	append result [read $f1 1024]
	if {[string length $result] >= [string length $big]} {
	    set x done
	}
    }
    vwait x
    close $f1
    set big {}
    set x
} done
set result {}

proc FcopyTestAccept {sock args} {
    after 1000 "close $sock"
}
proc FcopyTestDone {bytes {error {}}} {
    global fcopyTestDone
    if {[string length $error]} {
	set fcopyTestDone 1
    } else {
	set fcopyTestDone 0
    }
}

test io-53.5 {CopyData: error during fcopy} {socket} {
    set listen [socket -server FcopyTestAccept 2828]
    set in [open $thisScript]	;# 126 K
    set out [socket 127.0.0.1 2828]
    catch {unset fcopyTestDone}
    close $listen	;# This means the socket open never really succeeds
    fcopy $in $out -command FcopyTestDone
    if ![info exists fcopyTestDone] {
	vwait fcopyTestDone		;# The error occurs here in the b.g.
    }
    close $in
    close $out
    set fcopyTestDone	;# 1 for error condition
} 1
test io-53.6 {CopyData: error during fcopy} {stdio} {
    removeFile pipe
    removeFile test1
    catch {unset fcopyTestDone}
    set f1 [open pipe w]
    puts $f1 "exit 1"
    close $f1
    set in [open "|[list $::tcltest::tcltest pipe]" r+]
    set out [open test1 w]
    fcopy $in $out -command [list FcopyTestDone]
    if ![info exists fcopyTestDone] {
	vwait fcopyTestDone
    }
    catch {close $in}
    close $out
    set fcopyTestDone	;# 0 for plain end of file
} {0}

test io-54.1 {Recursive channel events} {socket} {
    # This test checks to see if file events are delivered during recursive
    # event loops when there is buffered data on the channel.

    proc accept {s a p} {
	global as
	fconfigure $s -translation lf
	puts $s "line 1\nline2\nline3"
	flush $s
	set as $s
    }
    proc readit {s next} {
	global result x
	lappend result $next
	if {$next == 1} {
	    fileevent $s readable [list readit $s 2]
	    vwait x
	}
	incr x
    }
    set ss [socket -server accept 2828]

    # We need to delay on some systems until the creation of the
    # server socket completes.

    set done 0
    for {set i 0} {$i < 10} {incr i} {
	if {![catch {set cs [socket [info hostname] 2828]}]} {
	    set done 1
	    break
	}
	after 100
    }
    if {$done == 0} {
	close $ss
	error "failed to connect to server"
    }
    set result {}
    set x 0
    vwait as
    fconfigure $cs -translation lf
    lappend result [gets $cs]
    fconfigure $cs -blocking off
    fileevent $cs readable [list readit $cs 1]
    set a [after 2000 { set x failure }]
    vwait x
    after cancel $a
    close $as
    close $ss
    close $cs
    list $result $x
} {{{line 1} 1 2} 2}
test io-54.2 {Testing for busy-wait in recursive channel events} {socket} {
    set accept {}
    set after {}
    set s [socket -server accept 3939]
    proc accept {s a p} {
	global counter accept

	set accept $s
	set counter 0
	fconfigure $s -blocking off -buffering line -translation lf
	fileevent $s readable "doit $s"
    }
    proc doit {s} {
	global counter after

	incr counter
	set l [gets $s]
	if {"$l" == ""} {
	    fileevent $s readable "doit1 $s"
	    set after [after 1000 newline]
	}
    }
    proc doit1 {s} {
	global counter accept

	incr counter
	set l [gets $s]
	close $s
	set accept {}
    }
    proc producer {} {
	global writer

	set writer [socket 127.0.0.1 3939]
	fconfigure $writer -buffering line
	puts -nonewline $writer hello
	flush $writer
    }
    proc newline {} {
	global writer done

	puts $writer hello
	flush $writer
	set done 1
    }
    producer
    vwait done
    close $writer
    close $s
    after cancel $after
    if {$accept != {}} {close $accept}
    set counter
} 1

test io-55.1 {ChannelEventScriptInvoker: deletion} {
    proc eventScript {fd} {
	close $fd
	error "planned error"
	set ::x whoops
    }
    proc bgerror {args} {
	set ::x got_error
    }
    set f [open fooBar w]
    fileevent $f writable [list eventScript $f]
    set x not_done
    vwait x
    set x
} {got_error}

test io-56.1 {ChannelTimerProc} {
    set f [open fooBar w]
    puts $f "this is a test"
    close $f
    set f [open fooBar r]
    testchannelevent $f add readable {
	read $f 1
	incr x
    }
    set x 0
    vwait x
    vwait x
    set result $x
    testchannelevent $f set 0 none
    after idle {set y done}
    vwait y
    close $f
    lappend result $y
} {2 done}

test io-57.1 {buffered data and file events, gets} {
    proc accept {sock args} {
	set ::s2 $sock
    }
    set server [socket -server accept 4040]
    set s [socket 127.0.0.1 4040]
    vwait s2
    update
    fileevent $s2 readable {lappend result readable}
    puts $s "12\n34567890"
    flush $s
    set result [gets $s2]
    after 1000 {lappend result timer}
    vwait result
    lappend result [gets $s2]
    vwait result
    close $s
    close $s2
    close $server
    set result
} {12 readable 34567890 timer}
test io-57.2 {buffered data and file events, read} {
    proc accept {sock args} {
	set ::s2 $sock
    }
    set server [socket -server accept 4041]
    set s [socket 127.0.0.1 4041]
    vwait s2
    update
    fileevent $s2 readable {lappend result readable}
    puts -nonewline $s "1234567890"
    flush $s
    set result [read $s2 1]
    after 1000 {lappend result timer}
    vwait result
    lappend result [read $s2 9]
    vwait result
    close $s
    close $s2
    close $server
    set result
} {1 readable 234567890 timer}
        
test io-58.1 {Tcl_NotifyChannel and error when closing} {unixOrPc} {
    set out [open script w]
    puts $out {
	puts "normal message from pipe"
	puts stderr "error message from pipe"
	exit 1
    }
    proc readit {pipe} {
	global x result
	if {[eof $pipe]} {
	    set x [catch {close $pipe} line]
	    lappend result catch $line
	} else {
	    gets $pipe line
	    lappend result gets $line
	}
    }
    close $out
    set pipe [open "|[list $::tcltest::tcltest] script" r]
    fileevent $pipe readable [list readit $pipe]
    set x ""
    set result ""
    vwait x
    list $x $result
} {1 {gets {normal message from pipe} gets {} catch {error message from pipe}}}


test io-59.1 {Thread reference of channels} {
    # TIP #10
    # More complicated tests (like that the reference changes as a
    # channel is moved from thread to thread) can be done only in the
    # extension which fully implements the moving of channels between
    # threads, i.e. 'Threads'. Or we have to extend [testthread] as well.

    set f [open longfile r]
    set result [testchannel mthread $f]
    close $f
    set result
} [testmainthread]



# cleanup
foreach file [list fooBar longfile script output test1 pipe my_script foo \
	bar test2 test3 cat stdout] {
    ::tcltest::removeFile $file
}
::tcltest::restoreState
::tcltest::cleanupTests
return