Tcl Source Code

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "name ?time?");
	return TCL_ERROR;
    }
    if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
	return TCL_ERROR;
    }
#if defined(_WIN32)
    /* We use a value of 0 to indicate the access time not available */
    if (buf.st_atime == 0) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                             "could not get access time for file \"%s\"",
                             TclGetString(objv[1])));
        return TCL_ERROR;
    }
#endif

    if (objc == 3) {
	/*
	 * Need separate variable for reading longs from an object on 64-bit
	 * platforms. [Bug 698146]
	 */

	long newTime;

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "name ?time?");
	return TCL_ERROR;
    }
    if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
	return TCL_ERROR;
    }
#if defined(_WIN32)
    /* We use a value of 0 to indicate the modification time not available */
    if (buf.st_mtime == 0) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                             "could not get modification time for file \"%s\"",
                             TclGetString(objv[1])));
        return TCL_ERROR;
    }
#endif
    if (objc == 3) {
	/*
	 * Need separate variable for reading longs from an object on 64-bit
	 * platforms. [Bug 698146]
	 */

	long newTime;

    cd $old
    set atime [file atime $file]
    after 1100; # pause a sec to notice change in atime
    set newatime [clock seconds]
    set modatime [file atime $file $newatime]
    expr {$newatime == $modatime ? 1 : "$newatime != $modatime"}
} -result 1
test cmdAH-20.7 {
    Tcl_FileObjCmd: atime (built-in Windows names)
} -constraints {win} -body {
    file atime con
} -result "could not get access time for file \"con\"" -returnCodes error
test cmdAH-20.7.1 {
    Tcl_FileObjCmd: atime (built-in Windows names with dir path and extension)
} -constraints {win} -body {
    file atime [file join [temporaryDirectory] CON.txt]
} -result "could not get access time for file \"[file join [temporaryDirectory] CON.txt]\"" -returnCodes error

if {[testConstraint unix] && [file exists /tmp]} {
    removeFile touch.me /tmp
} else {
    removeFile touch.me
}

    set old [file mtime $dirname]
    file mtime $dirname 0
    set new [file mtime $dirname]
    list $new [expr {$old != $new}]
} -cleanup {
    file delete -force $dirname
} -result {0 1}
test cmdAH-24.14 {
    Tcl_FileObjCmd: mtime (built-in Windows names)
} -constraints {win} -body {
    file mtime con
} -result "could not get modification time for file \"con\"" -returnCodes error
test cmdAH-24.14.1 {
    Tcl_FileObjCmd: mtime (built-in Windows names with dir path and extension)
} -constraints {win} -body {
    file mtime [file join [temporaryDirectory] CON.txt]
} -result "could not get modification time for file \"[file join [temporaryDirectory] CON.txt]\"" -returnCodes error

# 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

    puts $f "More text"
    close $f
    expr {[file size $gorpfile] - $oldsize}
} {10}
test cmdAH-27.3 {Tcl_FileObjCmd: size} {
    list [catch {file size _bogus_} msg] [string tolower $msg] $errorCode
} {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}}
test cmdAH-27.4 {
    Tcl_FileObjCmd: size (built-in Windows names)
} -constraints {win} -body {
    file size con
} -result 0
test cmdAH-27.4.1 {
    Tcl_FileObjCmd: size (built-in Windows names with dir path and extension)
} -constraints {win} -body {
    file size [file join [temporaryDirectory] con.txt]
} -result 0

catch {testsetplatform $platform}
removeFile $gorpfile
set gorpfile [makeFile "Test string" gorp.file]
catch {file attributes $gorpfile -permissions 0765}

# stat

    # stat(mode) with S_IFREG flag was returned as a negative number if mode_t
    # was a short instead of an unsigned short.
    file stat $filename stat
    expr {$stat(mode) > 0}
} -cleanup {
    removeFile $filename
} -result 1
test cmdAH-28.13 {Tcl_FileObjCmd: stat (built-in Windows names)} -setup {
    unset -nocomplain stat
} -body {
    file stat con stat
    lmap elem {atime ctime dev gid ino mode mtime nlink size type uid} {set stat($elem)}
} -result {0 0 -1 0 0 8630 0 0 0 characterSpecial 0}
test cmdAH-28.13.1 {Tcl_FileObjCmd: stat (built-in Windows names)} -setup {
    unset -nocomplain stat
} -body {
    file stat [file join [temporaryDirectory] CON.txt] stat
    lmap elem {atime ctime dev gid ino mode mtime nlink size type uid} {set stat($elem)}
} -result {0 0 -1 0 0 8630 0 0 0 characterSpecial 0}
unset -nocomplain stat

# type
test cmdAH-29.1 {Tcl_FileObjCmd: type} -returnCodes error -body {
    file type a b
} -result {wrong # args: should be "file type name"}
test cmdAH-29.2 {Tcl_FileObjCmd: type} {
    file type $dirfile
} directory
test cmdAH-29.3.0 {Tcl_FileObjCmd: delete removes link not file} {unix nonPortable} {
    set exists [list [file exists $linkfile] [file exists $gorpfile]]
    file delete $linkfile
    set exists2	[list [file exists $linkfile] [file exists $gorpfile]]

} -cleanup {
    file delete $linkdir
    removeDirectory $tempdir
} -result link
test cmdAH-29.5 {Tcl_FileObjCmd: type} {
    list [catch {file type _bogus_} msg] [string tolower $msg] $errorCode
} {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}}
test cmdAH-29.6 {
    Tcl_FileObjCmd: type (built-in Windows names)
} -constraints {win} -body {
    file type con
} -result "characterSpecial"
test cmdAH-29.6.1 {
    Tcl_FileObjCmd: type (built-in Windows names, with dir path and extension)
} -constraints {win} -body {
    file type [file join [temporaryDirectory] CON.txt]
} -result "characterSpecial"

