Tcl Source Code

Check-in [64f4ffa382]
Login

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

Overview
Comment:3597000 Consistent [file copy] result.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 64f4ffa38232cee286bc6efa322c7bc60d646925
User & Date: dgp 2013-03-19 14:39:09
Context
2013-03-19
14:59
Handle the (unlikely) case that the file is deleted in between. Suggested by Harald Oehlmann (Thanks... check-in: 7eee715c3f user: jan.nijtmans tags: trunk
14:39
3597000 Consistent [file copy] result. check-in: 64f4ffa382 user: dgp tags: trunk
14:31
3597000 Consistent [file copy] result. check-in: 629ee9f78d user: dgp tags: core-8-5-branch
13:57
[Bug 3608360]: Incompatible behaviour of "file exists". check-in: 5567ed9fa5 user: jan.nijtmans tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.






1
2
3
4
5
6
7





2013-03-19  Jan Nijtmans  <[email protected]>

	* win/tclWinFile.c: [Bug 3608360]: Incompatible behaviour of "file
	exists".

2013-03-18  Donal K. Fellows  <[email protected]>

>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
2013-03-19  Don Porter  <[email protected]>

	* generic/tclFCmd.c: [Bug 3597000] Consistent [file copy] result.
	* tests/fileSystem.test:

2013-03-19  Jan Nijtmans  <[email protected]>

	* win/tclWinFile.c: [Bug 3608360]: Incompatible behaviour of "file
	exists".

2013-03-18  Donal K. Fellows  <[email protected]>

Changes to generic/tclFCmd.c.

730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
	    /*
	     * We could examine 'errno' to double-check if the problem was
	     * with the target, but we checked the source above, so it should
	     * be quite clear
	     */

	    errfile = target;

	    /*
	     * We now need to reset the result, because the above call, if it
	     * failed, may have put an error message in place. (Ideally we
	     * would prefer not to pass an interpreter in above, but the
	     * channel IO code used by TclCrossFilesystemCopy currently
	     * requires one).
	     */

	    Tcl_ResetResult(interp);
	}
    }
    if ((copyFlag == 0) && (result == TCL_OK)) {
	if (S_ISDIR(sourceStatBuf.st_mode)) {
	    result = Tcl_FSRemoveDirectory(source, 1, &errorBuffer);
	    if (result != TCL_OK) {
		errfile = errorBuffer;
		if (Tcl_FSEqualPaths(errfile, source) == 0) {







|
|
|
|
|
|
<
|
<
|
<







730
731
732
733
734
735
736
737
738
739
740
741
742

743

744

745
746
747
748
749
750
751
	    /*
	     * We could examine 'errno' to double-check if the problem was
	     * with the target, but we checked the source above, so it should
	     * be quite clear
	     */

	    errfile = target;
	}
	/* 
	 * We now need to reset the result, because the above call,
	 * may have left set it.  (Ideally we would prefer not to pass
	 * an interpreter in above, but the channel IO code used by
	 * TclCrossFilesystemCopy currently requires one)

	 */

	Tcl_ResetResult(interp);

    }
    if ((copyFlag == 0) && (result == TCL_OK)) {
	if (S_ISDIR(sourceStatBuf.st_mode)) {
	    result = Tcl_FSRemoveDirectory(source, 1, &errorBuffer);
	    if (result != TCL_OK) {
		errfile = errorBuffer;
		if (Tcl_FSEqualPaths(errfile, source) == 0) {

Changes to tests/fileSystem.test.

637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
    lappend res $err
    lappend res [file exists file2]
} -cleanup {
    catch {testsimplefilesystem 0}
    file delete -force simplefile
    file delete -force file2
    cd $dir
} -result {0 10 1 {error copying "simplefs:/simplefile" to "file2": file already exists} 0 10 1}
test filesystem-7.5 {cross-filesystem file copy with -force} -setup {
    set dir [pwd]
    cd [tcltest::temporaryDirectory]
    set fout [open [file join simplefile] w]
    puts -nonewline $fout "1234567890"
    close $fout
    testsimplefilesystem 1







|







637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
    lappend res $err
    lappend res [file exists file2]
} -cleanup {
    catch {testsimplefilesystem 0}
    file delete -force simplefile
    file delete -force file2
    cd $dir
} -result {0 {} 1 {error copying "simplefs:/simplefile" to "file2": file already exists} 0 {} 1}
test filesystem-7.5 {cross-filesystem file copy with -force} -setup {
    set dir [pwd]
    cd [tcltest::temporaryDirectory]
    set fout [open [file join simplefile] w]
    puts -nonewline $fout "1234567890"
    close $fout
    testsimplefilesystem 1
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
    lappend res $err
    lappend res [file exists file2]
} -cleanup {
    testsimplefilesystem 0
    file delete -force simplefile
    file delete -force file2
    cd $dir
} -result {0 10 1 {error copying "simplefs:/simplefile" to "file2": file already exists} 0 10 1}
test filesystem-7.6 {cross-filesystem dir copy with -force} -setup {
    set dir [pwd]
    cd [tcltest::temporaryDirectory]
    file delete -force simpledir
    file mkdir simpledir
    file mkdir dir2
    set fout [open [file join simpledir simplefile] w]







|







662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
    lappend res $err
    lappend res [file exists file2]
} -cleanup {
    testsimplefilesystem 0
    file delete -force simplefile
    file delete -force file2
    cd $dir
} -result {0 {} 1 {error copying "simplefs:/simplefile" to "file2": file already exists} 0 {} 1}
test filesystem-7.6 {cross-filesystem dir copy with -force} -setup {
    set dir [pwd]
    cd [tcltest::temporaryDirectory]
    file delete -force simpledir
    file mkdir simpledir
    file mkdir dir2
    set fout [open [file join simpledir simplefile] w]