Select Code to Download

my $obj = ClosureObj->new();
isa_ok( $obj => 'ClosureObj' );

eval { $obj->('foo') };
ok( $@ =~ /^Attempt to access private class data/,
        "Stop from accessing class data" );

eval { $obj->foop() };
ok( $@ =~ /^No such field/, "Stop from accessing non-existant data" );

$obj->foo(3);
ok( $obj->foo == 3, "Foo is set" );

{
    no warnings; # About unintitlized vars
...
    ok( $obj->foo == undef, "Foo can be set to undef" );
}

my $obj2 = ClosureObj->new();
isa_ok( $obj2 => 'ClosureObj' );
...
ok( ($obj->foo == 2) && ($obj2->foo == 3),
        "Change in one object doesn't affect other" );

my $sub_obj = SubClosureObj->new();
isa_ok( $sub_obj => 'SubClosureObj' );
...
$sub_obj->bar(4);
ok( $sub_obj->bar == 4, "Sub object can set values" );

sub new
{
...
                $field{$name};
        } => $class;
}

{
        my %fields = ( . . . );
...
                } => $class;
        }
}

sub foo
{
...
        $self->('foop', shift) if @_;
        $self->('foop');
}

package SubClosureObj;
use base qw( ClosureObj );
...
        $self->('bar', shift) if @_;
        $self->('bar');
}

#!/usr/bin/perl

...
$sub_obj->bar(4);
ok( $sub_obj->bar == 4, "Sub object can set values" );