File perl-Tk-XPM-images-may-appear-in-the-colors-section.patch of Package perl-Tk.11482

From ee387812fccf2817200233c5331ba1e0fdcd2f3d Mon Sep 17 00:00:00 2001
From: Slaven Rezic <slaven@rezic.de>
Date: Sat, 2 Feb 2019 17:14:58 +0100
Subject: [PATCH 3/3] XPM images: "/*" may appear in the colors section

Another place where there should be no check for "/*".

Included test case in photo.t.
---
 pTk/mTk/additions/imgXPM.c |  2 +-
 t/photo.t                  | 22 +++++++++++++++++++++-
 2 files changed, 22 insertions(+), 2 deletions(-)

diff --git a/pTk/mTk/additions/imgXPM.c b/pTk/mTk/additions/imgXPM.c
index 93af045e..fc4d55e3 100644
--- a/pTk/mTk/additions/imgXPM.c
+++ b/pTk/mTk/additions/imgXPM.c
@@ -324,7 +324,7 @@ CommonReadXPM(interp, handle, format, imageHandle, destX, destY,
 	int found;
 
 	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 059b38a6..c27e5efb 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 + 2 + 2);
+plan tests => (2*(7 * $numFormats) + 2 + 2 + 1 + 2 + 2 + 2 + 2);
 
 my @files = ();
 
@@ -148,6 +148,26 @@ EOF
     ok $image, "'/*' in XPM data caused no problem";
 }
 
+{
+    # Similar test case for RT #128103 (comment marker in colors section)
+    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", /* weird color */
+"* c #6D4800",
+/* pixels */
+"................................................................................"
+};
+EOF
+    is $@, '', 'No error';
+    ok $image, "'/*' in XPM data caused no problem";
+}
+
 {
     # Error case: short read
     my $image = eval { $mw->Photo(-data => <<'EOF') };
-- 
2.21.0