BEGIN {
chdir 't' if -d 't';
- unshift @INC, '../lib' if -d '../lib';
+ @INC = '../lib';
$SIG{__WARN__} = sub {
if ($_[0] =~ /^Hides field 'b1' in base class/) {
$w++;
}
use strict;
+use warnings;
use vars qw($DEBUG);
package B1;
use base 'Foo::Bar';
use fields qw(foo bar baz);
+# Test repeatability for when modules get reloaded.
+package B1;
+use fields qw(b1 b2 b3);
+
+package D3;
+use base 'B2';
+use fields qw(b1 d1 _b1 _d1); # hide b1
+
package main;
-sub fstr
-{
+sub fstr {
my $h = shift;
my @tmp;
for my $k (sort {$h->{$a} <=> $h->{$b}} keys %$h) {
'Foo::Bar::Baz' => 'b1:1,b2:2,b3:3,foo:4,bar:5,baz:6',
);
-print "1..", int(keys %expect)+5, "\n";
+print "1..", int(keys %expect)+14, "\n";
my $testno = 0;
while (my($class, $exp) = each %expect) {
no strict 'refs';
# We should get compile time failures field name typos
eval q(my D3 $obj3 = $obj2; $obj3->{notthere} = "");
-print "not " unless $@ && $@ =~ /^No such field "notthere"/;
+print "not " unless $@ && $@ =~ /^No such pseudo-hash field "notthere"/;
+print "ok ", ++$testno, "\n";
+
+# Slices
+@$obj1{"_b1", "b1"} = (17, 29);
+print "not " unless "@$obj1[1,2]" eq "17 29";
+print "ok ", ++$testno, "\n";
+@$obj1[1,2] = (44,28);
+print "not " unless "@$obj1{'b1','_b1','b1'}" eq "28 44 28";
+print "ok ", ++$testno, "\n";
+
+my $ph = fields::phash(a => 1, b => 2, c => 3);
+print "not " unless fstr($ph) eq 'a:1,b:2,c:3';
+print "ok ", ++$testno, "\n";
+
+$ph = fields::phash([qw/a b c/], [1, 2, 3]);
+print "not " unless fstr($ph) eq 'a:1,b:2,c:3';
+print "ok ", ++$testno, "\n";
+
+$ph = fields::phash([qw/a b c/], [1]);
+print "not " if exists $ph->{b} or exists $ph->{c} or !exists $ph->{a};
+print "ok ", ++$testno, "\n";
+
+eval '$ph = fields::phash("odd")';
+print "not " unless $@ && $@ =~ /^Odd number of/;
print "ok ", ++$testno, "\n";
#fields::_dump();
-# check if
+# check if fields autovivify
{
package Foo;
use fields qw(foo bar);
print $a->{foo}[1], "\n";
print $a->{bar}->{A}, "\n";
}
+
+# check if fields autovivify
+{
+ package Bar;
+ use fields qw(foo bar);
+ sub new { return fields::new($_[0]) }
+
+ package main;
+ my Bar $a = Bar::->new();
+ $a->{foo} = ['a', 'ok ' . ++$testno, 'c'];
+ $a->{bar} = { A => 'ok ' . ++$testno };
+ print $a->{foo}[1], "\n";
+ print $a->{bar}->{A}, "\n";
+}
+
+
+# Test $VERSION bug
+package No::Version;
+
+use vars qw($Foo);
+sub VERSION { 42 }
+
+package Test::Version;
+
+use base qw(No::Version);
+print "not " unless $No::Version::VERSION =~ /set by base\.pm/;
+print "ok ", ++$testno ,"\n";