Tcl Source Code

Check-in [1581f9beac]
Login

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

Overview
Comment:alternative fix for [a7e00a0e02] breakage: just make sure that the variable $tmpspace is always set
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 1581f9beac5715890d105a41090756a89b0f3630
User & Date: jan.nijtmans 2012-06-15 09:39:34
Context
2012-06-19
11:58
make tclWinReg.c compile/run without UNICODE (suggested in bug #3362446) check-in: 2bdd7f3c3c user: jan.nijtmans tags: trunk
2012-06-16
17:20
merge trunk check-in: 2b00cddb34 user: dkf tags: tip-400-impl
2012-06-15
09:39
alternative fix for [a7e00a0e02] breakage: just make sure that the variable $tmpspace is always set check-in: 1581f9beac user: jan.nijtmans tags: trunk
09:02
upgrade to 1.2.7 build of dll check-in: 0799b50a05 user: jan.nijtmans tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to tests/fCmd.test.

35
36
37
38
39
40
41

42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59

60
61
62
63
64
65
66
	    ::tcltest::loadTestedCommands
	    load $::reglib Registry
	}
	testConstraint reg 1
    }
}


# Find a group that exists on this Unix system, or else skip tests that
# require Unix groups.
testConstraint foundGroup [expr {![testConstraint unix]}]
if {[testConstraint unix]} {
    catch {
	set groupList [exec groups]
	set group [lindex $groupList 0]
	testConstraint foundGroup 1
    }
}

proc dev dir {
    file stat $dir stat
    return $stat(dev)
}

if {[catch {makeDirectory tcl[pid] /tmp} tmpspace] == 0} {
    testConstraint xdev [expr {([dev .] != [dev $tmpspace])}]

}

# Also used in winFCmd...
if {[testConstraint win]} {
    set major [string index $tcl_platform(osVersion) 0]
    if {[testConstraint nt] && $major > 4} {
        if {$major > 5} {







>









|
<
|
|
|
|

|
|
>







35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52

53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
	    ::tcltest::loadTestedCommands
	    load $::reglib Registry
	}
	testConstraint reg 1
    }
}

set tmpspace /tmp;# default value
# Find a group that exists on this Unix system, or else skip tests that
# require Unix groups.
testConstraint foundGroup [expr {![testConstraint unix]}]
if {[testConstraint unix]} {
    catch {
	set groupList [exec groups]
	set group [lindex $groupList 0]
	testConstraint foundGroup 1
    }


    proc dev dir {
	file stat $dir stat
	return $stat(dev)
    }

    if {[catch {makeDirectory tcl[pid] /tmp} tmpspace] == 0} {
	testConstraint xdev [expr {([dev .] != [dev $tmpspace])}]
    }
}

# Also used in winFCmd...
if {[testConstraint win]} {
    set major [string index $tcl_platform(osVersion) 0]
    if {[testConstraint nt] && $major > 4} {
        if {$major > 5} {
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
    createfile [file join td1 td2 tf1]
    file mkdir td2
    file rename -force td2 td1
} -returnCodes error -match glob -result \
    [subst {error renaming "td2" to "[file join td1 td2]": file *}]
test fCmd-6.19 {CopyRenameOneFile: errno == EXDEV} -setup {
    cleanup $tmpspace
} -constraints {xdev notRoot} -body {
    createfile tf1
    file rename tf1 $tmpspace
    glob -nocomplain tf* [file join $tmpspace tf1]
} -result [file join $tmpspace tf1]
test fCmd-6.20 {CopyRenameOneFile: errno == EXDEV} -constraints {win} -setup {
    catch {file delete -force c:/tcl8975@ d:/tcl8975@}
} -body {
    file mkdir c:/tcl8975@
    if {[catch {file rename c:/tcl8975@ d:/}]} {
	return d:/tcl8975@
    }
    glob c:/tcl8975@ d:/tcl8975@
} -cleanup {
    file delete -force c:/tcl8975@
    catch {file delete -force d:/tcl8975@}
} -result {d:/tcl8975@}
test fCmd-6.21 {CopyRenameOneFile: copy/rename: S_ISDIR(source)} -setup {
    cleanup $tmpspace
} -constraints {xdev notRoot} -body {
    file mkdir td1
    file rename td1 $tmpspace
    glob -nocomplain td* [file join $tmpspace td*]
} -result [file join $tmpspace td1]
test fCmd-6.22 {CopyRenameOneFile: copy/rename: !S_ISDIR(source)} -setup {
    cleanup $tmpspace
} -constraints {xdev notRoot} -body {
    createfile tf1
    file rename tf1 $tmpspace
    glob -nocomplain tf* [file join $tmpspace tf*]
} -result [file join $tmpspace tf1]
test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} -setup {
    cleanup $tmpspace
} -constraints {notRoot xdev} -body {
    file mkdir td1/td2/td3
    file attributes td1 -permissions 0000
    file rename td1 $tmpspace
} -returnCodes error -cleanup {
    file attributes td1 -permissions 0755
    cleanup
} -match regexp -result {^error renaming "td1"( to "/tmp/tcl\d+/td1")?: permission denied$}







|


















|






|






|







588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
    createfile [file join td1 td2 tf1]
    file mkdir td2
    file rename -force td2 td1
} -returnCodes error -match glob -result \
    [subst {error renaming "td2" to "[file join td1 td2]": file *}]
