From 0c5fc4fd8981ee12eb6e3624fd50237a8170fb5e Mon Sep 17 00:00:00 2001
From: pjfl <github@roxsoft.co.uk>
Date: Wed, 11 Feb 2015 23:05:48 +0000
Subject: [PATCH] 0.36 Call instance_of in catch_class matching

---
 Changes                     |  2 ++
 lib/Unexpected.pm           |  2 +-
 lib/Unexpected/Functions.pm | 28 ++++++++++++++--------------
 t/10test_script.t           |  5 +++++
 4 files changed, 22 insertions(+), 15 deletions(-)

diff --git a/Changes b/Changes
index d17fc05..3678b38 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,7 @@
 Revision history for Unexpected
 
+          - Call instance_of in catch_class matching
+
 0.36.1    2014-12-22 01:02:53
           - Added explicite bool overload
           - Broken smoker a54c1c84-6bf5-1014-b4f9-dcd54300afcd
diff --git a/lib/Unexpected.pm b/lib/Unexpected.pm
index 30a225d..01bd23b 100644
--- a/lib/Unexpected.pm
+++ b/lib/Unexpected.pm
@@ -5,7 +5,7 @@ use namespace::autoclean;
 use overload '""'     => sub { $_[ 0 ]->as_string },
              bool     => sub { 1 },
              fallback => 1;
-use version; our $VERSION = qv( sprintf '0.36.%d', q$Rev: 1 $ =~ /\d+/gmx );
+use version; our $VERSION = qv( sprintf '0.36.%d', q$Rev: 2 $ =~ /\d+/gmx );
 
 use Moo;
 
diff --git a/lib/Unexpected/Functions.pm b/lib/Unexpected/Functions.pm
index 2737c01..0a3cdff 100644
--- a/lib/Unexpected/Functions.pm
+++ b/lib/Unexpected/Functions.pm
@@ -39,15 +39,15 @@ my $_exception_class = sub {
 };
 
 my $_match_class = sub {
-   my ($x, $ref, $blessed, $does, $key) = @_;
-
-   return !defined $key                                       ? !defined $x
-        : $key eq '*'                                         ? 1
-        : $key eq ':str'                                      ? !$ref
-        : $key eq $ref                                        ? 1
-        : $blessed && $x->can( 'class' ) && $x->class eq $key ? 1
-        : $blessed && $x->$does( $key )                       ? 1
-                                                              : 0;
+   my ($e, $ref, $blessed, $does, $key) = @_;
+
+   return !defined $key                        ? !defined $e
+        : $key eq '*'                          ? 1
+        : $key eq ':str'                       ? !$ref
+        : $key eq $ref                         ? 1
+        : $blessed && $e->can( 'instance_of' ) ? $e->instance_of( $key )
+        : $blessed && $e->$does( $key )        ? 1
+                                               : 0;
 };
 
 my $_quote_maybe = sub {
@@ -58,14 +58,14 @@ my $_gen_checker = sub {
    my @prototable = @_;
 
    return sub {
-      my $x       = shift;
-      my $ref     = ref $x;
-      my $blessed = blessed $x;
-      my $does    = ($blessed && $x->can( 'DOES' )) || 'isa';
+      my $e       = shift;
+      my $ref     = ref $e;
+      my $blessed = blessed $e;
+      my $does    = ($blessed && $e->can( 'DOES' )) || 'isa';
       my @table   = @prototable;
 
       while (my ($key, $value) = splice @table, 0, 2) {
-         $_match_class->( $x, $ref, $blessed, $does, $key ) and return $value
+         $_match_class->( $e, $ref, $blessed, $does, $key ) and return $value
       }
 
       return;
diff --git a/t/10test_script.t b/t/10test_script.t
index 74a4d04..6855dca 100644
--- a/t/10test_script.t
+++ b/t/10test_script.t
@@ -283,6 +283,11 @@ my $v = try { $class->throw( class => 'C' ) } catch_class [ C => sub { 42 } ];
 
 is $v, 42, 'Catch class';
 
+$v = try { $class->throw( class => 'D', error => 'Must have an error' ) }
+           catch_class [ B => sub { 42 } ];
+
+is $v, 42, 'Catch class - instance_of';
+
 eval { try { $class->throw( class => 'C' ) } catch_class [ D => sub { 42 } ]; };
 
 $e = _eval_error;