From fa0c0e6134dd5fa90b99a2156362074440f69f1b Mon Sep 17 00:00:00 2001 From: dkf Date: Sat, 19 Jun 2021 14:59:05 +0000 Subject: Start of implementing TIP 603: chan configure -stat --- unix/tclUnixChan.c | 169 ++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 168 insertions(+), 1 deletion(-) diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c index 4cb9af0..f5ab36e 100644 --- a/unix/tclUnixChan.c +++ b/unix/tclUnixChan.c @@ -124,6 +124,9 @@ static int FileCloseProc(void *instanceData, Tcl_Interp *interp, int flags); static int FileGetHandleProc(void *instanceData, int direction, void **handlePtr); +static int FileGetOptionProc(void *instanceData, + Tcl_Interp *interp, const char *optionName, + Tcl_DString *dsPtr); static int FileInputProc(void *instanceData, char *buf, int toRead, int *errorCode); static int FileOutputProc(void *instanceData, @@ -172,7 +175,7 @@ static const Tcl_ChannelType fileChannelType = { NULL, #endif NULL, /* Set option proc. */ - NULL, /* Get option proc. */ + FileGetOptionProc, /* Get option proc. */ FileWatchProc, /* Initialize notifier. */ FileGetHandleProc, /* Get OS handles out of channel. */ FileCloseProc, /* close2proc. */ @@ -603,6 +606,170 @@ FileGetHandleProc( return TCL_ERROR; } +/* + *---------------------------------------------------------------------- + * + * FileGetOptionProc -- + * + * Gets an option associated with an open file. If the optionName arg is + * non-NULL, retrieves the value of that option. If the optionName arg is + * NULL, retrieves a list of alternating option names and values for the + * given channel. + * + * Results: + * A standard Tcl result. Also sets the supplied DString to the string + * value of the option(s) returned. Sets error message if needed + * (by calling Tcl_BadChannelOption). + * + *---------------------------------------------------------------------- + */ + +static inline void +StoreElementInDict( + Tcl_Obj *dictObj, + const char *name, + Tcl_Obj *valueObj) +{ + /* + * We assume that the dict is being built fresh and that there's never any + * duplicate keys. + */ + + Tcl_Obj *nameObj = Tcl_NewStringObj(name, -1); + Tcl_DictObjPut(NULL, dictObj, nameObj, valueObj); +} + +static const char * +GetTypeFromMode( + int mode) +{ + /* + * TODO: deduplicate with tclCmdAH.c + */ + + if (S_ISREG(mode)) { + return "file"; + } else if (S_ISDIR(mode)) { + return "directory"; + } else if (S_ISCHR(mode)) { + return "characterSpecial"; + } else if (S_ISBLK(mode)) { + return "blockSpecial"; + } else if (S_ISFIFO(mode)) { + return "fifo"; +#ifdef S_ISLNK + } else if (S_ISLNK(mode)) { + return "link"; +#endif +#ifdef S_ISSOCK + } else if (S_ISSOCK(mode)) { + return "socket"; +#endif + } + return "unknown"; +} + +static Tcl_Obj * +StatOpenFile( + FileState *fsPtr) +{ + Tcl_StatBuf statBuf; + Tcl_Obj *dictObj; + unsigned short mode; + + if (fstat(fsPtr->fd, &statBuf) < 0) { + return NULL; + } + + /* + * TODO: merge with TIP 594 implementation (it's silly to have a + * duplicate!) + */ + + dictObj = Tcl_NewObj(); +#define STORE_ELEM(name, value) StoreElementInDict(dictObj, name, value) + + STORE_ELEM("dev", Tcl_NewWideIntObj((long)statBuf.st_dev)); + STORE_ELEM("ino", Tcl_NewWideIntObj((Tcl_WideInt)statBuf.st_ino)); + STORE_ELEM("nlink", Tcl_NewWideIntObj((long)statBuf.st_nlink)); + STORE_ELEM("uid", Tcl_NewWideIntObj((long)statBuf.st_uid)); + STORE_ELEM("gid", Tcl_NewWideIntObj((long)statBuf.st_gid)); + STORE_ELEM("size", Tcl_NewWideIntObj((Tcl_WideInt)statBuf.st_size)); +#ifdef HAVE_STRUCT_STAT_ST_BLOCKS + STORE_ELEM("blocks", Tcl_NewWideIntObj((Tcl_WideInt)statBuf.st_blocks)); +#endif +#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE + STORE_ELEM("blksize", Tcl_NewWideIntObj((long)statBuf.st_blksize)); +#endif + STORE_ELEM("atime", Tcl_NewWideIntObj( + Tcl_GetAccessTimeFromStat(&statBuf))); + STORE_ELEM("mtime", Tcl_NewWideIntObj( + Tcl_GetModificationTimeFromStat(&statBuf))); + STORE_ELEM("ctime", Tcl_NewWideIntObj( + Tcl_GetChangeTimeFromStat(&statBuf))); + mode = (unsigned short) statBuf.st_mode; + STORE_ELEM("mode", Tcl_NewWideIntObj(mode)); + STORE_ELEM("type", Tcl_NewStringObj(GetTypeFromMode(mode), -1)); +#undef STORE_ELEM + + return dictObj; +} + +static int +FileGetOptionProc( + void *instanceData, + Tcl_Interp *interp, + const char *optionName, + Tcl_DString *dsPtr) +{ + FileState *fsPtr = (FileState *)instanceData; + int valid = 0; /* Flag if valid option parsed. */ + int len; + + if (optionName == NULL) { + len = 0; + valid = 1; + } else { + len = strlen(optionName); + } + + /* + * Get option -stat + * Option is readonly and returned by [fconfigure chan -stat] but not + * returned by [fconfigure chan] without explicit option name. + */ + + if ((len > 1) && (strncmp(optionName, "-stat", len) == 0)) { + Tcl_Obj *dictObj = StatOpenFile(fsPtr); + const char *dictContents; + int dictLength; + + if (dictObj == NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't read file channel status: %s", + Tcl_PosixError(interp))); + return TCL_ERROR; + } + + /* + * Transfer dictionary to the DString. Note that we don't do this as + * an element as this is an option that can't be retrieved with a + * general probe. + */ + + dictContents = Tcl_GetStringFromObj(dictObj, &dictLength); + Tcl_DStringAppend(dsPtr, dictContents, dictLength); + Tcl_DecrRefCount(dictObj); + return TCL_OK; + } + + if (valid) { + return TCL_OK; + } + return Tcl_BadChannelOption(interp, optionName, + "stat"); +} + #ifdef SUPPORTS_TTY /* *---------------------------------------------------------------------- -- cgit v0.12 From 5ed49bbc61a1cb188a4b5a069f2de046b1d8d910 Mon Sep 17 00:00:00 2001 From: dkf Date: Sat, 19 Jun 2021 15:57:41 +0000 Subject: Added in missing field --- generic/tclCmdAH.c | 8 +- unix/configure | 276 +++++++++++++++++++++++++---------------------------- unix/configure.ac | 2 +- unix/tclUnixChan.c | 26 +++-- 4 files changed, 155 insertions(+), 157 deletions(-) diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 8e6200d..38e302f 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -2269,8 +2269,14 @@ StoreStatData( #ifdef HAVE_STRUCT_STAT_ST_BLKSIZE STORE_ARY("blksize", Tcl_NewWideIntObj((long)statPtr->st_blksize)); #endif +#ifdef HAVE_STRUCT_STAT_ST_RDEV + if (S_ISCHR(statPtr->st_mode) || S_ISBLK(statPtr->st_mode)) { + STORE_ARY("rdev", Tcl_NewWideIntObj((long) statPtr->st_rdev)); + } +#endif STORE_ARY("atime", Tcl_NewWideIntObj(Tcl_GetAccessTimeFromStat(statPtr))); - STORE_ARY("mtime", Tcl_NewWideIntObj(Tcl_GetModificationTimeFromStat(statPtr))); + STORE_ARY("mtime", Tcl_NewWideIntObj( + Tcl_GetModificationTimeFromStat(statPtr))); STORE_ARY("ctime", Tcl_NewWideIntObj(Tcl_GetChangeTimeFromStat(statPtr))); mode = (unsigned short) statPtr->st_mode; STORE_ARY("mode", Tcl_NewWideIntObj(mode)); diff --git a/unix/configure b/unix/configure index 98d3a50..94f754d 100755 --- a/unix/configure +++ b/unix/configure @@ -1,9 +1,10 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.70 for tcl 8.7. +# Generated by GNU Autoconf 2.71 for tcl 8.7. # # -# Copyright (C) 1992-1996, 1998-2017, 2020 Free Software Foundation, Inc. +# Copyright (C) 1992-1996, 1998-2017, 2020-2021 Free Software Foundation, +# Inc. # # # This configure script is free software; the Free Software Foundation @@ -1551,9 +1552,9 @@ test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF tcl configure 8.7 -generated by GNU Autoconf 2.70 +generated by GNU Autoconf 2.71 -Copyright (C) 2020 Free Software Foundation, Inc. +Copyright (C) 2021 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF @@ -1783,24 +1784,23 @@ printf "%s\n" "$ac_res" >&6; } } # ac_fn_c_check_func -# ac_fn_c_check_decl LINENO SYMBOL VAR INCLUDES -# --------------------------------------------- +# ac_fn_check_decl LINENO SYMBOL VAR INCLUDES EXTRA-OPTIONS FLAG-VAR +# ------------------------------------------------------------------ # Tests whether SYMBOL is declared in INCLUDES, setting cache variable VAR -# accordingly. -ac_fn_c_check_decl () +# accordingly. Pass EXTRA-OPTIONS to the compiler, using FLAG-VAR. +ac_fn_check_decl () { as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - # Initialize each $ac_[]_AC_LANG_ABBREV[]_decl_warn_flag once. - as_decl_name=`echo $2|sed 's/ *(.*//'` - as_decl_use=`echo $2|sed -e 's/(/((/' -e 's/)/) 0&/' -e 's/,/) 0& (/g'` + as_decl_name=`echo $2|sed 's/ *(.*//'` { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether $as_decl_name is declared" >&5 printf %s "checking whether $as_decl_name is declared... " >&6; } if eval test \${$3+y} then : printf %s "(cached) " >&6 else $as_nop - ac_save_werror_flag=$ac_c_werror_flag - ac_c_werror_flag="$ac_c_decl_warn_flag$ac_c_werror_flag" + as_decl_use=`echo $2|sed -e 's/(/((/' -e 's/)/) 0&/' -e 's/,/) 0& (/g'` + eval ac_save_FLAGS=\$$6 + as_fn_append $6 " $5" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ $4 @@ -1826,14 +1826,15 @@ else $as_nop eval "$3=no" fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext - ac_c_werror_flag=$ac_save_werror_flag + eval $6=\$ac_save_FLAGS + fi eval ac_res=\$$3 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 printf "%s\n" "$ac_res" >&6; } eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno -} # ac_fn_c_check_decl +} # ac_fn_check_decl # ac_fn_c_check_type LINENO TYPE VAR INCLUDES # ------------------------------------------- @@ -2019,7 +2020,7 @@ This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. It was created by tcl $as_me 8.7, which was -generated by GNU Autoconf 2.70. Invocation command line was +generated by GNU Autoconf 2.71. Invocation command line was $ $0$ac_configure_args_raw @@ -3650,7 +3651,10 @@ else CFLAGS= fi fi -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C11 features" >&5 +ac_prog_cc_stdc=no +if test x$ac_prog_cc_stdc = xno +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C11 features" >&5 printf %s "checking for $CC option to enable C11 features... " >&6; } if test ${ac_cv_prog_cc_c11+y} then : @@ -3674,28 +3678,28 @@ rm -f core conftest.err conftest.$ac_objext conftest.beam done rm -f conftest.$ac_ext CC=$ac_save_CC - fi -# AC_CACHE_VAL -ac_prog_cc_stdc_options= -case "x$ac_cv_prog_cc_c11" in #( - x) : - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 -printf "%s\n" "none needed" >&6; } ;; #( - xno) : - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 -printf "%s\n" "unsupported" >&6; } ;; #( - *) : - ac_prog_cc_stdc_options=" $ac_cv_prog_cc_c11" - CC="$CC$ac_prog_cc_stdc_options" - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c11" >&5 -printf "%s\n" "$ac_cv_prog_cc_c11" >&6; } ;; -esac -if test "x$ac_cv_prog_cc_c11" != xno + +if test "x$ac_cv_prog_cc_c11" = xno then : - ac_prog_cc_stdc=c11 - ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c11 + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +printf "%s\n" "unsupported" >&6; } +else $as_nop + if test "x$ac_cv_prog_cc_c11" = x +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +printf "%s\n" "none needed" >&6; } else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c11" >&5 +printf "%s\n" "$ac_cv_prog_cc_c11" >&6; } + CC="$CC $ac_cv_prog_cc_c11" +fi + ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c11 + ac_prog_cc_stdc=c11 +fi +fi +if test x$ac_prog_cc_stdc = xno +then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C99 features" >&5 printf %s "checking for $CC option to enable C99 features... " >&6; } if test ${ac_cv_prog_cc_c99+y} @@ -3706,9 +3710,9 @@ else $as_nop ac_save_CC=$CC cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ -$ac_c_conftest_c89_program +$ac_c_conftest_c99_program _ACEOF -for ac_arg in '' -std=gnu99 -std=c99 -c99 -AC99 -D_STDC_C99= -qlanglvl=extc1x -qlanglvl=extc99 +for ac_arg in '' -std=gnu99 -std=c99 -c99 -qlanglvl=extc1x -qlanglvl=extc99 -AC99 -D_STDC_C99= do CC="$ac_save_CC $ac_arg" if ac_fn_c_try_compile "$LINENO" @@ -3720,28 +3724,28 @@ rm -f core conftest.err conftest.$ac_objext conftest.beam done rm -f conftest.$ac_ext CC=$ac_save_CC - fi -# AC_CACHE_VAL -ac_prog_cc_stdc_options= -case "x$ac_cv_prog_cc_c99" in #( - x) : - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 -printf "%s\n" "none needed" >&6; } ;; #( - xno) : - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 -printf "%s\n" "unsupported" >&6; } ;; #( - *) : - ac_prog_cc_stdc_options=" $ac_cv_prog_cc_c99" - CC="$CC$ac_prog_cc_stdc_options" - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c99" >&5 -printf "%s\n" "$ac_cv_prog_cc_c99" >&6; } ;; -esac -if test "x$ac_cv_prog_cc_c99" != xno + +if test "x$ac_cv_prog_cc_c99" = xno then : - ac_prog_cc_stdc=c99 - ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c99 + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +printf "%s\n" "unsupported" >&6; } else $as_nop + if test "x$ac_cv_prog_cc_c99" = x +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +printf "%s\n" "none needed" >&6; } +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c99" >&5 +printf "%s\n" "$ac_cv_prog_cc_c99" >&6; } + CC="$CC $ac_cv_prog_cc_c99" +fi + ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c99 + ac_prog_cc_stdc=c99 +fi +fi +if test x$ac_prog_cc_stdc = xno +then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C89 features" >&5 printf %s "checking for $CC option to enable C89 features... " >&6; } if test ${ac_cv_prog_cc_c89+y} @@ -3754,8 +3758,7 @@ cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ $ac_c_conftest_c89_program _ACEOF -for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \ - -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" +for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" do CC="$ac_save_CC $ac_arg" if ac_fn_c_try_compile "$LINENO" @@ -3767,34 +3770,25 @@ rm -f core conftest.err conftest.$ac_objext conftest.beam done rm -f conftest.$ac_ext CC=$ac_save_CC - fi -# AC_CACHE_VAL -ac_prog_cc_stdc_options= -case "x$ac_cv_prog_cc_c89" in #( - x) : - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 -printf "%s\n" "none needed" >&6; } ;; #( - xno) : - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 -printf "%s\n" "unsupported" >&6; } ;; #( - *) : - ac_prog_cc_stdc_options=" $ac_cv_prog_cc_c89" - CC="$CC$ac_prog_cc_stdc_options" - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 -printf "%s\n" "$ac_cv_prog_cc_c89" >&6; } ;; -esac -if test "x$ac_cv_prog_cc_c89" != xno + +if test "x$ac_cv_prog_cc_c89" = xno then : - ac_prog_cc_stdc=c89 - ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c89 + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +printf "%s\n" "unsupported" >&6; } +else $as_nop + if test "x$ac_cv_prog_cc_c89" = x +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +printf "%s\n" "none needed" >&6; } else $as_nop - ac_prog_cc_stdc=no - ac_cv_prog_cc_stdc=no + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 +printf "%s\n" "$ac_cv_prog_cc_c89" >&6; } + CC="$CC $ac_cv_prog_cc_c89" fi - + ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c89 + ac_prog_cc_stdc=c89 fi - fi ac_ext=c @@ -4412,22 +4406,18 @@ printf "%s\n" "#define TCL_CFGVAL_ENCODING \"utf-8\"" >>confdefs.h # Look for libraries that we will need when compiling the Tcl shell #-------------------------------------------------------------------- -# The Clang compiler raises a warning for an undeclared identifier that matches -# a compiler builtin function. All extant Clang versions are affected, as of -# Clang 3.6.0. Test a builtin known to every version. This problem affects the -# C and Objective C languages, but Clang does report an error under C++ and -# Objective C++. -# -# Passing -fno-builtin to the compiler would suppress this problem. That -# strategy would have the advantage of being insensitive to stray warnings, but -# it would make tests less realistic. -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking how $CC reports undeclared, standard C functions" >&5 -printf %s "checking how $CC reports undeclared, standard C functions... " >&6; } -if test ${ac_cv_c_decl_report+y} +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC options needed to detect all undeclared functions" >&5 +printf %s "checking for $CC options needed to detect all undeclared functions... " >&6; } +if test ${ac_cv_c_undeclared_builtin_options+y} then : printf %s "(cached) " >&6 else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + ac_save_CFLAGS=$CFLAGS + ac_cv_c_undeclared_builtin_options='cannot detect' + for ac_arg in '' -fno-builtin; do + CFLAGS="$ac_save_CFLAGS $ac_arg" + # This test program should *not* compile successfully. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int @@ -4440,29 +4430,26 @@ main (void) _ACEOF if ac_fn_c_try_compile "$LINENO" then : - if test -s conftest.err -then : - # For AC_CHECK_DECL to react to warnings, the compiler must be silent on - # valid AC_CHECK_DECL input. No library function is consistently available - # on freestanding implementations, so test against a dummy declaration. - # Include always-available headers on the off chance that they somehow - # elicit warnings. - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + +else $as_nop + # This test program should compile successfully. + # No library function is consistently available on + # freestanding implementations, so test against a dummy + # declaration. Include always-available headers on the + # off chance that they somehow elicit warnings. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include #include #include #include extern void ac_decl (int, char *); + int main (void) { -#ifdef __cplusplus - (void) ac_decl ((int) 0, (char *) 0); - (void) ac_decl; -#else +(void) ac_decl (0, (char *) 0); (void) ac_decl; -#endif ; return 0; @@ -4470,39 +4457,33 @@ main (void) _ACEOF if ac_fn_c_try_compile "$LINENO" then : - if test -s conftest.err + if test x"$ac_arg" = x then : - { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error $? "cannot detect from compiler exit status or warnings -See \`config.log' for more details" "$LINENO" 5; } + ac_cv_c_undeclared_builtin_options='none needed' else $as_nop - ac_cv_c_decl_report=warning + ac_cv_c_undeclared_builtin_options=$ac_arg fi -else $as_nop - { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error $? "cannot compile a simple declaration test -See \`config.log' for more details" "$LINENO" 5; } + break fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext -else $as_nop - { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error $? "compiler does not report undeclared identifiers -See \`config.log' for more details" "$LINENO" 5; } -fi -else $as_nop - ac_cv_c_decl_report=error fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext -fi -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_decl_report" >&5 -printf "%s\n" "$ac_cv_c_decl_report" >&6; } + done + CFLAGS=$ac_save_CFLAGS -case $ac_cv_c_decl_report in - warning) ac_c_decl_warn_flag=yes ;; - *) ac_c_decl_warn_flag= ;; +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_undeclared_builtin_options" >&5 +printf "%s\n" "$ac_cv_c_undeclared_builtin_options" >&6; } + case $ac_cv_c_undeclared_builtin_options in #( + 'cannot detect') : + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot make $CC report undeclared builtins +See \`config.log' for more details" "$LINENO" 5; } ;; #( + 'none needed') : + ac_c_undeclared_builtin_options='' ;; #( + *) : + ac_c_undeclared_builtin_options=$ac_cv_c_undeclared_builtin_options ;; esac @@ -4975,15 +4956,14 @@ fi LIBS=$ac_saved_libs # TIP #509 - ac_fn_c_check_decl "$LINENO" "PTHREAD_MUTEX_RECURSIVE" "ac_cv_have_decl_PTHREAD_MUTEX_RECURSIVE" "#include -" + ac_fn_check_decl "$LINENO" "PTHREAD_MUTEX_RECURSIVE" "ac_cv_have_decl_PTHREAD_MUTEX_RECURSIVE" "#include +" "$ac_c_undeclared_builtin_options" "CFLAGS" if test "x$ac_cv_have_decl_PTHREAD_MUTEX_RECURSIVE" = xyes then : ac_have_decl=1 else $as_nop ac_have_decl=0 fi - printf "%s\n" "#define HAVE_DECL_PTHREAD_MUTEX_RECURSIVE $ac_have_decl" >>confdefs.h if test $ac_have_decl = 1 then : @@ -8796,15 +8776,14 @@ printf "%s\n" "#define HAVE_MTSAFE_GETHOSTBYADDR 1" >>confdefs.h else # Avoids picking hidden internal symbol from libc - ac_fn_c_check_decl "$LINENO" "gethostbyname_r" "ac_cv_have_decl_gethostbyname_r" "#include -" + ac_fn_check_decl "$LINENO" "gethostbyname_r" "ac_cv_have_decl_gethostbyname_r" "#include +" "$ac_c_undeclared_builtin_options" "CFLAGS" if test "x$ac_cv_have_decl_gethostbyname_r" = xyes then : ac_have_decl=1 else $as_nop ac_have_decl=0 fi - printf "%s\n" "#define HAVE_DECL_GETHOSTBYNAME_R $ac_have_decl" >>confdefs.h if test $ac_have_decl = 1 then : @@ -8965,15 +8944,14 @@ fi # Avoids picking hidden internal symbol from libc - ac_fn_c_check_decl "$LINENO" "gethostbyaddr_r" "ac_cv_have_decl_gethostbyaddr_r" "#include -" + ac_fn_check_decl "$LINENO" "gethostbyaddr_r" "ac_cv_have_decl_gethostbyaddr_r" "#include +" "$ac_c_undeclared_builtin_options" "CFLAGS" if test "x$ac_cv_have_decl_gethostbyaddr_r" = xyes then : ac_have_decl=1 else $as_nop ac_have_decl=0 fi - printf "%s\n" "#define HAVE_DECL_GETHOSTBYADDR_R $ac_have_decl" >>confdefs.h if test $ac_have_decl = 1 then : @@ -9482,6 +9460,14 @@ printf "%s\n" "#define HAVE_STRUCT_STAT_ST_BLKSIZE 1" >>confdefs.h fi +ac_fn_c_check_member "$LINENO" "struct stat" "st_rdev" "ac_cv_member_struct_stat_st_rdev" "$ac_includes_default" +if test "x$ac_cv_member_struct_stat_st_rdev" = xyes +then : + +printf "%s\n" "#define HAVE_STRUCT_STAT_ST_RDEV 1" >>confdefs.h + + +fi fi ac_fn_c_check_type "$LINENO" "blkcnt_t" "ac_cv_type_blkcnt_t" "$ac_includes_default" @@ -11849,7 +11835,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # values after options handling. ac_log=" This file was extended by tcl $as_me 8.7, which was -generated by GNU Autoconf 2.70. Invocation command line was +generated by GNU Autoconf 2.71. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS @@ -11908,10 +11894,10 @@ cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config='$ac_cs_config_escaped' ac_cs_version="\\ tcl config.status 8.7 -configured by $0, generated by GNU Autoconf 2.70, +configured by $0, generated by GNU Autoconf 2.71, with options \\"\$ac_cs_config\\" -Copyright (C) 2020 Free Software Foundation, Inc. +Copyright (C) 2021 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." diff --git a/unix/configure.ac b/unix/configure.ac index 485f13d..81d0bcc 100644 --- a/unix/configure.ac +++ b/unix/configure.ac @@ -361,7 +361,7 @@ SC_TIME_HANDLER #-------------------------------------------------------------------- if test "$ac_cv_cygwin" != "yes"; then - AC_CHECK_MEMBERS([struct stat.st_blocks, struct stat.st_blksize]) + AC_CHECK_MEMBERS([struct stat.st_blocks, struct stat.st_blksize, struct stat.st_rdev]) fi AC_CHECK_TYPES([blkcnt_t]) AC_CHECK_FUNC(fstatfs, , [AC_DEFINE(NO_FSTATFS, 1, [Do we have fstatfs()?])]) diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c index f5ab36e..f8b52a6 100644 --- a/unix/tclUnixChan.c +++ b/unix/tclUnixChan.c @@ -639,7 +639,7 @@ StoreElementInDict( Tcl_DictObjPut(NULL, dictObj, nameObj, valueObj); } -static const char * +static inline const char * GetTypeFromMode( int mode) { @@ -673,7 +673,8 @@ static Tcl_Obj * StatOpenFile( FileState *fsPtr) { - Tcl_StatBuf statBuf; + Tcl_StatBuf statBuf; /* Not allocated on heap; we're definitely + * API-synchronized with how Tcl is built! */ Tcl_Obj *dictObj; unsigned short mode; @@ -689,17 +690,22 @@ StatOpenFile( dictObj = Tcl_NewObj(); #define STORE_ELEM(name, value) StoreElementInDict(dictObj, name, value) - STORE_ELEM("dev", Tcl_NewWideIntObj((long)statBuf.st_dev)); - STORE_ELEM("ino", Tcl_NewWideIntObj((Tcl_WideInt)statBuf.st_ino)); - STORE_ELEM("nlink", Tcl_NewWideIntObj((long)statBuf.st_nlink)); - STORE_ELEM("uid", Tcl_NewWideIntObj((long)statBuf.st_uid)); - STORE_ELEM("gid", Tcl_NewWideIntObj((long)statBuf.st_gid)); - STORE_ELEM("size", Tcl_NewWideIntObj((Tcl_WideInt)statBuf.st_size)); + STORE_ELEM("dev", Tcl_NewWideIntObj((long) statBuf.st_dev)); + STORE_ELEM("ino", Tcl_NewWideIntObj((Tcl_WideInt) statBuf.st_ino)); + STORE_ELEM("nlink", Tcl_NewWideIntObj((long) statBuf.st_nlink)); + STORE_ELEM("uid", Tcl_NewWideIntObj((long) statBuf.st_uid)); + STORE_ELEM("gid", Tcl_NewWideIntObj((long) statBuf.st_gid)); + STORE_ELEM("size", Tcl_NewWideIntObj((Tcl_WideInt) statBuf.st_size)); #ifdef HAVE_STRUCT_STAT_ST_BLOCKS - STORE_ELEM("blocks", Tcl_NewWideIntObj((Tcl_WideInt)statBuf.st_blocks)); + STORE_ELEM("blocks", Tcl_NewWideIntObj((Tcl_WideInt) statBuf.st_blocks)); #endif #ifdef HAVE_STRUCT_STAT_ST_BLKSIZE - STORE_ELEM("blksize", Tcl_NewWideIntObj((long)statBuf.st_blksize)); + STORE_ELEM("blksize", Tcl_NewWideIntObj((long) statBuf.st_blksize)); +#endif +#ifdef HAVE_STRUCT_STAT_ST_RDEV + if (S_ISCHR(statBuf.st_mode) || S_ISBLK(statBuf.st_mode)) { + STORE_ELEM("rdev", Tcl_NewWideIntObj((long) statBuf.st_rdev)); + } #endif STORE_ELEM("atime", Tcl_NewWideIntObj( Tcl_GetAccessTimeFromStat(&statBuf))); -- cgit v0.12 From 5e07595538f97ed858b9b0b68e8c2884c5cb76e9 Mon Sep 17 00:00:00 2001 From: dkf Date: Sat, 19 Jun 2021 20:19:49 +0000 Subject: First attempt at Windows implementation. I don't develop on that platform, so this is extra dodgy! --- win/tclWinChan.c | 205 ++++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 204 insertions(+), 1 deletion(-) diff --git a/win/tclWinChan.c b/win/tclWinChan.c index 62991fc..e9e139d 100644 --- a/win/tclWinChan.c +++ b/win/tclWinChan.c @@ -80,6 +80,9 @@ static int FileCloseProc(ClientData instanceData, static int FileEventProc(Tcl_Event *evPtr, int flags); static int FileGetHandleProc(ClientData instanceData, int direction, ClientData *handlePtr); +static int FileGetOptionProc(ClientData instanceData, + Tcl_Interp *interp, const char *optionName, + Tcl_DString *dsPtr); static ThreadSpecificData *FileInit(void); static int FileInputProc(ClientData instanceData, char *buf, int toRead, int *errorCode); @@ -116,7 +119,7 @@ static const Tcl_ChannelType fileChannelType = { NULL, #endif NULL, /* Set option proc. */ - NULL, /* Get option proc. */ + FileGetOptionProc, /* Get option proc. */ FileWatchProc, /* Set up the notifier to watch the channel. */ FileGetHandleProc, /* Get an OS handle from channel. */ FileCloseProc, /* close2proc. */ @@ -135,6 +138,15 @@ static const Tcl_ChannelType fileChannelType = { #define SET_FLAG(var, flag) ((var) |= (flag)) #define CLEAR_FLAG(var, flag) ((var) &= ~(flag)) #define TEST_FLAG(value, flag) (((value) & (flag)) != 0) + +/* + * The number of 100-ns intervals between the Windows system epoch (1601-01-01 + * on the proleptic Gregorian calendar) and the Posix epoch (1970-01-01). + */ + +#define POSIX_EPOCH_AS_FILETIME \ + ((long long) 116444736 * (long long) 1000000000) + /* *---------------------------------------------------------------------- @@ -834,6 +846,197 @@ FileGetHandleProc( /* *---------------------------------------------------------------------- * + * FileGetOptionProc -- + * + * Gets an option associated with an open file. If the optionName arg is + * non-NULL, retrieves the value of that option. If the optionName arg is + * NULL, retrieves a list of alternating option names and values for the + * given channel. + * + * Results: + * A standard Tcl result. Also sets the supplied DString to the string + * value of the option(s) returned. Sets error message if needed + * (by calling Tcl_BadChannelOption). + * + *---------------------------------------------------------------------- + */ + +static inline ULONGLONG +CombineDwords( + DWORD hi, + DWORD lo) +{ + ULARGE_INTEGER converter; + + converter.LowPart = lo; + converter.HighPart = hi; + return converter.QuadPart; +} + +static inline void +StoreElementInDict( + Tcl_Obj *dictObj, + const char *name, + Tcl_Obj *valueObj) +{ + /* + * We assume that the dict is being built fresh and that there's never any + * duplicate keys. + */ + + Tcl_Obj *nameObj = Tcl_NewStringObj(name, -1); + Tcl_DictObjPut(NULL, dictObj, nameObj, valueObj); +} + +static inline time_t +ToCTime( + FILETIME fileTime) /* UTC time */ +{ + LARGE_INTEGER convertedTime; + + convertedTime.LowPart = fileTime.dwLowDateTime; + convertedTime.HighPart = (LONG) fileTime.dwHighDateTime; + + return (time_t) ((convertedTime.QuadPart - + (long long) POSIX_EPOCH_AS_FILETIME) / (long long) 10000000); +} + +static Tcl_Obj * +StatOpenFile( + FileState *fsPtr) +{ + DWORD attr; + int dev, nlink = 1; + unsigned short mode; + unsigned long long size, inode; + long long atime, ctime, mtime; + HANDLE fileHandle; + DWORD fileType = FILE_TYPE_UNKNOWN; + BY_HANDLE_FILE_INFORMATION data; + Tcl_DictObj *dictObj; + + if (GetFileInformationByHandle(infoPtr->handle, &data) != TRUE) { + Tcl_SetErrno(ENOENT); + return NULL; + } + + atime = ToCTime(data.ftLastAccessTime); + mtime = ToCTime(data.ftLastWriteTime); + ctime = ToCTime(data.ftCreationTime); + attr = data.dwFileAttributes; + size = CombineDwords(data.nFileSizeHigh, data.nFileSizeLow); + nlink = data.nNumberOfLinks; + + /* + * Unfortunately our stat definition's inode field (unsigned short) will + * throw away most of the precision we have here, which means we can't + * rely on inode as a unique identifier of a file. We'd really like to do + * something like how we handle 'st_size'. + */ + + inode = CombineDwords(data.nFileIndexHigh, data.nFileIndexLow); + + dev = dw.dwVolumeSerialNumber; + + /* + * Note that this code has no idea whether the file can be executed. + */ + + mode = (attr & FILE_ATTRIBUTE_DIRECTORY) ? S_IFDIR|S_IEXEC : S_IFREG; + mode |= (attr & FILE_ATTRIBUTE_READONLY) ? S_IREAD : S_IREAD|S_IWRITE; + mode |= (mode & (S_IREAD|S_IWRITE|S_IEXEC)) >> 3; + mode |= (mode & (S_IREAD|S_IWRITE|S_IEXEC)) >> 6; + + /* + * We don't construct a Tcl_StatBuf; we're using the info immediately. + */ + + dictObj = Tcl_NewObj(); +#define STORE_ELEM(name, value) StoreElementInDict(dictObj, name, value) + + STORE_ELEM("dev", Tcl_NewWideIntObj((long) dev)); + STORE_ELEM("ino", Tcl_NewWideIntObj((long long) inode)); + STORE_ELEM("nlink", Tcl_NewIntObj(nlink)); + STORE_ELEM("uid", Tcl_NewIntObj(0)); + STORE_ELEM("gid", Tcl_NewIntObj(0)); + STORE_ELEM("size", Tcl_NewWideIntObj((long long) size)); + STORE_ELEM("atime", Tcl_NewWideIntObj(atime)); + STORE_ELEM("mtime", Tcl_NewWideIntObj(mtime)); + STORE_ELEM("ctime", Tcl_NewWideIntObj(ctime)); + STORE_ELEM("mode", Tcl_NewWideIntObj(mode)); + + /* + * Windows only has files and directories, as far as we're concerned. + * Anything else and we definitely couldn't have got here anyway. + */ + if (attr & FILE_ATTRIBUTE_DIRECTORY) { + STORE_ELEM("type", Tcl_NewStringObj("directory", -1)); + } else { + STORE_ELEM("type", Tcl_NewStringObj("file", -1)); + } +#undef STORE_ELEM + + return dictObj; +} + +static int +FileGetOptionProc( + ClientData instanceData, /* The file state. */ + Tcl_Interp *interp, /* For error reporting. */ + const char *optionName, /* What option to read, or NULL for all. */ + Tcl_DString *dsPtr) /* Where to write the value read. */ +{ + FileInfo *infoPtr = (FileInfo *)instanceData; + int valid = 0; /* Flag if valid option parsed. */ + int len; + + if (optionName == NULL) { + len = 0; + valid = 1; + } else { + len = strlen(optionName); + } + + /* + * Get option -stat + * Option is readonly and returned by [fconfigure chan -stat] but not + * returned by [fconfigure chan] without explicit option name. + */ + + if ((len > 1) && (strncmp(optionName, "-stat", len) == 0)) { + return TCL_OK; + } + + if (valid) { + Tcl_Obj *dictObj = StatOpenFile(fsPtr); + const char *dictContents; + int dictLength; + + if (dictObj == NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't read file channel status: %s", + Tcl_PosixError(interp))); + return TCL_ERROR; + } + + /* + * Transfer dictionary to the DString. Note that we don't do this as + * an element as this is an option that can't be retrieved with a + * general probe. + */ + + dictContents = Tcl_GetStringFromObj(dictObj, &dictLength); + Tcl_DStringAppend(dsPtr, dictContents, dictLength); + Tcl_DecrRefCount(dictObj); + return TCL_OK; + } + return Tcl_BadChannelOption(interp, optionName, + "stat"); +} + +/* + *---------------------------------------------------------------------- + * * TclpOpenFileChannel -- * * Open an File based channel on Unix systems. -- cgit v0.12 From 1a062775d2735b0291d3dd2af446ea5192c48f2a Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 28 Jun 2021 12:32:35 +0000 Subject: Fix iocmd-8.4 testcase --- tests/ioCmd.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/ioCmd.test b/tests/ioCmd.test index dbca866..0b0ef3c 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -230,7 +230,7 @@ test iocmd-8.4 {fconfigure command} -setup { fconfigure $f1 froboz } -returnCodes error -cleanup { close $f1 -} -result [expectedOpts "froboz" {}] +} -result [expectedOpts "froboz" -stat] test iocmd-8.5 {fconfigure command} -returnCodes error -body { fconfigure stdin -buffering froboz } -result {bad value for -buffering: must be one of full, line, or none} -- cgit v0.12 From 79260bd6950b610ebc53b4fb8ee8317ef0c6a2a1 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 29 Jun 2021 08:54:19 +0000 Subject: Make tclWinChan.c compile again, fixing obvious implementation problems. Not tested if it actually works. --- win/tclWinChan.c | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/win/tclWinChan.c b/win/tclWinChan.c index e9e139d..19a198e 100644 --- a/win/tclWinChan.c +++ b/win/tclWinChan.c @@ -903,17 +903,15 @@ ToCTime( static Tcl_Obj * StatOpenFile( - FileState *fsPtr) + FileInfo *infoPtr) { DWORD attr; int dev, nlink = 1; unsigned short mode; unsigned long long size, inode; long long atime, ctime, mtime; - HANDLE fileHandle; - DWORD fileType = FILE_TYPE_UNKNOWN; BY_HANDLE_FILE_INFORMATION data; - Tcl_DictObj *dictObj; + Tcl_Obj *dictObj; if (GetFileInformationByHandle(infoPtr->handle, &data) != TRUE) { Tcl_SetErrno(ENOENT); @@ -936,7 +934,7 @@ StatOpenFile( inode = CombineDwords(data.nFileIndexHigh, data.nFileIndexLow); - dev = dw.dwVolumeSerialNumber; + dev = data.dwVolumeSerialNumber; /* * Note that this code has no idea whether the file can be executed. @@ -1008,7 +1006,7 @@ FileGetOptionProc( } if (valid) { - Tcl_Obj *dictObj = StatOpenFile(fsPtr); + Tcl_Obj *dictObj = StatOpenFile(infoPtr); const char *dictContents; int dictLength; -- cgit v0.12 From 65b685deca1ac743321e7ca505e84b391e5c3133 Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 13 Jul 2021 19:38:37 +0000 Subject: Added documentation --- doc/open.n | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/doc/open.n b/doc/open.n index c7c8cf6..68e8494 100644 --- a/doc/open.n +++ b/doc/open.n @@ -128,6 +128,28 @@ If a new file is created as part of opening it, \fIpermissions\fR (an integer) is used to set the permissions for the new file in conjunction with the process's file mode creation mask. \fIPermissions\fR defaults to 0666. +.PP +.VS "8.7, TIP 603" +When the file opened is an ordinary disk file, the \fBchan configure\fR and +\fBfconfigure\fR commands can be used to query this additional configuration +option: +.TP +\fB\-stat\fR +. +This option, when read, returns a dictionary of values much as is obtained +from the \fBfile stat\fR command, where that stat information relates to the +real opened file. Keys in the dictionary may include \fBatime\fR, \fBctime\fR, +\fBdev\fR, \fBgid\fR, \fBino\fR, \fBmode\fR, \fBmtime\fR, \fBnlink\fR, +\fBsize\fR, \fBtype\fR, and \fBuid\fR among others; the \fBmtime\fR, +\fBsize\fR and \fBtype\fR fields are guaranteed to be present and meaningful +on all platforms; other keys may be present too. +.RS +.PP +\fIImplementation note:\fR This option maps to a call to \fBfstat()\fR on +POSIX platforms, and to a call to \fBGetFileInformationByHandle()\fR on +Windows; the information reported is what those system calls produce. +.RE +.VE "8.7, TIP 603" .SH "COMMAND PIPELINES" .PP If the first character of \fIfileName\fR is -- cgit v0.12 From 136b650bda14f6705554dc145efa1d14a79b4513 Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 13 Jul 2021 19:53:38 +0000 Subject: Added a basic portable test of [fconfigure -stat] --- tests/ioCmd.test | 23 ++++++++++++++++++++++- 1 file changed, 22 insertions(+), 1 deletion(-) diff --git a/tests/ioCmd.test b/tests/ioCmd.test index 0b0ef3c..93815c9 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -582,7 +582,28 @@ test ioCmd-13.11 {open ... a+ must not use O_APPEND: Bug 1773127} -setup { } -cleanup { removeFile $f } -result 341234x6 - +test ioCmd-13.12 {open file produces something that has fconfigure -stat} -setup { + set f [makeFile {} iocmd13_12] + set result {} +} -body { + set fd [open $f wb] + set result [dict get [fconfigure $fd -stat] type] + fconfigure $fd -buffering none + puts -nonewline $fd abc + # Three ways of getting the size; all should agree! + lappend result [tell $fd] [file size $f] \ + [dict get [fconfigure $fd -stat] size] + puts -nonewline $fd def + lappend result [tell $fd] [file size $f] \ + [dict get [fconfigure $fd -stat] size] + puts -nonewline $fd ghi + lappend result [tell $fd] [file size $f] \ + [dict get [fconfigure $fd -stat] size] + close $fd + return $result +} -cleanup { + removeFile $f +} -result {file 3 3 3 6 6 6 9 9 9} test iocmd-14.1 {file id parsing errors} { list [catch {eof gorp} msg] $msg $::errorCode -- cgit v0.12