Add the `isa` operator

Adds a new infix operator named `isa`, with the semantics that

  $x isa SomeClass

is true if and only if `$x` is a blessed object reference that is either
`SomeClass` directly, or includes the class somewhere in its @ISA
hierarchy. It is false without warning or error for non-references or
non-blessed references.

This operator respects `->isa` method overloading, and is intended to
replace boilerplate code such as

  use Scalar::Util 'blessed';

  blessed($x) and $x->isa("SomeClass")

33 files changed, 471 insertions, 185 deletions

diff --git a/MANIFEST b/MANIFEST
index 77c67541a7..387ec389a0 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -5815,6 +5815,7 @@ t/op/index.t			See if index works
 t/op/index_thr.t		See if index works in another thread
 t/op/infnan.t			See if inf/nan work
 t/op/int.t			See if int works
+t/op/isa.t			See if isa works
 t/op/join.t			See if join works
 t/op/kill0.t			See if kill works
 t/op/kill0_child		Process tree script that is kill()ed
diff --git a/embed.fnc b/embed.fnc
index 412d4f6884..3abf9579da 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1777,6 +1777,7 @@ ApdR	|bool	|sv_derived_from_sv|NN SV* sv|NN SV *namesv|U32 flags
 ApdR	|bool	|sv_derived_from_pv|NN SV* sv|NN const char *const name|U32 flags
 ApdR	|bool	|sv_derived_from_pvn|NN SV* sv|NN const char *const name \
                                     |const STRLEN len|U32 flags
+ApdRx	|bool	|sv_isa_sv	|NN SV* sv|NN SV* namesv
 ApdR	|bool	|sv_does	|NN SV* sv|NN const char *const name
 ApdR	|bool	|sv_does_sv	|NN SV* sv|NN SV* namesv|U32 flags
 ApdR	|bool	|sv_does_pv	|NN SV* sv|NN const char *const name|U32 flags
diff --git a/embed.h b/embed.h
index 70caca176d..21d26d6423 100644
--- a/embed.h
+++ b/embed.h
@@ -600,6 +600,7 @@
 #define sv_inc_nomg(a)		Perl_sv_inc_nomg(aTHX_ a)
 #define sv_insert_flags(a,b,c,d,e,f)	Perl_sv_insert_flags(aTHX_ a,b,c,d,e,f)
 #define sv_isa(a,b)		Perl_sv_isa(aTHX_ a,b)
+#define sv_isa_sv(a,b)		Perl_sv_isa_sv(aTHX_ a,b)
 #define sv_isobject(a)		Perl_sv_isobject(aTHX_ a)
 #ifndef NO_MATHOMS
 #define sv_iv(a)		Perl_sv_iv(aTHX_ a)
@@ -1204,6 +1205,7 @@
 #define ck_glob(a)		Perl_ck_glob(aTHX_ a)
 #define ck_grep(a)		Perl_ck_grep(aTHX_ a)
 #define ck_index(a)		Perl_ck_index(aTHX_ a)
+#define ck_isa(a)		Perl_ck_isa(aTHX_ a)
 #define ck_join(a)		Perl_ck_join(aTHX_ a)
 #define ck_length(a)		Perl_ck_length(aTHX_ a)
 #define ck_lfun(a)		Perl_ck_lfun(aTHX_ a)
diff --git a/ext/Opcode/Opcode.pm b/ext/Opcode/Opcode.pm
index 417817929b..f20345c0dd 100644
--- a/ext/Opcode/Opcode.pm
+++ b/ext/Opcode/Opcode.pm
@@ -6,7 +6,7 @@ use strict;
 
 our($VERSION, @ISA, @EXPORT_OK);
 
-$VERSION = "1.44";
+$VERSION = "1.45";
 
 use Carp;
 use Exporter ();
@@ -324,6 +324,7 @@ invert_opset function.
 
     lt i_lt gt i_gt le i_le ge i_ge eq i_eq ne i_ne ncmp i_ncmp
     slt sgt sle sge seq sne scmp
+    isa
 
     substr vec stringify study pos length index rindex ord chr
 
diff --git a/feature.h b/feature.h
index 2b5b656bb8..0044b06b42 100644
--- a/feature.h
+++ b/feature.h
@@ -17,14 +17,15 @@
 #define FEATURE_MYREF_BIT           0x0004
 #define FEATURE_EVALBYTES_BIT       0x0008
 #define FEATURE_FC_BIT              0x0010
-#define FEATURE_POSTDEREF_QQ_BIT    0x0020
-#define FEATURE_REFALIASING_BIT     0x0040
-#define FEATURE_SAY_BIT             0x0080
-#define FEATURE_SIGNATURES_BIT      0x0100
-#define FEATURE_STATE_BIT           0x0200
-#define FEATURE_SWITCH_BIT          0x0400
-#define FEATURE_UNIEVAL_BIT         0x0800
-#define FEATURE_UNICODE_BIT         0x1000
+#define FEATURE_ISA_BIT             0x0020
+#define FEATURE_POSTDEREF_QQ_BIT    0x0040
+#define FEATURE_REFALIASING_BIT     0x0080
+#define FEATURE_SAY_BIT             0x0100
+#define FEATURE_SIGNATURES_BIT      0x0200
+#define FEATURE_STATE_BIT           0x0400
+#define FEATURE_SWITCH_BIT          0x0800
+#define FEATURE_UNIEVAL_BIT         0x1000
+#define FEATURE_UNICODE_BIT         0x2000
 
 #define FEATURE_BUNDLE_DEFAULT	0
 #define FEATURE_BUNDLE_510	1
@@ -54,6 +55,12 @@
 	 FEATURE_IS_ENABLED_MASK(FEATURE_FC_BIT)) \
     )
 
