ALP-pool/tcl
2
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Sync from SUSE:ALP:Source:Standard:1.0 tcl revision 7d8b74c28469e4730e48bdd6d01a4d9a

Browse Source
This commit is contained in:
Adrian Schröter 2023-07-31 13:45:14 +02:00
commit 56b1ea98fa
10 changed files with 2079 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
.gitattributes vendored Normal file
View File

@ -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

3
baselibs.conf Normal file
View File

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

14
macros.tcl Normal file
View File

@ -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

53
tcl-interp-limit-time.patch Normal file
View File

@ -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) {
/*

84
tcl-refchan-mode-needed.patch Normal file
View File

@ -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

3
tcl-rpmlintrc Normal file
View File

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

133
tcl-string-compare.patch Normal file
View File

@ -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} {

1545
tcl.changes Normal file
View File

File diff suppressed because it is too large Load Diff

218
tcl.spec Normal file
View File

@ -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

BIN
tcl8.6.13-src.tar.gz (Stored with Git LFS) Normal file
View File

Binary file not shown.