File perl-Tk-fix-for-RT-128103-XPM-loading-problem.p... of Package perl-Tk

Overview Repositories Revisions Requests Users Attributes Meta

File perl-Tk-fix-for-RT-128103-XPM-loading-problem.patch of Package perl-Tk

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

Places

File perl-Tk-fix-for-RT-128103-XPM-loading-problem.patch of Package perl-Tk

Places