test fCmd-6.19 {CopyRenameOneFile: errno == EXDEV} -setup {
    cleanup $tmpspace
} -constraints {unix notRoot} -body {
    createfile tf1
    file rename tf1 $tmpspace
    glob -nocomplain tf* [file join $tmpspace tf1]
} -result [file join $tmpspace tf1]
test fCmd-6.20 {CopyRenameOneFile: errno == EXDEV} -constraints {win} -setup {
    catch {file delete -force c:/tcl8975@ d:/tcl8975@}
} -body {
    file mkdir c:/tcl8975@
    if {[catch {file rename c:/tcl8975@ d:/}]} {
	return d:/tcl8975@
    }
    glob c:/tcl8975@ d:/tcl8975@
} -cleanup {
    file delete -force c:/tcl8975@
    catch {file delete -force d:/tcl8975@}
} -result {d:/tcl8975@}
test fCmd-6.21 {CopyRenameOneFile: copy/rename: S_ISDIR(source)} -setup {
    cleanup $tmpspace
} -constraints {unix notRoot} -body {
    file mkdir td1
    file rename td1 $tmpspace
    glob -nocomplain td* [file join $tmpspace td*]
} -result [file join $tmpspace td1]
test fCmd-6.22 {CopyRenameOneFile: copy/rename: !S_ISDIR(source)} -setup {
    cleanup $tmpspace
} -constraints {unix notRoot} -body {
    createfile tf1
    file rename tf1 $tmpspace
    glob -nocomplain tf* [file join $tmpspace tf*]
} -result [file join $tmpspace tf1]
test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} -setup {
    cleanup $tmpspace
} -constraints {xdev notRoot} -body {
    file mkdir td1/td2/td3
    file attributes td1 -permissions 0000
    file rename td1 $tmpspace
} -returnCodes error -cleanup {
    file attributes td1 -permissions 0755
    cleanup
} -match regexp -result {^error renaming "td1"( to "/tmp/tcl\d+/td1")?: permission denied$}
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
} -constraints {notRoot xdev} -body {
    file mkdir td1/td2/td3
    file rename td1 $tmpspace
    glob td* [file join $tmpspace td1 t*]
} -result [file join $tmpspace td1 td2]
test fCmd-6.30 {CopyRenameOneFile: TclpRemoveDirectory failed} -setup {
    cleanup $tmpspace
} -constraints {xdev notRoot} -body {
    file mkdir foo/bar
    file attr foo -perm 040555
    file rename foo/bar $tmpspace
} -returnCodes error -cleanup {
    catch {file delete [file join $tmpspace bar]}
    catch {file attr foo -perm 040777}
    catch {file delete -force foo}







|







690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
} -constraints {notRoot xdev} -body {
    file mkdir td1/td2/td3
    file rename td1 $tmpspace
    glob td* [file join $tmpspace td1 t*]
} -result [file join $tmpspace td1 td2]
test fCmd-6.30 {CopyRenameOneFile: TclpRemoveDirectory failed} -setup {
    cleanup $tmpspace
} -constraints {unix notRoot} -body {
    file mkdir foo/bar
    file attr foo -perm 040555
    file rename foo/bar $tmpspace
} -returnCodes error -cleanup {
    catch {file delete [file join $tmpspace bar]}
    catch {file attr foo -perm 040777}
    catch {file delete -force foo}
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
    catch {file rename tfa/dir tfa2}
} -cleanup {
    catch {file attributes tfa -permissions 0777}
    file delete -force tfa
} -result {1}
test fCmd-12.9 {renamefile: moving a file across volumes} -setup {
    cleanup $tmpspace
} -constraints {xdev notRoot} -body {
    set s [createfile tfa]
    file rename tfa $tmpspace
    list [checkcontent [file join $tmpspace tfa] $s] [file exists tfa]
} -cleanup {
    cleanup $tmpspace
} -result {1 0}
test fCmd-12.10 {renamefile: moving a directory across volumes} -setup {







|







1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
    catch {file rename tfa/dir tfa2}
} -cleanup {
    catch {file attributes tfa -permissions 0777}
    file delete -force tfa
} -result {1}
test fCmd-12.9 {renamefile: moving a file across volumes} -setup {
    cleanup $tmpspace
} -constraints {unix notRoot} -body {
    set s [createfile tfa]
    file rename tfa $tmpspace
    list [checkcontent [file join $tmpspace tfa] $s] [file exists tfa]
} -cleanup {
    cleanup $tmpspace
} -result {1 0}
test fCmd-12.10 {renamefile: moving a directory across volumes} -setup {