I've attached a simple works-for-me patch that permits the regular expression being any one of a list of possible strings.
This allows this package to Pass Tests on 5.14 release candidates.
From 807262f4aeb0694b6eabcc1acffecfa87e1df783 Mon Sep 17 00:00:00 2001
From: Kent Fredric <kentfredric@gmail.com>
Date: Sat, 7 May 2011 09:35:19 +1200
Subject: [PATCH] Suggested fix for RT#66841
Replace regexp validation tests with similar tests that permit it to be
any one of a list of values.
---
t/01_normal.t | 23 +++++++++++++++++------
1 files changed, 17 insertions(+), 6 deletions(-)
diff --git a/t/01_normal.t b/t/01_normal.t
index 305da37..08c57f4 100644
--- a/t/01_normal.t
+++ b/t/01_normal.t
@@ -18,12 +18,23 @@ use_ok('File::MimeInfo', qw/mimetype describe globs/); # 1
# test _glob_to_regexp
my $i = 0;
-for (
- [ '*.pl', '(?-xism:^.*\.pl$)' ], # 4
- [ '*.h++', '(?-xism:^.*\.h\+\+$)' ], # 5
- [ '*.[tar].*', '(?-xism:^.*\.[tar]\..*$)'], # 6
- [ '*.?', '(?-xism:^.*\..?$)'], # 7
-) { is( File::MimeInfo::_glob_to_regexp($_->[0]), $_->[1], 'glob '.++$i ) }
+for my $glob (
+ [ '*.pl', [ '(?-xism:^.*\.pl$)', '(?^u:^.*\.pl$)' ] ], # 4
+ [ '*.h++', [ '(?-xism:^.*\.h\+\+$)', '(?^u:^.*\.h\+\+$)' ] ], # 5
+ [ '*.[tar].*', [ '(?-xism:^.*\.[tar]\..*$)', '(?^u:^.*\.[tar]\..*$)' ] ], # 6
+ [ '*.?', [ '(?-xism:^.*\..?$)', '(?^u:^.*\..?$)' ] ], # 7
+ )
+{
+ my $converted = File::MimeInfo::_glob_to_regexp( $glob->[0] );
+ my $number = ++$i;
+ if ( my ($match) = grep { $_ eq "$converted" } @{ $glob->[1] } ) {
+ pass( 'glob ' . $number . ' matches an expected value' );
+ note explain $match;
+ next;
+ }
+ fail( 'glob ' . $number . ' matches an expected value' );
+ diag explain { got => "$converted", expected_one_of => $glob->[1] };
+}
# test parsing file names
$i = 0;
--
1.7.5.rc3
RT for rt.cpan.org