#!perl -T
#################################################################################################################################################################
#
# TESTS for UID.pm
#
#################################################################################################################################################################
use strict; use warnings; use Carp;
use Test::More 'no_plan';
use utf8; #because of our «,»
#—————————————————————————————————————————————————————————————————————————————————————————————
#hm, "is_deeply" actually seems to compare just the overloaded representation, so make our own
sub deeper($$;$) { return Test::More->builder->ok( deepcomp(@_), $_[2]); } # same?
sub deepless($$;$) { return Test::More->builder->ok(!deepcomp(@_), $_[2]); } # different?
#Hey, shouldn't these be functions in UID.pm, perhaps?? =)
sub deepcomp($$)
# compare actual structure to see whether two UIDs are the same
# Note that we are depending on knowing how UIDs work inside to check this!
{
my $tb=Test::More->builder; # to get an "OK" object
my ($foo, $bar)=@_;
return ref $foo eq ref $bar unless ref $foo eq "UID" and ref $bar eq "UID";
#unless both are UIDs, merely compare the ref-types
my @foo, my @bar;
eval { @foo=@$foo; @bar=@$bar; }; # UIDs should really be array-refs
my $same=overload::StrVal($foo) eq overload::StrVal($bar); # compare the refs' memory addresses
croak "ERROR! fake UID: $@" if $@=~/Can't use.*as ARRAY/ # if we can't de-array-ref them, they're not real UIDs!
or @foo!=2 or @bar!=2 # ...or if they don't both have exactly 2 elements each
or $same != ($foo[1] eq $bar[1]); #...or if the refs are the same and the full-names aren't, or vice versa
return $same;
}
#—————————————————————————————————————————————————————————————————————————————————————————————
BEGIN { use_ok "UID" }
diag( "Testing UID $UID::VERSION, Perl $], $^X" );
# Basic testing
BEGIN { use_ok "UID", 'foo'; } # define a UID
is foo, "«foo»", "Name"; # evaluates as string, so gets the name from foo
ok foo."" eq "«foo»", "Name again"; # force foo-as-string since "eq" is overloaded
is ${+foo}, "«main::foo»", "Full name"; # deref to get full name
isa_ok foo(), "UID", "Class";
is foo->[1], "main::foo", "Array deref";
is foo()?"Y":"N", "Y", "Bool context";
ok foo == foo, "Self-identity (==)"; #hm, won't work with cmp_ok, "==" -- will numify first
ok foo eq foo, "Self-identity (eq)";
deeper foo, foo, "Deep identity";
isn't foo, "foo", "Non-identity"; # again, compares string-overloaded value
ok foo ne "foo", "Non-identity too";
ok foo ne "«foo»", "Non-identity still";
my $f=foo;
is $f, foo, "Copy";
is $f, "«foo»", "Copy's name";
ok $f==foo, "Copy's identity";
is ref $f, "UID", "Class ref";
BEGIN { use_ok "UID", BAR=>BAZ=>QUX=>; } # define some more
deeper BAR, BAR, "Deep identity, bar none";
deepless foo, BAR, "Deep misidentity";
is BAR, "«BAR»", "String name";
is BAR, BAR, "String-val identity";
isn't foo, BAR, "Different UIDs"; # meh, as strings!
isn't BAR, BAZ, "Other different UIDs"; # meh, as strings!
ok BAR eq BAR, "Matching UIDs";
ok foo ne BAR, "Different UIDs";
cmp_ok BAR, ne=> BAZ, "Other different UIDs";
ok QUX==QUX, "Other other match";
ok foo!=QUX, "Other other difference";
# #hm, test for errors?
# use UID foo; # Can't create a UID called &foo!
# use UID "foo"; # can't redefine existing foo()
package Other; # Repeat intro stuff for new namespace:
use strict; use warnings;
use Test::More; # no plan because we already specified one in this file
use utf8; #because of our «,»
BEGIN { use_ok "UID", 'foo'; } # new foo in new namespace
is ${foo()}, "«Other::foo»", "Other package name";
is foo, main::foo(), "Compare package names";
main::deepless foo, main::foo(), "Compare package objects";
# Test contexts
my $either; #use this to save the results, then test them -- otherwise "is" itself will impose list-context all the time!
sub either { $either=wantarray?"LIST":"SCALAR" } # reacts differently in list vs scalar context
either; is $either, "SCALAR", "Plain scalar";
(undef)=either; is $either, "LIST", "Plain list";
foo, either; is $either, "SCALAR", "comma-scalar";
(undef)=foo either; is $either, "LIST", "call-list";
(foo, scalar either); is $either, "SCALAR", "Explicit scalar";
(undef)=foo scalar either; is $either, "SCALAR", "Explicit scalar too";
(undef)=foo (either); is $either, "LIST", "Explicit list";
#also with prototypes($)
sub one($) {@_} # forces a single scalar arg
#use []'s and then is_deeply to compare multiple values together
is_deeply [one foo], [foo], '$-prototype alone';
is_deeply [one foo, 42], [foo, 42], '$-prototype w/comma';
#test for error: is_deeply [one foo 42], <ERROR!>, '$-prototype w/arg';
# Test that passing args through a UID doesn't inadvertently evaluate them
use overload fallback=>1; use overload q(""), sub {$_->[0]++};
my $o=bless \my $x; # an object that increments everytime we evaluate it (as a string, anyway)
is $o, 0, "Incrementer";
is $o, 1, "Incremented";
(undef)=foo(foo $o, $o); # run it though «foo»
is $o, 2, "Passed through";
__END__