[svn-upgrade] Integrating new upstream version, librose-object-perl (0.855)

Changes

+0.855 (01.22.2009) - John Siracusa <siracusa@gmail.com>
+
+    * Added Class::XSAccessor support.
+
 0.854 (12.09.2008) - John Siracusa <siracusa@gmail.com>
 
     * Altered the default name for the adds_method and inherits_method

MANIFEST

@@ -13,6 +13,7 @@ t/basic.t
 t/lib/Person1.pm
 t/lib/Person2.pm
 t/makemethods.t
+t/makemethods-xs.t
 t/pod.t
 t/redefine.t
 META.yml                                 Module meta-data (added by MakeMaker)

META.yml

 --- #YAML:1.0
 name:               Rose-Object
-version:            0.854
+version:            0.855
 abstract:           A simple object base class.
 author:
     - John Siracusa <siracusa@gmail.com>

lib/Rose/Object.pm

@@ -2,7 +2,7 @@ package Rose::Object;
 
 use strict;
 
-our $VERSION = '0.854';
+our $VERSION = '0.855';
 
 sub new
 {

lib/Rose/Object/MakeMethods.pm

@@ -8,6 +8,8 @@ our $VERSION = '0.85';
 
 __PACKAGE__->allow_apparent_reload(1);
 
+our %Made_Method_Custom;
+
 sub import
 {
   my($class) = shift;
@@ -117,7 +119,7 @@ sub __make_methods
     METHOD: while(my($name, $code) = each(%$make))
     {
       Carp::croak "${class}::method_type(...) - key for $name is not a code ref!"
-        unless(ref $code eq 'CODE');
+        unless(ref $code eq 'CODE' || (ref $code eq 'HASH' && $code->{'make_method'}));
 
       if(my $code = $target_class->can($name))
       {
@@ -138,7 +140,18 @@ sub __make_methods
       }
 
       no warnings;
-      *{"${target_class}::$name"} = $code;
+
+      if(ref $code eq 'CODE')
+      {
+        *{"${target_class}::$name"} = $code;
+      }
+      else
+      {
+        # XXX: Must track these separately because they do not show up as
+        # XXX: being named __ANON__ when fetching the sub_identity()
+        $Made_Method_Custom{$target_class}{$name}++;
+        $code->{'make_method'}($name, $target_class, $options);
+      }
     }
   }
 
@@ -150,13 +163,14 @@ sub apparently_made_method
   my($class, $code) = @_;
   my($mm_class, $name) = $class->sub_identity($code);
   return 0  unless($class && $name);
-  return ($mm_class eq $class && $name eq '__ANON__') ? 1 : 0;
+  return (($mm_class eq $class && $name eq '__ANON__') ||
+          $Made_Method_Custom{$mm_class}{$name}) ? 1 : 0;
 }
 
 # Code from Sub::Identify
 sub sub_identity
 {
-  my($clas, $code) = @_;
+  my($class, $code) = @_;
 
   my @id;
 

lib/Rose/Object/MixIn.pm

@@ -306,6 +306,6 @@ John C. Siracusa (siracusa@gmail.com)
 
 =head1 LICENSE
 
-Copyright (c) 2008 by John C. Siracusa.  All rights reserved.  This program is
+Copyright (c) 2009 by John C. Siracusa.  All rights reserved.  This program is
 free software; you can redistribute it and/or modify it under the same terms
 as Perl itself.

t/makemethods.t

@@ -2,10 +2,17 @@
 
 use strict;
 
-use Test::More tests => 627;
+use Test::More tests => 629;
 
 BEGIN
 {
+  # Don't use Class::XSAccessor unless invoked from t/makemethods-xs.t
+  # as indicated by magic (false) value 0, set in t/makemethods-xs.t
+  unless(defined $ENV{'ROSE_OBJECT_NO_CLASS_XSACCESOR'})
+  {
+    $ENV{'ROSE_OBJECT_NO_CLASS_XSACCESOR'} = 1;
+  }
+
   use_ok('Rose::Object');
   use_ok('Rose::Object::MakeMethods::Generic');
   use_ok('Rose::Class');
@@ -24,8 +31,9 @@ ok(ref $p eq 'Person', 'Construct object (no init)');
 # scalar
 #
 
-$p->bar('bar');
-is($p->bar, 'bar', 'Set named attribute (scalar)');
+is($p->bar, undef, 'Get named attribute (scalar)');
+is($p->bar('bar'), 'bar', 'Set named attribute 1 (scalar)');
+is($p->bar, 'bar', 'Set named attribute 2 (scalar)');
 
 #
 # scalar --get_set_init