summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authorKarl Williamson <public@khwilliamson.com>2013-12-31 12:30:35 -0700
committerKarl Williamson <public@khwilliamson.com>2014-01-01 13:49:23 -0700
commit27f39eb8acaa22c545010301cc1183d1dc2909e5 (patch)
treef2ea4c2da4f2ad546c87997d010a57ab01153c4e /lib
parentebcaaa39d45ae969948eaf6f2f92d89398649700 (diff)
downloadperl-27f39eb8acaa22c545010301cc1183d1dc2909e5.tar.gz
Unicode::UCD::prop_aliases(): Don't generate spurious warnings
Certain inputs to prop_aliases caused spurious warning.
Diffstat (limited to 'lib')
-rw-r--r--lib/Unicode/UCD.pm19
-rw-r--r--lib/Unicode/UCD.t10
2 files changed, 24 insertions, 5 deletions
diff --git a/lib/Unicode/UCD.pm b/lib/Unicode/UCD.pm
index 8674545b1c..a4223341a5 100644
--- a/lib/Unicode/UCD.pm
+++ b/lib/Unicode/UCD.pm
@@ -5,7 +5,7 @@ use warnings;
no warnings 'surrogate'; # surrogates can be inputs to this
use charnames ();
-our $VERSION = '0.56';
+our $VERSION = '0.57';
require Exporter;
@@ -1844,12 +1844,21 @@ sub prop_aliases ($) {
# there, the input is unknown.
return;
}
- else {
+ elsif ($loose =~ / [:=] /x) {
# Here we found the name but not its aliases, so it has to
- # exist. This means it must be one of the Perl single-form
- # extensions. First see if it is for a property-value
- # combination in one of the following properties.
+ # exist. Exclude property-value combinations. (This shows up
+ # for something like ccc=vr which matches loosely, but is a
+ # synonym for ccc=9 which matches only strictly.
+ return;
+ }
+ else {
+
+ # Here it has to exist, and isn't a property-value
+ # combination. This means it must be one of the Perl
+ # single-form extensions. First see if it is for a
+ # property-value combination in one of the following
+ # properties.
my @list;
foreach my $property ("gc", "script") {
@list = prop_value_aliases($property, $loose);
diff --git a/lib/Unicode/UCD.t b/lib/Unicode/UCD.t
index 1c7b45cc38..61d1e7246a 100644
--- a/lib/Unicode/UCD.t
+++ b/lib/Unicode/UCD.t
@@ -13,6 +13,9 @@ BEGIN {
}
}
+my @warnings;
+local $SIG{__WARN__} = sub { push @warnings, @_ };
+
use strict;
use Unicode::UCD;
use Test::More;
@@ -534,6 +537,8 @@ is(prop_aliases("isgc"), undef,
"prop_aliases('isgc') returns <undef> since is not covered Perl extension");
is(prop_aliases("Is_Is_Any"), undef,
"prop_aliases('Is_Is_Any') returns <undef> since two is's");
+is(prop_aliases("ccc=vr"), undef,
+ "prop_aliases('ccc=vr') doesn't generate a warning");
require 'utf8_heavy.pl';
require "unicore/Heavy.pl";
@@ -2177,4 +2182,9 @@ my @alpha_invlist = prop_invlist("Alpha");
is(search_invlist(\@alpha_invlist, ord("\t")), undef, "search_invlist returns undef for code points before first one on the list");
ok($/ eq $input_record_separator, "The record separator didn't get overridden");
+
+if (! ok(@warnings == 0, "No warnings were generated")) {
+ diag(join "\n", "The warnings are:", @warnings);
+}
+
done_testing();