From: gfx <gfuji@cpan.org>
Date: Fri, 9 Oct 2009 05:03:00 +0000 (+0900)
Subject: Replace a moose recipe
X-Git-Tag: 0.37_05~11
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=596dcb263138e513428bb4af02d9be3505948a03;p=gitmo%2FMouse.git

Replace a moose recipe
---

diff --git a/t/000_recipes/001_point.t b/t/000_recipes/001_point.t
deleted file mode 100644
index 0d1b9a9..0000000
--- a/t/000_recipes/001_point.t
+++ /dev/null
@@ -1,200 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-use Test::More tests => 59;
-
-use Mouse::Util;
-use Test::Exception;
-
-{
-	package Point;	
-	use Mouse;
-		
-	has 'x' => (isa => 'Int', is => 'ro');
-	has 'y' => (isa => 'Int', is => 'rw');
-	
-	sub clear {
-	    my $self = shift;
-	    $self->{x} = 0;
-	    $self->y(0);    
-	}
-	
-    __PACKAGE__->meta->make_immutable();
-}{	
-	package Point3D;
-	use Mouse;
-	
-	extends 'Point';
-	
-	has 'z' => (isa => 'Int', is => 'bare');
-	
-	after 'clear' => sub {
-	    my $self = shift;
-	    $self->{z} = 0;
-	};
-	
-    __PACKAGE__->meta->make_immutable();
-}
-
-my $point = Point->new(x => 1, y => 2);	
-isa_ok($point, 'Point');
-isa_ok($point, 'Mouse::Object');
-
-is($point->x, 1, '... got the right value for x');
-is($point->y, 2, '... got the right value for y');
-
-$point->y(10);
-is($point->y, 10, '... got the right (changed) value for y');
-
-dies_ok {
-	$point->y('Foo');
-} '... cannot assign a non-Int to y';
-
-dies_ok {
-    $point->x(1000);
-} '... cannot assign to a read-only method';
-is($point->x, 1, '... got the right (un-changed) value for x');
-
-$point->clear();
-
-is($point->x, 0, '... got the right (cleared) value for x');
-is($point->y, 0, '... got the right (cleared) value for y');
-
-# check the type constraints on the constructor
-
-lives_ok {
-	Point->new(x => 0, y => 0);
-} '... can assign a 0 to x and y';
-
-dies_ok {
-	Point->new(x => 10, y => 'Foo');
-} '... cannot assign a non-Int to y';
-
-dies_ok {
-	Point->new(x => 'Foo', y => 10);
-} '... cannot assign a non-Int to x';
-
-# Point3D
-
-my $point3d = Point3D->new({ x => 10, y => 15, z => 3 });
-isa_ok($point3d, 'Point3D');
-isa_ok($point3d, 'Point');
-isa_ok($point3d, 'Mouse::Object');
-
-is($point3d->x, 10, '... got the right value for x');
-is($point3d->y, 15, '... got the right value for y');
-is($point3d->{'z'}, 3, '... got the right value for z');
-
-dies_ok {
-	$point3d->z;
-} '... there is no method for z';
-
-$point3d->clear();
-
-is($point3d->x, 0, '... got the right (cleared) value for x');
-is($point3d->y, 0, '... got the right (cleared) value for y');
-is($point3d->{'z'}, 0, '... got the right (cleared) value for z');
-
-dies_ok {
-	Point3D->new(x => 10, y => 'Foo', z => 3);
-} '... cannot assign a non-Int to y';
-
-dies_ok {
-	Point3D->new(x => 'Foo', y => 10, z => 3);
-} '... cannot assign a non-Int to x';
-
-dies_ok {
-	Point3D->new(x => 0, y => 10, z => 'Bar');
-} '... cannot assign a non-Int to z';
-
-# test some class introspection
-
-can_ok('Point', 'meta');
-isa_ok(Point->meta, 'Mouse::Meta::Class');
-
-can_ok('Point3D', 'meta');
-isa_ok(Point3D->meta, 'Mouse::Meta::Class');
-
-isnt(Point->meta, Point3D->meta, '... they are different metaclasses as well');
-
-# poke at Point
-
-is_deeply(
-	[ Point->meta->superclasses ],
-	[ 'Mouse::Object' ],
-	'... Point got the automagic base class');
-
-my @Point_methods = qw(meta new x y clear DESTROY);
-my @Point_attrs   = ('x', 'y');
-
-is_deeply(
-    [ sort @Point_methods                 ],
-    [ sort Point->meta->get_method_list() ],
-    '... we match the method list for Point');
-
-SKIP: {
-    skip "Mouse has no method introspection", 1 + @Point_methods;
-        
-    is_deeply(
-        [ sort @Point_attrs                      ],
-        [ sort Point->meta->get_attribute_list() ],
-        '... we match the attribute list for Point');	
-
-    foreach my $method (@Point_methods) {
-        ok(Point->meta->has_method($method), '... Point has the method "' . $method . '"');
-    }
-}
-
-foreach my $attr_name (@Point_attrs ) {
-	ok(Point->meta->has_attribute($attr_name), '... Point has the attribute "' . $attr_name . '"');    
-    my $attr = Point->meta->get_attribute($attr_name);
-	ok($attr->has_type_constraint, '... Attribute ' . $attr_name . ' has a type constraint');
-
-    SKIP: {
-        skip "Mouse type constraints are not objects", 2;
-        isa_ok($attr->type_constraint, 'Mouse::Meta::TypeConstraint');	
-        is($attr->type_constraint->name, 'Int', '... Attribute ' . $attr_name . ' has an Int type constraint');	
-    }
-}
-
-# poke at Point3D
-
-is_deeply(
-	[ Point3D->meta->superclasses ],
-	[ 'Point' ],
-	'... Point3D gets the parent given to it');
-
-my @Point3D_methods = qw(new meta clear DESTROY);
-my @Point3D_attrs   = ('z');
-
-SKIP: {
-    skip "Mouse has no method introspection", 2 + @Point3D_methods;
-
-    is_deeply(
-        [ sort @Point3D_methods                 ],
-        [ sort Point3D->meta->get_method_list() ],
-        '... we match the method list for Point3D');
-        
-    is_deeply(
-        [ sort @Point3D_attrs                      ],
-        [ sort Point3D->meta->get_attribute_list() ],
-        '... we match the attribute list for Point3D');	
-
-    foreach my $method (@Point3D_methods) {
-        ok(Point3D->meta->has_method($method), '... Point3D has the method "' . $method . '"');
-    }
-};
-
-foreach my $attr_name (@Point3D_attrs ) {
-	ok(Point3D->meta->has_attribute($attr_name), '... Point3D has the attribute "' . $attr_name . '"');    
-    my $attr = Point3D->meta->get_attribute($attr_name);
-	ok($attr->has_type_constraint, '... Attribute ' . $attr_name . ' has a type constraint');
-    SKIP: {
-        skip "Mouse type constraints are not objects", 2;
-        isa_ok($attr->type_constraint, 'Mouse::Meta::TypeConstraint');	
-        is($attr->type_constraint->name, 'Int', '... Attribute ' . $attr_name . ' has an Int type constraint');	
-    };
-}
-
diff --git a/t/000_recipes/moose_cookbook_basics_recipe1.t b/t/000_recipes/moose_cookbook_basics_recipe1.t
new file mode 100644
index 0000000..6288f17
--- /dev/null
+++ b/t/000_recipes/moose_cookbook_basics_recipe1.t
@@ -0,0 +1,222 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More 'no_plan';
+use Test::Exception;
+$| = 1;
+
+
+
+# =begin testing SETUP
+{
+
+  package Point;
+  use Mouse;
+
+  has 'x' => (isa => 'Int', is => 'rw', required => 1);
+  has 'y' => (isa => 'Int', is => 'rw', required => 1);
+
+  sub clear {
+      my $self = shift;
+      $self->x(0);
+      $self->y(0);
+  }
+
+  package Point3D;
+  use Mouse;
+
+  extends 'Point';
+
+  has 'z' => (isa => 'Int', is => 'rw', required => 1);
+
+  after 'clear' => sub {
+      my $self = shift;
+      $self->z(0);
+  };
+
+  package main;
+
+  # hash or hashrefs are ok for the constructor
+  my $point1 = Point->new(x => 5, y => 7);
+  my $point2 = Point->new({x => 5, y => 7});
+
+  my $point3d = Point3D->new(x => 5, y => 42, z => -5);
+}
+
+
+
+# =begin testing
+{
+my $point = Point->new( x => 1, y => 2 );
+isa_ok( $point, 'Point' );
+isa_ok( $point, 'Mouse::Object' );
+
+is( $point->x, 1, '... got the right value for x' );
+is( $point->y, 2, '... got the right value for y' );
+
+$point->y(10);
+is( $point->y, 10, '... got the right (changed) value for y' );
+
+dies_ok {
+    $point->y('Foo');
+}
+'... cannot assign a non-Int to y';
+
+dies_ok {
+    Point->new();
+}
+'... must provide required attributes to new';
+
+$point->clear();
+
+is( $point->x, 0, '... got the right (cleared) value for x' );
+is( $point->y, 0, '... got the right (cleared) value for y' );
+
+# check the type constraints on the constructor
+
+lives_ok {
+    Point->new( x => 0, y => 0 );
+}
+'... can assign a 0 to x and y';
+
+dies_ok {
+    Point->new( x => 10, y => 'Foo' );
+}
+'... cannot assign a non-Int to y';
+
+dies_ok {
+    Point->new( x => 'Foo', y => 10 );
+}
+'... cannot assign a non-Int to x';
+
+# Point3D
+
+my $point3d = Point3D->new( { x => 10, y => 15, z => 3 } );
+isa_ok( $point3d, 'Point3D' );
+isa_ok( $point3d, 'Point' );
+isa_ok( $point3d, 'Mouse::Object' );
+
+is( $point3d->x,     10, '... got the right value for x' );
+is( $point3d->y,     15, '... got the right value for y' );
+is( $point3d->{'z'}, 3,  '... got the right value for z' );
+
+$point3d->clear();
+
+is( $point3d->x, 0, '... got the right (cleared) value for x' );
+is( $point3d->y, 0, '... got the right (cleared) value for y' );
+is( $point3d->z, 0, '... got the right (cleared) value for z' );
+
+dies_ok {
+    Point3D->new( x => 10, y => 'Foo', z => 3 );
+}
+'... cannot assign a non-Int to y';
+
+dies_ok {
+    Point3D->new( x => 'Foo', y => 10, z => 3 );
+}
+'... cannot assign a non-Int to x';
+
+dies_ok {
+    Point3D->new( x => 0, y => 10, z => 'Bar' );
+}
+'... cannot assign a non-Int to z';
+
+dies_ok {
+    Point3D->new( x => 10, y => 3 );
+}
+'... z is a required attribute for Point3D';
+
+# test some class introspection
+
+can_ok( 'Point', 'meta' );
+isa_ok( Point->meta, 'Mouse::Meta::Class' );
+
+can_ok( 'Point3D', 'meta' );
+isa_ok( Point3D->meta, 'Mouse::Meta::Class' );
+
+isnt( Point->meta, Point3D->meta,
+    '... they are different metaclasses as well' );
+
+# poke at Point
+
+is_deeply(
+    [ Point->meta->superclasses ],
+    ['Mouse::Object'],
+    '... Point got the automagic base class'
+);
+
+my @Point_methods = qw(meta x y clear);
+my @Point_attrs = ( 'x', 'y' );
+
+is_deeply(
+    [ sort @Point_methods ],
+    [ sort Point->meta->get_method_list() ],
+    '... we match the method list for Point'
+);
+
+is_deeply(
+    [ sort @Point_attrs ],
+    [ sort Point->meta->get_attribute_list() ],
+    '... we match the attribute list for Point'
+);
+
+foreach my $method (@Point_methods) {
+    ok( Point->meta->has_method($method),
+        '... Point has the method "' . $method . '"' );
+}
+
+foreach my $attr_name (@Point_attrs) {
+    ok( Point->meta->has_attribute($attr_name),
+        '... Point has the attribute "' . $attr_name . '"' );
+    my $attr = Point->meta->get_attribute($attr_name);
+    ok( $attr->has_type_constraint,
+        '... Attribute ' . $attr_name . ' has a type constraint' );
+    isa_ok( $attr->type_constraint, 'Mouse::Meta::TypeConstraint' );
+    is( $attr->type_constraint->name, 'Int',
+        '... Attribute ' . $attr_name . ' has an Int type constraint' );
+}
+
+# poke at Point3D
+
+is_deeply(
+    [ Point3D->meta->superclasses ],
+    ['Point'],
+    '... Point3D gets the parent given to it'
+);
+
+my @Point3D_methods = qw( meta z clear );
+my @Point3D_attrs   = ('z');
+
+is_deeply(
+    [ sort @Point3D_methods ],
+    [ sort Point3D->meta->get_method_list() ],
+    '... we match the method list for Point3D'
+);
+
+is_deeply(
+    [ sort @Point3D_attrs ],
+    [ sort Point3D->meta->get_attribute_list() ],
+    '... we match the attribute list for Point3D'
+);
+
+foreach my $method (@Point3D_methods) {
+    ok( Point3D->meta->has_method($method),
+        '... Point3D has the method "' . $method . '"' );
+}
+
+foreach my $attr_name (@Point3D_attrs) {
+    ok( Point3D->meta->has_attribute($attr_name),
+        '... Point3D has the attribute "' . $attr_name . '"' );
+    my $attr = Point3D->meta->get_attribute($attr_name);
+    ok( $attr->has_type_constraint,
+        '... Attribute ' . $attr_name . ' has a type constraint' );
+    isa_ok( $attr->type_constraint, 'Mouse::Meta::TypeConstraint' );
+    is( $attr->type_constraint->name, 'Int',
+        '... Attribute ' . $attr_name . ' has an Int type constraint' );
+}
+}
+
+
+
+
+1;