+#define FEATURE_ISA_IS_ENABLED \
+    ( \
+	CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \
+	 FEATURE_IS_ENABLED_MASK(FEATURE_ISA_BIT) \
+    )
+
 #define FEATURE_SAY_IS_ENABLED \
     ( \
 	(CURRENT_FEATURE_BUNDLE >= FEATURE_BUNDLE_510 && \
@@ -236,6 +243,14 @@ S_magic_sethint_feature(pTHX_ SV *keysv, const char *keypv, STRLEN keylen,
             }
             return;
 
+        case 'i':
+            if (keylen == sizeof("feature_isa")-1
+                 && memcmp(subf+1, "sa", keylen - sizeof("feature_")) == 0) {
+                mask = FEATURE_ISA_BIT;
+                break;
+            }
+            return;
+
         case 'm':
             if (keylen == sizeof("feature_myref")-1
                  && memcmp(subf+1, "yref", keylen - sizeof("feature_")) == 0) {
diff --git a/gv.c b/gv.c
index 27cc0cfc30..eb4ab927fe 100644
--- a/gv.c
+++ b/gv.c
@@ -525,9 +525,10 @@ S_maybe_add_coresub(pTHX_ HV * const stash, GV *gv,
     case KEY_do      : case KEY_dump   : case KEY_else  : case KEY_elsif  :
     case KEY_END     : case KEY_eq     : case KEY_eval  :
     case KEY_for     : case KEY_foreach: case KEY_format: case KEY_ge     :
-    case KEY_given   : case KEY_goto   : case KEY_grep  :
-    case KEY_gt   : case KEY_if: case KEY_INIT: case KEY_last: case KEY_le:
-    case KEY_local: case KEY_lt: case KEY_m   : case KEY_map : case KEY_my:
+    case KEY_given   : case KEY_goto   : case KEY_grep  : case KEY_gt     :
+    case KEY_if      : case KEY_isa    : case KEY_INIT  : case KEY_last   :
+    case KEY_le      : case KEY_local  : case KEY_lt    : case KEY_m      :
+    case KEY_map     : case KEY_my:
     case KEY_ne   : case KEY_next : case KEY_no: case KEY_or: case KEY_our:
     case KEY_package: case KEY_print: case KEY_printf:
     case KEY_q    : case KEY_qq   : case KEY_qr     : case KEY_qw    :
diff --git a/keywords.c b/keywords.c
index 9fa30e616a..d503bc9c2d 100644
--- a/keywords.c
+++ b/keywords.c
@@ -203,7 +203,7 @@ Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords)
           goto unknown;
       }
 
-    case 3: /* 28 tokens of length 3 */
+    case 3: /* 29 tokens of length 3 */
       switch (name[0])
       {
         case 'E':
@@ -320,13 +320,27 @@ Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords)
           goto unknown;
 
         case 'i':
-          if (name[1] == 'n' &&
-              name[2] == 't')
-          {                                       /* int              */
-            return -KEY_int;
-          }
+          switch (name[1])
+          {
+            case 'n':
+              if (name[2] == 't')
+              {                                   /* int              */
+                return -KEY_int;
+              }
 
-          goto unknown;
+              goto unknown;
+
+            case 's':
+              if (name[2] == 'a')
+              {                                   /* isa              */
+                return (all_keywords || FEATURE_ISA_IS_ENABLED ? -KEY_isa : 0);
+              }
+
+              goto unknown;
+
+            default:
+              goto unknown;
+          }
 
         case 'l':
           if (name[1] == 'o' &&
@@ -3437,5 +3451,5 @@ unknown:
 }
 
 /* Generated from:
- * db0472e0ad4f44bd0816cad799d63b60d1bbd7e11cef40ea15bf0d00f69669f6 regen/keywords.pl
+ * f77998a5bc995c1b42d3d080de227ef5f11638bcd329367431d8f193aef2d3cc regen/keywords.pl
  * ex: set ro: */
diff --git a/keywords.h b/keywords.h
index 2b1d598a4e..23fa6944d8 100644
--- a/keywords.h
+++ b/keywords.h
@@ -123,152 +123,153 @@
 #define KEY_index		107
 #define KEY_int			108
 #define KEY_ioctl		109
-#define KEY_join		110
-#define KEY_keys		111
-#define KEY_kill		112
-#define KEY_last		113
-#define KEY_lc			114
-#define KEY_lcfirst		115
-#define KEY_le			116
-#define KEY_length		117
-#define KEY_link		118
-#define KEY_listen		119
-#define KEY_local		120
-#define KEY_localtime		121
-#define KEY_lock		122
-#define KEY_log			123
-#define KEY_lstat		124
-#define KEY_lt			125
-#define KEY_m			126
-#define KEY_map			127
-#define KEY_mkdir		128
-#define KEY_msgctl		129
-#define KEY_msgget		130
-#define KEY_msgrcv		131
-#define KEY_msgsnd		132
-#define KEY_my			133
-#define KEY_ne			134
-#define KEY_next		135
-#define KEY_no			136
-#define KEY_not			137
-#define KEY_oct			138
-#define KEY_open		139
-#define KEY_opendir		140
-#define KEY_or			141
-#define KEY_ord			142
-#define KEY_our			143
-#define KEY_pack		144
-#define KEY_package		145
-#define KEY_pipe		146
-#define KEY_pop			147
-#define KEY_pos			148
-#define KEY_print		149
-#define KEY_printf		150
-#define KEY_prototype		151
-#define KEY_push		152
-#define KEY_q			153
-#define KEY_qq			154
-#define KEY_qr			155
-#define KEY_quotemeta		156
-#define KEY_qw			157
-#define KEY_qx			158
-#define KEY_rand		159
-#define KEY_read		160
-#define KEY_readdir		161
-#define KEY_readline		162
-#define KEY_readlink		163
-#define KEY_readpipe		164
-#define KEY_recv		165
-#define KEY_redo		166
-#define KEY_ref			167
-#define KEY_rename		168
-#define KEY_require		169
-#define KEY_reset		170
-#define KEY_return		171
-#define KEY_reverse		172
-#define KEY_rewinddir		173
-#define KEY_rindex		174
-#define KEY_rmdir		175
-#define KEY_s			176
-#define KEY_say			177
-#define KEY_scalar		178
-#define KEY_seek		179
-#define KEY_seekdir		180
-#define KEY_select		181
-#define KEY_semctl		182
-#define KEY_semget		183
-#define KEY_semop		184
-#define KEY_send		185
-#define KEY_setgrent		186
-#define KEY_sethostent		187
-#define KEY_setnetent		188
-#define KEY_setpgrp		189
-#define KEY_setpriority		190
-#define KEY_setprotoent		191
-#define KEY_setpwent		192
-#define KEY_setservent		193
-#define KEY_setsockopt		194
-#define KEY_shift		195
-#define KEY_shmctl		196
-#define KEY_shmget		197
-#define KEY_shmread		198
-#define KEY_shmwrite		199
-#define KEY_shutdown		200
-#define KEY_sin			201
-#define KEY_sleep		202
-#define KEY_socket		203
-#define KEY_socketpair		204
-#define KEY_sort		205
-#define KEY_splice		206
-#define KEY_split		207
-#define KEY_sprintf		208
-#define KEY_sqrt		209
-#define KEY_srand		210
-#define KEY_stat		211
-#define KEY_state		212
-#define KEY_study		213
-#define KEY_sub			214
-#define KEY_substr		215
-#define KEY_symlink		216
-#define KEY_syscall		217
-#define KEY_sysopen		218
-#define KEY_sysread		219
-#define KEY_sysseek		220
-#define KEY_system		221
-#define KEY_syswrite		222
-#define KEY_tell		223
-#define KEY_telldir		224
-#define KEY_tie			225
-#define KEY_tied		226
-#define KEY_time		227
-#define KEY_times		228
-#define KEY_tr			229
-#define KEY_truncate		230
-#define KEY_uc			231
-#define KEY_ucfirst		232
-#define KEY_umask		233
-#define KEY_undef		234
-#define KEY_unless		235
-#define KEY_unlink		236
-#define KEY_unpack		237
-#define KEY_unshift		238
-#define KEY_untie		239
-#define KEY_until		240
-#define KEY_use			241
-#define KEY_utime		242
-#define KEY_values		243
-#define KEY_vec			244
-#define KEY_wait		245
-#define KEY_waitpid		246
-#define KEY_wantarray		247
-#define KEY_warn		248
-#define KEY_when		249
-#define KEY_while		250
-#define KEY_write		251
-#define KEY_x			252
-#define KEY_xor			253
-#define KEY_y			254
+#define KEY_isa			110
+#define KEY_join		111
+#define KEY_keys		112
+#define KEY_kill		113
+#define KEY_last		114
+#define KEY_lc			115
+#define KEY_lcfirst		116
+#define KEY_le			117
+#define KEY_length		118
+#define KEY_link		119
+#define KEY_listen		120
+#define KEY_local		121
+#define KEY_localtime		122
+#define KEY_lock		123
+#define KEY_log			124
+#define KEY_lstat		125
+#define KEY_lt			126
+#define KEY_m			127
+#define KEY_map			128
+#define KEY_mkdir		129
+#define KEY_msgctl		130
+#define KEY_msgget		131
+#define KEY_msgrcv		132
+#define KEY_msgsnd		133
+#define KEY_my			134
+#define KEY_ne			135
+#define KEY_next		136
+#define KEY_no			137
+#define KEY_not			138
+#define KEY_oct			139
+#define KEY_open		140
+#define KEY_opendir		141
+#define KEY_or			142
+#define KEY_ord			143
+#define KEY_our			144
+#define KEY_pack		145
+#define KEY_package		146
+#define KEY_pipe		147
+#define KEY_pop			148
+#define KEY_pos			149
+#define KEY_print		150
+#define KEY_printf		151
+#define KEY_prototype		152
+#define KEY_push		153
+#define KEY_q			154
+#define KEY_qq			155
+#define KEY_qr			156
+#define KEY_quotemeta		157
+#define KEY_qw			158
+#define KEY_qx			159
+#define KEY_rand		160
+#define KEY_read		161
+#define KEY_readdir		162
+#define KEY_readline		163
+#define KEY_readlink		164
+#define KEY_readpipe		165
+#define KEY_recv		166
+#define KEY_redo		167
+#define KEY_ref			168
+#define KEY_rename		169
+#define KEY_require		170
+#define KEY_reset		171
+#define KEY_return		172
+#define KEY_reverse		173
+#define KEY_rewinddir		174
+#define KEY_rindex		175
+#define KEY_rmdir		176
+#define KEY_s			177
+#define KEY_say			178
+#define KEY_scalar		179
+#define KEY_seek		180
+#define KEY_seekdir		181
+#define KEY_select		182
+#define KEY_semctl		183
+#define KEY_semget		184
+#define KEY_semop		185
+#define KEY_send		186
+#define KEY_setgrent		187
+#define KEY_sethostent		188
+#define KEY_setnetent		189
+#define KEY_setpgrp		190
+#define KEY_setpriority		191
+#define KEY_setprotoent		192
+#define KEY_setpwent		193
+#define KEY_setservent		194
+#define KEY_setsockopt		195
+#define KEY_shift		196
+#define KEY_shmctl		197
+#define KEY_shmget		198
+#define KEY_shmread		199
+#define KEY_shmwrite		200
+#define KEY_shutdown		201
+#define KEY_sin			202
+#define KEY_sleep		203
+#define KEY_socket		204
+#define KEY_socketpair		205
+#define KEY_sort		206
+#define KEY_splice		207
+#define KEY_split		208
+#define KEY_sprintf		209
+#define KEY_sqrt		210
+#define KEY_srand		211
+#define KEY_stat		212
+#define KEY_state		213
+#define KEY_study		214
+#define KEY_sub			215
+#define KEY_substr		216
+#define KEY_symlink		217
+#define KEY_syscall		218
+#define KEY_sysopen		219
+#define KEY_sysread		220
+#define KEY_sysseek		221
+#define KEY_system		222
+#define KEY_syswrite		223
+#define KEY_tell		224
+#define KEY_telldir		225
+#define KEY_tie			226
+#define KEY_tied		227
+#define KEY_time		228
+#define KEY_times		229
+#define KEY_tr			230
+#define KEY_truncate		231
+#define KEY_uc			232
+#define KEY_ucfirst		233
+#define KEY_umask		234
+#define KEY_undef		235
+#define KEY_unless		236
+#define KEY_unlink		237
+#define KEY_unpack		238
+#define KEY_unshift		239
+#define KEY_untie		240
+#define KEY_until		241
+#define KEY_use			242
+#define KEY_utime		243
+#define KEY_values		244
+#define KEY_vec			245
+#define KEY_wait		246
+#define KEY_waitpid		247
+#define KEY_wantarray		248
+#define KEY_warn		249
+#define KEY_when		250
+#define KEY_while		251
+#define KEY_write		252
+#define KEY_x			253
+#define KEY_xor			254
+#define KEY_y			255
 
 /* Generated from:
- * db0472e0ad4f44bd0816cad799d63b60d1bbd7e11cef40ea15bf0d00f69669f6 regen/keywords.pl
+ * f77998a5bc995c1b42d3d080de227ef5f11638bcd329367431d8f193aef2d3cc regen/keywords.pl
  * ex: set ro: */
diff --git a/lib/B/Deparse-core.t b/lib/B/Deparse-core.t
index 6ee935f5f7..991412a1dd 100644
--- a/lib/B/Deparse-core.t
+++ b/lib/B/Deparse-core.t
@@ -36,7 +36,7 @@ BEGIN {
 
 use strict;
 use Test::More;
-plan tests => 3886;
+plan tests => 3904;
 
 use feature (sprintf(":%vd", $^V)); # to avoid relying on the feature
                                     # logic to add CORE::
@@ -79,23 +79,25 @@ sub testit {
 	my $desc = "$keyword: lex=$lex $expr => $expected_expr";
 	$desc .= " (lex sub)" if $lexsub;
 
-
         my $code;
 	my $code_ref;
 	if ($lexsub) {
 	    package lexsubtest;
-	    no warnings 'experimental::lexical_subs';
+	    no warnings 'experimental::lexical_subs', 'experimental::isa';
 	    use feature 'lexical_subs';
 	    no strict 'vars';
             $code = "sub { state sub $keyword; ${vars}() = $expr }";
+	    $code = "use feature 'isa';\n$code" if $keyword eq "isa";
 	    $code_ref = eval $code
 			    or die "$@ in $expr";
 	}
 	else {
 	    package test;
+	    no warnings 'experimental::isa';
 	    use subs ();
 	    import subs $keyword;
 	    $code = "no strict 'vars'; sub { ${vars}() = $expr }";
+	    $code = "use feature 'isa';\n$code" if $keyword eq "isa";
 	    $code_ref = eval $code
 			    or die "$@ in $expr";
 	}
@@ -545,6 +547,7 @@ hex              01    $
 index            23    p
 int              01    $
 ioctl            3     p
+isa              B     -
 join             13    p
 # keys handled specially
 kill             123   p
diff --git a/lib/B/Deparse.pm b/lib/B/Deparse.pm
index 1ae4619d5d..ee126b1552 100644
--- a/lib/B/Deparse.pm
+++ b/lib/B/Deparse.pm
@@ -52,7 +52,7 @@ use B qw(class main_root main_start main_cv svref_2object opnumber perlstring
         MDEREF_SHIFT
     );
 
-$VERSION = '1.51';
+$VERSION = '1.52';
 use strict;
 our $AUTOLOAD;
 use warnings ();
@@ -3060,6 +3060,8 @@ sub pp_sge { binop(@_, "ge", 15) }
 sub pp_sle { binop(@_, "le", 15) }
 sub pp_scmp { maybe_targmy(@_, \&binop, "cmp", 14) }
 
+sub pp_isa { binop(@_, "isa", 15) }
+
 sub pp_sassign { binop(@_, "=", 7, SWAP_CHILDREN) }
 sub pp_aassign { binop(@_, "=", 7, SWAP_CHILDREN | LIST_CONTEXT) }
 
diff --git a/lib/B/Op_private.pm b/lib/B/Op_private.pm
index 972f0bba18..bcf8457b80 100644
--- a/lib/B/Op_private.pm
+++ b/lib/B/Op_private.pm
@@ -399,6 +399,7 @@ $bits{i_preinc}{0} = $bf[0];
 @{$bits{index}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
 $bits{int}{0} = $bf[0];
 @{$bits{ioctl}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
+@{$bits{isa}}{1,0} = ($bf[1], $bf[1]);
 @{$bits{join}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
 $bits{keys}{0} = $bf[0];
 @{$bits{kill}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
diff --git a/lib/feature.pm b/lib/feature.pm
index c81a35fb3b..668b43018e 100644
--- a/lib/feature.pm
+++ b/lib/feature.pm
@@ -9,6 +9,7 @@ our $VERSION = '1.57';
 
 our %feature = (
     fc              => 'feature_fc',
+    isa             => 'feature_isa',
     say             => 'feature_say',
     state           => 'feature_state',
     switch          => 'feature_switch',
@@ -29,7 +30,7 @@ our %feature_bundle = (
     "5.15"    => [qw(current_sub evalbytes fc say state switch unicode_eval unicode_strings)],
     "5.23"    => [qw(current_sub evalbytes fc postderef_qq say state switch unicode_eval unicode_strings)],
     "5.27"    => [qw(bitwise current_sub evalbytes fc postderef_qq say state switch unicode_eval unicode_strings)],
-    "all"     => [qw(bitwise current_sub declared_refs evalbytes fc postderef_qq refaliasing say signatures state switch unicode_eval unicode_strings)],
+    "all"     => [qw(bitwise current_sub declared_refs evalbytes fc isa postderef_qq refaliasing say signatures state switch unicode_eval unicode_strings)],
     "default" => [qw()],
 );
 
@@ -350,6 +351,14 @@ Reference to a Variable> for examples.
 
 This feature is available from Perl 5.26 onwards.
 
+=head2 The 'isa' feature
+
+This allows the use of the C<isa> infix operator, which tests whether the
+scalar given by the left operand is an object of the class given by the
+right operand. See L<perlop/Class Instance Operator> for more details.
+
+This feature is available from Perl 5.32 onwards.
+
 =head1 FEATURE BUNDLES
 
 It's possible to load multiple features together, using
diff --git a/lib/warnings.pm b/lib/warnings.pm
index ea067882b6..d434dcd36c 100644
--- a/lib/warnings.pm
+++ b/lib/warnings.pm
@@ -5,7 +5,7 @@
 
 package warnings;
 
-our $VERSION = "1.45";
+our $VERSION = "1.46";
 
 # Verify that we're called correctly so that warnings will work.
 # Can't use Carp, since Carp uses us!
@@ -106,6 +106,9 @@ our %Offsets = (
     'experimental::private_use'		=> 140,
     'experimental::uniprop_wildcards'	=> 142,
     'experimental::vlb'			=> 144,
+
+    # Warnings Categories added in Perl 5.031
+    'experimental::isa'			=> 146,
 );
 
 our %Bits = (
@@ -119,11 +122,12 @@ our %Bits = (
     'digit'				=> "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [31]
     'exec'				=> "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
     'exiting'				=> "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
-    'experimental'			=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x55\x51\x15\x50\x51\x01", # [51..56,58..62,66..68,70..72]
+    'experimental'			=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x55\x51\x15\x50\x51\x05", # [51..56,58..62,66..68,70..73]
     'experimental::alpha_assertions'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [67]
     'experimental::bitwise'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [58]
     'experimental::const_attr'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [59]
     'experimental::declared_refs'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [66]
+    'experimental::isa'			=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [73]
     'experimental::lexical_subs'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [52]
     'experimental::postderef'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00", # [55]
     'experimental::private_use'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [70]
@@ -195,11 +199,12 @@ our %DeadBits = (
     'digit'				=> "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [31]
     'exec'				=> "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
     'exiting'				=> "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
-    'experimental'			=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\xaa\xa2\x2a\xa0\xa2\x02", # [51..56,58..62,66..68,70..72]
+    'experimental'			=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\xaa\xa2\x2a\xa0\xa2\x0a", # [51..56,58..62,66..68,70..73]
     'experimental::alpha_assertions'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [67]
     'experimental::bitwise'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [58]
     'experimental::const_attr'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [59]
     'experimental::declared_refs'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [66]
+    'experimental::isa'			=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [73]
     'experimental::lexical_subs'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [52]
     'experimental::postderef'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00", # [55]
     'experimental::private_use'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [70]
@@ -262,8 +267,8 @@ our %DeadBits = (
 
 # These are used by various things, including our own tests
 our $NONE				=  "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0";
-our $DEFAULT				=  "\x10\x01\x00\x00\x00\x50\x04\x00\x00\x00\x00\x00\x00\x55\x51\x55\x50\x51\x01", # [2,4,22,23,25,52..56,58..63,66..68,70..72]
-our $LAST_BIT				=  146 ;
+our $DEFAULT				=  "\x10\x01\x00\x00\x00\x50\x04\x00\x00\x00\x00\x00\x00\x55\x51\x55\x50\x51\x05", # [2,4,22,23,25,52..56,58..63,66..68,70..73]
+our $LAST_BIT				=  148 ;
 our $BYTES				=  19 ;
 
 sub Croaker
@@ -813,6 +818,8 @@ The current hierarchy is:
          |                 |
          |                 +- experimental::declared_refs
          |                 |
+         |                 +- experimental::isa
+         |                 |
          |                 +- experimental::lexical_subs
          |                 |
          |                 +- experimental::postderef
diff --git a/op.c b/op.c
index 66d773f1a1..fcd29dd4e7 100644
--- a/op.c
+++ b/op.c
@@ -15090,6 +15090,22 @@ Perl_ck_length(pTHX_ OP *o)
 }
 
 
+OP *
+Perl_ck_isa(pTHX_ OP *o)
+{
+    OP *classop = cBINOPo->op_last;
+
+    PERL_ARGS_ASSERT_CK_ISA;
+
+    /* Convert barename into PV */
+    if(classop->op_type == OP_CONST && classop->op_private & OPpCONST_BARE) {
+        /* TODO: Optionally convert package to raw HV here */
+        classop->op_private &= ~(OPpCONST_BARE|OPpCONST_STRICT);
+    }
+
+    return o;
+}
+
 
 /*
    ---------------------------------------------------------
diff --git a/opcode.h b/opcode.h
index 021ea6b344..c4104dded1 100644
--- a/opcode.h
+++ b/opcode.h
@@ -543,6 +543,7 @@ EXTCONST char* const PL_op_name[] = {
 	"lvrefslice",
 	"lvavref",
 	"anonconst",
+	"isa",
 	"freed",
 };
 #endif
@@ -948,6 +949,7 @@ EXTCONST char* const PL_op_desc[] = {
 	"lvalue ref assignment",
 	"lvalue array reference",
 	"anonymous constant",
+	"derived class test",
 	"freed op",
 };
 #endif
@@ -1365,6 +1367,7 @@ EXT Perl_ppaddr_t PL_ppaddr[] /* or perlvars.h */
 	Perl_pp_lvrefslice,
 	Perl_pp_lvavref,
 	Perl_pp_anonconst,
+	Perl_pp_isa,
 }
 #endif
 #ifdef PERL_PPADDR_INITED
@@ -1778,6 +1781,7 @@ EXT Perl_check_t PL_check[] /* or perlvars.h */
 	Perl_ck_null,		/* lvrefslice */
 	Perl_ck_null,		/* lvavref */
 	Perl_ck_null,		/* anonconst */
+	Perl_ck_isa,		/* isa */
 }
 #endif
 #ifdef PERL_CHECK_INITED
@@ -2187,6 +2191,7 @@ EXTCONST U32 PL_opargs[] = {
 	0x00000440,	/* lvrefslice */
 	0x00000b40,	/* lvavref */
 	0x00000144,	/* anonconst */
+	0x00000204,	/* isa */
 };
 #endif
 
@@ -2855,6 +2860,7 @@ EXTCONST I16  PL_op_private_bitdef_ix[] = {
      233, /* lvrefslice */
      234, /* lvavref */
        0, /* anonconst */
+      12, /* isa */
 
 };
 
@@ -2879,7 +2885,7 @@ EXTCONST U16  PL_op_private_bitdefs[] = {
     0x0438, 0x1a50, 0x426c, 0x3d28, 0x3505, /* const */
     0x2fdc, 0x3659, /* gvsv */
     0x18b5, /* gv */
-    0x0067, /* gelem, lt, i_lt, gt, i_gt, le, i_le, ge, i_ge, eq, i_eq, ne, i_ne, ncmp, i_ncmp, slt, sgt, sle, sge, seq, sne, scmp, bit_and, bit_xor, bit_or, sbit_and, sbit_xor, sbit_or, smartmatch, lslice, xor */
+    0x0067, /* gelem, lt, i_lt, gt, i_gt, le, i_le, ge, i_ge, eq, i_eq, ne, i_ne, ncmp, i_ncmp, slt, sgt, sle, sge, seq, sne, scmp, bit_and, bit_xor, bit_or, sbit_and, sbit_xor, sbit_or, smartmatch, lslice, xor, isa */
     0x2fdc, 0x41b8, 0x03d7, /* padsv */
     0x2fdc, 0x41b8, 0x05b4, 0x30cc, 0x3ea9, /* padav */
     0x2fdc, 0x41b8, 0x05b4, 0x0650, 0x30cc, 0x3ea8, 0x2b41, /* padhv */
@@ -3348,6 +3354,7 @@ EXTCONST U8 PL_op_private_valid[] = {
     /* LVREFSLICE */ (OPpLVAL_INTRO),
     /* LVAVREF    */ (OPpARG1_MASK|OPpPAD_STATE|OPpLVAL_INTRO),
     /* ANONCONST  */ (OPpARG1_MASK),
+    /* ISA        */ (OPpARG2_MASK),
 
 };
 
diff --git a/opnames.h b/opnames.h
index d87ba88f01..d63371afd1 100644
--- a/opnames.h
+++ b/opnames.h
@@ -411,10 +411,11 @@ typedef enum opcode {
 	OP_LVREFSLICE	 = 394,
 	OP_LVAVREF	 = 395,
 	OP_ANONCONST	 = 396,
+	OP_ISA		 = 397,
 	OP_max		
 } opcode;
 
-#define MAXO 397
+#define MAXO 398
 #define OP_FREED MAXO
 
 /* the OP_IS_* macros are optimized to a simple range check because
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 23d3fe7656..664881286c 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -25,6 +25,15 @@ XXX New core language features go here.  Summarize user-visible core language
 enhancements.  Particularly prominent performance optimisations could go
 here, but most should go in the L</Performance Enhancements> section.
 
+=head2 The isa Operator
+
+A new experimental infix operator called C<isa> tests whether a given object
+is an instance of a given class or a class derived from it:
+
+    if( $obj isa Package::Name ) { ... }
+
+For more detail see L<perlop/Class Instance Operator>.
+
 [ List each enhancement as a =head2 entry ]
 
 =head1 Security
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 465317bf92..593032610c 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -3262,6 +3262,12 @@ an anonymous subroutine, or a reference to a subroutine.
 (W overload) You tried to overload a constant type the overload package is
 unaware of.
 
+=item isa is experimental
+
+(S experimental::isa) This warning is emitted if you use the (C<isa>)
+operator. This operator is currently experimental and its behaviour may
+change in future releases of Perl.
+
 =item -i used with no filenames on the command line, reading from STDIN
 
 (S inplace) The C<-i> option was passed on the command line, indicating
diff --git a/pod/perlop.pod b/pod/perlop.pod
index c4eecd6c79..57bda73252 100644
--- a/pod/perlop.pod
+++ b/pod/perlop.pod
@@ -78,6 +78,7 @@ values only, not array values.
     nonassoc	named unary operators
     nonassoc	< > <= >= lt gt le ge
     nonassoc	== != <=> eq ne cmp ~~
+    nonassoc    isa
     left	&
     left	| ^
     left	&&
@@ -575,6 +576,25 @@ function, available in Perl v5.16 or later:
 
     if ( fc($x) eq fc($y) ) { ... }
 
+=head2 Class Instance Operator
+X<isa operator>
+
+Binary C<isa> evaluates to true when left argument is an object instance of
+the class (or a subclass derived from that class) given by the right argument.
+If the left argument is not defined, not a blessed object instance, or does
+not derive from the class given by the right argument, the operator evaluates
+as false. The right argument may give the class either as a barename or a
+scalar expression that yields a string class name:
+
+    if( $obj isa Some::Class ) { ... }
+
+    if( $obj isa "Different::Class" ) { ... }
+    if( $obj isa $name_of_class ) { ... }
+
+This is an experimental feature and is available from Perl 5.31.6 when enabled
+by C<use feature 'isa'>. It emits a warning in the C<experimental::isa>
+category.
+
 =head2 Smartmatch Operator
 
 First available in Perl 5.10.1 (the 5.10.0 version behaved differently),
diff --git a/pp.c b/pp.c
index 9a06fcc808..5cd32e1c8a 100644
--- a/pp.c
+++ b/pp.c
@@ -7143,6 +7143,18 @@ PP(pp_argcheck)
     return NORMAL;
 }
 
+PP(pp_isa)
+{
+    dSP;
+    SV *left, *right;
+
+    right = POPs;
+    left  = TOPs;
+
+    SETs(boolSV(sv_isa_sv(left, right)));
+    RETURN;
+}
+
 /*
  * ex: set ts=8 sts=4 sw=4 et:
  */
diff --git a/pp_proto.h b/pp_proto.h
index 407cbd14a3..580ce937ec 100644
--- a/pp_proto.h
+++ b/pp_proto.h
@@ -126,6 +126,7 @@ PERL_CALLCONV OP *Perl_pp_index(pTHX);
 PERL_CALLCONV OP *Perl_pp_int(pTHX);
 PERL_CALLCONV OP *Perl_pp_introcv(pTHX);
 PERL_CALLCONV OP *Perl_pp_ioctl(pTHX);
+PERL_CALLCONV OP *Perl_pp_isa(pTHX);
 PERL_CALLCONV OP *Perl_pp_iter(pTHX);
 PERL_CALLCONV OP *Perl_pp_join(pTHX);
 PERL_CALLCONV OP *Perl_pp_kvaslice(pTHX);
diff --git a/proto.h b/proto.h
index 649b6d397d..364b12e8c7 100644
--- a/proto.h
+++ b/proto.h
@@ -480,6 +480,11 @@ PERL_CALLCONV OP *	Perl_ck_index(pTHX_ OP *o)
 #define PERL_ARGS_ASSERT_CK_INDEX	\
 	assert(o)
 
+PERL_CALLCONV OP *	Perl_ck_isa(pTHX_ OP *o)
+			__attribute__warn_unused_result__;
+#define PERL_ARGS_ASSERT_CK_ISA	\
+	assert(o)
+
 PERL_CALLCONV OP *	Perl_ck_join(pTHX_ OP *o)
 			__attribute__warn_unused_result__;
 #define PERL_ARGS_ASSERT_CK_JOIN	\
@@ -3412,6 +3417,11 @@ PERL_CALLCONV void	Perl_sv_insert_flags(pTHX_ SV *const bigstr, const STRLEN off
 PERL_CALLCONV int	Perl_sv_isa(pTHX_ SV* sv, const char *const name);
 #define PERL_ARGS_ASSERT_SV_ISA	\
 	assert(name)
+PERL_CALLCONV bool	Perl_sv_isa_sv(pTHX_ SV* sv, SV* namesv)
+			__attribute__warn_unused_result__;
+#define PERL_ARGS_ASSERT_SV_ISA_SV	\
+	assert(sv); assert(namesv)
+
 PERL_CALLCONV int	Perl_sv_isobject(pTHX_ SV* sv);
 #define PERL_ARGS_ASSERT_SV_ISOBJECT
 #ifndef NO_MATHOMS
diff --git a/regen/feature.pl b/regen/feature.pl
index efecebbee8..e3eb8e9432 100755
--- a/regen/feature.pl
+++ b/regen/feature.pl
@@ -35,6 +35,7 @@ my %feature = (
     unicode_strings => 'unicode',
     fc              => 'fc',
     signatures      => 'signatures',
+    isa             => 'isa',
 );
 
 # NOTE: If a feature is ever enabled in a non-contiguous range of Perl
@@ -752,6 +753,14 @@ Reference to a Variable> for examples.
 
 This feature is available from Perl 5.26 onwards.
 
+=head2 The 'isa' feature
+
+This allows the use of the C<isa> infix operator, which tests whether the
+scalar given by the left operand is an object of the class given by the
+right operand. See L<perlop/Class Instance Operator> for more details.
+
+This feature is available from Perl 5.32 onwards.
+
 =head1 FEATURE BUNDLES
 
 It's possible to load multiple features together, using
diff --git a/regen/keywords.pl b/regen/keywords.pl
index 9619d86faf..ffc4882efa 100755
--- a/regen/keywords.pl
+++ b/regen/keywords.pl
@@ -46,6 +46,7 @@ my %feature_kw = (
     evalbytes => 'evalbytes',
     __SUB__   => '__SUB__',
     fc        => 'fc',
+    isa       => 'isa',
 );
 
 my %pos = map { ($_ => 1) } @{$by_strength{'+'}};
@@ -217,6 +218,7 @@ __END__
 -index
 -int
 -ioctl
+-isa
 -join
 -keys
 -kill
diff --git a/regen/opcodes b/regen/opcodes
index 4e8236947a..745acbbd04 100644
--- a/regen/opcodes
+++ b/regen/opcodes
@@ -572,3 +572,5 @@ lvref		lvalue ref assignment	ck_null		d%
 lvrefslice	lvalue ref assignment	ck_null		d@
 lvavref		lvalue array reference	ck_null		d%
 anonconst	anonymous constant	ck_null		ds1
+
+isa		derived class test	ck_isa		s2
diff --git a/regen/warnings.pl b/regen/warnings.pl
index 1c58b3ad0e..93e6763344 100644
--- a/regen/warnings.pl
+++ b/regen/warnings.pl
@@ -16,7 +16,7 @@
 #
 # This script is normally invoked from regen.pl.
 
-$VERSION = '1.45';
+$VERSION = '1.46';
 
 BEGIN {
     require './regen/regen_lib.pl';
@@ -117,6 +117,8 @@ my $tree = {
                                     [ 5.029, DEFAULT_ON ],
                                 'experimental::vlb' =>
                                     [ 5.029, DEFAULT_ON ],
+                                'experimental::isa' =>
+                                    [ 5.031, DEFAULT_ON ],
                         }],
 
         'missing'       => [ 5.021, DEFAULT_OFF],
diff --git a/sv.c b/sv.c
index 0a853bccfa..6a23ae5e9d 100644
--- a/sv.c
+++ b/sv.c
@@ -10301,8 +10301,12 @@ Perl_sv_isobject(pTHX_ SV *sv)
 =for apidoc sv_isa
 
 Returns a boolean indicating whether the SV is blessed into the specified
-class.  This does not check for subtypes; use C<sv_derived_from> to verify
-an inheritance relationship.
+class.
+
+This does not check for subtypes or method overloading. Use C<sv_isa_sv> to
+verify an inheritance relationship in the same way as the C<isa> operator by
+respecting any C<isa()> method overloading; or C<sv_derived_from_sv> to test
+directly on the actual object type.
 
 =cut
 */
diff --git a/t/op/coreamp.t b/t/op/coreamp.t
index d7700e0e1d..3320ff75d2 100644
--- a/t/op/coreamp.t
+++ b/t/op/coreamp.t
@@ -1162,9 +1162,9 @@ like $@, qr'^Undefined format "STDOUT" called',
     AUTOLOAD BEGIN CHECK CORE DESTROY END INIT UNITCHECK
     __DATA__ __END__
     and cmp default do dump else elsif eq eval for foreach format ge given goto
-    grep gt if last le local lt m map my ne next no or our package print printf
-    q qq qr qw qx redo require return s say sort state sub tr unless until use
-    when while x xor y
+    grep gt if isa last le local lt m map my ne next no or our package print
+    printf q qq qr qw qx redo require return s say sort state sub tr unless
+    until use when while x xor y
   );
   open my $kh, $keywords_file
     or die "$0 cannot open $keywords_file: $!";
diff --git a/t/op/coresubs.t b/t/op/coresubs.t
index 2ee63ef5fc..1fa11c02f0 100644
--- a/t/op/coresubs.t
+++ b/t/op/coresubs.t
@@ -17,7 +17,7 @@ use B;
 my %unsupported = map +($_=>1), qw (
  __DATA__ __END__ AUTOLOAD BEGIN UNITCHECK CORE DESTROY END INIT CHECK and
   cmp default do dump else elsif eq eval for foreach
-  format ge given goto grep gt if last le local lt m map my ne next
+  format ge given goto grep gt if isa last le local lt m map my ne next
   no  or  our  package  print  printf  q  qq  qr  qw  qx  redo  require
   return s say sort state sub tr unless until use
   when while x xor y
diff --git a/t/op/isa.t b/t/op/isa.t
new file mode 100644
index 0000000000..96a9c2139e
--- /dev/null
+++ b/t/op/isa.t
@@ -0,0 +1,49 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    require './test.pl';
+    set_up_inc('../lib');
+    require Config;
+}
+
+use strict;
+use feature 'isa';
+no warnings 'experimental::isa';
+
+plan 11;
+
+package BaseClass {}
+package DerivedClass { our @ISA = qw(BaseClass) }
+package CustomClass {
+   sub isa { length($_[1]) == 9; }
+}
+
+my $baseobj = bless {}, "BaseClass";
+my $derivedobj = bless {}, "DerivedClass";
+my $customobj = bless {}, "CustomClass";
+
+# Bareword package name
+ok($baseobj isa BaseClass, '$baseobj isa BaseClass');
+ok(not($baseobj isa Another::Class), '$baseobj is not Another::Class');
+
+# String package name
+ok($baseobj isa "BaseClass",         '$baseobj isa BaseClass');
+ok(not($baseobj isa "DerivedClass"), '$baseobj is not DerivedClass');
+
+ok($derivedobj isa "DerivedClass", '$derivedobj isa DerivedClass');
+ok($derivedobj isa "BaseClass",    '$derivedobj isa BaseClass');
+
+# Expression giving a package name
+my $classname = "DerivedClass";
+ok($derivedobj isa $classname, '$derivedobj isa DerivedClass via SV');
+
+# Invoked on instance which overrides ->isa
+ok($customobj isa "Something",          '$customobj isa Something');
+ok(not($customobj isa "SomethingElse"), '$customobj isa SomethingElse');
+
+ok(not(undef isa "BaseClass"), 'undef is not BaseClass');
+ok(not([] isa "BaseClass"),    'ARRAYref is not BaseClass');
+
+# TODO: Consider 
+#    LHS = other class
diff --git a/toke.c b/toke.c
index 6dcb6fe36b..ab358a1540 100644
--- a/toke.c
+++ b/toke.c
@@ -7800,6 +7800,11 @@ yyl_word_or_keyword(pTHX_ char *s, STRLEN len, I32 key, I32 orig_keyword, struct
     case KEY_ioctl:
         LOP(OP_IOCTL,XTERM);
 
+    case KEY_isa:
+        Perl_ck_warner_d(aTHX_
+            packWARN(WARN_EXPERIMENTAL__ISA), "isa is experimental");
+        Rop(OP_ISA);
+
     case KEY_join:
         LOP(OP_JOIN,XTERM);
 
diff --git a/universal.c b/universal.c
index 3658b9b8a1..a2d7d8682e 100644
--- a/universal.c
+++ b/universal.c
@@ -188,6 +188,74 @@ Perl_sv_derived_from_pvn(pTHX_ SV *sv, const char *const name, const STRLEN len,
 }
 
 /*
+=for apidoc sv_isa_sv
+
+Returns a boolean indicating whether the SV is an object reference and is
+derived from the specified class, respecting any C<isa()> method overloading
+it may have. Returns false if C<sv> is not a reference to an object, or is
+not derived from the specified class.
+
+This is the function used to implement the behaviour of the C<isa> operator.
+
+Not to be confused with the older C<sv_isa> function, which does not use an
+overloaded C<isa()> method, nor will check subclassing.
+
+=cut
+
+*/
+
+bool
+Perl_sv_isa_sv(pTHX_ SV *sv, SV *namesv)
+{
+    GV *isagv;
+
+    PERL_ARGS_ASSERT_SV_ISA_SV;
+
+    if(!SvROK(sv) || !SvOBJECT(SvRV(sv)))
+        return FALSE;
+
+    /* This abuse of gv_fetchmeth_pv() with level = 1 skips the UNIVERSAL
+     * lookup
+     * TODO: Consider if we want a NOUNIVERSAL flag for requesting this in a
+     * more obvious way
+     */
+    isagv = gv_fetchmeth_pvn(SvSTASH(SvRV(sv)), "isa", 3, 1, 0);
+    if(isagv) {
+        dSP;
+        CV *isacv = isGV(isagv) ? GvCV(isagv) : (CV *)isagv;
+        SV *retsv;
+        bool ret;
+
+        PUTBACK;
+
+        ENTER;
+        SAVETMPS;
+
+        EXTEND(SP, 2);
+        PUSHMARK(SP);
+        PUSHs(sv);
+        PUSHs(namesv);
+        PUTBACK;
+
+        call_sv((SV *)isacv, G_SCALAR);
+
+        SPAGAIN;
+        retsv = POPs;
+        ret = SvTRUE(retsv);
+        PUTBACK;
+
+        FREETMPS;
+        LEAVE;
+
+        return ret;
+    }
+
+    /* TODO: Support namesv being an HV ref to the stash directly? */
+
+    return sv_derived_from_sv(sv, namesv, 0);
+}
+
+/*
 =for apidoc sv_does_sv
 
 Returns a boolean indicating whether the SV performs a specific, named role.
diff --git a/warnings.h b/warnings.h
index 0677df1446..cf3d363ddc 100644
--- a/warnings.h
+++ b/warnings.h
@@ -127,6 +127,10 @@
 #define WARN_EXPERIMENTAL__UNIPROP_WILDCARDS 71
 #define WARN_EXPERIMENTAL__VLB		 72
 
+/* Warnings Categories added in Perl 5.031 */
+
+#define WARN_EXPERIMENTAL__ISA		 73
+
 
 /*
 =for apidoc Amnh||WARN_ALL
@@ -202,6 +206,7 @@
 =for apidoc Amnh||WARN_EXPERIMENTAL__PRIVATE_USE
 =for apidoc Amnh||WARN_EXPERIMENTAL__UNIPROP_WILDCARDS
 =for apidoc Amnh||WARN_EXPERIMENTAL__VLB
+=for apidoc Amnh||WARN_EXPERIMENTAL__ISA
 
 =cut
 */