[Bast-commits] r3289 - in trunk/Class-Accessor-Grouped: . lib/Class/Accessor t t/lib

[claco at dev.catalyst.perl.org]

Author: claco
Date: 2007-05-11 02:34:21 +0100 (Fri, 11 May 2007)
New Revision: 3289

Added:
   trunk/Class-Accessor-Grouped/t/lib/NotReallyAClass.pm
Modified:
   trunk/Class-Accessor-Grouped/Changes
   trunk/Class-Accessor-Grouped/lib/Class/Accessor/Grouped.pm
   trunk/Class-Accessor-Grouped/t/component.t
   trunk/Class-Accessor-Grouped/t/strict.t
   trunk/Class-Accessor-Grouped/t/warnings.t
Log:
set_comonent_class now only dies when the class is an installed/installable class and can't be loaded


Modified: trunk/Class-Accessor-Grouped/Changes
===================================================================
--- trunk/Class-Accessor-Grouped/Changes	2007-05-10 23:46:23 UTC (rev 3288)
+++ trunk/Class-Accessor-Grouped/Changes	2007-05-11 01:34:21 UTC (rev 3289)
@@ -1,5 +1,9 @@
 Revision history for Class::Accessor::Grouped.
 
+0.05001 Thur May 10 20:55:11 2007
+    - set_component_class now only dies if the specified class is a
+        installed/installable class and fails to load it.
+
 0.05000 Tue May 08 19:42:33 2007
     - Added get/set_component_class
 

Modified: trunk/Class-Accessor-Grouped/lib/Class/Accessor/Grouped.pm
===================================================================
--- trunk/Class-Accessor-Grouped/lib/Class/Accessor/Grouped.pm	2007-05-10 23:46:23 UTC (rev 3288)
+++ trunk/Class-Accessor-Grouped/lib/Class/Accessor/Grouped.pm	2007-05-11 01:34:21 UTC (rev 3289)
@@ -4,11 +4,11 @@
 use Carp;
 use Class::Inspector ();
 use Class::ISA ();
-use Scalar::Util ();
+use Scalar::Util qw/reftype blessed/;
 
 use vars qw($VERSION);
 
-$VERSION = '0.05000';
+$VERSION = '0.05001';
 
 =head1 NAME
 
@@ -58,7 +58,7 @@
 
     sub _mk_group_accessors {
         my($self, $maker, $group, @fields) = @_;
-        my $class = Scalar::Util::blessed($self) || $self;
+        my $class = blessed $self || $self;
 
         # So we don't have to do lots of lookups inside the loop.
         $maker = $self->can($maker) unless ref $maker;
@@ -294,8 +294,8 @@
     my ($self, $get) = @_;
     my $class;
 
-    if (Scalar::Util::blessed($self)) {
-        my $reftype = Scalar::Util::reftype($self);
+    if (blessed $self) {
+        my $reftype = reftype $self;
         $class = ref $self;
 
         if ($reftype eq 'HASH' && exists $self->{$get}) {
@@ -344,8 +344,8 @@
 sub set_inherited {
     my ($self, $set, $val) = @_;
 
-    if (Scalar::Util::blessed($self)) {
-        if (Scalar::Util::reftype($self) eq 'HASH') {
+    if (blessed $self) {
+        if (reftype $self eq 'HASH') {
             return $self->{$set} = $val;
         } else {
             croak('Cannot set inherited value on an object instance that is not hash-based');
@@ -408,7 +408,7 @@
     my ($self, $field, $value) = @_;
 
     if ($value) {
-        if (!Class::Inspector->loaded($value)) {
+        if (Class::Inspector->installed($value) && !Class::Inspector->loaded($value)) {
             eval "use $value";
 
             croak("Could not load $field '$value': ", $@) if $@;
@@ -425,7 +425,7 @@
 =cut
 
 sub get_super_paths {
-    my $class = Scalar::Util::blessed $_[0] || $_[0];
+    my $class = blessed $_[0] || $_[0];
 
     return Class::ISA::super_path($class);
 };

Modified: trunk/Class-Accessor-Grouped/t/component.t
===================================================================
--- trunk/Class-Accessor-Grouped/t/component.t	2007-05-10 23:46:23 UTC (rev 3288)
+++ trunk/Class-Accessor-Grouped/t/component.t	2007-05-11 01:34:21 UTC (rev 3289)
@@ -1,4 +1,4 @@
-use Test::More tests => 7;
+use Test::More tests => 8;
 use strict;
 use warnings;
 use lib 't/lib';
@@ -7,14 +7,20 @@
 
 is(AccessorGroups->result_class, undef);
 
-# croak on set where class can't be loaded
+## croak on set where class can't be loaded and it's a physical class
 my $dying = AccessorGroups->new;
 eval {
-    $dying->result_class('Junkies');
+    $dying->result_class('NotReallyAClass');
 };
-ok($@ =~ /Could not load result_class 'Junkies'/);
+ok($@ =~ /Could not load result_class 'NotReallyAClass'/);
 is($dying->result_class, undef);
 
+
+## don't croak when the class isn't available but not loaded for people
+## who create class/packages on the fly
+$dying->result_class('JunkiesNeverInstalled');
+is($dying->result_class, 'JunkiesNeverInstalled');
+
 ok(!Class::Inspector->loaded('BaseInheritedGroups'));
 AccessorGroups->result_class('BaseInheritedGroups');
 ok(Class::Inspector->loaded('BaseInheritedGroups'));

Added: trunk/Class-Accessor-Grouped/t/lib/NotReallyAClass.pm
===================================================================

Modified: trunk/Class-Accessor-Grouped/t/strict.t
===================================================================
--- trunk/Class-Accessor-Grouped/t/strict.t	2007-05-10 23:46:23 UTC (rev 3288)
+++ trunk/Class-Accessor-Grouped/t/strict.t	2007-05-11 01:34:21 UTC (rev 3289)
@@ -20,7 +20,7 @@
 ## finally run under -T. Until then, I'm on my own here. ;-)
 my @files;
 my %trusted = (
-
+    'NotReallyAClass.pm' => 1
 );
 
 find({  wanted => \&wanted,

Modified: trunk/Class-Accessor-Grouped/t/warnings.t
===================================================================
--- trunk/Class-Accessor-Grouped/t/warnings.t	2007-05-10 23:46:23 UTC (rev 3288)
+++ trunk/Class-Accessor-Grouped/t/warnings.t	2007-05-11 01:34:21 UTC (rev 3289)
@@ -20,7 +20,7 @@
 ## finally run under -T. Until then, I'm on my own here. ;-)
 my @files;
 my %trusted = (
-
+    'NotReallyAClass.pm' => 1
 );
 
 find({  wanted => \&wanted,