Unicode::UCD::prop_aliases(): Don't generate spurious warnings
authorKarl Williamson <public@khwilliamson.com>
Tue, 31 Dec 2013 19:30:35 +0000 (12:30 -0700)
committerKarl Williamson <public@khwilliamson.com>
Wed, 1 Jan 2014 20:49:23 +0000 (13:49 -0700)
Certain inputs to prop_aliases caused spurious warning.

lib/Unicode/UCD.pm
lib/Unicode/UCD.t

index 8674545..a422334 100644 (file)
@@ -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);
index 1c7b45c..61d1e72 100644 (file)
@@ -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();