Merge 9.0

8 files changed, 200 insertions, 17 deletions

diff --git a/unix/Makefile.in b/unix/Makefile.in
index 1bf5814..e7dee7a 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -2307,9 +2307,8 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in gen
 	$(DIST_INSTALL_DATA) $(GENERIC_DIR)/*.decls $(DISTDIR)/generic
 	$(DIST_INSTALL_DATA) $(GENERIC_DIR)/README $(DISTDIR)/generic
 	$(DIST_INSTALL_DATA) $(GENERIC_DIR)/tclGetDate.y $(DISTDIR)/generic
-	$(DIST_INSTALL_DATA) $(TOP_DIR)/changes $(TOP_DIR)/ChangeLog $(TOP_DIR)/README.md \
-		$(TOP_DIR)/ChangeLog.[12]??? $(TOP_DIR)/license.terms \
-		$(DISTDIR)
+	$(DIST_INSTALL_DATA) $(TOP_DIR)/changes $(TOP_DIR)/README.md \
+		$(TOP_DIR)/license.terms $(DISTDIR)
 	$(INSTALL_DATA_DIR) $(DISTDIR)/library
 	$(DIST_INSTALL_DATA) $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \
 		$(TOP_DIR)/library/manifest.txt \
@@ -2446,7 +2445,7 @@ html-tk: ${NATIVE_TCLSH}
 	@EXTRA_BUILD_HTML@
 
 BUILD_HTML = \
-	@${NATIVE_TCLSH} $(TOOL_DIR)/tcltk-man2html.tcl \
+	@${NATIVE_TCLSH} -encoding utf-8 $(TOOL_DIR)/tcltk-man2html.tcl \
 		--useversion=$(MAJOR_VERSION).$(MINOR_VERSION) \
 		--htmldir="$(HTML_INSTALL_DIR)" \
 		--srcdir=$(TOP_DIR) $(BUILD_HTML_FLAGS)
diff --git a/unix/configure b/unix/configure
index 4c54fbe..c0f7a32 100755
--- a/unix/configure
+++ b/unix/configure
@@ -9506,6 +9506,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"
diff --git a/unix/configure.ac b/unix/configure.ac
index 238e47a..17da218 100644
--- a/unix/configure.ac
+++ b/unix/configure.ac
@@ -371,7 +371,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/dltest/pkgooa.c b/unix/dltest/pkgooa.c
index 444bb81..e75a2c3 100644
--- a/unix/dltest/pkgooa.c
+++ b/unix/dltest/pkgooa.c
@@ -125,18 +125,18 @@ Pkgooa_Init(
     }
     if (tclStubsPtr == NULL) {
 	Tcl_AppendResult(interp, "Tcl stubs are not initialized, "
-		"did you compile using -DUSE_TCL_STUBS? ");
+		"did you compile using -DUSE_TCL_STUBS? ", NULL);
 	return TCL_ERROR;
     }
     if (Tcl_OOInitStubs(interp) == NULL) {
 	return TCL_ERROR;
     }
     if (tclOOStubsPtr == NULL) {
-	Tcl_AppendResult(interp, "TclOO stubs are not initialized");
+	Tcl_AppendResult(interp, "TclOO stubs are not initialized", NULL);
 	return TCL_ERROR;
     }
     if (tclOOIntStubsPtr == NULL) {
-	Tcl_AppendResult(interp, "TclOO internal stubs are not initialized");
+	Tcl_AppendResult(interp, "TclOO internal stubs are not initialized", NULL);
 	return TCL_ERROR;
     }
 
diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c
index 6feaeae..eea1453 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,
@@ -164,7 +167,7 @@ static const Tcl_ChannelType fileChannelType = {
     FileOutputProc,		/* Output proc. */
 	NULL,
     NULL,			/* Set option proc. */
-    NULL,			/* Get option proc. */
+    FileGetOptionProc,		/* Get option proc. */
     FileWatchProc,		/* Initialize notifier. */
     FileGetHandleProc,		/* Get OS handles out of channel. */
     FileCloseProc,		/* close2proc. */
@@ -275,7 +278,7 @@ FileInputProc(
      */
 
     do {
-	bytesRead = read(fsPtr->fd, buf, toRead);
+	bytesRead = read(fsPtr->fd, buf, (size_t)toRead);
     } while ((bytesRead < 0) && (errno == EINTR));
 
     if (bytesRead < 0) {
@@ -324,7 +327,7 @@ FileOutputProc(
 
 	return 0;
     }
-    written = write(fsPtr->fd, buf, toWrite);
+    written = write(fsPtr->fd, buf, (size_t)toWrite);
     if (written >= 0) {
 	return written;
     }
@@ -534,6 +537,176 @@ 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 inline 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;	/* Not allocated on heap; we're definitely
+				 * API-synchronized with how Tcl is built! */
+    Tcl_Obj *dictObj;
+    unsigned short mode;
+
+    if (TclOSfstat(fsPtr->fd, &statBuf) < 0) {
+	return NULL;
+    }
+
+    /*
+     * TODO: merge with TIP 594 implementation (it's silly to have a
+     * duplicate!)
+     */
+
+    TclNewObj(dictObj);
+#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
+#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)));
+    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;
+	Tcl_Size 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
 /*
  *----------------------------------------------------------------------
diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c
index 41985ab..8606960 100644
--- a/unix/tclUnixFile.c
+++ b/unix/tclUnixFile.c
@@ -63,6 +63,7 @@ TclpFindExecutable(
     const char *name, *p;
     Tcl_StatBuf statBuf;
     Tcl_DString buffer, nameString, cwd, utfName;
+    Tcl_Obj *obj;
 
     if (argv0 == NULL) {
 	return;
@@ -138,7 +139,8 @@ TclpFindExecutable(
 	    p++;
 	}
     }
-    TclSetObjNameOfExecutable(Tcl_NewObj(), NULL);
+    TclNewObj(obj);
+    TclSetObjNameOfExecutable(obj, NULL);
     goto done;
 
     /*
@@ -161,7 +163,8 @@ TclpFindExecutable(
     }
 
     if (TclpGetCwd(NULL, &cwd) == NULL) {
-	TclSetObjNameOfExecutable(Tcl_NewObj(), NULL);
+	TclNewObj(obj);
+	TclSetObjNameOfExecutable(obj, NULL);
 	goto done;
     }
 
diff --git a/unix/tclUnixPipe.c b/unix/tclUnixPipe.c
index 9923ba8..c1fae5d 100644
--- a/unix/tclUnixPipe.c
+++ b/unix/tclUnixPipe.c
@@ -549,7 +549,7 @@ TclpCreateProcess(
 	 * here, since this is the error case. [Bug: 6148]
 	 */
 
-	Tcl_WaitPid((Tcl_Pid) INT2PTR(pid), &status, 0);
+	Tcl_WaitPid((Tcl_Pid)INT2PTR(pid), &status, 0);
     }
 
     if (errPipeIn) {
diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c
index cf3b7a1..5d357c9 100644
--- a/unix/tclUnixThrd.c
+++ b/unix/tclUnixThrd.c
@@ -214,7 +214,7 @@ TclpThreadCreate(
     Tcl_ThreadId *idPtr,	/* Return, the ID of the thread */
     Tcl_ThreadCreateProc *proc,	/* Main() function of the thread */
     void *clientData,	/* The one argument to Main() */
-    size_t stackSize,		/* Size of stack for the new thread */
+    TCL_HASH_TYPE stackSize,	/* Size of stack for the new thread */
     int flags)			/* Flags controlling behaviour of the new
 				 * thread. */
 {
@@ -228,7 +228,7 @@ TclpThreadCreate(
 
 #ifdef HAVE_PTHREAD_ATTR_SETSTACKSIZE
     if (stackSize != TCL_THREAD_STACK_DEFAULT) {
-	pthread_attr_setstacksize(&attr, stackSize);
+	pthread_attr_setstacksize(&attr, (size_t)stackSize);
 #ifdef TCL_THREAD_STACK_MIN
     } else {
 	/*
@@ -247,7 +247,7 @@ TclpThreadCreate(
 
 	result = pthread_attr_getstacksize(&attr, &size);
 	if (!result && (size < TCL_THREAD_STACK_MIN)) {
-	    pthread_attr_setstacksize(&attr, (size_t) TCL_THREAD_STACK_MIN);
+	    pthread_attr_setstacksize(&attr, (size_t)TCL_THREAD_STACK_MIN);
 	}
 #endif /* TCL_THREAD_STACK_MIN */
     }