1#!/usr/bin/perl 2 3use strict; 4use warnings; 5use Test::More tests => 8; 6 7BEGIN { use_ok('XML::Entities::Data') } 8 9sub are_funcnames; 10sub each_in_all; 11sub char2entity_sane; 12sub str2ords; 13 14my @names; 15ok(@names = XML::Entities::Data::names, "Are any entity sets defined?"); 16 17ok(are_funcnames(@names), "Do names() contain real function names?"); 18 19is(ref XML::Entities::Data::all(), 'HASH', "Does all() return a hashref?"); 20 21no strict 'refs'; 22my $val1 = "XML::Entities::Data::$names[0]"->(); 23my $val2 = "XML::Entities::Data::$names[0]"->(); 24use strict; 25cmp_ok($val1, '==', $val2, "Does caching work?"); 26 27ok(each_in_all(), "Is every set a subset of all?"); 28 29is(ref XML::Entities::Data::char2entity('all'), 'HASH', "Does char2entity return a hashref?"); 30ok(char2entity_sane(), "Does char2entity return a reverse mapping of all?"); 31 32sub are_funcnames { 33 for (@_) { 34 if (not XML::Entities::Data->can($_)) { 35 diag("Function '$_' returned by names() but not defined."); 36 return 0 37 } 38 no strict 'refs'; 39 my $rv = "XML::Entities::Data::$_"->(); 40 use strict; 41 if (ref $rv ne 'HASH') { 42 diag("Function $_ did not return a hashref but '$rv'"); 43 return 0 44 } 45 } 46 return 1 47} 48 49sub each_in_all { 50 my @names = XML::Entities::Data::names(); 51 my %all = %{ XML::Entities::Data::all() }; 52 for my $name (@names) { 53 no strict 'refs'; 54 my $set = "XML::Entities::Data::$name"->(); 55 use strict 'refs'; 56 for my $ent (keys %$set) { 57 if (not exists $all{ $ent }) { 58 diag("entity '$ent' is defined in set '$name' but not in 'all'"); 59 return 0 60 } 61 elsif ($all{ $ent } ne $set->{ $ent }) { 62 diag("Entity '$ent' has different definitions in '$name' ($$set{$ent}) and in all ($all{$ent}). OK but weird."); 63 } 64 } 65 } 66 return 1 67} 68 69sub char2entity_sane { 70 my %all = %{ XML::Entities::Data::all() }; 71 my %c2e = %{ XML::Entities::Data::char2entity('all') }; 72 my @entnames = keys %all; 73 my @entchars = values %all; 74 for my $i (0 .. $#entchars) { 75 my $entchar = $entchars[$i]; 76 if (not exists $c2e{ $entchar }) { 77 my $ords = str2ords($entchar); 78 my $message = "char2entity doesn't map '$ords'" 79 . " despite that all() maps '$entnames[$i]' onto it"; 80 diag($message); 81 return 0 82 } 83 my $backmap = $c2e{ $entchar }; 84 $backmap =~ s/^&//; 85 $backmap =~ s/;$//; 86 if ($all{ $backmap } ne $entchar and $all{ "$backmap;" } ne $entchar) { 87 my $ords = str2ords($entchar); 88 diag("char2entity maps '$ords' onto '$backmap' but all() maps '$backmap' to '$all{$backmap.';'}'"); 89 return 0 90 } 91 } 92 return 1 93} 94 95sub str2ords { 96 my ($string) = @_; 97 my @ords = map {'chr('.ord($_).')'} split //, $string; 98 my $ords = join('-', @ords); 99 return $ords 100} 101