# Error conditions
test cmdAH-30.1 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
    file gorp x
} -result {unknown or ambiguous subcommand "gorp": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mkdir, mtime, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempfile, type, volumes, or writable}
test cmdAH-30.2 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
    file ex x

    int checkLinks)		/* If non-zero, behave like 'lstat' */
{
    DWORD attr;
    int dev, nlink = 1;
    unsigned short mode;
    unsigned int inode = 0;
    HANDLE fileHandle;
    DWORD fileType = FILE_TYPE_UNKNOWN;

    /*
     * If we can use 'createFile' on this, then we can use the resulting
     * fileHandle to read more information (nlink, ino) than we can get from
     * other attributes reading APIs. If not, then we try to fall back on the
     * 'getFileAttributesExProc', and if that isn't available, then on even
     * simpler routines.
     *
     * Special consideration must be given to Windows hardcoded names
     * like CON, NULL, COM1, LPT1 etc. For these, we still need to
     * do the CreateFile as some may not exist (e.g. there is no CON
     * in wish by default). However the subsequent GetFileInformationByHandle
     * will fail. We do a WinIsReserved to see if it is one of the special
     * names, and if successful, mock up a BY_HANDLE_FILE_INFORMATION
     * structure.
     */

    fileHandle = CreateFile(nativePath, GENERIC_READ,
	    FILE_SHARE_READ | FILE_SHARE_WRITE, NULL, OPEN_EXISTING,
	    FILE_FLAG_BACKUP_SEMANTICS | FILE_FLAG_OPEN_REPARSE_POINT, NULL);

    if (fileHandle != INVALID_HANDLE_VALUE) {
	BY_HANDLE_FILE_INFORMATION data;

	if (GetFileInformationByHandle(fileHandle,&data) != TRUE) {
            fileType = GetFileType(fileHandle);
            CloseHandle(fileHandle);
            if (fileType != FILE_TYPE_CHAR && fileType != FILE_TYPE_DISK) {
                Tcl_SetErrno(ENOENT);
                return -1;
            }
            /* Mock up the expected structure */
            memset(&data, 0, sizeof(data));
            statPtr->st_atime = 0;
            statPtr->st_mtime = 0;
            statPtr->st_ctime = 0;
        } else {
            CloseHandle(fileHandle);
            statPtr->st_atime = ToCTime(data.ftLastAccessTime);
            statPtr->st_mtime = ToCTime(data.ftLastWriteTime);
            statPtr->st_ctime = ToCTime(data.ftCreationTime);
        }
	attr = data.dwFileAttributes;

	statPtr->st_size = ((Tcl_WideInt) data.nFileSizeLow) |
		(((Tcl_WideInt) data.nFileSizeHigh) << 32);




	/*
	 * On Unix, for directories, nlink apparently depends on the number of
	 * files in the directory.  We could calculate that, but it would be a
	 * bit of a performance penalty, I think. Hence we just use what
	 * Windows gives us, which is the same as Unix for files, at least.
	 */

	statPtr->st_atime = ToCTime(data.ftLastAccessTime);
	statPtr->st_mtime = ToCTime(data.ftLastWriteTime);
	statPtr->st_ctime = ToCTime(data.ftCreationTime);
    }

    dev = NativeDev(nativePath);
    mode = NativeStatMode(attr, checkLinks, NativeIsExec(nativePath));
    if (fileType == FILE_TYPE_CHAR) {
        mode &= ~S_IFMT;
        mode |= S_IFCHR;
    } else if (fileType == FILE_TYPE_DISK) {
        mode &= ~S_IFMT;
        mode |= S_IFBLK;
    }

    statPtr->st_dev	= (dev_t) dev;
    statPtr->st_ino	= inode;
    statPtr->st_mode	= mode;
    statPtr->st_nlink	= nlink;
    statPtr->st_uid	= 0;
    statPtr->st_gid	= 0;

 * defined.
 */

#ifndef S_IFLNK
#   define S_IFLNK        0120000  /* Symbolic Link */
#endif

/* 
 * Windows compilers do not define S_IFBLK. However, Tcl uses it in
 * GetTypeFromMode to identify blockSpecial devices based on the
 * value in the statsbuf st_mode field. We have no other way to pass this
 * from NativeStat on Windows so are forced to define it here.
 * The definition here is essentially what is seen on Linux and MingW.
 * XXX - the root problem is Tcl using Unix definitions instead of
 * abstracting the structure into a platform independent one. Sigh - perhaps
 * Tcl 9
 */
#ifndef S_IFBLK
#   define S_IFBLK (S_IFDIR | S_IFCHR)
#endif

#ifndef S_ISREG
#   ifdef S_IFREG
#       define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
#   else
#       define S_ISREG(m) 0
#   endif
#endif /* !S_ISREG */