isa-perl.pl

#!/usr/bin/env perl
# Times Perl's two ways of testing whether a value is an object of a class:
#
#   blessed($x) && $x->isa($class)   the isa method, guarded by blessed()
#   $x isa $class                    the infix isa operator (Perl 5.36+),
#                                    with the class in a variable
#
# plus blessed($x) alone for reference, on objects of various classes and
# on unblessed values.  Core Perl only.
#
#   perl isa-perl-issue.pl [--rounds N] [--time SECONDS] [--iters N]
#
# Times are ns per test, with the time of an empty loop subtracted, and
# the minimum over --rounds rounds.

use v5.36;
use Getopt::Long;
use Scalar::Util qw( blessed );
use Time::HiRes  qw( time );

GetOptions(
    'rounds=i' => \( my $ROUNDS = 5 ),
    'time=f'   => \( my $TIME   = 0.2 ),
    'iters=i'  => \( my $ITERS  = 100_000 ),
) or die "usage: $0 [--rounds N] [--time SECONDS] [--iters N]\n";

# --- test classes -----------------------------------------------------------
package Plain     { sub new { my $v = 0; bless \$v, shift } }      # blessed scalar ref
package Base      { sub new { bless {}, shift } }
package Deep1     { our @ISA = ('Base') }
package Deep2     { our @ISA = ('Deep1') }
package Deep3     { our @ISA = ('Deep2') }
package Deep4     { our @ISA = ('Deep3') }
package Deep5     { our @ISA = ('Deep4') }                         # five levels below Base
package OwnIsa    { sub new { bless {}, shift } sub isa { my ( $self, $c ) = @_; $c eq 'OwnIsa' } }
package Unrelated { sub new { bless {}, shift } }
package main;

# --- the timing loops -------------------------------------------------------
# Each loop runs one test $ITERS times.  The loops are identical except for
# the test, so subtracting the empty loop's time leaves the test's cost.

sub loop_empty   ( $x, $c ) { for ( 1 .. $ITERS ) { } }
sub loop_method  ( $x, $c ) { for ( 1 .. $ITERS ) { my $r = blessed($x) && $x->isa($c) } }
sub loop_blessed ( $x, $c ) { for ( 1 .. $ITERS ) { my $r = blessed($x) } }
sub loop_isa_var ( $x, $c ) { for ( 1 .. $ITERS ) { my $r = $x isa $c } }

# --- the values tested ------------------------------------------------------
# label, value, class to test against
my @cases = (
    [ 'Plain object, tested as Plain',     Plain->new,     'Plain'  ],
    [ 'Deep5 object, tested as Base',      Deep5->new,     'Base'   ],
    [ 'Deep5 object, tested as Deep5',     Deep5->new,     'Deep5'  ],
    [ 'OwnIsa object (overrides isa)',     OwnIsa->new,    'OwnIsa' ],
    [ 'Unrelated object, tested as Plain', Unrelated->new, 'Plain'  ],
    [ 'unblessed array ref',               [ 1, 2, 3 ],    'Plain'  ],
    [ 'unblessed hash ref',                { x => 1 },     'Plain'  ],
    [ 'plain scalar',                      42,             'Plain'  ],
    [ 'undef',                             undef,          'Plain'  ],
);

# --- sanity check that the method and the operator agree --------------------
for my $case (@cases) {
    my ( $label, $x, $c ) = @$case;
    my $method   = !!( blessed($x) && $x->isa($c) );
    my $operator = !!( $x isa $c );
    warn "note: method and operator disagree for $label (method $method, operator $operator)\n"
      if $method != $operator;
}

# --- timing -----------------------------------------------------------------
# ns per iteration of one loop: run it repeatedly for at least $TIME seconds
sub ns_per_iteration ( $loop, $x, $c ) {
    $loop->( $x, $c );                                    # warm up
    my $runs  = 0;
    my $start = time;
    do { $loop->( $x, $c ); $runs++ } while time - $start < $TIME;
    return 1e9 * ( time - $start ) / ( $runs * $ITERS );
}

my @tests = ( 'blessed && ->isa', 'blessed', 'isa op' );
my %best;                                   # $best{$label}{$test}: minimum ns

for my $round ( 1 .. $ROUNDS ) {
    for my $case (@cases) {
        my ( $label, $x, $c ) = @$case;

        my $empty = ns_per_iteration( \&loop_empty, $x, $c );
        my %ns;
        $ns{'blessed && ->isa'} = ns_per_iteration( \&loop_method,  $x, $c ) - $empty;
        $ns{'blessed'}          = ns_per_iteration( \&loop_blessed, $x, $c ) - $empty;
        $ns{'isa op'}           = ns_per_iteration( \&loop_isa_var, $x, $c ) - $empty;

        for my $test (@tests) {
            $best{$label}{$test} = $ns{$test}
              if !defined $best{$label}{$test} || $ns{$test} < $best{$label}{$test};
        }
    }
}

# --- report -----------------------------------------------------------------
printf "perl %vd on %s; %d rounds, minimum, empty-loop time subtracted\n\n", $^V, $^O, $ROUNDS;
printf "%-34s %17s %17s %17s\n", 'value (ns per test)', @tests;
for my $case (@cases) {
    my $label = $case->[0];
    printf "%-34s %14.1f ns %14.1f ns %14.1f ns\n", $label, @{ $best{$label} }{@tests};
}