Check-in [30c24a65a0]
Not logged in

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

Overview
Comment:add tcl upstream changes
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 30c24a65a01dcea4467d92dbb060ed5064d21cb2
User & Date: chw 2019-09-11 16:13:00
Context
2019-09-12
05:49
haiku tweaks in libwebsockets check-in: d02d27b490 user: chw tags: trunk
2019-09-11
16:15
merge with trunk check-in: 8c494d215a user: chw tags: wtf-8-experiment
16:13
add tcl upstream changes check-in: 30c24a65a0 user: chw tags: trunk
2019-09-10
17:01
more selected tcl upstream changes check-in: 7dee8bfabb user: chw tags: trunk
Changes

Changes to jni/tcl/library/tm.tcl.

307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
...
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
#
# Sideeffects
#	May add paths to the list of defaults.

proc ::tcl::tm::Defaults {} {
    global env tcl_platform

    lassign [split [info tclversion] .] major minor
    set exe [file normalize [info nameofexecutable]]

    # Note that we're using [::list], not [list] because [list] means
    # something other than [::list] in this namespace.
    roots [::list \
	    [file dirname [info library]] \
	    [file join [file dirname [file dirname $exe]] lib] \
................................................................................
# Results
#	No result.
#
# Sideeffects
#	Calls 'path add' to paths to the list of module search paths.

proc ::tcl::tm::roots {paths} {
    regexp {^(\d+)\.(\d+)} [package present Tcl] - major minor
    foreach pa $paths {
	set p [file join $pa tcl$major]
	for {set n $minor} {$n >= 0} {incr n -1} {
	    set px [file join $p ${major}.${n}]
	    if {![interp issafe]} {set px [file normalize $px]}
	    path add $px
	}







|







 







|







307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
...
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
#
# Sideeffects
#	May add paths to the list of defaults.

proc ::tcl::tm::Defaults {} {
    global env tcl_platform

    regexp {^(\d+)\.(\d+)} [package provide Tcl] - major minor
    set exe [file normalize [info nameofexecutable]]

    # Note that we're using [::list], not [list] because [list] means
    # something other than [::list] in this namespace.
    roots [::list \
	    [file dirname [info library]] \
	    [file join [file dirname [file dirname $exe]] lib] \
................................................................................
# Results
#	No result.
#
# Sideeffects
#	Calls 'path add' to paths to the list of module search paths.

proc ::tcl::tm::roots {paths} {
    regexp {^(\d+)\.(\d+)} [package provide Tcl] - major minor
    foreach pa $paths {
	set p [file join $pa tcl$major]
	for {set n $minor} {$n >= 0} {incr n -1} {
	    set px [file join $p ${major}.${n}]
	    if {![interp issafe]} {set px [file normalize $px]}
	    path add $px
	}

Changes to jni/tcl/tests/cmdAH.test.

1310
1311
1312
1313
1314
1315
1316
1317
















1318




1319
1320
1321
1322
1323
1324
1325
    file delete -force $filename
} -result {3155760000 3155760000}

# owned
test cmdAH-25.1 {Tcl_FileObjCmd: owned} -returnCodes error -body {
    file owned a b
} -result {wrong # args: should be "file owned name"}
test cmdAH-25.2 {Tcl_FileObjCmd: owned} -constraints win -body {
















    file owned $gorpfile




} -result 1
test cmdAH-25.2.1 {Tcl_FileObjCmd: owned} -constraints unix -setup {
    # Avoid problems with AFS
    set tmpfile [makeFile "data" touch.me /tmp]
} -body {
    file owned $tmpfile
} -cleanup {







|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>







1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
    file delete -force $filename
} -result {3155760000 3155760000}

# owned
test cmdAH-25.1 {Tcl_FileObjCmd: owned} -returnCodes error -body {
    file owned a b
} -result {wrong # args: should be "file owned name"}
test cmdAH-25.2 {Tcl_FileObjCmd: owned} -constraints win -setup {
    set fn $gorpfile
    # prefer temp file to check owner (try to avoid bug [7de2d722bd]):
    if {
	[info exists ::env(TEMP)] && [file isdirectory $::env(TEMP)] &&
        [file dirname $fn] ne [file normalize $::env(TEMP)]
    } {
	set fn [file join $::env(TEMP)/test-owner-from-tcl.txt]
	set fn [makeFile "data" test-owner-from-tcl.txt $::env(TEMP)]
    }
    # be sure we have really owned this file before trying to check that
    # (avoid dependency on admin with UAC and the setting "System objects:
    # Default owner for objects created by members of the Administrators group"):
    catch {
	exec takeown /F [file nativename $fn]
    }
} -body {
    file owned $fn
} -cleanup {
    if {$fn ne $gorpfile} {
	removeFile $fn
    }
} -result 1
test cmdAH-25.2.1 {Tcl_FileObjCmd: owned} -constraints unix -setup {
    # Avoid problems with AFS
    set tmpfile [makeFile "data" touch.me /tmp]
} -body {
    file owned $tmpfile
} -cleanup {

Changes to jni/tcl/tests/tm.test.

196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
    ::tcl::tm::path list
} -result {geode snarf foo}


proc genpaths {base} {
    # Normalizing picks up drive letters on windows [Bug 1053568]
    set base [file normalize $base]
    lassign [split [package present Tcl] .] major minor
    set results {}
    set base [file join $base tcl$major]
    lappend results [file join $base site-tcl]
    for {set i 0} {$i <= $minor} {incr i} {
	lappend results [file join $base ${major}.$i]
    }
    return $results







|







196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
    ::tcl::tm::path list
} -result {geode snarf foo}


proc genpaths {base} {
    # Normalizing picks up drive letters on windows [Bug 1053568]
    set base [file normalize $base]
    regexp {^(\d+)\.(\d+)} [package provide Tcl] - major minor
    set results {}
    set base [file join $base tcl$major]
    lappend results [file join $base site-tcl]
    for {set i 0} {$i <= $minor} {incr i} {
	lappend results [file join $base ${major}.$i]
    }
    return $results