main/perl-tk: fix build with gcc 14

and add a segfault fix from Gentoo
This commit is contained in:
Natanael Copa 2024-08-14 13:25:15 +02:00
parent d2b5ab425e
commit 48a858e7ec
4 changed files with 424 additions and 3 deletions

View file

@ -5,7 +5,7 @@ pkgname=perl-tk
#_pkgreal is used by apkbuild-cpan to find modules at MetaCpan
_pkgreal=Tk
pkgver=804.036
pkgrel=6
pkgrel=7
pkgdesc="Tk - a Graphical User Interface Toolkit"
url="https://metacpan.org/release/Tk/"
arch="all"
@ -13,7 +13,12 @@ license="TCL AND HPND-Pbmplus AND CC-BY-SA-3.0 AND MIT-open-group AND MIT"
depends="perl"
makedepends="perl-dev libx11-dev libpng-dev"
subpackages="$pkgname-doc"
source="https://cpan.metacpan.org/authors/id/S/SR/SREZIC/Tk-$pkgver.tar.gz"
source="https://cpan.metacpan.org/authors/id/S/SR/SREZIC/Tk-$pkgver.tar.gz
gcc14.patch
Tk-804.036-Fix-STRLEN-vs-int-pointer-confusion-in-Tcl_GetByteAr.patch
Tk-804.036-crash.patch
"
builddir="$srcdir/$_pkgreal-$pkgver"
build() {
@ -32,4 +37,9 @@ package() {
find "$pkgdir" \( -name perllocal.pod -o -name .packlist \) -delete
}
sha512sums="7d8b82127a5fdbb2f0387f541af8844a09f1230f377b92d511ecb12e81bfd5ef56d4fe925cac064a798a96a003bb8465b6df37cff18a960f3631bb3a214cd812 Tk-804.036.tar.gz"
sha512sums="
7d8b82127a5fdbb2f0387f541af8844a09f1230f377b92d511ecb12e81bfd5ef56d4fe925cac064a798a96a003bb8465b6df37cff18a960f3631bb3a214cd812 Tk-804.036.tar.gz
f99fc62ffa34da4d26232bbee364317d357c12136873c48763d60f4ef0556823ca3da4a32355e70aed1e0faddd76ea9485db51bbefb37cf2b43576ee9bddb89f gcc14.patch
b1af73e7924c1638533d2a33d0232ea280eb204e8d1a071746951192c096182bc5a1fd3381e69e60d92eb934ea2736dd07c9623ea99e343a284d5ee636d350d5 Tk-804.036-Fix-STRLEN-vs-int-pointer-confusion-in-Tcl_GetByteAr.patch
529b605a1579ab0b7f609b83f4c627238effc852502e6a4bdd432b4b229fd7f44cefb4b48be46125183005a10c6df5dc153bfe0e7ead4c3b562f241520e26473 Tk-804.036-crash.patch
"

View file

@ -0,0 +1,48 @@
https://bugs.gentoo.org/916814
https://salsa.debian.org/georgesk/perl-tk/-/blob/master/debian/patches/80-Fix-STRLEN-vs-int-pointer-confusion-in-Tcl_GetByteAr.patch?ref_type=heads
From a26233c844c52f49ef9cca5f88dd9063aac60d0f Mon Sep 17 00:00:00 2001
From: Niko Tyni <ntyni@debian.org>
Date: Thu, 11 Jan 2024 18:28:58 +0000
Subject: [PATCH] Fix STRLEN vs int pointer confusion in
Tcl_GetByteArrayFromObj()
Perl 5.37.2, more precisely commit
https://github.com/Perl/perl5/commit/1ef9039bccbfe64f47f201b6cfb7d6d23e0b08a7
changed the implementation of SvPV() et al., breaking t/balloon.t,
t/canvas2.t and t/photo.t on big-endian 64-bit architectures such as
ppc64 and s390x because StringMatchGIF() no longer recognized GIF files.
This is because Tcl_GetByteArrayFromObj() was calling SvPV() with an int
pointer instead of a correct STRLEN pointer, and the new implementation
is more sensitive to this: it assigns the pointers as-is, resulting in
the int pointer pointing at the wrong end of the 64-bit length.
Other functions taking a length pointer, at least Tcl_GetStringFromObj()
already seem to do things correctly, so presumably this is not a
systematic issue.
---
objGlue.c | 5 ++++-
1 file changed, 4 insertions(+), 1 deletion(-)
diff --git a/objGlue.c b/objGlue.c
index d4927ea..dbd6a50 100644
--- a/objGlue.c
+++ b/objGlue.c
@@ -627,7 +627,10 @@ Tcl_GetByteArrayFromObj(Tcl_Obj * objPtr, int * lengthPtr)
sv_utf8_downgrade(objPtr, 0);
if (lengthPtr)
{
- return (unsigned char *) SvPV(objPtr, *lengthPtr);
+ STRLEN len;
+ unsigned char *s = SvPV(objPtr, len);
+ *lengthPtr = len;
+ return s;
}
else
{
--
2.30.2

View file

@ -0,0 +1,167 @@
https://github.com/eserte/perl-tk/pull/48
https://github.com/eserte/perl-tk/pull/89
From e7c5041b4fff6210bc0348c72b538efae32aede3 Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Thu, 28 Mar 2019 22:59:17 -0500
Subject: [PATCH 1/3] Fix segfaults due to parameter size mismatch
See: https://rt.cpan.org/Ticket/Display.html?id=128955
As also done upstream: https://core.tcl-lang.org/tk/info/0d9c0d50f9
--- a/pTk/mTk/generic/tkCanvText.c
+++ b/pTk/mTk/generic/tkCanvText.c
@@ -1234,8 +1234,7 @@ GetTextIndex(interp, canvas, itemPtr, obj, indexPtr)
* index. */
{
TextItem *textPtr = (TextItem *) itemPtr;
- size_t length;
- int c;
+ int c, length;
TkCanvas *canvasPtr = (TkCanvas *) canvas;
Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr;
char *string;
--- a/pTk/mTk/generic/tkFrame.c
+++ b/pTk/mTk/generic/tkFrame.c
@@ -493,8 +493,7 @@ CreateFrame(clientData, interp, objc, objv, type, appName)
CONST char *className, *screenName, *colormapName, *arg;
Tcl_Obj *visualName;
Tcl_Obj *useOption;
- int i, c, depth;
- size_t length;
+ int i, c, depth, length;
unsigned int mask;
Colormap colormap;
Visual *visual;
@@ -749,8 +748,7 @@ FrameWidgetObjCmd(clientData, interp, objc, objv)
};
register Frame *framePtr = (Frame *) clientData;
int result = TCL_OK, index;
- size_t length;
- int c, i;
+ int c, i, length;
Tcl_Obj *objPtr;
if (objc < 2) {
From 2bba8c45fcbcd9f3d45b7bc5f290e324d7c01a13 Mon Sep 17 00:00:00 2001
From: Christopher Chavez <chrischavez@gmx.us>
Date: Fri, 12 Feb 2021 11:28:48 -0600
Subject: [PATCH 2/3] tkFrame.c: remove redundant casts
--- a/pTk/mTk/generic/tkFrame.c
+++ b/pTk/mTk/generic/tkFrame.c
@@ -522,7 +522,7 @@ CreateFrame(clientData, interp, objc, objv, type, appName)
visualName = NULL;
colormap = None;
for (i = 2; i < objc; i += 2) {
- arg = Tcl_GetStringFromObj(objv[i], (int *) &length);
+ arg = Tcl_GetStringFromObj(objv[i], &length);
if (length < 2) {
continue;
}
@@ -796,7 +796,7 @@ FrameWidgetObjCmd(clientData, interp, objc, objv)
*/
for (i = 2; i < objc; i++) {
- char *arg = Tcl_GetStringFromObj(objv[i], (int *) &length);
+ char *arg = Tcl_GetStringFromObj(objv[i], &length);
if (length < 2) {
continue;
}
From 3dd0956e92df84ec0e788368ff0214e527d28dd8 Mon Sep 17 00:00:00 2001
From: Christopher Chavez <chrischavez@gmx.us>
Date: Fri, 12 Feb 2021 11:29:16 -0600
Subject: [PATCH 3/3] tkImgPhoto.c: fix instances of RT #128955
Remove unnecessary casts to (int *)
As done upstream: https://core.tcl-lang.org/tk/info/0d9c0d50f9
--- a/pTk/mTk/generic/tkImgPhoto.c
+++ b/pTk/mTk/generic/tkImgPhoto.c
@@ -676,10 +676,9 @@ ImgPhotoCmd(clientData, interp, objc, objv)
XColor color;
Tk_PhotoImageFormat *imageFormat;
int imageWidth, imageHeight;
- int matched;
+ int length, matched;
Tcl_Channel chan;
Tk_PhotoHandle srcHandle;
- size_t length;
Tcl_Obj *obj;
int c;
ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
@@ -723,7 +722,7 @@ ImgPhotoCmd(clientData, interp, objc, objv)
Tcl_WrongNumArgs(interp, 2, objv, "option");
return TCL_ERROR;
}
- arg = Tcl_GetStringFromObj(objv[2], (int *) &length);
+ arg = Tcl_GetStringFromObj(objv[2], &length);
if (strncmp(arg,"-data", length) == 0) {
if (masterPtr->dataString) {
Tcl_SetObjResult(interp, masterPtr->dataString);
@@ -768,7 +767,7 @@ ImgPhotoCmd(clientData, interp, objc, objv)
return TCL_OK;
}
if (objc == 3) {
- char *arg = Tcl_GetStringFromObj(objv[2], (int *) &length);
+ char *arg = Tcl_GetStringFromObj(objv[2], &length);
if (!strncmp(arg, "-data", length)) {
Tcl_Obj *subobj = Tcl_NewStringObj("-data {} {} {}", 14);
if (masterPtr->dataString) {
@@ -5753,8 +5752,8 @@ PhotoOptionFind(interp, obj)
Tcl_Interp *interp; /* Interpreter that is being deleted. */
Tcl_Obj *obj; /* Name of option to be found. */
{
- size_t length;
- char *name = Tcl_GetStringFromObj(obj, (int *) &length);
+ int length;
+ char *name = Tcl_GetStringFromObj(obj, &length);
OptionAssocData *list;
char *prevname = NULL;
Tcl_ObjCmdProc *proc = (Tcl_ObjCmdProc *) NULL;
From 0cc1fd7c599fc6b7050fcd7442f10824b032c462 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Thu, 3 Jan 2019 20:53:24 +0000
Subject: [PATCH] Fix for conflicting symbols in X.h and Windows.h
Backported from Tcl/Tk 8.6.10:
see https://core.tcl-lang.org/tk/info/9e31fd944934
Fixes #87
--- a/pTk/mTk/xlib/X11/X.h
+++ b/pTk/mTk/xlib/X11/X.h
@@ -73,7 +73,9 @@ typedef unsigned long KeyCode; /* In order to use IME, the Macintosh needs
* RESERVED RESOURCE AND CONSTANT DEFINITIONS
*****************************************************************/
-#define None 0L /* universal null resource or null atom */
+#ifndef _WIN32
+# define None 0L /* See bug [9e31fd9449] and below */
+#endif
#define ParentRelative 1L /* background pixmap in CreateWindow
and ChangeWindowAttributes */
@@ -179,13 +181,20 @@ are reserved in the protocol for errors and replies. */
#define ShiftMask (1<<0)
#define LockMask (1<<1)
-#define ControlMask (1<<2)
+#ifndef _WIN32
+# define ControlMask (1<<2) /* See bug [9e31fd9449] and below */
+#endif
#define Mod1Mask (1<<3)
#define Mod2Mask (1<<4)
#define Mod3Mask (1<<5)
#define Mod4Mask (1<<6)
#define Mod5Mask (1<<7)
+/* See bug [9e31fd9449], this way prevents conflicts with Win32 headers */
+#ifdef _WIN32
+enum _Bug9e31fd9449 { None = 0, ControlMask = (1<<2) };
+#endif
+
/* modifier names. Used to build a SetModifierMapping request or
to read a GetModifierMapping request. These correspond to the
masks defined above. */

196
main/perl-tk/gcc14.patch Normal file
View file

@ -0,0 +1,196 @@
--- config/signedchar.c
+++ ./config/signedchar.c
@@ -1,4 +1,4 @@
-main()
+int main()
{
signed char x = 'a';
return (x - 'a');
--- config/unsigned.c
+++ ./config/unsigned.c
@@ -1,3 +1,5 @@
+#include <stdlib.h>
+
int main()
{
char x[] = "\377";
--- pTk/config/Hstrdup.c
+++ ./pTk/config/Hstrdup.c
@@ -1,4 +1,5 @@
#include <string.h>
+#include <stdlib.h>
#define STRING "Whatever"
--- pTk/config/Hstrtoul.c
+++ ./pTk/config/Hstrtoul.c
@@ -1,3 +1,4 @@
+#include <string.h>
#include <stdlib.h>
int main()
--- pTk/mTk/generic/tkEvent.c
+++ ./pTk/mTk/generic/tkEvent.c
@@ -1153,6 +1153,7 @@ TkEventDeadWindow(winPtr)
Time
TkCurrentTime(dispPtr, fallbackCurrent)
TkDisplay *dispPtr; /* Display for which the time is desired. */
+ int fallbackCurrent;
{
register XEvent *eventPtr;
ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
--- pTk/mTk/generic/tkImage.c
+++ ./pTk/mTk/generic/tkImage.c
@@ -1083,6 +1083,8 @@ int x;
int y;
int width;
int height;
+int imgWidth;
+int imgHeight;
{
Tk_Tile tile = (Tk_Tile) clientData;
Tk_TileChange *handler;
--- Event/Event.xs
+++ ./Event/Event.xs
@@ -1532,7 +1532,7 @@ PROTOTYPES: DISABLE
BOOT:
{
#ifdef pWARN_NONE
- SV *old_warn = PL_curcop->cop_warnings;
+ char *old_warn = PL_curcop->cop_warnings;
PL_curcop->cop_warnings = pWARN_NONE;
#endif
newXS("Tk::Event::INIT", XS_Tk__Event_INIT, file);
--- config/pregcomp2.c
+++ ./config/pregcomp2.c
@@ -4,5 +4,5 @@
int main() {
SV* sv = newSViv(0);
- regexp* rx = pregcomp(sv, 0);
+ void *rx = (void *) pregcomp(sv, 0);
}
--- pTk/Xlib.t
+++ ./pTk/Xlib.t
@@ -331,7 +331,7 @@ VFUNC(int,XIntersectRegion,V_XIntersectR
#endif /* !DO_X_EXCLUDE */
#ifndef XKeycodeToKeysym
-VFUNC(KeySym,XKeycodeToKeysym,V_XKeycodeToKeysym,_ANSI_ARGS_((Display *, unsigned int, int)))
+VFUNC(KeySym,XKeycodeToKeysym,V_XKeycodeToKeysym,_ANSI_ARGS_((Display *, unsigned char, int)))
#endif /* #ifndef XKeycodeToKeysym */
#ifndef XKeysymToString
--- pTk/mTk/generic/tkCanvText.c
+++ ./pTk/mTk/generic/tkCanvText.c
@@ -1250,7 +1250,7 @@ GetTextIndex(interp, canvas, itemPtr, ob
goto doxy;
}
- string = Tcl_GetStringFromObj(obj, &length);
+ string = Tcl_GetStringFromObj(obj, NULL);
c = string[0];
length = strlen(string);
--- tkGlue.c
+++ ./tkGlue.c
@@ -5549,7 +5549,7 @@ _((pTHX))
#define COP_WARNINGS_TYPE SV*
#endif
#ifdef pWARN_NONE
- COP_WARNINGS_TYPE old_warn = PL_curcop->cop_warnings;
+ char *old_warn = PL_curcop->cop_warnings;
PL_curcop->cop_warnings = pWARN_NONE;
#endif
From 061e4744c01dd2ed461fd0009cb1699c4f37f131 Mon Sep 17 00:00:00 2001
From: Randy Eckenrode <randy@largeandhighquality.com>
Date: Thu, 7 Sep 2023 05:17:32 +0200
Subject: [PATCH 1/2] jpeg: fix build with clang 16
The jpeg `configure` script fails to detect clang as a functioning C
compiler because it uses a test with a `main` that returns an implicit
`int`, which results in an error with clang 16.
---
JPEG/jpeg/configure | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/JPEG/jpeg/configure b/JPEG/jpeg/configure
index 35c9db5c..ce76b557 100755
--- a/JPEG/jpeg/configure
+++ b/JPEG/jpeg/configure
@@ -623,7 +623,7 @@ cross_compiling=$ac_cv_prog_cc_cross
cat > conftest.$ac_ext <<EOF
#line 625 "configure"
#include "confdefs.h"
-main(){return(0);}
+int main(){return(0);}
EOF
if { (eval echo configure:629: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
ac_cv_prog_cc_works=yes
From 3c5126df9b06bd6c87211d762b081cc801368fa5 Mon Sep 17 00:00:00 2001
From: Christopher Chavez <chrischavez@gmx.us>
Date: Thu, 14 Sep 2023 06:27:52 -0500
Subject: [PATCH 2/2] jpeg: more fixes for clang 16
---
JPEG/jpeg/configure | 17 ++++++++++++++---
1 file changed, 14 insertions(+), 3 deletions(-)
diff --git a/JPEG/jpeg/configure b/JPEG/jpeg/configure
index ce76b557..c5593f2f 100755
--- a/JPEG/jpeg/configure
+++ b/JPEG/jpeg/configure
@@ -1281,6 +1281,10 @@ else
#line 1282 "configure"
#include "confdefs.h"
+#include <stdio.h>
+#ifdef HAVE_STDLIB_H
+#include <stdlib.h>
+#endif
#ifdef HAVE_PROTOTYPES
int is_char_signed (int arg)
#else
@@ -1298,7 +1302,7 @@ int is_char_signed (arg)
return 1; /* assume char is signed otherwise */
}
char signed_char_check = (char) (-67);
-main() {
+int main() {
exit(is_char_signed((int) signed_char_check));
}
EOF
@@ -1327,6 +1331,10 @@ else
#line 1328 "configure"
#include "confdefs.h"
+#include <stdio.h>
+#ifdef HAVE_STDLIB_H
+#include <stdlib.h>
+#endif
#ifdef HAVE_PROTOTYPES
int is_shifting_signed (long arg)
#else
@@ -1350,7 +1358,7 @@ int is_shifting_signed (arg)
printf("I fear the JPEG software will not work at all.\n\n");
return 0; /* try it with unsigned anyway */
}
-main() {
+int main() {
exit(is_shifting_signed(-0x7F7E80B1L));
}
EOF
@@ -1380,7 +1388,10 @@ else
#include "confdefs.h"
#include <stdio.h>
-main() {
+#ifdef HAVE_STDLIB_H
+#include <stdlib.h>
+#endif
+int main() {
if (fopen("conftestdata", "wb") != NULL)
exit(0);
exit(1);