Tcl Source Code

Check-in [4c431fc1c9]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:merge trunk
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | gahr-bug-5f71353740 | tip-444
Files: files | file ages | folders
SHA1: 4c431fc1c9076a488fd349c59af5944ee9b10f1f
User & Date: gahr 2016-02-23 19:44:07
Context
2016-02-24
09:10
More comprehensive tests adding and subtracting week-days check-in: f991a78d7a user: gahr tags: gahr-bug-5f71353740, tip-444
2016-02-23
19:44
merge trunk check-in: 4c431fc1c9 user: gahr tags: gahr-bug-5f71353740, tip-444
16:31
Make sure that adding 0 weekdays doesn't result in going back in time check-in: ef26db9e93 user: gahr tags: gahr-bug-5f71353740, tip-444
2016-02-22
12:39
Convert remaining env.test test-cases to tcltest-2 format check-in: d6a977a3a6 user: jan.nijtmans tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclEnv.c.

547
548
549
550
551
552
553
554

555
556
557
558
559
560
561
...
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
 * EnvTraceProc --
 *
 *	This function is invoked whenever an environment variable is read,
 *	modified or deleted. It propagates the change to the global "environ"
 *	array.
 *
 * Results:
 *	Always returns NULL to indicate success.

 *
 * Side effects:
 *	Environment variable changes get propagated. If the whole "env" array
 *	is deleted, then we stop managing things for this interpreter (usually
 *	this happens because the whole interpreter is being deleted).
 *
 *----------------------------------------------------------------------
................................................................................
     */

    if (flags & TCL_TRACE_READS) {
	Tcl_DString valueString;
	const char *value = TclGetEnv(name2, &valueString);

	if (value == NULL) {
	    Tcl_UnsetVar2(interp, name1, name2, 0);
	    return NULL;
	}
	Tcl_SetVar2(interp, name1, name2, value, 0);
	Tcl_DStringFree(&valueString);
    }

    /*
     * For unset traces, let TclUnsetEnv do all the work.






|
>







 







|
<







547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
...
606
607
608
609
610
611
612
613

614
615
616
617
618
619
620
 * EnvTraceProc --
 *
 *	This function is invoked whenever an environment variable is read,
 *	modified or deleted. It propagates the change to the global "environ"
 *	array.
 *
 * Results:
 *	Returns NULL to indicate success, or an error-message if the array
 *	element being handled doesn't exist.
 *
 * Side effects:
 *	Environment variable changes get propagated. If the whole "env" array
 *	is deleted, then we stop managing things for this interpreter (usually
 *	this happens because the whole interpreter is being deleted).
 *
 *----------------------------------------------------------------------
................................................................................
     */

    if (flags & TCL_TRACE_READS) {
	Tcl_DString valueString;
	const char *value = TclGetEnv(name2, &valueString);

	if (value == NULL) {
	    return (char *) "no such variable";

	}
	Tcl_SetVar2(interp, name1, name2, value, 0);
	Tcl_DStringFree(&valueString);
    }

    /*
     * For unset traces, let TclUnsetEnv do all the work.

Changes to tests/env.test.

274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303

304
305
306
307
308
309
310




311


312
313




314
315

316
317
318
319
320
321
322
    i eval { set env(THIS_SHOULD_EXIST) a}
    set     result [info exists env(THIS_SHOULD_EXIST)]
    lappend result [set env(THIS_SHOULD_EXIST)]
    lappend result [info exists env(THIS_SHOULD_EXIST)]
} -cleanup {
    interp delete i
} -result {1 a 1}
test env-5.5 {corner cases - cannot have null entries on Windows} {win} {
    set env() a
    catch {set env()}
} {1}

test env-6.1 {corner cases - add lots of env variables} {} {
    set size [array size env]
    for {set i 0} {$i < 100} {incr i} {
	set env(BOGUS$i) $i
    }
    expr {[array size env] - $size}
} 100

test env-7.1 {[219226]: whole env array should not be unset by read} {
    set n [array size env]
    set s [array startsearch env]
    while {[array anymore env $s]} {
	array nextelement env $s
	incr n -1
    }
    array donesearch env $s
    return $n
} 0

test env-7.2 {[219226]: links to env elements should not be removed by read} {
    apply {{} {
	set ::env(test7_2) ok
	upvar env(test7_2) elem
	set ::env(PATH)
	try {
	    return $elem




	} finally {


	    unset ::env(test7_2)
	}




    }}
} ok


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

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






|


|

|





|

|








|
>
|




<
|
>
>
>
>
|
>
>
|
|
>
>
>
>

<
>







274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309

310
311
312
313
314
315
316
317
318
319
320
321
322
323
324

325
326
327
328
329
330
331
332
    i eval { set env(THIS_SHOULD_EXIST) a}
    set     result [info exists env(THIS_SHOULD_EXIST)]
    lappend result [set env(THIS_SHOULD_EXIST)]
    lappend result [info exists env(THIS_SHOULD_EXIST)]
} -cleanup {
    interp delete i
} -result {1 a 1}
test env-5.5 {corner cases - cannot have null entries on Windows} -constraints win -body {
    set env() a
    catch {set env()}
} -result 1

test env-6.1 {corner cases - add lots of env variables} -body {
    set size [array size env]
    for {set i 0} {$i < 100} {incr i} {
	set env(BOGUS$i) $i
    }
    expr {[array size env] - $size}
} -result 100

test env-7.1 {[219226]: whole env array should not be unset by read} -body {
    set n [array size env]
    set s [array startsearch env]
    while {[array anymore env $s]} {
	array nextelement env $s
	incr n -1
    }
    array donesearch env $s
    return $n
} -result 0

test env-7.2 {[219226]: links to env elements should not be removed by read} -body {
    apply {{} {
	set ::env(test7_2) ok
	upvar env(test7_2) elem
	set ::env(PATH)

	return $elem
    }}
} -result ok

test env-7.3 {[9b4702]: testing existence of env(some_thing) should not destroy trace} -body {
    apply {{} {
      catch {unset ::env(test7_3)}
      proc foo args {
        set ::env(test7_3) ok
      }
      trace add variable ::env(not_yet_existent) write foo
      info exists ::env(not_yet_existent)
      set ::env(not_yet_existent) "Now I'm here";
      return [info exists ::env(test7_3)]
    }}

} -result 1

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

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