Fix corner case of stringify-only overloaded values

Just a trivial cleanup, uncovered during the de-Path::Class work

diff --git a/Changes b/Changes
index ac61b35..43740e2 100644 (file)
--- a/Changes
+++ b/Changes
@@ -8,6 +8,8 @@ Revision history for DBIx::Class
     * Fixes
         - Ensure failing on_connect* / on_disconnect* are dealt with properly,
           notably on_connect* failures now properly abort the entire connect
+        - Fix corner case of stringify-only overloaded objects being used in
+          create()/populate()
 
     * Misc
         - Skip tests in a way more intelligent and speedy manner when optional

diff --git a/lib/DBIx/Class/Row.pm b/lib/DBIx/Class/Row.pm
index 222817a..a4a18b9 100644 (file)
--- a/lib/DBIx/Class/Row.pm
+++ b/lib/DBIx/Class/Row.pm
@@ -9,7 +9,7 @@ use Scalar::Util 'blessed';
 use List::Util 'first';
 use Try::Tiny;
 use DBIx::Class::Carp;
-use SQL::Abstract 'is_literal_value';
+use SQL::Abstract qw( is_literal_value is_plain_value );
 
 ###
 ### Internal method
@@ -1215,7 +1215,13 @@ sub store_column {
     unless exists $self->{_column_data}{$column} || $self->result_source->has_column($column);
   $self->throw_exception( "set_column called for ${column} without value" )
     if @_ < 3;
-  return $self->{_column_data}{$column} = $value;
+
+  # stringify all refs explicitly, guards against overloaded objects
+  # with defined stringification AND fallback => 0 (ugh!)
+  $self->{_column_data}{$column} = ( length ref $value and is_plain_value( $value ) )
+    ? "$value"
+    : $value
+  ;
 }
 
 =head2 inflate_result

diff --git a/t/100populate.t b/t/100populate.t
index 5102118..4b7f929 100644 (file)
--- a/t/100populate.t
+++ b/t/100populate.t
@@ -7,10 +7,23 @@ use Test::Warn;
 use lib qw(t/lib);
 use DBICTest;
 use DBIx::Class::_Util qw(sigwarn_silencer serialize);
-use Path::Class::File ();
 use Math::BigInt;
 use List::Util qw/shuffle/;
 
+{
+  package DBICTest::StringifiesOnly;
+  use overload
+    '""' => sub { $_[0]->[0] },
+    fallback => 0,
+  ;
+}
+{
+  package DBICTest::StringifiesViaFallback;
+  use overload
+    'bool' => sub { $_[0]->[0] },
+  ;
+}
+
 my $schema = DBICTest->init_schema();
 
 # The map below generates stuff like:
@@ -388,8 +401,8 @@ warnings_like {
 
   # the stringification has nothing to do with the artist name
   # this is solely for testing consistency
-  my $fn = Path::Class::File->new ('somedir/somefilename.tmp');
-  my $fn2 = Path::Class::File->new ('somedir/someotherfilename.tmp');
+  my $fn = bless [ 'somedir/somefilename.tmp' ], 'DBICTest::StringifiesOnly';
+  my $fn2 = bless [ 'somedir/someotherfilename.tmp' ], 'DBICTest::StringifiesViaFallback';
   my $rank = Math::BigInt->new(42);
 
   my $args = {
@@ -443,12 +456,17 @@ warnings_like {
   };
 
   # generate the AoH equivalent based on the AoAs above
+  # also generate the expected HRI output ( is_deeply is too smart for its own good )
   for my $bag (values %$args) {
     $bag->{AoH} = [];
+    $bag->{Expected} = [];
     my @hdr = @{$bag->{AoA}[0]};
     for my $v ( @{$bag->{AoA}}[1..$#{$bag->{AoA}}] ) {
       push @{$bag->{AoH}}, my $h = {};
       @{$h}{@hdr} = @$v;
+
+      push @{$bag->{Expected}}, my $hs = {};
+      @{$hs}{@hdr} = map { "$_" } @$v;
     }
   }
 
@@ -464,7 +482,7 @@ warnings_like {
       $rs->populate($args->{$tst}{$type});
       is_deeply(
         $rs->all_hri,
-        $args->{$tst}{AoH},
+        $args->{$tst}{Expected},
         "Populate() $tst in void context"
       );
 
@@ -473,7 +491,7 @@ warnings_like {
       my $dummy = $rs->populate($args->{$tst}{$type});
       is_deeply(
         $rs->all_hri,
-        $args->{$tst}{AoH},
+        $args->{$tst}{Expected},
         "Populate() $tst in non-void context"
       );
 
@@ -482,7 +500,7 @@ warnings_like {
       my @dummy = $rs->populate($args->{$tst}{$type});
       is_deeply(
         $rs->all_hri,
-        $args->{$tst}{AoH},
+        $args->{$tst}{Expected},
         "Populate() $tst in non-void context"
       );
     }
@@ -493,7 +511,7 @@ warnings_like {
 
     is_deeply(
       $rs->all_hri,
-      $args->{$tst}{AoH},
+      $args->{$tst}{Expected},
       "Create() $tst"
     );
   }

diff --git a/t/lib/DBICTest/Schema/Artist.pm b/t/lib/DBICTest/Schema/Artist.pm
index 8087292..00c1ef6 100644 (file)
--- a/t/lib/DBICTest/Schema/Artist.pm
+++ b/t/lib/DBICTest/Schema/Artist.pm
@@ -180,7 +180,7 @@ sub sqlt_deploy_hook {
 
 sub store_column {
   my ($self, $name, $value) = @_;
-  $value = 'X '.$value if ($name eq 'name' && $value && $value =~ /(X )?store_column test/);
+  $value = 'X '.$value if ($name eq 'name' && defined $value && $value =~ /(X )?store_column test/);
   $self->next::method($name, $value);
 }