r44160 - in /branches/upstream/libclass-accessor-children-perl: ./ current/ current/lib/ current/lib/Class/ current/lib/Class/Accessor/ current/lib/Class/Accessor/Children/ current/t/
dustywilson-guest at users.alioth.debian.org
dustywilson-guest at users.alioth.debian.org
Wed Sep 16 18:20:49 UTC 2009
Author: dustywilson-guest
Date: Wed Sep 16 18:20:41 2009
New Revision: 44160
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=44160
Log:
[svn-inject] Installing original source of libclass-accessor-children-perl
Added:
branches/upstream/libclass-accessor-children-perl/
branches/upstream/libclass-accessor-children-perl/current/
branches/upstream/libclass-accessor-children-perl/current/Changes
branches/upstream/libclass-accessor-children-perl/current/MANIFEST
branches/upstream/libclass-accessor-children-perl/current/META.yml
branches/upstream/libclass-accessor-children-perl/current/Makefile.PL
branches/upstream/libclass-accessor-children-perl/current/README
branches/upstream/libclass-accessor-children-perl/current/lib/
branches/upstream/libclass-accessor-children-perl/current/lib/Class/
branches/upstream/libclass-accessor-children-perl/current/lib/Class/Accessor/
branches/upstream/libclass-accessor-children-perl/current/lib/Class/Accessor/Children/
branches/upstream/libclass-accessor-children-perl/current/lib/Class/Accessor/Children.pm (with props)
branches/upstream/libclass-accessor-children-perl/current/lib/Class/Accessor/Children/Fast.pm (with props)
branches/upstream/libclass-accessor-children-perl/current/make-dist.sh (with props)
branches/upstream/libclass-accessor-children-perl/current/t/
branches/upstream/libclass-accessor-children-perl/current/t/00_pod.t
branches/upstream/libclass-accessor-children-perl/current/t/01_new.t
branches/upstream/libclass-accessor-children-perl/current/t/10_accessors.t
branches/upstream/libclass-accessor-children-perl/current/t/11_children.t
branches/upstream/libclass-accessor-children-perl/current/t/12_error.t
branches/upstream/libclass-accessor-children-perl/current/t/20_accessors_fast.t
branches/upstream/libclass-accessor-children-perl/current/t/21_children_fast.t
branches/upstream/libclass-accessor-children-perl/current/t/22_error_fast.t
Added: branches/upstream/libclass-accessor-children-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-accessor-children-perl/current/Changes?rev=44160&op=file
==============================================================================
--- branches/upstream/libclass-accessor-children-perl/current/Changes (added)
+++ branches/upstream/libclass-accessor-children-perl/current/Changes Wed Sep 16 18:20:41 2009
@@ -1,0 +1,4 @@
+# Class::Accessor::Children
+
+2007/08/16 version 0.02:
+ - the first release!
Added: branches/upstream/libclass-accessor-children-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-accessor-children-perl/current/MANIFEST?rev=44160&op=file
==============================================================================
--- branches/upstream/libclass-accessor-children-perl/current/MANIFEST (added)
+++ branches/upstream/libclass-accessor-children-perl/current/MANIFEST Wed Sep 16 18:20:41 2009
@@ -1,0 +1,16 @@
+lib/Class/Accessor/Children.pm
+lib/Class/Accessor/Children/Fast.pm
+MANIFEST
+README
+Makefile.PL
+Changes
+make-dist.sh
+t/00_pod.t
+t/01_new.t
+t/10_accessors.t
+t/11_children.t
+t/12_error.t
+t/20_accessors_fast.t
+t/21_children_fast.t
+t/22_error_fast.t
+META.yml Module meta-data (added by MakeMaker)
Added: branches/upstream/libclass-accessor-children-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-accessor-children-perl/current/META.yml?rev=44160&op=file
==============================================================================
--- branches/upstream/libclass-accessor-children-perl/current/META.yml (added)
+++ branches/upstream/libclass-accessor-children-perl/current/META.yml Wed Sep 16 18:20:41 2009
@@ -1,0 +1,13 @@
+--- #YAML:1.0
+name: Class-Accessor-Children
+version: 0.02
+abstract: ~
+license: perl
+generated_by: ExtUtils::MakeMaker version 6.36
+distribution_type: module
+requires:
+ Class::Accessor: 0
+ Test::More: 0
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.2.html
+ version: 1.2
Added: branches/upstream/libclass-accessor-children-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-accessor-children-perl/current/Makefile.PL?rev=44160&op=file
==============================================================================
--- branches/upstream/libclass-accessor-children-perl/current/Makefile.PL (added)
+++ branches/upstream/libclass-accessor-children-perl/current/Makefile.PL Wed Sep 16 18:20:41 2009
@@ -1,0 +1,17 @@
+use strict;
+use ExtUtils::MakeMaker;
+
+my $opt = {
+ NAME => 'Class::Accessor::Children',
+ VERSION_FROM => 'lib/Class/Accessor/Children.pm',
+ PREREQ_PM => {
+ 'Test::More' => '0',
+ 'Class::Accessor' => '0',
+ },
+};
+
+my $mm = $ExtUtils::MakeMaker::VERSION;
+$mm =~ s/[^\d\.]+//g;
+$opt->{LICENSE} = 'perl' if ( $mm >= 6.3001 );
+
+WriteMakefile( %$opt );
Added: branches/upstream/libclass-accessor-children-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-accessor-children-perl/current/README?rev=44160&op=file
==============================================================================
--- branches/upstream/libclass-accessor-children-perl/current/README (added)
+++ branches/upstream/libclass-accessor-children-perl/current/README Wed Sep 16 18:20:41 2009
@@ -1,0 +1,67 @@
+NAME
+ Class::Accessor::Children - Automated child-class/accessor generation
+
+SYNOPSIS
+ BEFORE (WITHOUT THIS)
+
+ package MyClass::Foo;
+ use base qw( Class:Accessor );
+ __PACKAGE__->mk_ro_accessors(qw( jacob michael joshua ethan ));
+
+ package MyClass::Bar;
+ use base qw( Class:Accessor );
+ __PACKAGE__->mk_ro_accessors(qw( emily emma madison isabella ));
+
+ package MyClass::Baz;
+ use base qw( Class:Accessor );
+ __PACKAGE__->mk_ro_accessors(qw( haruka haruto miyu yuto ));
+
+ AFTER (WITH THIS)
+
+ package MyClass;
+ use base qw( Class::Accessor::Children );
+ __PACKAGE__->mk_child_ro_accessors(
+ Foo => [qw( jacob michael joshua ethan )],
+ Bar => [qw( emily emma madison isabella )],
+ Baz => [qw( haruka haruto miyu yuto )],
+ );
+
+DESCRIPTION
+ This module automagically generates child classes which have
+ accessor/mutator methods.
+
+ This module inherits "Class::Accessor" to make accessors.
+
+METHODS
+ This module provides the following methods in addition to all methods
+ provided by "Class::Accessor".
+
+ mk_child_accessors
+ MyClass->mk_child_accessors( Foo => \@fields, ... );
+
+ This generates a child class named "MyClass::Foo" which have
+ accessor/mutator methods each named in "\@fields".
+
+ mk_child_ro_accessors
+ MyClass->mk_child_ro_accessors( Bar => \@fields, ... );
+
+ This generates a child class named "MyClass::Bar" which have read-only
+ accessors (ie. true accessors).
+
+ mk_child_wo_accessors
+ MyClass->mk_child_wo_accessors( Baz => \@fields, ... );
+
+ This generates a child class named "MyClass::Baz" which have write-only
+ accessor (ie. mutators).
+
+SEE ALSO
+ Class::Accessor
+
+AUTHOR
+ Yusuke Kawasaki <http://www.kawa.net/>
+
+COPYRIGHT AND LICENSE
+ Copyright (c) 2007 Yusuke Kawasaki. All rights reserved. This program is
+ free software; you can redistribute it and/or modify it under the same
+ terms as Perl itself.
+
Added: branches/upstream/libclass-accessor-children-perl/current/lib/Class/Accessor/Children.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-accessor-children-perl/current/lib/Class/Accessor/Children.pm?rev=44160&op=file
==============================================================================
--- branches/upstream/libclass-accessor-children-perl/current/lib/Class/Accessor/Children.pm (added)
+++ branches/upstream/libclass-accessor-children-perl/current/lib/Class/Accessor/Children.pm Wed Sep 16 18:20:41 2009
@@ -1,0 +1,113 @@
+package Class::Accessor::Children;
+use base qw( Class::Accessor );
+use Carp;
+use vars qw( $VERSION );
+$VERSION = '0.02';
+
+sub mk_child_accessors {
+ _mk_child_classes( mk_accessors => @_ );
+}
+sub mk_child_ro_accessors {
+ _mk_child_classes( mk_ro_accessors => @_ );
+}
+sub mk_child_wo_accessors {
+ _mk_child_classes( mk_wo_accessors => @_ );
+}
+
+sub _mk_child_classes {
+ my $method = shift;
+ my $base = shift;
+ Carp::croak 'Odd number arguments' if scalar @_ % 2;
+ while ( scalar @_ ) {
+ my $name = shift;
+ my $list = shift;
+ Carp::croak 'Invalid child class name' if ref $name;
+ $list = [ grep {$_ ne ''} split( /\s+/, $list )] unless ref $list;
+ my $child = ( $name ne '' ) ? $base.'::'.$name : $base;
+ if ( ! $child->isa( __PACKAGE__ )) {
+ no strict 'refs';
+ push( @{$child.'::ISA'}, __PACKAGE__ );
+ }
+ $child->$method( @$list );
+ }
+}
+
+=head1 NAME
+
+Class::Accessor::Children - Automated child-class/accessor generation
+
+=head1 SYNOPSIS
+
+BEFORE (WITHOUT THIS)
+
+ package MyClass::Foo;
+ use base qw( Class:Accessor );
+ __PACKAGE__->mk_ro_accessors(qw( jacob michael joshua ethan ));
+
+ package MyClass::Bar;
+ use base qw( Class:Accessor );
+ __PACKAGE__->mk_ro_accessors(qw( emily emma madison isabella ));
+
+ package MyClass::Baz;
+ use base qw( Class:Accessor );
+ __PACKAGE__->mk_ro_accessors(qw( haruka haruto miyu yuto ));
+
+AFTER (WITH THIS)
+
+ package MyClass;
+ use base qw( Class::Accessor::Children );
+ __PACKAGE__->mk_child_ro_accessors(
+ Foo => [qw( jacob michael joshua ethan )],
+ Bar => [qw( emily emma madison isabella )],
+ Baz => [qw( haruka haruto miyu yuto )],
+ );
+
+=head1 DESCRIPTION
+
+This module automagically generates child classes
+which have accessor/mutator methods.
+
+This module inherits C<Class::Accessor> to make accessors.
+
+=head1 METHODS
+
+This module provides the following methods in addition to all methods
+provided by C<Class::Accessor>.
+
+=head2 mk_child_accessors
+
+ MyClass->mk_child_accessors( Foo => \@fields, ... );
+
+This generates a child class named C<MyClass::Foo>
+which have accessor/mutator methods each named in C<\@fields>.
+
+=head2 mk_child_ro_accessors
+
+ MyClass->mk_child_ro_accessors( Bar => \@fields, ... );
+
+This generates a child class named C<MyClass::Bar>
+which have read-only accessors (ie. true accessors).
+
+=head2 mk_child_wo_accessors
+
+ MyClass->mk_child_wo_accessors( Baz => \@fields, ... );
+
+This generates a child class named C<MyClass::Baz>
+which have write-only accessor (ie. mutators).
+
+=head1 SEE ALSO
+
+L<Class::Accessor>
+
+=head1 AUTHOR
+
+Yusuke Kawasaki L<http://www.kawa.net/>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (c) 2007 Yusuke Kawasaki. All rights reserved.
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=cut
+1;
Propchange: branches/upstream/libclass-accessor-children-perl/current/lib/Class/Accessor/Children.pm
------------------------------------------------------------------------------
svn:executable =
Added: branches/upstream/libclass-accessor-children-perl/current/lib/Class/Accessor/Children/Fast.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-accessor-children-perl/current/lib/Class/Accessor/Children/Fast.pm?rev=44160&op=file
==============================================================================
--- branches/upstream/libclass-accessor-children-perl/current/lib/Class/Accessor/Children/Fast.pm (added)
+++ branches/upstream/libclass-accessor-children-perl/current/lib/Class/Accessor/Children/Fast.pm Wed Sep 16 18:20:41 2009
@@ -1,0 +1,115 @@
+package Class::Accessor::Children::Fast;
+use base qw( Class::Accessor::Fast );
+use Carp;
+use vars qw( $VERSION );
+$VERSION = '0.02';
+
+sub mk_child_accessors {
+ _mk_child_classes( mk_accessors => @_ );
+}
+sub mk_child_ro_accessors {
+ _mk_child_classes( mk_ro_accessors => @_ );
+}
+sub mk_child_wo_accessors {
+ _mk_child_classes( mk_wo_accessors => @_ );
+}
+
+sub _mk_child_classes {
+ my $method = shift;
+ my $base = shift;
+ Carp::croak 'Odd number arguments' if scalar @_ % 2;
+ while ( scalar @_ ) {
+ my $name = shift;
+ my $list = shift;
+ Carp::croak 'Invalid child class name' if ref $name;
+ $list = [ grep {$_ ne ''} split( /\s+/, $list )] unless ref $list;
+ my $child = ( $name ne '' ) ? $base.'::'.$name : $base;
+ if ( ! $child->isa( __PACKAGE__ )) {
+ no strict 'refs';
+ push( @{$child.'::ISA'}, __PACKAGE__ );
+ }
+ $child->$method( @$list );
+ }
+}
+
+=head1 NAME
+
+Class::Accessor::Children::Fast - Faster, child-class/accessor generation
+
+=head1 SYNOPSIS
+
+BEFORE (WITHOUT THIS)
+
+ package MyClass::Foo;
+ use base qw( Class:Accessor::Fast );
+ __PACKAGE__->mk_ro_accessors(qw( jacob michael joshua ethan ));
+
+ package MyClass::Bar;
+ use base qw( Class:Accessor::Fast );
+ __PACKAGE__->mk_ro_accessors(qw( emily emma madison isabella ));
+
+ package MyClass::Baz;
+ use base qw( Class:Accessor::Fast );
+ __PACKAGE__->mk_ro_accessors(qw( haruka haruto miyu yuto ));
+
+AFTER (WITH THIS)
+
+ package MyClass;
+ use base qw( Class::Accessor::Children::Fast );
+ __PACKAGE__->mk_child_ro_accessors(
+ Foo => [qw( jacob michael joshua ethan )],
+ Bar => [qw( emily emma madison isabella )],
+ Baz => [qw( haruka haruto miyu yuto )],
+ );
+
+=head1 DESCRIPTION
+
+This module automagically generates child classes
+which have accessor/mutator methods.
+
+This module inherits C<Class::Accessor::Fast> to make accessors.
+
+=head1 METHODS
+
+This module provides the following methods in addition to all methods
+provided by C<Class::Accessor::Fast>.
+
+=head2 mk_child_accessors
+
+ MyClass->mk_child_accessors( Foo => \@fields, ... );
+
+This generates a child class named C<MyClass::Foo>
+which have accessor/mutator methods each named in C<\@fields>.
+
+=head2 mk_child_ro_accessors
+
+ MyClass->mk_child_ro_accessors( Bar => \@fields, ... );
+
+This generates a child class named C<MyClass::Bar>
+which have read-only accessors (ie. true accessors).
+
+=head2 mk_child_wo_accessors
+
+ MyClass->mk_child_wo_accessors( Baz => \@fields, ... );
+
+This generates a child class named C<MyClass::Baz>
+which have write-only accessor (ie. mutators).
+
+=head1 SEE ALSO
+
+L<Class::Accessor::Children>
+
+L<Class::Accessor::Fast>
+
+=head1 AUTHOR
+
+Yusuke Kawasaki L<http://www.kawa.net/>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (c) 2007 Yusuke Kawasaki. All rights reserved.
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=cut
+1;
Propchange: branches/upstream/libclass-accessor-children-perl/current/lib/Class/Accessor/Children/Fast.pm
------------------------------------------------------------------------------
svn:executable =
Added: branches/upstream/libclass-accessor-children-perl/current/make-dist.sh
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-accessor-children-perl/current/make-dist.sh?rev=44160&op=file
==============================================================================
--- branches/upstream/libclass-accessor-children-perl/current/make-dist.sh (added)
+++ branches/upstream/libclass-accessor-children-perl/current/make-dist.sh Wed Sep 16 18:20:41 2009
@@ -1,0 +1,29 @@
+#!/bin/sh
+
+die () {
+ echo "$*" >&2
+ exit 1
+}
+doit () {
+ echo "\$ $*" >&2
+ $* || die "[ERROR:$?]"
+}
+
+egrep -v '^t/.*\.t$' MANIFEST > MANIFEST~
+ls -t t/*.t | sort >> MANIFEST~
+diff MANIFEST MANIFEST~ > /dev/null || doit /bin/mv -f MANIFEST~ MANIFEST
+/bin/rm -f MANIFEST~
+
+[ -f Makefile ] && doit rm -f Makefile
+doit perl Makefile.PL
+doit make
+doit make disttest
+
+main=`grep 'lib/.*pm$' < MANIFEST | head -1`
+[ "$main" == "" ] && die "main module is not found in MANIFEST"
+doit pod2text $main > README
+
+doit make dist
+doit /bin/rm -fr blib pm_to_blib
+
+ls -lt *.tar.gz | head -1
Propchange: branches/upstream/libclass-accessor-children-perl/current/make-dist.sh
------------------------------------------------------------------------------
svn:executable =
Added: branches/upstream/libclass-accessor-children-perl/current/t/00_pod.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-accessor-children-perl/current/t/00_pod.t?rev=44160&op=file
==============================================================================
--- branches/upstream/libclass-accessor-children-perl/current/t/00_pod.t (added)
+++ branches/upstream/libclass-accessor-children-perl/current/t/00_pod.t Wed Sep 16 18:20:41 2009
@@ -1,0 +1,12 @@
+use strict;
+use Test::More;
+
+my $FILES = [qw(
+ lib/Class/Accessor/Children.pm
+ lib/Class/Accessor/Children/Fast.pm
+)];
+local $@;
+eval "use Test::Pod 1.00";
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+all_pod_files_ok( @$FILES );
+;1;
Added: branches/upstream/libclass-accessor-children-perl/current/t/01_new.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-accessor-children-perl/current/t/01_new.t?rev=44160&op=file
==============================================================================
--- branches/upstream/libclass-accessor-children-perl/current/t/01_new.t (added)
+++ branches/upstream/libclass-accessor-children-perl/current/t/01_new.t Wed Sep 16 18:20:41 2009
@@ -1,0 +1,18 @@
+# ----------------------------------------------------------------
+ use strict;
+ use Test::More tests => 4;
+# ----------------------------------------------------------------
+{
+ use_ok qw( Class::Accessor::Children );
+ my $api = Class::Accessor::Children->new();
+ ok( ref $api, 'new()' );
+}
+# ----------------------------------------------------------------
+{
+ use_ok qw( Class::Accessor::Children::Fast );
+ my $api = Class::Accessor::Children::Fast->new();
+ ok( ref $api, 'new()' );
+}
+# ----------------------------------------------------------------
+;1;
+# ----------------------------------------------------------------
Added: branches/upstream/libclass-accessor-children-perl/current/t/10_accessors.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-accessor-children-perl/current/t/10_accessors.t?rev=44160&op=file
==============================================================================
--- branches/upstream/libclass-accessor-children-perl/current/t/10_accessors.t (added)
+++ branches/upstream/libclass-accessor-children-perl/current/t/10_accessors.t Wed Sep 16 18:20:41 2009
@@ -1,0 +1,54 @@
+# ----------------------------------------------------------------
+ use strict;
+ use Test::More tests => 15;
+ use_ok qw( Class::Accessor::Children );
+# ----------------------------------------------------------------
+{
+ package Foo;
+ use base qw( Class::Accessor::Children );
+ __PACKAGE__->mk_accessors(qw( one two ));
+ __PACKAGE__->mk_ro_accessors(qw( three four ));
+ __PACKAGE__->mk_wo_accessors(qw( five six ));
+}
+# ----------------------------------------------------------------
+foreach my $class (qw( Foo )) {
+ my $foo = $class->new( {one=>1,three=>3,five=>5} );
+ ok( ref $foo, 'foo - new' );
+ ok( $foo->isa( 'Class::Accessor' ), 'foo - isa' );
+ ok( ! $foo->can( 'zero' ), 'foo - zero' );
+
+ # read
+
+ is( $foo->one, 1, 'read one' );
+ is( $foo->two, undef, 'read two' );
+ is( $foo->three, 3, 'read three' );
+ is( $foo->four, undef, 'read four' );
+ {
+ local $@;
+ eval { $foo->five; };
+ ok( $@, 'read five [write-only]' );
+ }
+
+ # write
+
+ ok( $foo->two( 2 ), 'write two' );
+ {
+ local $@;
+ eval { $foo->four( 4 ); };
+ ok( $@, 'write four [read-only]' );
+ }
+ ok( $foo->six( 6 ), 'write six' );
+
+ # read
+
+ is( $foo->two, 2, 'read two' );
+ is( $foo->four, undef, 'read four' );
+ {
+ local $@;
+ eval { $foo->six; };
+ ok( $@, 'read six [write-only]' );
+ }
+}
+# ----------------------------------------------------------------
+;1;
+# ----------------------------------------------------------------
Added: branches/upstream/libclass-accessor-children-perl/current/t/11_children.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-accessor-children-perl/current/t/11_children.t?rev=44160&op=file
==============================================================================
--- branches/upstream/libclass-accessor-children-perl/current/t/11_children.t (added)
+++ branches/upstream/libclass-accessor-children-perl/current/t/11_children.t Wed Sep 16 18:20:41 2009
@@ -1,0 +1,91 @@
+# ----------------------------------------------------------------
+ use strict;
+ use Test::More tests => 29;
+ use_ok qw( Class::Accessor::Children );
+# ----------------------------------------------------------------
+{
+ package Foo;
+ use base qw( Class::Accessor::Children );
+ __PACKAGE__->mk_child_accessors(
+ Odd => [qw( one seven )],
+ Even => [qw( two eight )],
+ );
+ __PACKAGE__->mk_child_ro_accessors(
+ Odd => [qw( three nine )],
+ Even => [qw( four ten )],
+ );
+ __PACKAGE__->mk_child_wo_accessors(
+ Odd => [qw( five eleven )],
+ Even => [qw( six twelve )],
+ );
+}
+# ----------------------------------------------------------------
+{
+ my $odd = Foo::Odd->new( {one=>1,three=>3,five=>5} );
+ ok( ref $odd, 'odd - new' );
+ ok( $odd->isa( 'Class::Accessor' ), 'odd - isa' );
+ ok( ! $odd->can( 'zero' ), 'odd - zero' );
+
+ my $even = Foo::Even->new( {two=>2,four=>4,six=>6} );
+ ok( ref $even, 'even - new' );
+ ok( $even->isa( 'Class::Accessor' ), 'even - isa' );
+ ok( ! $even->can( 'zero' ), 'even - zero' );
+
+ # read
+
+ is( $odd->one, 1, 'read one' );
+ is( $even->two, 2, 'read two' );
+ is( $odd->three, 3, 'read three' );
+ is( $even->four, 4, 'read four' );
+ {
+ local $@;
+ eval { $odd->five; };
+ ok( $@, 'read five [write-only]' );
+ }
+ {
+ local $@;
+ eval { $even->six; };
+ ok( $@, 'read six [write-only]' );
+ }
+ is( $odd->seven, undef, 'read three' );
+ is( $even->eight, undef, 'read eight' );
+ is( $odd->nine, undef, 'read nine' );
+ is( $even->ten, undef, 'read ten' );
+
+ # write
+
+ ok( $odd->seven( 7 ), 'write seven' );
+ ok( $even->eight( 8 ), 'write eight' );
+ {
+ local $@;
+ eval { $odd->nine( 9 ); };
+ ok( $@, 'write nine [read-only]' );
+ }
+ {
+ local $@;
+ eval { $odd->ten( 10 ); };
+ ok( $@, 'write ten [read-only]' );
+ }
+ ok( $odd->eleven( 11 ), 'write eleven' );
+ ok( $even->twelve( 12 ), 'write twelve' );
+
+ # read
+
+ is( $odd->seven, 7, 'read three' );
+ is( $even->eight, 8, 'read eight' );
+ is( $odd->nine, undef, 'read nine' );
+ is( $even->ten, undef, 'read ten' );
+ {
+ local $@;
+ eval { $odd->eleven; };
+ ok( $@, 'read eleven [write-only]' );
+ }
+ {
+ local $@;
+ eval { $even->twelve; };
+ ok( $@, 'read twelve [write-only]' );
+ }
+}
+# ----------------------------------------------------------------
+;1;
+# ----------------------------------------------------------------
Added: branches/upstream/libclass-accessor-children-perl/current/t/12_error.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-accessor-children-perl/current/t/12_error.t?rev=44160&op=file
==============================================================================
--- branches/upstream/libclass-accessor-children-perl/current/t/12_error.t (added)
+++ branches/upstream/libclass-accessor-children-perl/current/t/12_error.t Wed Sep 16 18:20:41 2009
@@ -1,0 +1,40 @@
+# ----------------------------------------------------------------
+ package Foo;
+ use strict;
+ use Test::More tests => 9;
+ use_ok qw( Class::Accessor::Children );
+ use base qw( Class::Accessor::Children );
+# ----------------------------------------------------------------
+{
+ {
+ local $@;
+ eval { __PACKAGE__->mk_child_accessors(); };
+ ok( ! $@, 'no accessors' );
+ }
+ {
+ local $@;
+ eval { __PACKAGE__->mk_child_accessors( 'odd' ); };
+ ok( $@, 'odd number arguments' );
+ }
+ {
+ local $@;
+ eval { __PACKAGE__->mk_child_accessors( [], [] ); };
+ ok( $@, 'Invalid child class name' );
+ }
+ {
+ local $@;
+ eval { __PACKAGE__->mk_child_accessors( child => 'aaa bbb' ); };
+ ok( ! $@, 'scalar' );
+ ok( Foo::child->can( 'aaa' ), 'split 1' );
+ ok( Foo::child->can( 'bbb' ), 'split 2' );
+ }
+ {
+ local $@;
+ eval { __PACKAGE__->mk_child_accessors( '' => [qw( ccc )] ); };
+ ok( ! $@, 'zero' );
+ ok( Foo->can( 'ccc' ), 'base' );
+ }
+}
+# ----------------------------------------------------------------
+;1;
+# ----------------------------------------------------------------
Added: branches/upstream/libclass-accessor-children-perl/current/t/20_accessors_fast.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-accessor-children-perl/current/t/20_accessors_fast.t?rev=44160&op=file
==============================================================================
--- branches/upstream/libclass-accessor-children-perl/current/t/20_accessors_fast.t (added)
+++ branches/upstream/libclass-accessor-children-perl/current/t/20_accessors_fast.t Wed Sep 16 18:20:41 2009
@@ -1,0 +1,54 @@
+# ----------------------------------------------------------------
+ use strict;
+ use Test::More tests => 15;
+ use_ok qw( Class::Accessor::Children::Fast );
+# ----------------------------------------------------------------
+{
+ package Foo;
+ use base qw( Class::Accessor::Children::Fast );
+ __PACKAGE__->mk_accessors(qw( one two ));
+ __PACKAGE__->mk_ro_accessors(qw( three four ));
+ __PACKAGE__->mk_wo_accessors(qw( five six ));
+}
+# ----------------------------------------------------------------
+foreach my $class (qw( Foo )) {
+ my $foo = $class->new( {one=>1,three=>3,five=>5} );
+ ok( ref $foo, 'foo - new' );
+ ok( $foo->isa( 'Class::Accessor' ), 'foo - isa' );
+ ok( ! $foo->can( 'zero' ), 'foo - zero' );
+
+ # read
+
+ is( $foo->one, 1, 'read one' );
+ is( $foo->two, undef, 'read two' );
+ is( $foo->three, 3, 'read three' );
+ is( $foo->four, undef, 'read four' );
+ {
+ local $@;
+ eval { $foo->five; };
+ ok( $@, 'read five [write-only]' );
+ }
+
+ # write
+
+ ok( $foo->two( 2 ), 'write two' );
+ {
+ local $@;
+ eval { $foo->four( 4 ); };
+ ok( $@, 'write four [read-only]' );
+ }
+ ok( $foo->six( 6 ), 'write six' );
+
+ # read
+
+ is( $foo->two, 2, 'read two' );
+ is( $foo->four, undef, 'read four' );
+ {
+ local $@;
+ eval { $foo->six; };
+ ok( $@, 'read six [write-only]' );
+ }
+}
+# ----------------------------------------------------------------
+;1;
+# ----------------------------------------------------------------
Added: branches/upstream/libclass-accessor-children-perl/current/t/21_children_fast.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-accessor-children-perl/current/t/21_children_fast.t?rev=44160&op=file
==============================================================================
--- branches/upstream/libclass-accessor-children-perl/current/t/21_children_fast.t (added)
+++ branches/upstream/libclass-accessor-children-perl/current/t/21_children_fast.t Wed Sep 16 18:20:41 2009
@@ -1,0 +1,91 @@
+# ----------------------------------------------------------------
+ use strict;
+ use Test::More tests => 29;
+ use_ok qw( Class::Accessor::Children::Fast );
+# ----------------------------------------------------------------
+{
+ package Foo;
+ use base qw( Class::Accessor::Children::Fast );
+ __PACKAGE__->mk_child_accessors(
+ Odd => [qw( one seven )],
+ Even => [qw( two eight )],
+ );
+ __PACKAGE__->mk_child_ro_accessors(
+ Odd => [qw( three nine )],
+ Even => [qw( four ten )],
+ );
+ __PACKAGE__->mk_child_wo_accessors(
+ Odd => [qw( five eleven )],
+ Even => [qw( six twelve )],
+ );
+}
+# ----------------------------------------------------------------
+{
+ my $odd = Foo::Odd->new( {one=>1,three=>3,five=>5} );
+ ok( ref $odd, 'odd - new' );
+ ok( $odd->isa( 'Class::Accessor' ), 'odd - isa' );
+ ok( ! $odd->can( 'zero' ), 'odd - zero' );
+
+ my $even = Foo::Even->new( {two=>2,four=>4,six=>6} );
+ ok( ref $even, 'even - new' );
+ ok( $even->isa( 'Class::Accessor' ), 'even - isa' );
+ ok( ! $even->can( 'zero' ), 'even - zero' );
+
+ # read
+
+ is( $odd->one, 1, 'read one' );
+ is( $even->two, 2, 'read two' );
+ is( $odd->three, 3, 'read three' );
+ is( $even->four, 4, 'read four' );
+ {
+ local $@;
+ eval { $odd->five; };
+ ok( $@, 'read five [write-only]' );
+ }
+ {
+ local $@;
+ eval { $even->six; };
+ ok( $@, 'read six [write-only]' );
+ }
+ is( $odd->seven, undef, 'read three' );
+ is( $even->eight, undef, 'read eight' );
+ is( $odd->nine, undef, 'read nine' );
+ is( $even->ten, undef, 'read ten' );
+
+ # write
+
+ ok( $odd->seven( 7 ), 'write seven' );
+ ok( $even->eight( 8 ), 'write eight' );
+ {
+ local $@;
+ eval { $odd->nine( 9 ); };
+ ok( $@, 'write nine [read-only]' );
+ }
+ {
+ local $@;
+ eval { $odd->ten( 10 ); };
+ ok( $@, 'write ten [read-only]' );
+ }
+ ok( $odd->eleven( 11 ), 'write eleven' );
+ ok( $even->twelve( 12 ), 'write twelve' );
+
+ # read
+
+ is( $odd->seven, 7, 'read three' );
+ is( $even->eight, 8, 'read eight' );
+ is( $odd->nine, undef, 'read nine' );
+ is( $even->ten, undef, 'read ten' );
+ {
+ local $@;
+ eval { $odd->eleven; };
+ ok( $@, 'read eleven [write-only]' );
+ }
+ {
+ local $@;
+ eval { $even->twelve; };
+ ok( $@, 'read twelve [write-only]' );
+ }
+}
+# ----------------------------------------------------------------
+;1;
+# ----------------------------------------------------------------
Added: branches/upstream/libclass-accessor-children-perl/current/t/22_error_fast.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-accessor-children-perl/current/t/22_error_fast.t?rev=44160&op=file
==============================================================================
--- branches/upstream/libclass-accessor-children-perl/current/t/22_error_fast.t (added)
+++ branches/upstream/libclass-accessor-children-perl/current/t/22_error_fast.t Wed Sep 16 18:20:41 2009
@@ -1,0 +1,40 @@
+# ----------------------------------------------------------------
+ package Foo;
+ use strict;
+ use Test::More tests => 9;
+ use_ok qw( Class::Accessor::Children::Fast );
+ use base qw( Class::Accessor::Children::Fast );
+# ----------------------------------------------------------------
+{
+ {
+ local $@;
+ eval { __PACKAGE__->mk_child_accessors(); };
+ ok( ! $@, 'no accessors' );
+ }
+ {
+ local $@;
+ eval { __PACKAGE__->mk_child_accessors( 'odd' ); };
+ ok( $@, 'odd number arguments' );
+ }
+ {
+ local $@;
+ eval { __PACKAGE__->mk_child_accessors( [], [] ); };
+ ok( $@, 'Invalid child class name' );
+ }
+ {
+ local $@;
+ eval { __PACKAGE__->mk_child_accessors( child => 'aaa bbb' ); };
+ ok( ! $@, 'scalar' );
+ ok( Foo::child->can( 'aaa' ), 'split 1' );
+ ok( Foo::child->can( 'bbb' ), 'split 2' );
+ }
+ {
+ local $@;
+ eval { __PACKAGE__->mk_child_accessors( '' => [qw( ccc )] ); };
+ ok( ! $@, 'zero' );
+ ok( Foo->can( 'ccc' ), 'base' );
+ }
+}
+# ----------------------------------------------------------------
+;1;
+# ----------------------------------------------------------------
More information about the Pkg-perl-cvs-commits
mailing list