summaryrefslogtreecommitdiff
path: root/lib/unicore
diff options
context:
space:
mode:
authorKarl Williamson <public@khwilliamson.com>2010-10-30 09:43:50 -0600
committerFather Chrysostomos <sprout@cpan.org>2010-10-31 06:11:41 -0700
commit45e32b91012d25c005eeed1854b16d65b27931cb (patch)
tree8867a76d1e9f73583471d95ab7539ee1769124be /lib/unicore
parent8eb023a9cc1ea46c4dc9b9bb6dd651817ac32889 (diff)
downloadperl-45e32b91012d25c005eeed1854b16d65b27931cb.tar.gz
mktables: Add tests for wrong equivalence attempts
mktables allows for multiple tables to be made equivalent, which in Unix terminology means that they are essentially symbolic links. However this should happen only when they have the same code points in them to begin with. This adds a little more error checking.
Diffstat (limited to 'lib/unicore')
-rw-r--r--lib/unicore/mktables21
1 files changed, 15 insertions, 6 deletions
diff --git a/lib/unicore/mktables b/lib/unicore/mktables
index b7cda6457c..b13fe0e09a 100644
--- a/lib/unicore/mktables
+++ b/lib/unicore/mktables
@@ -6560,12 +6560,21 @@ sub trace { return main::trace(@_); }
my $addr = do { no overloading; pack 'J', $self; };
my $current_leader = ($related) ? $parent{$addr} : $leader{$addr};
- if ($related &&
- ! $other->perl_extension
- && ! $current_leader->perl_extension)
- {
- Carp::my_carp_bug("set_equivalent_to should have 'Related => 0 for equivalencing two Unicode properties. Assuming $self is not related to $other");
- $related = 0;
+ if ($related) {
+ if ($current_leader->perl_extension) {
+ if ($other->perl_extension) {
+ Carp::my_carp_bug("Use add_alias() to set two Perl tables '$self' and '$other', equivalent.");
+ return;
+ }
+ } elsif (! $other->perl_extension) {
+ Carp::my_carp_bug("set_equivalent_to should have 'Related => 0 for equivalencing two Unicode properties. Assuming $self is not related to $other");
+ $related = 0;
+ }
+ }
+
+ if (! $self->is_empty && ! $self->matches_identically_to($other)) {
+ Carp::my_carp_bug("$self should be empty or match identically to $other. Not setting equivalent");
+ return;
}
my $leader = do { no overloading; pack 'J', $current_leader; };