diff options
author | Karl Williamson <public@khwilliamson.com> | 2013-12-31 12:30:35 -0700 |
---|---|---|
committer | Karl Williamson <public@khwilliamson.com> | 2014-01-01 13:49:23 -0700 |
commit | 27f39eb8acaa22c545010301cc1183d1dc2909e5 (patch) | |
tree | f2ea4c2da4f2ad546c87997d010a57ab01153c4e /lib | |
parent | ebcaaa39d45ae969948eaf6f2f92d89398649700 (diff) | |
download | perl-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.pm | 19 | ||||
-rw-r--r-- | lib/Unicode/UCD.t | 10 |
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(); |