TIP #594: Modernize "file stat" interface

3 files changed, 82 insertions, 32 deletions

diff --git a/doc/file.n b/doc/file.n
index daa0ad8..bb6a7d3 100644
--- a/doc/file.n
+++ b/doc/file.n
@@ -269,14 +269,14 @@ symbolic and hard links (the latter for files only). Windows
 supports symbolic directory links and hard file links on NTFS drives.
 .RE
 .TP
-\fBfile lstat \fIname varName\fR
+\fBfile lstat \fIname ?varName?\fR
 .
 Same as \fBstat\fR option (see below) except uses the \fIlstat\fR
 kernel call instead of \fIstat\fR.  This means that if \fIname\fR
-refers to a symbolic link the information returned in \fIvarName\fR
-is for the link rather than the file it refers to.  On systems that
-do not support symbolic links this option behaves exactly the same
-as the \fBstat\fR option.
+refers to a symbolic link the information returned is for the link
+rather than the file it refers to.  On systems that do not support
+symbolic links this option behaves exactly the same as the
+\fBstat\fR option.
 .TP
 \fBfile mkdir\fR ?\fIdir\fR ...?
 .
@@ -411,19 +411,20 @@ that use the third component do not attempt to perform tilde
 substitution.
 .RE
 .TP
-\fBfile stat \fIname varName\fR
-.
-Invokes the \fBstat\fR kernel call on \fIname\fR, and uses the variable
-given by \fIvarName\fR to hold information returned from the kernel call.
-\fIVarName\fR is treated as an array variable, and the following elements
-of that variable are set: \fBatime\fR, \fBctime\fR, \fBdev\fR, \fBgid\fR,
-\fBino\fR, \fBmode\fR, \fBmtime\fR, \fBnlink\fR, \fBsize\fR, \fBtype\fR,
-\fBuid\fR.  Each element except \fBtype\fR is a decimal string with the
-value of the corresponding field from the \fBstat\fR return structure;
-see the manual entry for \fBstat\fR for details on the meanings of the
-values.  The \fBtype\fR element gives the type of the file in the same
-form returned by the command \fBfile type\fR.  This command returns an
-empty string.
+\fBfile stat \fIname ?varName?\fR
+.
+Invokes the \fBstat\fR kernel call on \fIname\fR, and returns a
+dictionary with the information returned from the kernel call. If
+\fIvarName\fR is given, it uses the variable to hold the information.
+\fIVarName\fR is treated as an array variable, and in such case the
+command returns the empty string. The following elements are set:
+\fBatime\fR, \fBctime\fR, \fBdev\fR, \fBgid\fR, \fBino\fR, \fBmode\fR,
+\fBmtime\fR, \fBnlink\fR, \fBsize\fR, \fBtype\fR, \fBuid\fR.  Each element
+except \fBtype\fR is a decimal string with the value of the corresponding
+field from the \fBstat\fR return structure; see the manual entry for
+\fBstat\fR for details on the meanings of the values.  The \fBtype\fR
+element gives the type of the file in the same form returned by the
+command \fBfile type\fR.
 .TP
 \fBfile system \fIname\fR
 .
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 092bbd1..07541bd 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -1412,14 +1412,18 @@ FileAttrLinkStatCmd(
 {
     Tcl_StatBuf buf;
 
-    if (objc != 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "name varName");
+    if (objc < 2 || objc > 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "name ?varName?");
 	return TCL_ERROR;
     }
     if (GetStatBuf(interp, objv[1], Tcl_FSLstat, &buf) != TCL_OK) {
 	return TCL_ERROR;
     }
-    return StoreStatData(interp, objv[2], &buf);
+    if (objc == 2) {
+	return StoreStatData(interp, NULL, &buf);
+    } else {
+	return StoreStatData(interp, objv[2], &buf);
+    }
 }
 
 /*
@@ -1448,14 +1452,18 @@ FileAttrStatCmd(
 {
     Tcl_StatBuf buf;
 
-    if (objc != 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "name varName");
+    if (objc < 2 || objc > 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "name ?varName?");
 	return TCL_ERROR;
     }
     if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
 	return TCL_ERROR;
     }
-    return StoreStatData(interp, objv[2], &buf);
+    if (objc == 2) {
+	return StoreStatData(interp, NULL, &buf);
+    } else {
+	return StoreStatData(interp, objv[2], &buf);
+    }
 }
 
 /*
@@ -2355,7 +2363,7 @@ GetStatBuf(
  *
  *	This is a utility procedure that breaks out the fields of a "stat"
  *	structure and stores them in textual form into the elements of an
- *	associative array.
+ *	associative array (if given) or returns a dictionary.
  *
  * Results:
  *	Returns a standard Tcl return value. If an error occurs then a message
@@ -2375,9 +2383,40 @@ StoreStatData(
     Tcl_StatBuf *statPtr)	/* Pointer to buffer containing stat data to
 				 * store in varName. */
 {
-    Tcl_Obj *field, *value;
+    Tcl_Obj *field, *value, *result;
     unsigned short mode;
 
+    if (varName == NULL) {
+        result = Tcl_NewObj();
+        Tcl_IncrRefCount(result);
+#define DOBJPUT(key, objValue)                  \
+        Tcl_DictObjPut(NULL, result,            \
+            Tcl_NewStringObj((key), -1),        \
+            (objValue));
+        DOBJPUT("dev",	Tcl_NewWideIntObj((long)statPtr->st_dev));
+        DOBJPUT("ino",	Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_ino));
+        DOBJPUT("nlink",	Tcl_NewWideIntObj((long)statPtr->st_nlink));
+        DOBJPUT("uid",	Tcl_NewWideIntObj((long)statPtr->st_uid));
+        DOBJPUT("gid",	Tcl_NewWideIntObj((long)statPtr->st_gid));
+        DOBJPUT("size",	Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_size));
+#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
+        DOBJPUT("blocks",	Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_blocks));
+#endif
+#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
+        DOBJPUT("blksize", Tcl_NewWideIntObj((long)statPtr->st_blksize));
+#endif
+        DOBJPUT("atime",	Tcl_NewWideIntObj(Tcl_GetAccessTimeFromStat(statPtr)));
+        DOBJPUT("mtime",	Tcl_NewWideIntObj(Tcl_GetModificationTimeFromStat(statPtr)));
+        DOBJPUT("ctime",	Tcl_NewWideIntObj(Tcl_GetChangeTimeFromStat(statPtr)));
+        mode = (unsigned short) statPtr->st_mode;
+        DOBJPUT("mode",	Tcl_NewWideIntObj(mode));
+        DOBJPUT("type",	Tcl_NewStringObj(GetTypeFromMode(mode), -1));
+#undef DOBJPUT
+        Tcl_SetObjResult(interp, result);
+        Tcl_DecrRefCount(result);
+        return TCL_OK;
+    }
+
     /*
      * Assume Tcl_ObjSetVar2() does not keep a copy of the field name!
      *
diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index a734541..a9e199e 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -1194,10 +1194,10 @@ test cmdAH-22.3 {Tcl_FileObjCmd: isfile} {file isfile $dirfile} 0
 catch {file link -symbolic $linkfile $gorpfile}
 test cmdAH-23.1 {Tcl_FileObjCmd: lstat} -returnCodes error -body {
     file lstat a
-} -result {wrong # args: should be "file lstat name varName"}
+} -result {could not read "a": no such file or directory}
 test cmdAH-23.2 {Tcl_FileObjCmd: lstat} -returnCodes error -body {
     file lstat a b c
-} -result {wrong # args: should be "file lstat name varName"}
+} -result {wrong # args: should be "file lstat name ?varName?"}
 test cmdAH-23.3 {Tcl_FileObjCmd: lstat} -setup {
     unset -nocomplain stat
 } -constraints {unix nonPortable} -body {
@@ -1527,14 +1527,14 @@ catch {file attributes $gorpfile -permissions 0o765}
 
 # stat
 test cmdAH-28.1 {Tcl_FileObjCmd: stat} -returnCodes error -body {
-    file stat _bogus_
-} -result {wrong # args: should be "file stat name varName"}
+    file stat
+} -result {wrong # args: should be "file stat name ?varName?"}
 test cmdAH-28.2 {Tcl_FileObjCmd: stat} -returnCodes error -body {
     file stat _bogus_ a b
-} -result {wrong # args: should be "file stat name varName"}
+} -result {wrong # args: should be "file stat name ?varName?"}
 test cmdAH-28.3 {Tcl_FileObjCmd: stat} -setup {
     unset -nocomplain stat
-    set stat(blocks) [set stat(blksize) {}]
+    array set stat {blocks {} blksize {}}
 } -body {
     file stat $gorpfile stat
     unset stat(blocks) stat(blksize); # Ignore these fields; not always set
@@ -1627,6 +1627,16 @@ test cmdAH-28.13.1 {Tcl_FileObjCmd: stat (built-in Windows names)} -constraints
     }
     set res
 } -result {0 0 -1 0 0 8630 0 0 0 characterSpecial 0}
+test cmdAH-28.14 {Tcl_FileObjCmd: stat} -setup {
+    unset -nocomplain stat
+} -body {
+    file stat $gorpfile stat
+    expr {
+		[lsort -stride 2 [array get stat]]
+		eq
+		[lsort -stride 2 [file stat $gorpfile]]
+	}
+} -result {1}
 unset -nocomplain stat
 
 # type