[Bast-commits] r5107 - in SQL-Abstract/1.x/branches/1.50_RC: . lib/SQL t

[dami at dev.catalyst.perl.org]

Author: dami
Date: 2008-11-12 05:25:34 +0000 (Wed, 12 Nov 2008)
New Revision: 5107

Added:
   SQL-Abstract/1.x/branches/1.50_RC/t/09refkind.t
Modified:
   SQL-Abstract/1.x/branches/1.50_RC/MANIFEST
   SQL-Abstract/1.x/branches/1.50_RC/lib/SQL/Abstract.pm
Log:
fixed _refkind for \$object, \\$object. Added tests for _refkind

Modified: SQL-Abstract/1.x/branches/1.50_RC/MANIFEST
===================================================================
--- SQL-Abstract/1.x/branches/1.50_RC/MANIFEST	2008-11-12 03:48:12 UTC (rev 5106)
+++ SQL-Abstract/1.x/branches/1.50_RC/MANIFEST	2008-11-12 05:25:34 UTC (rev 5107)
@@ -11,4 +11,6 @@
 t/06order_by.t
 t/07subqueries.t
 t/08special_ops.t
+t/09refkind.t
 
+

Modified: SQL-Abstract/1.x/branches/1.50_RC/lib/SQL/Abstract.pm
===================================================================
--- SQL-Abstract/1.x/branches/1.50_RC/lib/SQL/Abstract.pm	2008-11-12 03:48:12 UTC (rev 5106)
+++ SQL-Abstract/1.x/branches/1.50_RC/lib/SQL/Abstract.pm	2008-11-12 05:25:34 UTC (rev 5107)
@@ -871,23 +871,23 @@
   my ($self, $data) = @_;
   my $suffix = '';
   my $ref;
+  my $n_steps = 0;
 
-  # $suffix = 'REF' x (length of ref chain, i. e. \\[] is REFREFREF)
   while (1) {
-    # blessed references are considered like scalars
-    last if blessed $data;
-    $suffix .= 'REF';
-    $ref     = ref $data;
-
-    last if $ref ne 'REF';
+    # blessed objects are treated like scalars
+    $ref = (blessed $data) ? '' : ref $data;
+    $n_steps += 1 if $ref;
+    last          if $ref ne 'REF';
     $data = $$data;
   }
 
-  return $ref          ? $ref.$suffix   :
-         defined $data ? 'SCALAR'       :
-                         'UNDEF';
+  my $base = $ref || (defined $data ? 'SCALAR' : 'UNDEF');
+
+  return $base . ('REF' x $n_steps);
 }
 
+
+
 sub _try_refkind {
   my ($self, $data) = @_;
   my @try = ($self->_refkind($data));

Added: SQL-Abstract/1.x/branches/1.50_RC/t/09refkind.t
===================================================================
--- SQL-Abstract/1.x/branches/1.50_RC/t/09refkind.t	                        (rev 0)
+++ SQL-Abstract/1.x/branches/1.50_RC/t/09refkind.t	2008-11-12 05:25:34 UTC (rev 5107)
@@ -0,0 +1,31 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More;
+use SQL::Abstract;
+
+plan tests => 13;
+
+my $obj = bless {}, "Foo::Bar";
+
+is(SQL::Abstract->_refkind(undef), 'UNDEF', 'UNDEF');
+
+is(SQL::Abstract->_refkind({}), 'HASHREF', 'HASHREF');
+is(SQL::Abstract->_refkind([]), 'ARRAYREF', 'ARRAYREF');
+
+is(SQL::Abstract->_refkind(\{}), 'HASHREFREF', 'HASHREFREF');
+is(SQL::Abstract->_refkind(\[]), 'ARRAYREFREF', 'ARRAYREFREF');
+
+is(SQL::Abstract->_refkind(\\{}), 'HASHREFREFREF', 'HASHREFREFREF');
+is(SQL::Abstract->_refkind(\\[]), 'ARRAYREFREFREF', 'ARRAYREFREFREF');
+
+is(SQL::Abstract->_refkind("foo"), 'SCALAR', 'SCALAR');
+is(SQL::Abstract->_refkind(\"foo"), 'SCALARREF', 'SCALARREF');
+is(SQL::Abstract->_refkind(\\"foo"), 'SCALARREFREF', 'SCALARREFREF');
+
+# objects are treated like scalars
+is(SQL::Abstract->_refkind($obj), 'SCALAR', 'SCALAR');
+is(SQL::Abstract->_refkind(\$obj), 'SCALARREF', 'SCALARREF');
+is(SQL::Abstract->_refkind(\\$obj), 'SCALARREFREF', 'SCALARREFREF');
+