diff options
| -rw-r--r-- | ChangeLog | 5 | ||||
| -rw-r--r-- | generic/tclCmdAH.c | 9 | ||||
| -rw-r--r-- | generic/tclFileName.c | 13 | ||||
| -rw-r--r-- | generic/tclIOUtil.c | 32 | ||||
| -rw-r--r-- | tests/cmdAH.test | 4 | ||||
| -rw-r--r-- | unix/configure.in | 8 |
6 files changed, 37 insertions, 34 deletions
@@ -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/tclFileName.c (Tcl_GetBlocksFromStat): + * generic/tclIOUtil.c (Tcl_Stat): + * 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 95e6fd8..4edfdec 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.122 2009/11/18 21:59:51 nijtmans Exp $ + * RCS: @(#) $Id: tclCmdAH.c,v 1.123 2009/12/28 12:55:48 dkf Exp $ */ #include "tclInt.h" @@ -1614,7 +1614,7 @@ StoreStatData( /* * Watch out porters; the inode is meant to be an *unsigned* value, so the - * cast might fail when there isn't a real arithmentic 'long long' type... + * cast might fail when there isn't a real arithmetic 'long long' type... */ STORE_ARY("dev", Tcl_NewLongObj((long)statPtr->st_dev)); @@ -1623,9 +1623,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/tclFileName.c b/generic/tclFileName.c index 664ba94..8a25eb4 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.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: tclFileName.c,v 1.99 2009/12/21 23:25:40 nijtmans Exp $ + * RCS: @(#) $Id: tclFileName.c,v 1.100 2009/12/28 12:55:48 dkf Exp $ */ #include "tclInt.h" @@ -46,7 +46,7 @@ static int DoGlob(Tcl_Interp *interp, Tcl_Obj *resultPtr, * specific files. */ -#if (!defined(HAVE_ST_BLOCKS) && !defined(GUESSED_BLOCK_SIZE)) +#if (!defined(HAVE_STRUCT_STAT_ST_BLKSIZE) && !defined(GUESSED_BLOCK_SIZE)) #define GUESSED_BLOCK_SIZE 1024 #endif @@ -2672,11 +2672,12 @@ Tcl_WideUInt Tcl_GetBlocksFromStat( const Tcl_StatBuf *statPtr) { -#ifdef HAVE_ST_BLOCKS +#ifdef HAVE_STRUCT_STAT_ST_BLOCKS return (Tcl_WideUInt) statPtr->st_blocks; #else - return ((Tcl_WideUInt) statPtr->st_size - + (GUESSED_BLOCK_SIZE-1)) / GUESSED_BLOCK_SIZE; + register unsigned blksize = Tcl_GetBlockSizeFromStat(statPtr); + + return ((Tcl_WideUInt) statPtr->st_size + blksize - 1) / blksize; #endif } @@ -2684,7 +2685,7 @@ unsigned Tcl_GetBlockSizeFromStat( const Tcl_StatBuf *statPtr) { -#ifdef HAVE_ST_BLOCKS +#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE return (unsigned) statPtr->st_blksize; #else /* diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 79769c9..a077bab 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.165 2009/11/18 21:59:51 nijtmans Exp $ + * RCS: @(#) $Id: tclIOUtil.c,v 1.166 2009/12/28 12:55:48 dkf Exp $ */ #include "tclInt.h" @@ -224,18 +224,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_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)) @@ -254,23 +250,17 @@ Tcl_Stat( 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; } @@ -298,8 +288,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 } diff --git a/tests/cmdAH.test b/tests/cmdAH.test index c179eb6..182d43b 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.66 2009/01/08 16:41:34 dkf Exp $ +# RCS: @(#) $Id: cmdAH.test,v 1.67 2009/12/28 12:55:48 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2.1 @@ -1295,8 +1295,10 @@ test cmdAH-28.2 {Tcl_FileObjCmd: stat} -returnCodes error -body { } -result {wrong # args: should be "file stat name varName"} test cmdAH-28.3 {Tcl_FileObjCmd: stat} -setup { catch {unset stat} + set stat(blocks) [set stat(blksize) {}] } -body { file stat $gorpfile stat + unset stat(blocks) stat(blksize); # Ignore these fields; not always set lsort [array names stat] } -result {atime ctime dev gid ino mode mtime nlink size type uid} test cmdAH-28.4 {Tcl_FileObjCmd: stat} -setup { diff --git a/unix/configure.in b/unix/configure.in index bbed928..17e35ed 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.208 2009/11/25 14:25:57 stwo Exp $ +# RCS: @(#) $Id: configure.in,v 1.209 2009/12/28 12:55:48 dkf Exp $ AC_INIT([tcl],[8.6]) AC_PREREQ(2.59) @@ -278,11 +278,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()?])]) #-------------------------------------------------------------------- |