foo

diff --git a/Changes b/Changes
index 7c6622c..81af1f7 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,6 +1,10 @@
 Revision history for Perl extension Moose
 
 0.25
+    * Moose::Cookbook::Recipe7 
+      - added new recipe for augment/inner functionality
+        - added test for this
+
     * Moose::Meta::Attribute
       - required attributes now will no longer accept undef 
         from the constructor, even if there is a default and lazy
@@ -8,6 +12,13 @@ Revision history for Perl extension Moose
       - default subroutines must return a value which passes the 
         type constraint
         - added tests for this
+    
+    * Moose::Meta::Attribute
+    * Moose::Meta::Method::Constructor
+    * Moose::Meta::Method::Accessor        
+      - type-constraint tests now handle overloaded objects correctly
+        in the error message
+        - added tests for this (thanks to EvanCarroll) 
 
     * Moose::Meta::Role
       - massive refactoring of this code

diff --git a/lib/Moose/Cookbook/Recipe7.pod b/lib/Moose/Cookbook/Recipe7.pod
new file mode 100644 (file)
index 0000000..f53df9c
--- /dev/null
+++ b/lib/Moose/Cookbook/Recipe7.pod
@@ -0,0 +1,82 @@
+
+=pod
+
+=head1 NAME
+
+Moose::Cookbook::Recipe7 - The augment/inner example
+
+=head1 SYNOPSIS
+  
+  package Document::Page;
+  use Moose;
+  
+  has 'body' => (is => 'rw', isa => 'Str', default => sub {''});
+  
+  sub create {
+      my $self = shift;
+      $self->open_page;
+      inner();
+      $self->close_page;
+  }
+  
+  sub append_body { 
+      my ($self, $appendage) = @_;
+      $self->body($self->body . $appendage);
+  }
+  
+  sub open_page { (shift)->append_body('<page>') }
+  sub open_page { (shift)->append_body('</page>') }  
+  
+  package MyDocument::PageWithHeadersAndFooters;
+  use Moose;
+  
+  extends 'Document::Page';
+  
+  augment create => sub {
+      my $self = shift;
+      $self->create_header;
+      inner();
+      $self->create_footer;
+  }
+  
+  sub create_header { (shift)->append_body('<header/>') }
+  sub create_footer { (shift)->append_body('<footer/>') }  
+  
+  package MyDocument::TPSReport;
+  use Moose;
+  
+  extends 'MyDocument::PageWithHeadersAndFooters';
+  
+  augment create => sub {
+      my $self = shift;
+      $self->create_tps_report;
+  };
+  
+  sub create_tps_report {
+     (shift)->append_body('<report type="tps"/>') 
+  }
+
+=head1 DESCRIPTION
+
+=head1 CONCLUSION
+
+=head1 FOOTNOTES
+
+=over 4
+
+=back
+
+=head1 AUTHOR
+
+Stevan Little E<lt>stevan@iinteractive.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2006, 2007 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut       

diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm
index c6e4abf..e50fe7d 100644 (file)
--- a/lib/Moose/Meta/Attribute.pm
+++ b/lib/Moose/Meta/Attribute.pm
@@ -6,6 +6,7 @@ use warnings;
 
 use Scalar::Util 'blessed', 'weaken', 'reftype';
 use Carp         'confess';
+use overload     ();
 
 our $VERSION   = '0.11';
 our $AUTHORITY = 'cpan:STEVAN';
@@ -237,7 +238,13 @@ sub initialize_instance_slot {
                            $self->name . 
                            ") does not pass the type constraint (" . 
                            $type_constraint->name .
-                           ") with '" . (defined $val ? $val : 'undef') . "'";                 
+                           ") with '" . 
+                           (defined $val 
+                               ? (overload::Overloaded($val) 
+                                    ? overload::StrVal($val) 
+                                    : $val) 
+                               : 'undef') . 
+                           "'";                        
         }
        }
 
@@ -267,7 +274,11 @@ sub set_value {
         }
         defined($type_constraint->_compiled_type_constraint->($value))
                || confess "Attribute ($attr_name) does not pass the type constraint ("
-               . $type_constraint->name . ") with " . (defined($value) ? ("'" . $value . "'") : "undef")
+               . $type_constraint->name 
+               . ") with " 
+               . (defined($value) 
+                    ? ("'" . (overload::Overloaded($value) ? overload::StrVal($value) : $value) . "'") 
+                    : "undef")
           if defined($value);
     }
     

diff --git a/lib/Moose/Meta/Method/Accessor.pm b/lib/Moose/Meta/Method/Accessor.pm
index d02ec24..4a16288 100644 (file)
--- a/lib/Moose/Meta/Method/Accessor.pm
+++ b/lib/Moose/Meta/Method/Accessor.pm
@@ -114,10 +114,11 @@ sub _inline_check_constraint {
        
        return '' unless $attr->has_type_constraint;
        
-       return sprintf <<'EOF', $value, $value, $value, $value
+       return sprintf <<'EOF', $value, $value, $value, $value, $value, $value
 defined($type_constraint->(%s))
        || confess "Attribute (" . $attr->name . ") does not pass the type constraint ("
-       . $attr->type_constraint->name . ") with " . (defined(%s) ? "'%s'" : "undef")
+       . $attr->type_constraint->name . ") with " 
+       . (defined(%s) ? (overload::Overloaded(%s) ? overload::StrVal(%s) : %s) : "undef")
   if defined(%s);
 EOF
 }
