Tcl Source Code

2011-10-07  Jan Nijtmans  <[email protected]>

	* generic/tclIORChan.c:    Fix gcc warning
	(discovered with latest mingw, based on gcc 4.6.1)
	* tests/env.test:      Fix env.test, when running
	under wine 1.3 (partly backported from Tcl 8.6)

2011-10-03  Venkat Iyer <[email protected]>

	* library/tzdata/Africa/Dar_es_Salaam: Update to Olson's tzdata2011k
	* library/tzdata/Africa/Kampala
	* library/tzdata/Africa/Nairobi
	* library/tzdata/Asia/Gaza

# 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.

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

# Some tests require the "exec" command.
# Skip them if exec is not defined.
testConstraint exec [llength [info commands exec]]

#
# 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)
} {}

	upvar $listname list
	set i [lsearch -nocase $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 {}
    }
    return $out
}

# Save the current environment variables at the start of the test.

set env2 [array get env]
foreach name [array names env] {


    # Keep some environment variables that support operation of the tcltest
    # package.
    if {[string toupper $name] ni {
	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
    }} {
	unset env($name)
    }
}

test env-2.1 {adding environment variables} {exec} {
    getenv

    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}

} 100

# Restore the environment variables at the end of the test.

foreach name [array names env] {
    unset env($name)
}

array set env $env2


# cleanup
removeFile $printenvScript
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End: