Sync from SUSE:SLFO:Main tcl revision 7d8b74c28469e4730e48bdd6d01a4d9a

.gitattributes

@@ -0,0 +1,23 @@
+## Default LFS
+*.7z filter=lfs diff=lfs merge=lfs -text
+*.bsp filter=lfs diff=lfs merge=lfs -text
+*.bz2 filter=lfs diff=lfs merge=lfs -text
+*.gem filter=lfs diff=lfs merge=lfs -text
+*.gz filter=lfs diff=lfs merge=lfs -text
+*.jar filter=lfs diff=lfs merge=lfs -text
+*.lz filter=lfs diff=lfs merge=lfs -text
+*.lzma filter=lfs diff=lfs merge=lfs -text
+*.obscpio filter=lfs diff=lfs merge=lfs -text
+*.oxt filter=lfs diff=lfs merge=lfs -text
+*.pdf filter=lfs diff=lfs merge=lfs -text
+*.png filter=lfs diff=lfs merge=lfs -text
+*.rpm filter=lfs diff=lfs merge=lfs -text
+*.tbz filter=lfs diff=lfs merge=lfs -text
+*.tbz2 filter=lfs diff=lfs merge=lfs -text
+*.tgz filter=lfs diff=lfs merge=lfs -text
+*.ttf filter=lfs diff=lfs merge=lfs -text
+*.txz filter=lfs diff=lfs merge=lfs -text
+*.whl filter=lfs diff=lfs merge=lfs -text
+*.xz filter=lfs diff=lfs merge=lfs -text
+*.zip filter=lfs diff=lfs merge=lfs -text
+*.zst filter=lfs diff=lfs merge=lfs -text

baselibs.conf

@@ -0,0 +1,3 @@
+tcl
+ +/usr/lib(64)?/tcl/.*
+ requires -tcl-<targettype>

macros.tcl

@@ -0,0 +1,14 @@
+# RPM macros for Tcl
+
+# The minor version of Tcl
+%tcl_version %(echo 'puts [info tclversion]'|tclsh)
+
+# compiled packges should go here
+%tcl_archdir %(echo 'puts [lindex $tcl_pkgPath 0]'|tclsh)
+
+# script-only packages should go here
+%tcl_noarchdir %(echo 'puts [lindex  $tcl_pkgPath 1]'|tclsh)
+
+# tclscriptdir is deprecated, please use tcl_archdir or
+# tcl_noarchdir instead, depending on the type of your package
+%tclscriptdir %tcl_noarchdir

tcl-interp-limit-time.patch

@@ -0,0 +1,53 @@
+Index: generic/tclInterp.c
+==================================================================
+--- generic/tclInterp.c
++++ generic/tclInterp.c
+@@ -4684,11 +4684,11 @@
+ 	case OPT_SEC:
+ 	    if (Tcl_LimitTypeEnabled(childInterp, TCL_LIMIT_TIME)) {
+ 		Tcl_Time limitMoment;
+ 
+ 		Tcl_LimitGetTime(childInterp, &limitMoment);
+-		Tcl_SetObjResult(interp, Tcl_NewLongObj(limitMoment.sec));
++		Tcl_SetObjResult(interp, Tcl_NewWideIntObj(limitMoment.sec));
+ 	    }
+ 	    break;
+ 	}
+ 	return TCL_OK;
+     } else if ((objc-consumedObjc) & 1 /* isOdd(objc-consumedObjc) */) {
+@@ -4742,28 +4742,30 @@
+ 			    "BADVALUE", NULL);
+ 		    return TCL_ERROR;
+ 		}
+ 		limitMoment.usec = ((long) tmp)*1000;
+ 		break;
+-	    case OPT_SEC:
++	    case OPT_SEC: {
++		Tcl_WideInt sec;
+ 		secObj = objv[i+1];
+ 		(void) Tcl_GetStringFromObj(objv[i+1], &secLen);
+ 		if (secLen == 0) {
+ 		    break;
+ 		}
+-		if (TclGetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
++		if (TclGetWideIntFromObj(interp, objv[i+1], &sec) != TCL_OK) {
+ 		    return TCL_ERROR;
+ 		}
+-		if (tmp < 0) {
++		if (sec < 0) {
+ 		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ 			    "seconds must be at least 0", -1));
+ 		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
+ 			    "BADVALUE", NULL);
+ 		    return TCL_ERROR;
+ 		}
+-		limitMoment.sec = tmp;
++		limitMoment.sec = sec;
+ 		break;
++	    }
+ 	    }
+ 	}
+ 	if (milliObj != NULL || secObj != NULL) {
+ 	    if (milliObj != NULL) {
+ 		/*
+

tcl-refchan-mode-needed.patch

@@ -0,0 +1,84 @@
+--- doc/refchan.n.orig
++++ doc/refchan.n
+@@ -53,8 +53,8 @@ here, then the \fBfinalize\fR subcommand
+ .PP
+ The \fImode\fR argument tells the handler whether the channel was
+ opened for reading, writing, or both. It is a list containing any of
+-the strings \fBread\fR or \fBwrite\fR. The list will always
+-contain at least one element.
++the strings \fBread\fR or \fBwrite\fR. The list may be empty, but
++will usually contain at least one element. 
+ .PP
+ The subcommand must throw an error if the chosen mode is not
+ supported by the \fIcmdPrefix\fR.
+--- generic/tclIORChan.c.orig
++++ generic/tclIORChan.c
+@@ -532,7 +532,7 @@ TclChanCreateObjCmd(
+ 
+     /*
+      * First argument is a list of modes. Allowed entries are "read", "write".
+-     * Expect at least one list element. Abbreviations are ok.
++     * Empty list is uncommon, but allowed. Abbreviations are ok.
+      */
+ 
+     modeObj = objv[MODE];
+@@ -905,6 +905,11 @@ TclChanPostEventObjCmd(
+     if (EncodeEventMask(interp, "event", objv[EVENT], &events) != TCL_OK) {
+ 	return TCL_ERROR;
+     }
++    if (events == 0) {
++	Tcl_SetObjResult(interp,
++		Tcl_NewStringObj("bad event list: is empty", -1));
++	return TCL_ERROR;
++    }
+ 
+     /*
+      * Check that the channel is actually interested in the provided events.
+@@ -2007,10 +2012,10 @@ ReflectGetOption(
+  * EncodeEventMask --
+  *
+  *	This function takes a list of event items and constructs the
+- *	equivalent internal bitmask. The list must contain at least one
+- *	element. Elements are "read", "write", or any unique abbreviation of
+- *	them. Note that the bitmask is not changed if problems are
+- *	encountered.
++ *	equivalent internal bitmask. The list may be empty but will usually
++ *	contain at least one element. Valid elements are "read", "write", or
++ *	any unique abbreviation of them. Note that the bitmask is not changed
++ *	if problems are encountered.
+  *
+  * Results:
+  *	A standard Tcl error code. A bitmask where TCL_READABLE and/or
+@@ -2040,12 +2045,6 @@ EncodeEventMask(
+ 	return TCL_ERROR;
+     }
+ 
+-    if (listc < 1) {
+-	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+-                "bad %s list: is empty", objName));
+-	return TCL_ERROR;
+-    }
+-
+     events = 0;
+     while (listc > 0) {
+ 	if (Tcl_GetIndexFromObj(interp, listv[listc-1], eventOptions,
+--- tests/ioCmd.test.orig
++++ tests/ioCmd.test
+@@ -670,12 +670,12 @@ test iocmd-21.1 {chan create, wrong#args
+     catch {chan create a b c} msg
+     set msg
+ } {wrong # args: should be "chan create mode cmdprefix"}
+-test iocmd-21.2 {chan create, invalid r/w mode, empty} {
+-    proc foo {} {}
+-    catch {chan create {} foo} msg
++test iocmd-21.2 {chan create, r/w mode empty} {
++    proc foo {cmd args} { return {initialize finalize watch} }
++    set chan [chan create {} foo]
++    close $chan
+     rename foo {}
+-    set msg
+-} {bad mode list: is empty}
++} {}
+ test iocmd-21.3 {chan create, invalid r/w mode, bad string} {
+     proc foo {} {}
+     catch {chan create {c} foo} msg

tcl-rpmlintrc

@@ -0,0 +1,3 @@
+addFilter("no-soname")
+addFilter("files-duplicate")
+addFilter("bin-sh-syntax-error")

tcl-string-compare.patch

@@ -0,0 +1,133 @@
+--- generic/tclCmdMZ.c.orig
++++ generic/tclCmdMZ.c
+@@ -2629,7 +2629,7 @@ StringEqualCmd(
+      */
+ 
+     objv += objc-2;
+-    match = TclStringCmp(objv[0], objv[1], 0, nocase, reqlength);
++    match = TclStringCmp(objv[0], objv[1], 1, nocase, reqlength);
+     Tcl_SetObjResult(interp, Tcl_NewBooleanObj(match ? 0 : 1));
+     return TCL_OK;
+ }
+@@ -2702,8 +2702,8 @@ TclStringCmp(
+     Tcl_Obj *value2Ptr,
+     int checkEq,		/* comparison is only for equality */
+     int nocase,			/* comparison is not case sensitive */
+-    int reqlength)		/* requested length; -1 to compare whole
+-				 * strings */
++    int reqlength)		/* requested length in characters; -1 to
++				 * compare whole strings */
+ {
+     const char *s1, *s2;
+     int empty, length, match, s1len, s2len;
+@@ -2731,10 +2731,10 @@ TclStringCmp(
+     } else if ((value1Ptr->typePtr == &tclStringType)
+ 	    && (value2Ptr->typePtr == &tclStringType)) {
+ 	/*
+-	 * Do a unicode-specific comparison if both of the args are of String
++	 * Do a Unicode-specific comparison if both of the args are of String
+ 	 * type. If the char length == byte length, we can do a memcmp. In
+ 	 * benchmark testing this proved the most efficient check between the
+-	 * unicode and string comparison operations.
++	 * Unicode and string comparison operations.
+ 	 */
+ 
+ 	if (nocase) {
+@@ -2748,6 +2748,9 @@ TclStringCmp(
+ 		    && (value1Ptr->bytes != NULL)
+ 		    && (s2len == value2Ptr->length)
+ 		    && (value2Ptr->bytes != NULL)) {
++		/* each byte represents one character so s1l3n, s2l3n, and
++		 * reqlength are in both bytes and characters
++		 */
+ 		s1 = value1Ptr->bytes;
+ 		s2 = value2Ptr->bytes;
+ 		memCmpFn = memcmp;
+@@ -2756,14 +2759,17 @@ TclStringCmp(
+ 		s2 = (char *) Tcl_GetUnicode(value2Ptr);
+ 		if (
+ #if defined(WORDS_BIGENDIAN) && (TCL_UTF_MAX != 4)
+-			1
++		    1
+ #else
+-			checkEq
++		    checkEq
+ #endif /* WORDS_BIGENDIAN */
+-		        ) {
++		) {
+ 		    memCmpFn = memcmp;
+ 		    s1len *= sizeof(Tcl_UniChar);
+ 		    s2len *= sizeof(Tcl_UniChar);
++		    if (reqlength > 0) {
++			reqlength *= sizeof(Tcl_UniChar);
++		    }
+ 		} else {
+ 		    memCmpFn = (memCmpFn_t) Tcl_UniCharNcmp;
+ 		}
+@@ -2805,7 +2811,7 @@ TclStringCmp(
+ 	    s2 = TclGetStringFromObj(value2Ptr, &s2len);
+ 	}
+ 
+-	if (!nocase && checkEq) {
++	if (!nocase && checkEq && reqlength < 0) {
+ 	    /*
+ 	     * When we have equal-length we can check only for (in)equality.
+ 	     * We can use memcmp() in all (n)eq cases because we don't need to
+@@ -2826,24 +2832,28 @@ TclStringCmp(
+ 		s1len = Tcl_NumUtfChars(s1, s1len);
+ 		s2len = Tcl_NumUtfChars(s2, s2len);
+ 		memCmpFn = (memCmpFn_t)
+-			(nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp);
++		    (nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp);
+ 	    }
+ 	}
+     }
+ 
++    /* At this point s1len, s2len, and reqlength should by now have been
++     * adjusted so that they are all in the units expected by the selected
++     * comparison function.
++     */
++
+     length = (s1len < s2len) ? s1len : s2len;
+     if (reqlength > 0 && reqlength < length) {
+ 	length = reqlength;
+     } else if (reqlength < 0) {
+ 	/*
+-	 * The requested length is negative, so we ignore it by setting it to
+-	 * length + 1 so we correct the match var.
++	 * The requested length is negative, so ignore it by setting it to
++	 * length + 1 to correct the match var.
+ 	 */
+-
+ 	reqlength = length + 1;
+     }
+ 
+-    if (checkEq && (s1len != s2len)) {
++    if (checkEq && reqlength < 0 && (s1len != s2len)) {
+ 	match = 1;		/* This will be reversed below. */
+     } else {
+ 	/*
+--- tests/stringComp.test.orig
++++ tests/stringComp.test
+@@ -100,7 +100,7 @@ foreach {tname tbody tresult tcode} {
+     {unicode} {string compare \334 \u00fc} -1 {}
+     {unicode} {string compare \334\334\334\374\374 \334\334\334\334\334} 1 {}
+     {high bit} {
+-	# This test will fail if the underlying comparison
++	# This test fails if the underlying comparison
+ 	# is using signed chars instead of unsigned chars.
+ 	# (like SunOS's default memcmp thus the compat/memcmp.c)
+ 	string compare "\x80" "@"
+@@ -156,10 +156,10 @@ foreach {tname tbody tresult tcode} {
+     {-nocase null strings} {
+ 	string compare -nocase foo ""
+     } 1 {}
+-    {with length, unequal strings} {
++    {with length, unequal strings, partial first string} {
+ 	string compare -length 2 abc abde
+     } 0 {}
+-    {with length, unequal strings} {
++    {with length, unequal strings 2, full first string} {
+ 	string compare -length 2 ab abde
+     } 0 {}
+     {with NUL character vs. other ASCII} {

tcl.spec

@@ -0,0 +1,218 @@
+#
+# spec file for package tcl
+#
+# Copyright (c) 2023 SUSE LLC
+#
+# All modifications and additions to the file contributed by third parties
+# remain the property of their copyright owners, unless otherwise agreed
+# upon. The license for this file, and modifications and additions to the
+# file, is the same license as for the pristine package itself (unless the
+# license for the pristine package is not an Open Source License, in which
+# case the license is the MIT License). An "Open Source License" is a
+# license that conforms to the Open Source Definition (Version 1.9)
+# published by the Open Source Initiative.
+
+# Please submit bugfixes or comments via https://bugs.opensuse.org/
+#
+
+
+%if 0%{!?_rpmmacrodir:1}
+%define _rpmmacrodir %{_rpmconfigdir}/macros.d
+%endif
+
+Name:           tcl
+URL:            http://www.tcl.tk
+Version:        8.6.13
+Release:        0
+%define         rrc %{nil}
+%define TCL_MINOR %(echo %version | cut -c1-3)
+%define itclver 4.2.3
+BuildRoot:      %{_tmppath}/%{name}-%{version}-build
+Summary:        The Tcl Programming Language
+License:        TCL
+Group:          Development/Languages/Tcl
+Provides:       itcl = %itclver
+Provides:       tclsh
+Provides:       tclsh%{TCL_MINOR}
+Obsoletes:      itcl < %itclver
+# Require the extension from the SQLite package instead of shipping
+# the embedded copy, which might be outdated.
+Requires:       sqlite3-tcl
+# bug437293
+%ifarch ppc64
+Obsoletes:      tcl-64bit
+%endif
+#
+PreReq:         /bin/rm
+Source0:        http://prdownloads.sourceforge.net/tcl/%{name}%{version}%{rrc}-src.tar.gz
+Source1:        tcl-rpmlintrc
+Source2:        baselibs.conf
+Source3:        macros.tcl
+Patch0:         tcl-refchan-mode-needed.patch
+Patch1:         tcl-string-compare.patch
+Patch2:         tcl-interp-limit-time.patch
+BuildRequires:  autoconf
+BuildRequires:  pkg-config
+BuildRequires:  zlib-devel
+# Required for test suite:
+BuildRequires:  timezone
+
+%description
+Tcl (Tool Command Language) is a very powerful but easy to learn
+dynamic programming language, suitable for a very wide range of uses,
+including web and desktop applications, networking, administration,
+testing and many more. Open source and business-friendly, Tcl is a
+mature yet evolving language that is truly cross platform, easily
+deployed and highly extensible.
+
+For more information on Tcl see http://www.tcl.tk and
+http://wiki.tcl.tk .
+
+%package devel
+Summary:        Header Files and C API Documentation for Tcl
+Group:          Development/Libraries/Tcl
+Requires:       tcl = %version
+# bug437293
+%ifarch ppc64
+Obsoletes:      tcl-devel-64bit
+%endif
+Obsoletes:      itcl-devel < %itclver
+Provides:       itcl-devel = %itclver
+#
+
+%description devel
+This package contains header files and documentation needed for writing
+Tcl extensions in compiled languages like C, C++, etc., or for
+embedding the Tcl interpreter in programs written in such languages.
+
+This package is not needed for writing extensions or applications in
+the Tcl language itself.
+
+%prep
+%setup -q -n %name%version
+if ! test -d pkgs/itcl%itclver; then
+   : Version mismatch in itcl, please chek the %%itclver macro!
+   exit 1
+fi
+%patch0
+%patch1
+%patch2
+
+# The SQLite extension is provided by the sqlite3 package,
+# so don't build it here.
+rm -r pkgs/sqlite3.*
+
+%build
+%global _lto_cflags %{_lto_cflags} -ffat-lto-objects
+%define scriptdir %_libdir/tcl
+export TCL_PACKAGE_PATH="%scriptdir %_datadir/tcl"
+export TCL_LIBRARY="%scriptdir/tcl%TCL_MINOR"
+cd unix
+autoconf
+%configure \
+	--enable-man-symlinks \
+	--enable-man-compression=gzip \
+	--without-tzdata
+make %{?_smp_mflags} \
+	PACKAGE_DIR="%scriptdir"
+
+%check
+cd unix
+# Some of the regressioin tests write to $HOME, so better redirect them
+mkdir home
+export HOME=$PWD/home
+# Run the testsuite to gather some data for the profile-based
+# optimisation and let rpmbuild fail on unexpected test failures.
+cat > known-failures <<EOF
+async-4.2
+async-4.3
+chan-17.4
+chan-io-53.9
+clock-33.5a
+clock-33.8
+clock-33.8a
+event-7.5
+event-11.4
+event-12.4
+exec-19.1
+http-3.25
+interp-34.9
+interp-34.13
+interp-36.7
+io-53.9
+msgcat-14.2
+socket_inet6-2.13
+timer-1.1
+timer-2.1
+timer-3.2
+timer-6.4
+timer-6.5
+thread-7.24
+thread-7.25
+thread-7.28
+thread-7.29
+thread-7.30
+thread-7.31
+thread-20.9
+thread-21.16
+%ifarch riscv64
+binary-40.3
+%endif
+%if 0%{?qemu_user_space_build}
+socket-14.15
+thread-16.2
+%endif
+EOF
+%ifnarch s390 s390x
+make test 2>&1 | tee testresults
+grep FAILED testresults | grep -Fvwf known-failures && exit 1
+%endif
+exit 0
+
+%install
+make -C unix install install-private-headers \
+	INSTALL_ROOT=%buildroot
+rm -f %buildroot%scriptdir/tcl%TCL_MINOR/ldAix
+ln -sf tclsh%TCL_MINOR %buildroot%_prefix/bin/tclsh
+ln -sf tclsh.1.gz %buildroot%_mandir/man1/tclsh%TCL_MINOR.1.gz
+mkdir -p %buildroot%_datadir/tcl
+install -D %{S:3} -m 644 %buildroot%_rpmmacrodir/macros.tcl
+
+# The information in TCL_LIBS is not needed for shared libraries
+# and we don't support static linking.
+sed -i "/^TCL_LIBS=/s/'.*'$//" %buildroot%_libdir/tclConfig.sh
+sed -i "/^Libs.private: /s/ .*$//" %buildroot%_libdir/pkgconfig/tcl.pc
+
+%if "%_lib" == "lib64"
+%post
+test -L /usr/lib/tcl%TCL_MINOR && /bin/rm -f /usr/lib/tcl%TCL_MINOR
+exit 0
+%endif
+
+%files
+%defattr(-,root,root,755)
+%doc README.md changes license.terms ChangeLog*
+%docdir %_mandir/mann
+%doc %_mandir/man1/*
+%doc %_mandir/mann/*
+%_prefix/bin/*
+%_libdir/lib*.so
+%_datadir/tcl
+%scriptdir
+%exclude %scriptdir/*/*.a
+%exclude %scriptdir/*/*Config.sh
+%exclude %scriptdir/*/tclAppInit.c
+%_rpmmacrodir/macros.tcl
+
+%files devel
+%defattr(-,root,root)
+%doc %_mandir/man3/*
+%_includedir/*
+%scriptdir/*/tclAppInit.c
+%attr(0644,root,root) %_libdir/*.a
+%attr(0644,root,root) %scriptdir/*/*.a
+%scriptdir/*/*Config.sh
+%_libdir/*Config.sh
+%_libdir/pkgconfig/*
+
+%changelog