@@ -153,7 +154,7 @@ sub _inline_check_lazy {
                       : '') .
                '        (defined($type_constraint->($default)))' .
                '               || confess "Attribute (" . $attr->name . ") does not pass the type constraint ("' .
-               '               . $attr->type_constraint->name . ") with " . (defined($default) ? "\'$default\'" : "undef")' .
+               '               . $attr->type_constraint->name . ") with " . (defined($default) ? (overload::Overloaded($default) ? overload::StrVal($default) : $default) : "undef")' .               
                '          if defined($default);' .                     
                   '        $_[0]->{$attr_name} = $default; ' .
                   '    }' .

diff --git a/lib/Moose/Meta/Method/Constructor.pm b/lib/Moose/Meta/Method/Constructor.pm
index 4553078..1fcc5ab 100644 (file)
--- a/lib/Moose/Meta/Method/Constructor.pm
+++ b/lib/Moose/Meta/Method/Constructor.pm
@@ -202,7 +202,8 @@ sub _generate_type_constraint_check {
     return (
         'defined(' . $type_constraint_name . '->_compiled_type_constraint->(' . $value_name . '))'
        . "\n\t" . '|| confess "Attribute (' . $attr->name . ') does not pass the type constraint ('
-        . $attr->type_constraint->name . ') with " . (defined() ? "' . $value_name . '" : "undef");'
+        . $attr->type_constraint->name 
+        . ') with " . (defined(' . $value_name . ') ? (overload::Overloaded(' . $value_name . ') ? overload::StrVal(' . $value_name . ') : ' . $value_name . ') : "undef");'
     );    
 }
 

diff --git a/t/007_recipe.t b/t/007_recipe.t
new file mode 100644 (file)
index 0000000..3b62cca
--- /dev/null
+++ b/t/007_recipe.t
@@ -0,0 +1,76 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More no_plan => 1;
+use Test::Exception;
+
+BEGIN {
+    use_ok('Moose');           
+}
+
+## Augment/Inner
+
+{
+    package Document::Page;
+    use Moose;
+
+    has 'body' => (is => 'rw', isa => 'Str', default => sub {''});
+
+    sub create {
+        my $self = shift;
+        $self->open_page;
+        inner();
+        $self->close_page;
+    }
+
+    sub append_body { 
+        my ($self, $appendage) = @_;
+        $self->body($self->body . $appendage);
+    }
+
+    sub open_page  { (shift)->append_body('<page>') }
+    sub close_page { (shift)->append_body('</page>') }  
+
+    package Document::PageWithHeadersAndFooters;
+    use Moose;
+
+    extends 'Document::Page';
+
+    augment 'create' => sub {
+        my $self = shift;
+        $self->create_header;
+        inner();
+        $self->create_footer;
+    };
+
+    sub create_header { (shift)->append_body('<header/>') }
+    sub create_footer { (shift)->append_body('<footer/>') }  
+
+    package TPSReport;
+    use Moose;
+
+    extends 'Document::PageWithHeadersAndFooters';
+
+    augment 'create' => sub {
+        my $self = shift;
+        $self->create_tps_report;
+    };
+
+    sub create_tps_report {
+       (shift)->append_body('<report type="tps"/>') 
+    }    
+}
+
+my $tps_report = TPSReport->new;
+isa_ok($tps_report, 'TPSReport');
+
+is(
+$tps_report->create, 
+q{<page><header/><report type="tps"/><footer/></page>},
+'... got the right TPS report');
+
+
+
+

diff --git a/t/071_misc_attribute_tests.t b/t/071_misc_attribute_tests.t
index 808e646..79391d1 100644 (file)
--- a/t/071_misc_attribute_tests.t
+++ b/t/071_misc_attribute_tests.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 9;
+use Test::More tests => 12;
 use Test::Exception;
 
 BEGIN {
@@ -104,3 +104,25 @@ BEGIN {
     
 }
 
+{
+    {
+        package OverloadedStr;
+        use Moose;
+        use overload '""' => sub { 'this is *not* a string' };
+
+        has 'a_str' => ( isa => 'Str' , is => 'rw' );
+    }
+
+    my $moose_obj = OverloadedStr->new;
+
+    is($moose_obj->a_str( 'foobar' ), 'foobar', 'setter took string');
+    ok($moose_obj, 'this is a *not* a string');
+
+    throws_ok { 
+        $moose_obj->a_str( $moose_obj ) 
+    } qr/Attribute \(a_str\) does not pass the type constraint \(Str\) with OverloadedStr\=HASH\(.*?\)/, '... dies without overloading the string';
+
+}
+
+
+