Ref-Util-XS

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN


        * Allow the custom OPs to be deparsed with B::Deparse.
          (Graham @haarg Knop)
        * Optimize the shared object size by moving common call checker
          logic into a function. (James Raspass)

0.116     2017-05-13 15:13:41+02:00 Europe/Amsterdam

        * Changes rephrasing. (Ilmari)
        * Restore 5.6 compatibility
        * Replace docs with a link to Ref::Util

0.115     2017-05-12 09:48:02+02:00 Europe/Amsterdam

        * This (and 0.114) is effectively Ref-Util 0.113. It is being
          released as Ref-Util-XS to make room for Ref-Util's new
          pure-Perl implementation.

0.114

0.113     2017-01-16 19:36:58+01:00 Europe/Amsterdam

META.json  view on Meta::CPAN

{
   "abstract" : "XS implementation for Ref::Util",
   "author" : [
      "Sawyer X <xsawyerx@cpan.org>",
      "Aaron Crane <arc@cpan.org>",
      "Vikenty Fesunov <vyf@cpan.org>",
      "Gonzalo Diethelm <gonzus@cpan.org>",
      "Karen Etheridge <ether@cpan.org>",
      "Graham Knop <haarg@cpan.org>"
   ],
   "dynamic_config" : 0,
   "generated_by" : "Dist::Zilla version 6.010, CPAN::Meta::Converter version 2.150010",

META.json  view on Meta::CPAN

         },
         "requires" : {
            "B::Concise" : "0",
            "ExtUtils::MakeMaker" : "0",
            "File::Spec" : "0",
            "Test::More" : "0.96"
         }
      }
   },
   "provides" : {
      "Ref::Util::XS" : {
         "file" : "lib/Ref/Util/XS.pm",
         "version" : "0.117"
      }
   },
   "release_status" : "stable",
   "resources" : {
      "bugtracker" : {
         "web" : "https://github.com/p5pclub/ref-util-xs/issues"
      },
      "repository" : {

META.yml  view on Meta::CPAN

---
abstract: 'XS implementation for Ref::Util'
author:
  - 'Sawyer X <xsawyerx@cpan.org>'
  - 'Aaron Crane <arc@cpan.org>'
  - 'Vikenty Fesunov <vyf@cpan.org>'
  - 'Gonzalo Diethelm <gonzus@cpan.org>'
  - 'Karen Etheridge <ether@cpan.org>'
  - 'Graham Knop <haarg@cpan.org>'
build_requires:
  B::Concise: '0'
  ExtUtils::MakeMaker: '0'

META.yml  view on Meta::CPAN

configure_requires:
  ExtUtils::MakeMaker: '0'
dynamic_config: 0
generated_by: 'Dist::Zilla version 6.010, CPAN::Meta::Converter version 2.150010'
license: mit
meta-spec:
  url: http://module-build.sourceforge.net/META-spec-v1.4.html
  version: '1.4'
name: Ref-Util-XS
provides:
  Ref::Util::XS:
    file: lib/Ref/Util/XS.pm
    version: '0.117'
requires:
  Exporter: '5.57'
  XSLoader: '0'
  perl: '5.006'
resources:
  bugtracker: https://github.com/p5pclub/ref-util-xs/issues
  repository: git://github.com/p5pclub/ref-util-xs.git
version: '0.117'

Makefile.PL  view on Meta::CPAN

# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.010.
use strict;
use warnings;

use 5.006;

use ExtUtils::MakeMaker;

my %WriteMakefileArgs = (
  "ABSTRACT" => "XS implementation for Ref::Util",
  "AUTHOR" => "Sawyer X <xsawyerx\@cpan.org>, Aaron Crane <arc\@cpan.org>, Vikenty Fesunov <vyf\@cpan.org>, Gonzalo Diethelm <gonzus\@cpan.org>, Karen Etheridge <ether\@cpan.org>, Graham Knop <haarg\@cpan.org>",
  "CONFIGURE_REQUIRES" => {
    "ExtUtils::MakeMaker" => 0
  },
  "DISTNAME" => "Ref-Util-XS",
  "LICENSE" => "mit",
  "MIN_PERL_VERSION" => "5.006",
  "NAME" => "Ref::Util::XS",
  "PREREQ_PM" => {
    "Exporter" => "5.57",
    "XSLoader" => 0
  },
  "TEST_REQUIRES" => {
    "B::Concise" => 0,
    "ExtUtils::MakeMaker" => 0,
    "File::Spec" => 0,
    "Test::More" => "0.96"
  },

README  view on Meta::CPAN



This archive contains the distribution Ref-Util-XS,
version 0.117:

  XS implementation for Ref::Util

This software is Copyright (c) 2018 by Sawyer X.

This is free software, licensed under:

  The MIT (X11) License


This README file was generated by Dist::Zilla::Plugin::Readme v6.010.

XS.xs  view on Meta::CPAN

    SvGETMAGIC(ref);                                    \
    SETs( COND(cond) ? &PL_sv_yes : &PL_sv_no );        \
  }

#define DECL_RUNTIME_FUNC(x, cond)                              \
    static void                                                 \
    THX_xsfunc_ ## x (pTHX_ CV *cv)                             \
    {                                                           \
        dXSARGS;                                                \
        if (items != 1)                                         \
            Perl_croak(aTHX_ "Usage: Ref::Util::XS::" #x "(ref)");  \
        FUNC_BODY(cond);                                        \
    }

#define DECL_XOP(x) \
    static XOP x ## _xop;

#define DECL_MAIN_FUNC(x, cond)                 \
    static OP *                                 \
    x ## _op(pTHX)                              \
    {                                           \

XS.xs  view on Meta::CPAN

    static OP *                                                                \
    THX_ck_entersub_args_ ## x(pTHX_ OP *entersubop, GV *namegv, SV *ckobj)    \
    {                                                                          \
        return call_checker_common(aTHX_ entersubop, namegv, ckobj, x ## _op); \
    }

#if !USE_CUSTOM_OPS

#define DECL(x, cond) DECL_RUNTIME_FUNC(x, cond)
#define INSTALL(x, ref) \
    newXSproto("Ref::Util::XS::" #x, THX_xsfunc_ ## x, __FILE__, "$");

#else

#define DECL(x, cond)                           \
    DECL_RUNTIME_FUNC(x, cond)                  \
    DECL_XOP(x)                                 \
    DECL_MAIN_FUNC(x, cond)                     \
    DECL_CALL_CHK_FUNC(x)

#define INSTALL(x, ref)                                               \
    {                                                                 \
        CV *cv;                                                       \
        XopENTRY_set(& x ##_xop, xop_name, #x);                       \
        XopENTRY_set(& x ##_xop, xop_desc, "'" ref "' ref check");    \
        XopENTRY_set(& x ##_xop, xop_class, OA_UNOP);                 \
        Perl_custom_op_register(aTHX_ x ##_op, & x ##_xop);           \
        cv = newXSproto_portable(                                     \
            "Ref::Util::XS::" #x, THX_xsfunc_ ## x, __FILE__, "$"         \
        );                                                            \
        cv_set_call_checker(cv, THX_ck_entersub_args_ ## x, (SV*)cv); \
    }

// This function extracts the args for the custom op, and deletes the remaining
// ops from memory, so they can then be replaced entirely by the custom op.
/*
    This is how the ops will look like:

    $ perl -MO=Concise -E'is_arrayref($foo)'

XS.xs  view on Meta::CPAN

DECL(is_blessed_ref,       !PLAIN)
DECL(is_blessed_scalarref, JUSTSCALAR && !PLAIN)
DECL(is_blessed_arrayref,  REFTYPE(== SVt_PVAV) && !PLAIN)
DECL(is_blessed_hashref,   REFTYPE(== SVt_PVHV) && !PLAIN)
DECL(is_blessed_coderef,   REFTYPE(== SVt_PVCV) && !PLAIN)
DECL(is_blessed_globref,   REFTYPE(== SVt_PVGV) && !PLAIN)
DECL(is_blessed_formatref, FORMATREF && !PLAIN)
DECL(is_blessed_ioref,     REFTYPE(== SVt_PVIO) && !PLAIN)
DECL(is_blessed_refref,    REFREF && !PLAIN)

MODULE = Ref::Util::XS		PACKAGE = Ref::Util::XS

PROTOTYPES: DISABLE

BOOT:
    {
        INSTALL( is_ref, "" )
        INSTALL( is_scalarref, "SCALAR" )
        INSTALL( is_arrayref,  "ARRAY"  )
        INSTALL( is_hashref,   "HASH"   )
        INSTALL( is_coderef,   "CODE"   )

lib/Ref/Util/XS.pm  view on Meta::CPAN

package Ref::Util::XS;
# ABSTRACT: XS implementation for Ref::Util
$Ref::Util::XS::VERSION = '0.117';
use strict;
use warnings;
use XSLoader;

use Exporter 5.57 'import';

our %EXPORT_TAGS = ( 'all' => [qw<
    is_ref
    is_scalarref
    is_arrayref

lib/Ref/Util/XS.pm  view on Meta::CPAN

    is_blessed_arrayref
    is_blessed_hashref
    is_blessed_coderef
    is_blessed_globref
    is_blessed_formatref
    is_blessed_refref
>] );

our @EXPORT_OK   = ( @{ $EXPORT_TAGS{'all'} } );

XSLoader::load('Ref::Util::XS', $Ref::Util::XS::{VERSION} ? ${ $Ref::Util::XS::{VERSION} } : ());

if (_using_custom_ops()) {
  for my $op (@{$EXPORT_TAGS{all}}) {
    no strict 'refs';
    *{"B::Deparse::pp_$op"} = sub {
      my ($deparse, $bop, $cx) = @_;
      my @kids = $deparse->deparse($bop->first, 6);
      my $sib = $bop->first->sibling;
      if (ref $sib ne 'B::NULL') {
        push @kids, $deparse->deparse($sib, 6);

lib/Ref/Util/XS.pm  view on Meta::CPAN

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Ref::Util::XS - XS implementation for Ref::Util

=head1 VERSION

version 0.117

=head1 SYNOPSIS

    use Ref::Util;
    # Don't use Ref::Util::XS directly!

    if (is_arrayref($something) {
        print for @$something;
    }
    elsif (is_hashref($something)) {
        print for sort values %$something;
    }

=head1 DESCRIPTION

Ref::Util::XS is the XS implementation of Ref::Util, which provides several
functions to help identify references in a more convenient way than the
usual approach of examining the return value of C<ref>.

You should use L<Ref::Util::XS> by installing L<Ref::Util> itself: if the system
you install it on has a C compiler available, C<Ref::Util::XS> will be
installed and used automatically, providing a significant speed boost to
everything that uses C<Ref::Util>.

See L<Ref::Util> for full documentation of the available functions.

=head1 THANKS

The following people have been invaluable in their feedback and support.

=over 4

=item * Yves Orton

=item * Steffen Müller

t/all-permutations.t  view on Meta::CPAN

use strict;
use warnings;
use Test::More 'tests' => 5;
use Ref::Util::XS ':all';

use constant FORMAT_REFS_WORK => ("$]" >= 5.007);

# FIXME: plain regular expressions, blessed regular expressions

my $plain_formatref = do {
    format FH1 =
.
    *FH1{'FORMAT'};
};

t/all-permutations.t  view on Meta::CPAN


my @all_keys     = sort keys %all;
my @plain_keys   = sort keys %plain;
my @blessed_keys = sort keys %blessed;

subtest 'non-refs' => sub {
    foreach my $value ( 0, 1, 'string', '', undef, '0', '0e0' ) {
        # better string representation for test output
        my $rep = defined $value ? $value eq '' ? q{''} : $value : '(undef)';

        for my $name (grep /^is_/, @Ref::Util::XS::EXPORT_OK) {
            next if !FORMAT_REFS_WORK && $name =~ /formatref/;
            my $func = do { no strict 'refs'; \&{"Ref::Util::XS::$name"} };
            ok( !$func->($value), "$name($rep) is false" );
        }
    }

    done_testing();
};

subtest 'plain references only work on is_plain functions' => sub {
    # each %plain should fail each test of the %blessed
    foreach my $plain_type (@plain_keys) {

t/arrayref.t  view on Meta::CPAN

use strict;
use warnings;
use Test::More tests => 7;

BEGIN {
    use_ok('Ref::Util::XS');
    Ref::Util::XS->import('is_arrayref');
}

can_ok( Ref::Util::XS::, 'is_arrayref' );
Ref::Util::XS::is_arrayref(\1);

ok( !is_arrayref(\1), 'Correctly identify scalarref' );
ok( !is_arrayref({}), 'Correctly identify hashref' );
ok( !is_arrayref(sub {}), 'Correctly identify coderef' );
ok( !is_arrayref(qr//), 'Correctly identify regexpref' );
ok( is_arrayref([]), 'Correctly identify arrayref' );

t/b-concise.t  view on Meta::CPAN

use strict;
use warnings;
use Test::More;
use Ref::Util::XS 'is_arrayref';
require B::Concise;

plan skip_all => 'This version of B::Concise does not have "compile"'
    if !B::Concise->can('compile');

plan skip_all => 'nothing to do when no custom ops'
    if !Ref::Util::XS::_using_custom_ops();

plan tests => 2;

sub func { is_arrayref([]) }

my $walker = B::Concise::compile('-exec', 'func', \&func);
B::Concise::walk_output(\ my $buf);
eval { $walker->() };
my $exn = $@;

t/dynamic.t  view on Meta::CPAN

use strict;
use warnings;
use Ref::Util::XS;
use Test::More tests => 2;

my $cb = Ref::Util::XS->can('is_arrayref');
ok( $cb->([]), 'is_arrayref with can()' );
ok( !$cb->({}), 'is_arrayref with can()' );

t/expr.t  view on Meta::CPAN

use strict;
use warnings;
use Test::More tests => 1;
use Ref::Util::XS 'is_arrayref';

sub arrayref { [] }
ok( is_arrayref( arrayref() ), 'Got arrayref from expression' );

t/functions.t  view on Meta::CPAN

        [bless(sub {}),              'blessed code'],
        [$blessed_glob,              'blessed glob'],
        [do { bless \\(my $x = 1) }, 'blessed ref'],
        [$blessed_format,            'blessed format'],
    );

    plan tests => 26 * @cases + 1;  # extra one is for use_ok() above
}

BEGIN {
    use_ok('Ref::Util::XS');

    Ref::Util::XS->import(qw<
        is_ref
        is_scalarref
        is_arrayref
        is_hashref
        is_coderef
        is_regexpref
        is_globref
        is_formatref
        is_ioref
        is_refref

t/list.t  view on Meta::CPAN

use strict;
use warnings;
use Test::More tests => 2;
use Ref::Util::XS qw<is_arrayref is_hashref>;

# Call multiple routines in a single list expression:
my @got = ( is_arrayref([]), is_hashref({}) );

ok( $got[0], 'got arrayref in list context' );
ok( $got[1], 'got hashref in list context' );

t/magic-readonly.t  view on Meta::CPAN

use strict;
use warnings;
use Test::More;
use Ref::Util::XS qw<is_hashref is_plain_hashref is_blessed_hashref>;

eval { require Readonly; Readonly->import; 1; }
or plan 'skip_all' => 'Readonly is required for this test';

plan 'tests' => 3;

Readonly::Scalar( my $rh2 => { a => { b => 2 } } );

ok( is_hashref($rh2), 'Readonly objects work!' );
ok( is_plain_hashref($rh2), 'They are not plain!' );

t/magic.t  view on Meta::CPAN

use strict;
use warnings;
use Ref::Util::XS qw<is_arrayref>;
use Test::More 'tests' => 1;

my ( $x, $y );

{
    package Foo;
    sub TIESCALAR { bless {}, shift }
    sub FETCH { $x }
}

t/toomany.t  view on Meta::CPAN

use strict;
use warnings;
use Test::More tests => 6;
use Ref::Util::XS qw<is_arrayref is_hashref>;

my $array_func = \&is_arrayref;
my $hash_func = \&is_hashref;

is(prototype($array_func), '$', 'is_arrayref has "$" prototype');
is(prototype($hash_func), '$', 'is_hashref has "$" prototype');

# We have to use string eval for this, because when the custom op is being
# used, we expect the direct calls to fail at compile time
my @cases = (

t/toomany.t  view on Meta::CPAN

    [is_hashref => 'is_hashref([], 17)',
     'direct hash call with too many arguments'],
    [is_hashref => '$hash_func->([], 17)',
     'hash call through coderef with too many arguments'],
);

for my $case (@cases) {
    my ($name, $code, $desc) = @$case;
    scalar eval $code;
    my $exn = $@;
    like($exn, qr/^(?: \QUsage: Ref::Util::XS::$name(ref)\E
                     | \QToo many arguments for Ref::Util::XS::$name\E\b )/x,
         $desc);
}

tools/bench.pl  view on Meta::CPAN

use strict;
use warnings;
use constant { 'AMOUNT' => 1e8 };

use Ref::Util::XS qw<is_arrayref is_plain_arrayref is_plain_hashref>;
use Scalar::Util ();
use Data::Util ':check';
use Dumbbench;
use Dumbbench::Instance::PerlSub;

my $bench = Dumbbench->new(
    'target_rel_precision' => 0.005, # seek ~0.5%
    'initial_runs'         => 20,    # the higher the more reliable
);

my $amount = AMOUNT();
my $ref    = [];

no warnings;
$bench->add_instances(
    Dumbbench::Instance::PerlSub->new(
        'name' => 'Ref::Util::XS::is_plain_arrayref (CustomOP)',
        'code' => sub { Ref::Util::XS::is_plain_arrayref($ref) for ( 1 .. $amount ) },
    ),

    Dumbbench::Instance::PerlSub->new(
        'name' => 'ref(), reftype(), !blessed()',
        'code' => sub {
            ref $ref
                && Scalar::Util::reftype($ref) eq 'ARRAY'
                && !Scalar::Util::blessed($ref)
                for ( 1 .. $amount );
        },



( run in 0.381 second using v1.01-cache-2.11-cpan-a5abf4f5562 )