summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2009-12-28 13:53:40 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2009-12-28 13:53:40 (GMT)
commit28c061614a5610548f9c14ac2b02a06260223f3c (patch)
tree9c91a854f863f5c7082c60168418c2fc5a9410ed
parent016e636e5322d845b59bb6ecd6754894b9a98aec (diff)
downloadtcl-28c061614a5610548f9c14ac2b02a06260223f3c.zip
tcl-28c061614a5610548f9c14ac2b02a06260223f3c.tar.gz
tcl-28c061614a5610548f9c14ac2b02a06260223f3c.tar.bz2
[Bug 942170]: Detect the st_blocks field of 'struct stat' correctly.
-rw-r--r--ChangeLog5
-rw-r--r--generic/tclCmdAH.c19
-rw-r--r--generic/tclIOUtil.c43
-rw-r--r--generic/tclTest.c8
-rw-r--r--tests/cmdAH.test4
-rw-r--r--unix/configure.in8
6 files changed, 46 insertions, 41 deletions
diff --git a/ChangeLog b/ChangeLog
index ff75e4f..c0c590e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,10 @@
2009-12-28 Donal K. Fellows <dkf@users.sf.net>
+ * unix/configure.in: [Bug 942170]: Detect the st_blocks field of
+ * generic/tclCmdAH.c (StoreStatData): 'struct stat' correctly.
+ * generic/tclIOUtil.c (Tcl_Stat, Tcl_FSStat):
+ * generic/tclTest.c (PretendTclpStat):
+
* generic/tclInterp.c (TimeLimitCallback): [Bug 2891362]: Ensure that
* tests/interp.test (interp-34.13): the granularity ticker is
reset when we check limits because of the time limit event firing.
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index abcb083..5b7cd34 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCmdAH.c,v 1.93.2.1 2008/07/21 19:38:17 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclCmdAH.c,v 1.93.2.2 2009/12/28 13:53:40 dkf Exp $
*/
#include "tclInt.h"
@@ -1500,13 +1500,13 @@ StoreStatData(
*/
#define STORE_ARY(fieldName, object) \
- TclNewLiteralStringObj(field, fieldName); \
- Tcl_IncrRefCount(field); \
- value = (object); \
+ TclNewLiteralStringObj(field, fieldName); \
+ Tcl_IncrRefCount(field); \
+ value = (object); \
if (Tcl_ObjSetVar2(interp,varName,field,value,TCL_LEAVE_ERR_MSG)==NULL) { \
- TclDecrRefCount(field); \
- return TCL_ERROR; \
- } \
+ TclDecrRefCount(field); \
+ return TCL_ERROR; \
+ } \
TclDecrRefCount(field);
/*
@@ -1520,9 +1520,12 @@ StoreStatData(
STORE_ARY("uid", Tcl_NewLongObj((long)statPtr->st_uid));
STORE_ARY("gid", Tcl_NewLongObj((long)statPtr->st_gid));
STORE_ARY("size", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_size));
-#ifdef HAVE_ST_BLOCKS
+#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
STORE_ARY("blocks", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_blocks));
#endif
+#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
+ STORE_ARY("blksize", Tcl_NewLongObj((long)statPtr->st_blksize));
+#endif
STORE_ARY("atime", Tcl_NewLongObj((long)statPtr->st_atime));
STORE_ARY("mtime", Tcl_NewLongObj((long)statPtr->st_mtime));
STORE_ARY("ctime", Tcl_NewLongObj((long)statPtr->st_ctime));
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 396acd7..6c1e64b 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -17,7 +17,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclIOUtil.c,v 1.151.2.1 2008/11/14 00:22:39 nijtmans Exp $
+ * RCS: @(#) $Id: tclIOUtil.c,v 1.151.2.2 2009/12/28 13:53:40 dkf Exp $
*/
#include "tclInt.h"
@@ -66,20 +66,14 @@ Tcl_Stat(
{
int ret;
Tcl_StatBuf buf;
- Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1);
-
-#ifndef TCL_WIDE_INT_IS_LONG
- Tcl_WideInt tmp1, tmp2;
-#ifdef HAVE_ST_BLOCKS
- Tcl_WideInt tmp3;
-#endif
-#endif
+ Tcl_Obj *pathPtr = Tcl_NewStringObj(path, -1);
Tcl_IncrRefCount(pathPtr);
ret = Tcl_FSStat(pathPtr, &buf);
Tcl_DecrRefCount(pathPtr);
if (ret != -1) {
#ifndef TCL_WIDE_INT_IS_LONG
+ Tcl_WideInt tmp1, tmp2, tmp3 = 0;
# define OUT_OF_RANGE(x) \
(((Tcl_WideInt)(x)) < Tcl_LongAsWide(LONG_MIN) || \
((Tcl_WideInt)(x)) > Tcl_LongAsWide(LONG_MAX))
@@ -91,29 +85,24 @@ Tcl_Stat(
*
* Note that ino_t/ino64_t is unsigned...
*
- * Workaround gcc warning of "comparison is always false due to limited range of
- * data type" by assigning to tmp var of type Tcl_WideInt.
+ * Workaround gcc warning of "comparison is always false due to
+ * limited range of data type" by assigning to tmp var of type
+ * Tcl_WideInt.
*/
tmp1 = (Tcl_WideInt) buf.st_ino;
tmp2 = (Tcl_WideInt) buf.st_size;
-#ifdef HAVE_ST_BLOCKS
+#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
tmp3 = (Tcl_WideInt) buf.st_blocks;
#endif
- if (OUT_OF_URANGE(tmp1) || OUT_OF_RANGE(tmp2)
-#ifdef HAVE_ST_BLOCKS
- || OUT_OF_RANGE(tmp3)
-#endif
- ) {
-#ifdef EFBIG
+ if (OUT_OF_URANGE(tmp1) || OUT_OF_RANGE(tmp2) || OUT_OF_RANGE(tmp3)) {
+#if defined(EFBIG)
errno = EFBIG;
-#else
-# ifdef EOVERFLOW
+#elif defined(EOVERFLOW)
errno = EOVERFLOW;
-# else
-# error "What status should be returned for file size out of range?"
-# endif
+#else
+#error "What status should be returned for file size out of range?"
#endif
return -1;
}
@@ -141,8 +130,10 @@ Tcl_Stat(
oldStyleBuf->st_atime = buf.st_atime;
oldStyleBuf->st_mtime = buf.st_mtime;
oldStyleBuf->st_ctime = buf.st_ctime;
-#ifdef HAVE_ST_BLOCKS
+#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
oldStyleBuf->st_blksize = buf.st_blksize;
+#endif
+#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
oldStyleBuf->st_blocks = (blkcnt_t) buf.st_blocks;
#endif
}
@@ -2002,8 +1993,10 @@ Tcl_FSStat(
buf->st_atime = oldStyleStatBuffer.st_atime;
buf->st_mtime = oldStyleStatBuffer.st_mtime;
buf->st_ctime = oldStyleStatBuffer.st_ctime;
-#ifdef HAVE_ST_BLOCKS
+#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
buf->st_blksize = oldStyleStatBuffer.st_blksize;
+#endif
+#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
buf->st_blocks = Tcl_LongAsWide(oldStyleStatBuffer.st_blocks);
#endif
return retVal;
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 1da98b8..f92c0cd 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -14,7 +14,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclTest.c,v 1.114.2.3 2009/12/12 19:46:32 dkf Exp $
+ * RCS: @(#) $Id: tclTest.c,v 1.114.2.4 2009/12/28 13:53:40 dkf Exp $
*/
#define TCL_TEST
@@ -5101,7 +5101,7 @@ PretendTclpStat(
*/
if (OUT_OF_URANGE(realBuf.st_ino) || OUT_OF_RANGE(realBuf.st_size)
-# ifdef HAVE_ST_BLOCKS
+# ifdef HAVE_STRUCT_STAT_ST_BLOCKS
|| OUT_OF_RANGE(realBuf.st_blocks)
# endif
) {
@@ -5139,8 +5139,10 @@ PretendTclpStat(
buf->st_atime = realBuf.st_atime;
buf->st_mtime = realBuf.st_mtime;
buf->st_ctime = realBuf.st_ctime;
-# ifdef HAVE_ST_BLOCKS
+# ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
buf->st_blksize = realBuf.st_blksize;
+# endif
+# ifdef HAVE_STRUCT_STAT_ST_BLOCKS
buf->st_blocks = (blkcnt_t) realBuf.st_blocks;
# endif
}
diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index 44316c5..d573bb9 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -10,7 +10,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: cmdAH.test,v 1.57 2007/12/13 15:26:06 dgp Exp $
+# RCS: @(#) $Id: cmdAH.test,v 1.57.2.1 2009/12/28 13:53:40 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2.1
@@ -1321,7 +1321,9 @@ test cmdAH-28.2 {Tcl_FileObjCmd: stat} {
} {1 {wrong # args: should be "file stat name varName"} NONE}
test cmdAH-28.3 {Tcl_FileObjCmd: stat} {
catch {unset stat}
+ set stat(blocks) [set stat(blksize) {}]
file stat $gorpfile stat
+ unset stat(blocks) stat(blksize)
lsort [array names stat]
} {atime ctime dev gid ino mode mtime nlink size type uid}
test cmdAH-28.4 {Tcl_FileObjCmd: stat} {
diff --git a/unix/configure.in b/unix/configure.in
index ac4cba7..6f2073f 100644
--- a/unix/configure.in
+++ b/unix/configure.in
@@ -3,7 +3,7 @@ dnl This file is an input file used by the GNU "autoconf" program to
dnl generate the file "configure", which is run during Tcl installation
dnl to configure the system for the local environment.
#
-# RCS: @(#) $Id: configure.in,v 1.180.2.14 2009/11/25 14:31:40 stwo Exp $
+# RCS: @(#) $Id: configure.in,v 1.180.2.15 2009/12/28 13:53:40 dkf Exp $
AC_INIT([tcl],[8.5])
AC_PREREQ(2.59)
@@ -244,11 +244,11 @@ fi
SC_TIME_HANDLER
#--------------------------------------------------------------------
-# Some systems (e.g., IRIX 4.0.5) lack the st_blksize field
-# in struct stat. But we might be able to use fstatfs instead.
+# Some systems (e.g., IRIX 4.0.5) lack some fields in struct stat. But
+# we might be able to use fstatfs instead.
#--------------------------------------------------------------------
-AC_CHECK_MEMBERS([struct stat.st_blksize])
+AC_CHECK_MEMBERS([struct stat.st_blocks, struct stat.st_blksize])
AC_CHECK_FUNC(fstatfs, , [AC_DEFINE(NO_FSTATFS, 1, [Do we have fstatfs()?])])
#--------------------------------------------------------------------