Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | Fix env.test, when running under wine 1.3 (partly backported from Tcl 8.6) |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | core-8-4-branch |
Files: | files | file ages | folders |
SHA1: |
951880c45743433ab7ce0349d1860edb |
User & Date: | jan.nijtmans 2011-10-07 20:54:45 |
Context
2011-10-11
| ||
13:19 | [Bug 2935503] Incorrect mode field returned by file stat command check-in: 77f44a0961 user: jan.nijtmans tags: core-8-4-branch | |
2011-10-07
| ||
21:16 | Fix env.test, when running under wine 1.3 (partly backported from Tcl 8.6) check-in: 1c15b03dcd user: jan.nijtmans tags: core-8-5-branch | |
20:54 | Fix env.test, when running under wine 1.3 (partly backported from Tcl 8.6) check-in: 951880c457 user: jan.nijtmans tags: core-8-4-branch | |
11:58 | Fix gcc warnings (discovered with latest mingw, based on gcc 4.6.1) check-in: 72e8ccc7aa user: jan.nijtmans tags: core-8-4-branch | |
Changes
Changes to ChangeLog.
1 2 3 4 5 6 7 8 9 10 11 12 13 | 2011-10-07 Jan Nijtmans <[email protected]> * win/tclWinChan.c: Fix various gcc warnings * win/tclWinConsole.c: (discovered with latest * win/tclWinNotify.c: mingw, based on gcc 4.6.1) * win/tclWinReg.c: 2011-09-26 Jan Nijtmans <[email protected]> * win/rules.vc: Support Visual Studio 11 2011-09-16 Jan Nijtmans <[email protected]> | > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | 2011-10-07 Jan Nijtmans <[email protected]> * win/tclWinChan.c: Fix various gcc warnings * win/tclWinConsole.c: (discovered with latest * win/tclWinNotify.c: mingw, based on gcc 4.6.1) * win/tclWinReg.c: * tests/env.test: Fix env.test, when running under wine 1.3 (partly backported from Tcl 8.6) 2011-09-26 Jan Nijtmans <[email protected]> * win/rules.vc: Support Visual Studio 11 2011-09-16 Jan Nijtmans <[email protected]> |
︙ | ︙ |
Changes to tests/env.test.
1 2 | # Commands covered: none (tests environment variable implementation) # | | | | | | | | < | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 | # Commands covered: none (tests environment variable implementation) # # 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-1993 The Regents of the University of California. # Copyright (c) 1994 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. package require tcltest 2 namespace import -force ::tcltest::* # # These tests will run on any platform (and indeed crashed on the Mac). So put # them before you test for the existance of exec. # test env-1.1 {propagation of env values to child interpreters} { catch {interp delete child} catch {unset env(test)} interp create child set env(test) garbage set return [child eval {set env(test)}] interp delete child unset env(test) set return } {garbage} # # This one crashed on Solaris under Tcl8.0, so we only want to make sure it # runs. # test env-1.2 {lappend to env value} { catch {unset env(test)} set env(test) aaaaaaaaaaaaaaaa append env(test) bbbbbbbbbbbbbb unset env(test) } {} |
︙ | ︙ | |||
61 62 63 64 65 66 67 | upvar $listname list set i [lsearch $list $name] if {$i >= 0} { set list [lreplace $list $i $i] } return $list } | > > > > | > > > > | | > | | | 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 | upvar $listname list set i [lsearch $list $name] if {$i >= 0} { set list [lreplace $list $i $i] } return $list } proc mangle s { regsub -all {\[|\\|\]} $s {\\&} s regsub -all {[\u0000-\u001f\u007f-\uffff]} $s {[manglechar &]} s return [subst -novariables $s] } proc manglechar c { return [format {\u%04x} [scan $c %c]] } set names [lsort [array names env]] if {$tcl_platform(platform) == "windows"} { lrem names HOME lrem names COMSPEC lrem names ComSpec lrem names "" } foreach name { TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH PURE_PROG_NAME DISPLAY SHLIB_PATH SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING __CF_USER_TEXT_ENCODING SECURITYSESSIONID LANG WINDIR TERM CommonProgramFiles ProgramFiles } { lrem names $name } foreach p $names { puts "[mangle $p]=[mangle $env($p)]" } exit } printenv] # [exec] is required here to see the actual environment received # by child processes. proc getenv {} { global printenvScript tcltest catch {exec [interpreter] $printenvScript} out if {$out == "child process exited abnormally"} { set out {} |
︙ | ︙ | |||
108 109 110 111 112 113 114 | # Added the following lines so that child tcltest can actually find its # library if the initial tcltest is run from a non-standard place. # ('saved' env vars) foreach name { TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH DISPLAY SHLIB_PATH SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING | | > > | 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 | # Added the following lines so that child tcltest can actually find its # library if the initial tcltest is run from a non-standard place. # ('saved' env vars) foreach name { TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH DISPLAY SHLIB_PATH SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING SECURITYSESSIONID LANG WINDIR TERM CommonProgramFiles ProgramFiles } { if {[info exists env2($name)]} { set env($name) $env2($name); } } test env-2.1 {adding environment variables} {exec} { getenv |
︙ | ︙ | |||
161 162 163 164 165 166 167 | unset env(XYZZY) set result } {XYZZY=garbage} test env-4.3 {setting international environment variables} {exec} { set env(\ua7) \ub6 getenv | | | | | 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 | unset env(XYZZY) set result } {XYZZY=garbage} test env-4.3 {setting international environment variables} {exec} { set env(\ua7) \ub6 getenv } {\u00a7=\u00b6} test env-4.4 {changing international environment variables} {exec} { set env(\ua7) \ua7 getenv } {\u00a7=\u00a7} test env-4.5 {unsetting international environment variables} {exec} { set env(\ub6) \ua7 unset env(\ua7) set result [getenv] unset env(\ub6) set result } {\u00b6=\u00a7} test env-5.0 {corner cases - set a value, it should exist} {} { set env(temp) a set result [set env(temp)] unset env(temp) set result } {a} |
︙ | ︙ | |||
255 256 257 258 259 260 261 | set env($name) $env2($name) } # cleanup removeFile $printenvScript ::tcltest::cleanupTests return | > > > > | 265 266 267 268 269 270 271 272 273 274 275 | set env($name) $env2($name) } # cleanup removeFile $printenvScript ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: |