File perl-Tk-fix-for-RT-128103-XPM-loading-problem.patch of Package perl-Tk.11482
From f1a6aa1dbd2a35ee7ef59a6683169b51dcdda799 Mon Sep 17 00:00:00 2001
From: Slaven Rezic <slaven@rezic.de>
Date: Sat, 2 Feb 2019 14:56:03 +0100
Subject: [PATCH 1/3] fix for RT #128103 (XPM loading problem)
Loading XPM files used to fail if the data contained "/*".
Fixed with a small test case.
---
pTk/mTk/additions/imgXPM.c | 4 ++--
t/photo.t | 22 +++++++++++++++++++++-
2 files changed, 23 insertions(+), 3 deletions(-)
diff --git a/pTk/mTk/additions/imgXPM.c b/pTk/mTk/additions/imgXPM.c
index 3d555150..421b17d7 100644
--- a/pTk/mTk/additions/imgXPM.c
+++ b/pTk/mTk/additions/imgXPM.c
@@ -425,7 +425,7 @@ CommonReadXPM(interp, handle, format, imageHandle, destX, destY,
i = srcY;
while (i-- > 0) {
p = Gets(handle, buffer,MAX_BUFFER);
- while (((p = strchr(p,'\"')) == NULL) || ((strstr(p,"/*")) != NULL)) {
+ while (((p = strchr(p,'\"')) == NULL)) {
p = Gets(handle, buffer,MAX_BUFFER);
if (p == NULL) {
return TCL_ERROR;
@@ -437,7 +437,7 @@ CommonReadXPM(interp, handle, format, imageHandle, destX, destY,
for (h = height; h > 0; h--) {
p = Gets(handle, buffer,MAX_BUFFER);
- while (((p = strchr(p,'\"')) == NULL) || ((strstr(p,"/*")) != NULL)) {
+ while (((p = strchr(p,'\"')) == NULL)) {
p = Gets(handle, buffer,MAX_BUFFER);
if (p == NULL) {
return TCL_ERROR;
diff --git a/t/photo.t b/t/photo.t
index 57064e09..8d4c2a51 100644
--- a/t/photo.t
+++ b/t/photo.t
@@ -15,7 +15,7 @@ $numFormats++ unless $@;
my $mw = MainWindow->new();
$mw->geometry('+100+100');
-plan tests => (2*(7 * $numFormats) + 2 + 2 + 1 + 2);
+plan tests => (2*(7 * $numFormats) + 2 + 2 + 1 + 2 + 2);
my @files = ();
@@ -128,6 +128,26 @@ $col++;
like $@, qr{\Qhas dimension(s) <= 0}, 'No dimensions error message';
}
+{
+ # Test case for RT #128103
+ my $image = eval { $mw->Photo(-data => <<'EOF') };
+/* XPM */
+static char *noname[] = {
+/* width height ncolors chars_per_pixel */
+"80 1 4 1",
+/* colors */
+" c #000000",
+". c #914800",
+"/ c #482455",
+"* c #6D4800",
+/* pixels */
+"innyymtytnnt>qqqqqq=qcickkk,rwq,qrr,rir,rq>qrrrrjrxiriitq=@/*/@o^#=r,rtifqq@#@#="
+};
+EOF
+ is $@, '', 'No error';
+ ok $image, "'/*' in XPM data caused no problem";
+}
+
$mw->after(2500,[destroy => $mw]);
MainLoop;
--
2.21.0